{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: IDFCONF867)}}
====== IDFCONF867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:AND|AND]], [[george:macro:BITDEFS|BITDEFS]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXU|BXU]], [[george:macro:DO|DO]], [[george:macro:ELSE|ELSE]], [[george:macro:FI|FI]], [[george:macro:FIXTRA|FIXTRA]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNTMISB|HUNTMISB]], [[george:macro:HUNTW|HUNTW]], [[george:macro:IDFOPEN|IDFOPEN]], [[george:macro:IF|IF]], [[george:macro:LGEOG|LGEOG]], [[george:macro:MFREECELL|MFREECELL]], [[george:macro:MGETCELL|MGETCELL]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MSEARCH|MSEARCH]], [[george:macro:MXB|MXB]], [[george:macro:NEW|NEW]], [[george:macro:REPEAT|REPEAT]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:THEN|THEN]], [[george:macro:UP|UP]], [[george:macro:WHILE|WHILE]]
22FL #SEG IDFCONF8 [A C PUTMAN
22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982
22^= #OPT K0IDFCONF=0
23DW #LIS K0IDFCONF>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF
23YG 8HIDFCONF
24D6 SEGENTRY K1IDFCONF,X1IDFCONF
24XQ SEGENTRY K2IDFCONF,X2IDFCONF
25CB #
25JJ ... SEGENTRY K3IDFCONF,X3IDFCONF
25PQ ...#
25X2 #
26BL # THIS SEGMENT IS FOR INSERTING INTO THE IDF A
26W= ...# CONFIGURATION REPORT ON A 7900 CHANNEL
27*W #
27TG #
28*6 # AWORK1: IF B0=1,B2-23 IS PROGRAM PROPERTY NO OF RELEVANT CI
28SQ # IF B0=0,B15-23 IS GEOG NO OF 7900
29#B # AWORK2: B0=1 IF CLUSTERING CHANGED
29S2 # B2-23: IF ZERO,CLOSE IDF BEFORE EXIT
2=?L #
2=R= #
2#=6 #
2#=? ...[
2#=D ...[ B11 OF WORD FOR IDENTIFIER IN CONFIG REPORT = 7502 LP OR PSEUDO DEVICE
2#=K ...[ ( WORD COPIED INTO X4 )
2#=Q ...[
2#=X ... BITDEFS 4,11,W7502LPPVDU
2#?9 ...[
2### ...[ MASKS FOR BITS TO BE COPIED FROM NEW TO OLD IDENT. CELL
2#*C ...[
2#BG ...ZCY #40300000 [FOR BTYPE
2#CK ... #03777777 [FOR BNUMB
2#DN ...[
2#FR ...[ MASKS FOR OLD CELL BITS TO BE RETAINED
2#GW ...[
2#H^ ...ZKEEP #37077777 [FOR BTYPE
2#K4 ... #74000000 [FOR BNUMB
2#L7 ...[
2#M= ...ZCEDI +BTYPE
2#N* ... +BNUMB
2#PQ #
2*9B XOPEN
2*P2 SBX 7 FX1
2B8L IDFOPEN XBRK
2BN= ADX 7 FX1
2C7W EXIT 7 0
2CMG XBRK
2D76 UP
2DLQ #
2F6B #
2FL2 # SUBROUTINE TO SEARCH FOR UNIT/CI CHANNEL CELL
2G5L #
2GK= #
2H4W ZMSEARCH
2HJG SBX 7 FX1
2J46 LDN 3 BIPB [BASE OF IPB CHAIN
2JHQ MSEARCH 2,3,4
2K3B SMO FX2
2KH2 LDX 0 ACOMMUNE1
2L2L BZE 0 XERR [J TO GEOERR IF UNIT NOT FOUND
2LG= LDX 0 BRECNO(2)
2L^W SMO FX2
2MFG STO 0 AWORK3 [RECORD NO OF UNIT/CI CHANNEL
2M^6 SMO FX2
2NDQ STO 3 AWORK4 [CELL PTR WITHIN RECORD
2NYB SMO 2
2PD2 LDX 5 BLINE(3) [PTR TO IDENTIFIER CHAIN
2PXL ADX 7 FX1
2QC= EXIT 7 0
2QWW #
2QXK ...[ SUBROUTINE TO FIND REC + CELL PTRS FOR CELL DEFINED IN AW3
2QY# ...UNITNEW
2Q^3 ... SMO FX2
2Q^Q ... LDX 3 AWORK3
2R2F ...[
2R38 ...[ FIND CELL DEFINED IN X3
2R3X ...[
2R4L ...NXTEC LDXC 0 3
2R5* ... SRL 0 9
2R64 ... ANDN 3 #777
2R6R ... TXU 0 BRECNO(2)
2R7G ... BCC (7)
2R89 ... BRN YNEW
2R8Y ...[
2R9M ...[
2R=B ...[ USE NXNEW IF X2 NOT IDF REC.
2R?5 ...[
2R?S ...NXNEW LDXC 0 3
2R#H ... SRL 0 9
2R*= ... ANDN 3 #777
2RBG #
2RW6 # SUBROUTINE TO SET X2 POINTING TO A1 OF FRRB CONTAINING RECORD
2S*Q # KNOWN TO BE IN CORE.ON ENTRY X0 CONTAINS RECORD NO REQD
2STB #
2T*2 #
2TSL YNEW
2W#= SMO FX2
2WRW STO 0 ACOMMUNE3
2X?G NEW 2
2XR6 EXIT 7 0
2XRB ...[
2XRL ...[ FIND CELL POINTED AT BY POINTER
2XRW ...[
2XS6 ...POINT
2XSB ... LDX 3 6
2XSL ... BRN NXTEC
2XSM ...SEARCH
2XSN ... SBX 6 FX1 [BROUGHT IN FROM IDFCANC
2XSP ... MSEARCH 2,3,4
2XSQ ... SMO FX2
2XSR ... LDX 0 ACOMMUNE1
2XSS ... ADX 6 FX1
2XST ... EXIT 6 0
2XSW ...#
2XSX ...[
2XT6 ...[ THIS SUB. IS FOR RE-CHAINING CELLS. X2 AND X3 POINT TO CELL WHICH
2XTB ...[ IS TO GET A NEW FPTR. X5 IS AN IDF POINTER WHICH WILL BECOME THE NEW
2XTL ...[ PPTR, BUT FIRST WE MUST CHECK B0. ON EXIT X5 GETS THE OLD FPTR.
2XTW ...[
2XW6 ...SCHAIN
2XWB ... ADX 3 2
2XWL ... LDXC 0 5
2XWW ... BZE 0 ZNCH [ J IF NEW FPTR ZERO
2XX6 ... SRL 01 9
2XXB ... TXU 0 BRECNO(2)
2XXL ... BCC ZAMRE [J IF RECNO OK
2XXW ... ORX 0 BIT9 [WILL BE B0
2XY6 ...ZAMRE SLL 01 9
2XYB ...ZNCH LDX 5 0(3) [SAVE OLD FPTR
2XYL ... STO 0 0(3) [STORE NEW ONE
2XYW ... EXIT 7 0
2X^6 ...[
2X^B ...[ SUB. TO UPDATE IDF-IDELETE BLOCK
2X^L ...[
2X^W ...SEDEL HUNTW 2,IDF,IDELETE
2Y26 ... BPZ 2 ZDELSET [J IF BLOCK ALREADY EXISTS
2Y2B ... SBX 7 FX1
2Y2L ... LDX 2 FX2
2Y2W ... SETUPCORE AWORK4(2),2,IDF,IDELETE
2Y36 ... STOZ A1(2) [INITIALISE A1
2Y3B ... ADX 7 1
2Y3L ...ZDELSET
2Y3W ... LDN 0 1
2Y46 ... ADS 0 A1(2) [UPDATE A1
2Y4B ... SMO A1(2)
2Y4L ... STO 4 A1(2) [STORE IDENT NO.
2Y4W ... EXIT 7 0
2Y56 ...[
2Y5B ...[ SUB. TO COPY PARTS OF BTYPE AND BNUMB FROM ONE CELL TO ANOTHER
2Y5L ...[
2Y5W ...UPDCE LDX 0 ZCY(1) [MASK OF BITS TO BE COPIED
2Y66 ... LDX 5 ZKEEP(1) [MASK OF BITS TO BE LEFT UNCHANGED
2Y6B ... ERX 0 4 [X4 USED TO ALTER WHICH BITS ARE...
2Y6L ... ERX 5 4 [...COPIED
2Y6W ... SMO ZCEDI(1) [GET TO CORRECT WD. IN CELL
2Y76 ... ANDX 0 0(2)
2Y7B ... SMO ZCEDI(1)
2Y7L ... ANDX 5 0(3)
2Y7W ... ORX 0 5 [SET UP NEW CONTENTS FOR CELL
2Y86 ... SMO ZCEDI(1)
2Y8B ... STO 0 0(3)
2Y8L ... EXIT 7 0
2Y8W ...[
2Y96 ...[
2Y=Q #
2YQB #
2^=2 # SUBROUTINE TO FIND CELL WHOSE IDF PTR IS IN X3 ON ENTRY.
2^PL # ON EXIT X2->A1 OF FRRB CONTAINING RECORD AND X3 CONTAINS
329= # CELL PTR WITHIN THE RECORD
32NW #
338G #
33N6 NEXCELL
347Q BPZ 3 YSAME [J IF CELL IN CURRENT RECORD
34MB SBX 7 FX1
3572 LDXC 0 3 [REMOVE B0
35LL SRL 0 9
366= LDX 2 FX2
36KW STO 0 ACOMMUNE3(2) [STORE NO OF NEXT RECORD REQD
375G MXB 2,NOFX12 [FIND NEXT RECORD
37K6 ADX 7 FX1
384Q YSAME
38JB ANDN 3 #777 [RELATIVE CELL PTR
3942 EXIT 7 0
39HL #
3=3= #
3=GW # SUBROUTINE TO OBTAIN A NEW CELL
3?2G #
3?G6 #
3?^Q YMGETCELL
3#FB SBX 7 FX1
3#^2 MGETCELL 2,3
3*DL ADX 7 FX1
3*Y= EXIT 7 0
3BCW #
3BXG #
3CC6 # SUBROUTINE TO FREE A CELL
3CWQ #
3DBB #
3DW2 YFREE
3F*L SBX 5 FX1
3FT= MFREECELL 2,3 [PTR GIVEN TO NEXT CELL ON CHAIN
3G#W ADX 5 FX1
3GSG EXIT 5 0
3H#6 #
45B= #
45C^ ...[ SUB TO SEE IF IDENT IN X0 IS CHANGED
45FN ...[ AW4 IS IDELETE ADDR. OR GSIGN IF NO IDELETE
45HC ...[
45K6 ...SCADL SMO FX2
45LT ... LDXC 1 AWORK4
45NJ ... BCS ZVND [J IF ALL IDENTS DELETED
45Q? ... BRN ZDELP
45S2 ...[
4H99 ...ZDELP
4H=# ... ADN 1 1
4H?C ... LDXC 7 A1(1)
4H#G ... BCS £ [UNSET B0
4H*K ... SBX 7 0
4HBN ... BZE 7 ZVND
4HCR ... BNG 7 ZDELP [J TO CHECK NEXT IDELETE ENTRY
4HDW ... EXIT 6 1 [IDENT NOT FOUND
4HF^ ...ZVND BPZ 1 (6) [EXIT UNLESS CALLED FROM RIGHTCONF
4HHB LDX 0 GSIGN
4J32 SMO FX2
4JGL ORS 0 AWORK2 [SET CLUSTER CHANGE MARKER
4K2= EXIT 6 0
4LF6 #
529C ...#
52=N ...#
52?^ ...# ENTRY FROM IDFTPUPD MACRO.ACOMMUNE1
52*= ...# CONTAINS DEVICE LIST PTR OF 7900
52BH ...#
52CS ...#
52F5 ...X1IDFCONF
52FP ... STOZ AWORK2(2)
52GB ... LGEOG ACOMMUNE1(2),4 [FIND GEOG NO FROM DEVICE LIST PTR
52HM ... STO 4 AWORK1(2) [KEEP GEOG NUMBER (B0 ZERO)
52JY ... CALL 7 XOPEN [OPEN THE IDF
52L9 ... BRN YIDFE
52L? ...#
52L* ...# ENTRY POINT TO DELETE ENTIRE CONFIGURATION
52LC ...# INCLUDING UNIT CELL. IDF ALREADY OPEN
52LF ...# CAN BE CALLED FROM SETIDF AT EMS IF IPB NOT
52LH ...# ON INSTALLATION.
52LK ...# ACOMMUNE2 CONTAINS GEOG UNIT NO
52LM ...#
52LP ...X3IDFCONF
52LR ... LDX 4 ACOMMUNE2(2)
52LT ... STO 4 AWORK1(2) [STORE UNIT NO
52LX ... STO 4 AWORK2(2)
52L^ ... BNZ 4 YIDF3
52M3 ... LDN 6 1 [MAKE SURE AWORK2
52M5 ... STO 6 AWORK2(2) [NON ZERO
52M7 ...YIDF3 LDN 0 0
52M9 ... CALL 7 YNEW [FIND REC NO ZERO
52M? ... BRN YIDFE
52MQ #
537B #
53M2 # ENTRY FROM IDFCIUPD MACRO.ACOMMUNE1 CONTAINS THE PROGRAM
546L # PROPERTY NUMBER WITH B0 SET IF THE IDF IS TO BE OPENED.
54L= # ACOMMUNE2 INDICATES WHETHER THE IDF IS TO BE CLOSED ON EXIT
555W #
55KG #
5656 X2IDFCONF
56JQ LDX 0 ACOMMUNE2(2) [MARKER WD : IF B2-23 ZERO CLOSE IDF
574B STO 0 AWORK2(2) [ON EXIT,OTHERWISE LEAVE OPEN
57J2 LDXC 4 ACOMMUNE1(2) [PROGRAM PROPERTY NUMBER
583L BCC YIDFC [J IF IDF ALREADY OPEN
58H= CALL 7 XOPEN [OPEN THE IDF
592W BRN YIDFD
59GG YIDFC
5=26 LDN 0 0
5=FQ CALL 7 YNEW [FIND RECORD ZERO
5=^B YIDFD
5?F2 ADX 4 GSIGN [SET B0 TO INDICATE CI REQD
5?YL SMO FX2
5#D= STO 4 AWORK1 [PRESERVE PROGRAM PROPERTY WD
5#N4 ...YIDFE
5#XW CALL 7 ZMSEARCH [SEARCH FOR UNIT/CI CHANNEL
5*X6 #
9FPW NOUASAT
9F^N ... LDX 7 5
9G9G HUNTW 1,IDF,IREPORT
9GP6 BNG 1 YNOBLK [J IF BLOCK NOT PRESENT
9H8Q LDN 5 1
9HNB SBS 5 A1(1)
9J82 LDX 0 A1(1)
9JML BZE 0 XNOENT [J IF NO ENTRIES IN IREPORT BLOCK
9K7= ADN 3 7 [TEMP BASE OF IDENT CHAIN IN CELL
9KLW SMO 5
9L6G LDX 4 A1(1) [FIRST ENTRY IN BLK
9LL6 CALL 7 YMGETCELL [OBTAIN NEW CELL ON TEMP CHAIN
9M5Q LDX 6 2 [RECORD PTR OF NEW FREE CELL
9MKB SMO FX2
9N52 LDX 0 AWORK3 [RECORD NO OF UNIT/CI CHANNEL CELL
9NJL CALL 7 YNEW [SET X2->START OF THIS RECORD
9P4= LDX 1 2
9PHW LDX 2 6
9Q3G SMO FX2
9QH6 ADX 1 AWORK4 [X1 IS ABS PTR TO UNIT/CI CELL
9R2Q LDX 7 BTYPE(1)
9RGB LDEX 6 7 [GEOG UNIT NO OR ZERO FOR CI CHANNEL
9S22 SRL 7 9
9SFL ORX 7 6
9S^= SMO 3
9TDW STO 7 BTYPE(2) [STORE TYPE OF UNIT AND GEOG NO
9TYG LDCT 0 #200
9WD6 SMO 3
9WXQ STO 0 BNUMB(2) [INDICATE MOPPED OFF IDENTIFIER
9XCB BNZ 6 YNEXENT [J IF NOT CI CHANNEL
9XX2 LDX 0 CIPROPNO(1)
9YBL SMO 3
9YW= STO 0 IPROPNO(2) [STORE PROGRAM PROPERTY NUMBER
9^*W YNEXENT
9^TG BPZ 4 XIDENT [J FOR IDENTIFIER ENTRY
=2*6 LDXC 0 4 [UNSET B0
=2SQ SRL 0 15 [PRESERVE LINE/TERM INDICATOR
=3#B ANDX 4 BSP16 [KEEP LS 15 BITS
=3S2 BNZ 0 XTERM [J IF TERMINAL
=4?L LDCT 0 #200 [MOPPED OFF IDENT
=4R= ADX 0 4 [SET TERM NUMBER BACK TO ZERO
=5=W SMO 3
=5QG STO 0 BNUMB(2) [STORE LINE NUMBER
=6=6 YREHUNT
=6PQ MHUNTW 1,IDF,IREPORT
=79B BXE 5 A1(1),XEND [J IF ALL ENTRIES DEALT WITH
=7P2 ADN 5 1
=88L SMO 5
=8N= LDX 4 A1(1) [NEXT ENTRY
=97W BRN YNEXENT
=9MG XTERM
==76 BCHX 2 £
==LQ SMO 3
=?6B DCH 4 BNUMB(2) [DEPOSIT TERM NUMBER IN CHAR 1
=?L2 BRN YREHUNT
=#5L XIDENT
=#K= LDX 0 4
=*4W ANDN 0 #7777 [IDENTIFIER NUMBER
=*JG SMO 3
=B46 STO 0 BNO(2)
=B5P ... LDX 1 FX1
=B7# ... ADX 1 TABLE7502ID(1) [ NO. OF 7502 ID + FX1
=B8X ... WHILE 1,U,FX1 [ MORE IDS IN TABLE
=B=G ... AND 0,U,TABLE7502ID(1) [ NOT SAME ID NO.
=B#5 ... DO
=B*N ... SBN 1 1
=BC? ... REPEAT
=BDW ... IF 1,U,FX1 [ IDENTIFIER IN TABLE OF 7502 IDS
=BGF ... THEN
=BJ4 ... LDX 1 2
=BKM ... ADX 1 3
=BM= ... BS 1,IDF7502LP
=BNT ... FI
=BQD ... IF BS,,W7502LPPVDU [ 7502 LP OR PSEUDO DEVICE
=BS3 ... THEN
=BTL ... LDX 1 2
=BX9 ... ADX 1 3
=BYS ... LDX 0 4
=C2C ... SRL 0 15
=C42 ... ANDN 0 #77
=C5K ... SBN 0 3
=C78 ... IF 0,ZE [ LP
=C8R ... THEN
=C=B ... BS 1,IDF7502LP
=C?^ ... ELSE
=C*J ... BS 1,IDFPSEUDO
=C*Y ... FIXTRA K20IDFCONF [++++++++++
=CB# ... LDCT 0 0 [TO #400 BY WRPVDUS
=CBN ... ORS 0 BTYPE(1) [POSSIBLY SET WRONGED
=CC7 ... FI
=CDQ ... FI
=CH2 LDX 0 4
=D2L SRL 0 15 [DEVICE TYPE IN BOTTOM 6 BITS
=DG= ... SRL 4 13 [INITIALLY B5-8 CONTAIN DEVICE TYPE
=HD2 SRC 4 1 [B10 IS SPOOLABLE BIT
=HXL BPZ 4 XSPOOLABLE
=JC= ERX 4 CACT [SET SPOOLABLE BIT
=JWW SBN 0 7
=KBG BZE 0 XSPOOLABLE [J IF TP:NOT SPOOLING
=KW6 LDCT 0 #20
=L*Q SMO 3
=LTB ORS 0 BNUMB(2) [SET SPOOLING BIT
=M*2 XSPOOLABLE
=MSL ... SRC 4 1 [INITIALLY B9 IS RJE OR AUTO-ANS BIT
=N#= ... BPZ 4 XRJE [J IF NOT RJE-AUTO-ANS
=NRW ... ERX 4 CACT [SET RJE-AUTO-ANS BIT FOR IDF
=PR6 XRJE
=Q2Y ... LDX 6 4 [SAVE X4 IN X6
=Q=Q SRC 4 6
=QCY ... LDCT 0 #177 [MASK FOR BITS 2-8 INCL
=QK6 ... ANDX 4 0 [MASK OUT DEVICE TYPE AND SPOOL&RJE
=QQB SMO 3
=R=2 ORS 4 BTYPE(2) [STORE DEVICE TYPE
=RBD ... SRC 6 6
=RGW ... BPZ 6 NWR [J. NOT MARKED WRONGED
=RM# ... LDCT 4 #400
=RRQ ... SMO 3
=RY8 ... ORS 4 BTYPE(2) [SET WRONGED BIT IN BTYPE
=S4L ...NWR MHUNTW 1,IDF,IREPORT
=S9= BXE 5 A1(1),XEND [J IF ALL ENTRIES DEALT WITH
=SNW ADN 5 1
=T8G SMO 5
=TN6 LDX 4 A1(1) [NEXT ENTRY
=W7Q #
=WMB #
=X72 # NEXT WE CHAIN A NEW CELL INTO THE TEMPORARY CHAIN
=XLL # AND COPY INFORMATION FROM THE PREVIOUS IDENT CELL
=Y6= #
=YKW #
=^5G LDX 6 BRECNO(2) [RECORD NO OF CURRENT IDENT CELL
=^K6 SLL 6 9
?24Q ADX 6 3 [ADD CELL PTR WITHIN REC
?2JB CALL 7 YMGETCELL [GET A NEW CELL ON TEMP CHAIN
?342 LDX 0 6
?3HL SRL 0 9 [RECORD NO OF PREVIOUS CELL
?43= LDX 1 2 [PRESERVE PTR TO REC OF NEW CELL
?4GW CALL 7 YNEW [FIND RECORD CONTAINING PREV CELL
?52G LDX 0 1
?5G6 LDX 1 2 [X1->START OF REC OF PREV CELL
?5^Q LDX 2 0 [X2->START OF REC OF NEW CELL
?6FB ANDN 6 #777
?6^2 ADX 1 6 [ABSOLUTE PTR TO PREVIOUS CELL
?7DL LDN 6 2(1)
?7Y= SMO 3
?8CW ... LDN 7 2(2) [TRANSFER CONTENTS OF WDS 2,3
?8XG ... MOVE 6 2 [IN IDENT CELL TO NEW CELL
?9C6 LDX 6 BSP16
?9WQ SMO 3
?=BB ANDS 6 2(2) [REMOVE DEVICE TYPE
??T= LDCT 6 #30
?##W SMO 3
?#SG ORS 6 BNUMB(2)
?*#6 SMO 3
?*RQ ERS 6 BNUMB(2) [CLEAR SPOOLING AND ATTENDED BITS
?B67 ... SMO 3
?BDJ ... STOZ 4(2) [ CLEAR WORD 4 OF CELL
?BR2 BRN YNEXENT
?C=L XEND
?CQ= ... FREECORE 1
?D9W #
?DPG #
?F96 # THE IDENTIFIER CELLS HAVE BEEN CHAINED FROM WORD 7 OF
?FNQ # THE UNIT CELL. THEY ARE NOW SORTED INTO ASCENDING ORDER
?G8B ...# AND CHAINED FROM WORD 6 OF UNIT CELL
?GN2 #
?H7L #
?H#S ... SMO FX2
?HG2 ... STOZ ACOMMUNE2
?HM= NEXTTEMP
?J6W LDX 2 FX2
?JLG LDX 0 AWORK3(2) [RECORD NO OF UNIT CELL
?K66 LDX 3 AWORK4(2) [CELL PTR WITHIN RECORD
?KKQ LDX 6 0
?L5B SLL 6 9
?LK2 ... ADN 6 6(3) [PTR TO BASE OF NEW IDENT CHAIN
?M4L CALL 7 YNEW [FIND RECORD OF UNIT
?MJ= LDX 4 2
?N3W ADX 3 2 [ABS PTR TO UNIT CELL
?NHG LDX 5 7(3) [PTR TO NEXT CELL ON TEMP CHAIN
?P36 BZE 5 XSTOP [J WHEN ALL CELLS SORTED
?PGQ LDN 0 1
?PT7 ... SMO FX2
?Q7J ... ADS 0 ACOMMUNE2 [INCREASE COUNT OF IDENTS
?QG2 BPZ 5 SAMEREC1 [J IF CELL IN SAME RECORD
?Q^L LDXC 0 5
?RF= SRL 0 9
?RYW CALL 7 YNEW [FIND REC OF CURRENT IDENT CELL
?SDG SAMEREC1
?SY6 LDX 1 2 [SO X1->REC OF CURRENT IDENT CELL
?TCQ ANDN 5 #777 [CELL PTR WITHIN IDENT RECORD
?TXB LDX 2 4 [RESTORE PTR TO RECORD OF UNIT
?WC2 SMO 5
?WWL LDX 4 0(1) [PTR TO NEXT CELL ON TEMP CHAIN
?XB= BZE 4 TEMPJOIN [J IF NO FURTHER CELLS
?XTW SMO 5
?Y*G STOZ 0(1) [CLEAR FPTR IN IDENT CELL
?YT6 LDXC 0 4
?^#Q SRL 0 9
?^SB ORX 4 GSIGN
#2#2 BXU 0 BRECNO(2),TEMPJOIN [J IF RECORDS OF UNIT CELL
#2RL ERX 4 GSIGN [AND NEXT TEMP CELL DIFFER
#3?= TEMPJOIN
#3QW STO 4 7(3) [STORE PTR TO 1ST TEMP CELL IN BASE
#4=G ... LDX 4 6(3) [PTR TO 1ST IDENT ON PROPER CHAIN
#4Q6 SMO 5 [X1,X5->IDENT TO BE CHAINED
#59Q LDX 3 BNO(1) [IDENT NO OF CELL TO BE CHAINED
#5PB NEXTIDENT
#692 BZE 4 XENDCHAIN [J AT END OF CHAIN
#6NL BPZ 4 SAMEREC2
#78= LDXC 0 4
#7MW SRL 0 9
#87G CALL 7 YNEW [X2->REC OF 1ST IDENT ON CHAIN
#8M6 SAMEREC2
#96Q ANDN 4 #777 [CELL PTR WITHIN RECORD
#9LB SMO 4
#=62 TXL 3 BNO(2)
#=KL BCS XFRONT [J WHEN HIGHER IDENT NO FOUND
#?5= LDX 6 BRECNO(2)
#?JW SLL 6 9 [OTHERWISE SET PTR TO LAST
##4G ADX 6 4 [CELL EXAMINED ON PROPER CHAIN
##J6 SMO 4
#*3Q LDX 4 0(2) [NEXT IDENT ON PROPER CHAIN
#*HB BRN NEXTIDENT
#B32 XENDCHAIN
#BGL SMO FX2
#C2= STO 3 ACOMMUNE1 [STORE NEW HIGHEST IDENT NO
#CFW XFRONT
#C^G LDX 4 BRECNO(1)
#DF6 SLL 4 9 [SET UP COMBINED PTR TO
#DYQ ADX 4 5 [IDENT CELL TO BE CHAINED
#FDB LDX 2 1
#FY2 LDX 0 6 [X6 CONTAINS IDF POINTER OF
#GCL SRL 0 9 [WORD WHICH WILL POINT TO NEW IDENT
#GX= BXE 0 BRECNO(1),SAMEREC3
#HBW CALL 7 YNEW [SO X2->REC OF THIS WORD
#HWG ORX 4 GSIGN
#JB6 SAMEREC3
#JTQ ANDN 6 #777 [REL PTR OF WORD WITHIN RECORD
#K*B SMO 6
#KT2 LDX 3 0(2) [NEXT PTR ON PROPER CHAIN
#L#L SMO 6
#LS= STO 4 0(2) [SET UP PTR TO CURRENT IDENT
#M?W BZE 3 RECHAIN [J AT END OF PROPER CHAIN
#MRG LDXC 0 3
#N?6 SRL 0 9
#NQQ ORX 3 GSIGN
#P=B BXU 0 BRECNO(1),RECHAIN [J IF RECORDS OF CURRENT IDENT AND
#PQ2 ERX 3 GSIGN [NEXT IDENT ON PROPER CHAIN DIFFER
#Q9L RECHAIN
#QP= SMO 5
#R8W STO 3 0(1) [STORE FPTR IN CURRENT IDENT CELL
#RNG BRN NEXTTEMP
#S86 XSTOP
#S8? ...[
#S8D ...[ NOW X3 HAS ADDR. OF UNIT CELL. AW3 AND AW4 POINT TO UNIT CELL.
#S8K ...[
#S8Q ... LDX 0 BLINE(3)
#S8X ... BZE 0 NOLDS [ ANY IDENTS ON OLD CHAIN?
#S94 ... LDX 2 FX2
#S99 ... LDX 6 AWORK3(2) [[SET UP IDF PTR TO UNIT CELL
#S9B ... SLL 6 9
#S9H ... ADX 6 AWORK4(2)
#S9N ... STO 6 AWORK3(2) [[AND KEEP IN AW3
#S9T ... ADN 6 BLINE [SET UP IDF POINTER TO BASE OF
#S=2 ...[ TEMP CHAIN
#S=7 ... LDX 0 BNUMB(3)
#S=# ... ANDN 0 #7777
#S=F ... ADN 0 2
#S=L ... STO 0 AWORK4(2) [SAVE LTH FOR IDELETE
#S=R ...[ IDENT. CHAIN
#S=Y ...PREZA CALL 7 UNITNEW [[FIND UNIT CELL
#S?5 ...ZAY SMO 3
#S?= ... LDX 4 6(2) [PICK UP PTR. TO NEXT TEMP CELL
#S?C ...[
#S?J ... CALL 7 POINT [GET PTR TO NEXT CELL ON IDENT CHAIN
#S?P ... SMO 3
#S?W ... LDX 5 0(2)
#S#3 ...ZNXTECE
#S#8 ... BZE 5 ZENOCH [IS THIS IDF PTR. ZERO - J IF SO
#S#* ... LDX 3 5
#S#G ... CALL 7 NEXCELL [GET NEXT CELL ON OLD CHAIN
#S#M ...[ ( MAY NOT BE IN CORE)
#S#S ... ADX 2 3
#S#^ ... LDX 1 2
#S*6 ... LDX 3 4
#S*? ... LDX 4 BNO(1) [AND PICK UP OLD IDENT. NO. (M)
#S*D ... BZE 3 ZDELED [J IF REACHED END OF TEMP CHAIN
#S*K ... CALL 7 NXNEW
#S*Q ... SMO 3
#S*X ... LDX 0 BNO(2) [LOAD NEW IDENT NO. (N)
#SB4 ... SBX 0 4
#SB9 ... BNG 0 ZADDED [J IF M>N (EXTRA IDENT ADDED)
#SBB ... BNZ 0 ZDELED [J IF N>M (IDENT DELETED)
#SBH ...[ IDENT NOS SAME - CHECK DEVICE TYPE
#SBN ... LDX 6 5
#SBT ... ADX 2 3
#SC2 ... LDX 3 1 [JUST TO BE CONVENTIONAL USE X1=FX1
#SC7 ... LDX 1 FX1
#SC# ... LDCH 0 BTYPE(3)
#SCB ... ANDN 0 #37 [LOOSE RI WR BIT
#SCF ... LDCH 7 BTYPE(2)
#SCH ... ANDN 7 #37 [LOOSE RI WR BIT
#SCL ... ERX 0 7
#SCR ... BNZ 0 ZALTY [J IF DEV TYPE CHANGED
#SCY ...[
#SD5 ...[ NOW SEE IF BOTH OLD AND NEW MARKED SPOOLABLE
#SD= ... LDCT 4 1
#SDC ... ANDX 4 BTYPE(2)
#SDJ ... ANDX 4 BTYPE(3)
#SDP ... BZE 4 NSPBL [J IF NOT
#SDW ... LDCT 4 #30 [SET X4 SO WE COPY SPOOLING + ATT.
#SF3 ...NSPBL ADN 1 1
#SF8 ... CALL 7 UPDCE [UPDATE BNUMB
#SF* ... SBN 1 1
#SFG ... LDN 4 0
#SFM ... CALL 7 UPDCE [UPDATE BTYPE
#SFN ... LDX 0 4(2)
#SFP ... STO 0 4(3) [ UPDATE WORD 4
#SFQ ... FIXTRA K21IDFCONF [++++++++++
#SFR ... BRN ZNO [NULL BY WRPVDUS
#SFS ... LDX 0 BTYPE(3)
#SFT ... SLL 0 1
#SFW ... BPZ 0 ZNO [J IF NOT PSEUDO
#SFX ... LDCT 0 #400
#SFY ... ORS 0 BTYPE(3) [SET WRONGED BIT
#SF^ ...ZNO
#SG2 ...[ NOW FREE TEMP CELL
#SG3 ...RELCY
#SG6 ... CALL 7 UNITNEW
#SG? ... ADN 3 6 [POINT TO TEMP CHAIN
#SGD ... CALL 5 YFREE [FREE CELL
#SGK ... SBN 3 6
#SGQ ... BRN ZAY [GO TO DEAL WITH NEXT CELLS
#SGX ...[
#SH4 ...[ DEVICE TYPE CHANGED - RESET BNUMB , BTYPE AND WORD 4
#SH9 ...[
#SHB ...ZALTY
#SHH ... LDX 0 BTYPE(2)
#SHN ... STO 0 BTYPE(3)
#SHT ... LDX 0 BNUMB(2)
#SJ2 ... STO 0 BNUMB(3)
#SJ3 ... LDX 0 4(2)
#SJ4 ... STO 0 4(3)
#SJ7 ... ORX 4 GSIGN [SET MARKER" CHANGED BUT NOT DELETED"
#SJ# ...[ FOR IDELETE BLOCK
#SJF ... CALL 7 SEDEL [UPDATE IDELETE
#SJL ... BRN RELCY
#SJR ...[
#SJY ...[
#SK5 ...[ DELETED IDENT.
#SK= ...[
#SKC ...ZDELED
#SKJ ... LDX 6 5
#SKP ... CALL 7 SEDEL [UPDATE IDELETE BLOCK
#SKW ... BRN PREZA [GO ON TO NEXT IDENT.
#SL3 ...[
#SL8 ...[ END OF OLD CHAIN
#SL* ...[
#SLG ...ZENOCH
#SLM ... BZE 4 TWEX [J IF NEW CHAIN ENDED TOO
#SLS ... LDX 3 4
#SL^ ... CALL 7 NXTEC [ELSE FIND NEW CELL
#SM6 ... SMO 3
#SM? ... LDX 0 BNO(2) [SAVE IDENT. NO.
#SMD ...[
#SMK ...[ EXTRA CELL TO BE INCLUDED. X5 IS CURR
#SMQ ...[
#SMX ...ZADDED
#SN4 ... LDX 4 0 [NEW HIGHEST IDENT. IF END OF OLD CHN
#SN9 ... CALL 7 SCHAIN [MAKE FPTR. POINT.TO CURRENT OLD CELL
#SNB ... CALL 7 UNITNEW [BACK TO UNIT CELL
#SNH ... BNG 4 NOFIO [J UNLESS OLD CHAIN FINISHED
#SNN ... SMO 3
#SNT ... STO 4 5(2) [STORE NEW HIGHEST IDENT. NO.
#SP2 ...NOFIO LDN 0 1
#SP7 ... SMO 3
#SP# ... ADS 0 BNUMB(2) [INCREASE NO. IDENTS.
#SPF ... LDX 4 5 [SAVE IDF PTR. TO NEXT TEMP CELL
#SPL ... ADN 3 6 [POINT TO BASE OF TEMP CHAIN
#SPR ... CALL 7 SCHAIN [UPDATE FIRST TEMP CELL PTR.
#SPY ... LDX 3 6
#SQ5 ... LDX 6 5 [UPDATE POINTER P
#SQ= ... CALL 7 NXTEC [FIND PREVIOUS POINTED CELL
#SQC ... CALL 7 SCHAIN [MAKE IT POINT AT NEW POINTED CELL
#SQJ ...[
#SQP ...[ NOW X5 PTS. TO THE NEXT OLD CELL TO BE DEALT WITH AND X4 IS NEXT TEMP
#SQW ...[ CELL - SO GO BACK TO COMPARE THESE CELLS
#SR3 ... BRN ZNXTECE
#SR8 ...[
#SR* ...[ NO OLD CELLS ON UNIT
#SRG ...[
#SRM ...NOLDS LDX 0 6(3)
#SRS ... STO 0 BLINE(3) [RECHAIN TEMP CELLS AS IDENT CHN
#SR^ ... STOZ 6(3)
#SS6 ... LDX 2 FX2
#SS? ... LDX 0 ACOMMUNE2(2)
#SSD ... DSA 0 BNUMB(3)
#SSK ... LDX 0 ACOMMUNE1(2)
#SSQ ... STO 0 5(3)
#ST4 ...#
#ST9 ...# HAVING ESTABLISHED THAT THERE WERE IDENTIFIERS ON THE OLD
#STB ...# CONFIGURATION WE REMOVE FROM THE APERI/CONSOLE BLOCK ALL
#STH ...# ENTRIES REFERRING TO NOMINATED CONSOLES ON THE OLD
#STN ...# CONFIGURATION. (THE APERI/CONSOLE ENTRIES CORRESPOND TO
#STT ...# REMOTE NOMINATED CONSOLES ON ALL CI CHANNELS AND ON
#SW2 ...# 7900S ON THE CURRENT INSTALLATION.) THIS ROUTINE MUST
#SW7 ...# NOT COORDINATE.
#SW# ...#
#SWF ...#
#SWG ...TWEX
#SX6 ... HUNTW 1,IDF,IDELETE
#SX7 ... BNG 1 ZENCN
#SX8 ... NGN 0 1
#SX9 ... SMO A1(1)
#SX= ... STO 0 A1+1(1) [SET -1 AFTER LAST IDENT WD
#SXC ...TEACO SMO FX2
#SXJ ... STO 1 AWORK4
#SXP ... HUNTMISB 2,APERI,CONSOLE [HUNT ALONG MISC CHAIN
#SXW ... BNG 2 SNOMINIDF [BLOCK ABSENT
#SY3 ... LDX 1 2
#SY8 ... SMO FX2
#SY* ... LDX 7 AWORK1 [MARKER OF TYPE OF ENTRY
#SYG ... LDX 3 A1(1) [NO OF WORDS IN USE
#SYM ... SBN 3 2 [2 RED TAPE WORDS
#SYS ... BZE 3 SFREECONS
#SY^ ...THISENTRY
#S^6 ... LDX 5 A1+1(2)
#S^? ... BPZ 5 NEXTENTRY [J IF CONSOLE ON MX/UX
#S^D ... LDX 4 A1+2(2)
#S^K ... LDX 0 4
#S^Q ... ANDN 0 #7777
#S^X ... SRL 4 12 [7900 GEOG NO OR ZERO FOR CI
#T3L ... LDEX 6 7
#T3R ...TESTENTRY
#T3Y ... ERX 6 4 [COMPARE GEOG OR PROP NOS
#T45 ... ANDX 6 BITS22LS [CLEAR B0,B1
#T4= ... BNZ 6 NEXTENTRY [J IF NO MATCH
#T4C ...[
#T4J ...[ SAVE X1 AND X7
#T4P ... LDX 4 1
#T4W ... LDX 5 7
#T53 ... CALL 6 SCADL
#T58 ... LDN 6 0 [IDENT UNCHANGED
#T5* ...[ RESTORE X1 AND X7
#T5G ... LDX 1 4
#T5M ... LDX 7 5
#T5S ... BNZ 6 NEXTENTRY [J IF IDENT UNCHANGED
#T5^ ... SBN 3 HUIDGENTLEN
#T66 ... LDN 4 A1+1+HUIDGENTLEN(2) [MOVE UP ENTRIES
#T6? ... LDN 5 A1+1(2) [AT LEAST ZERO WORD
#T6D ... MOVE 4 1(3) [TO BE MOVED
#T6K ... LDN 0 HUIDGENTLEN
#T6Q ... SBS 0 A1(1) [UPDATE NO OF USED WORDS
#T6X ... BNZ 3 THISENTRY [J IF MORE TO EXAMINE
#T74 ... BRN SCHECKLEN
#T79 ...NEXTENTRY
#T7B ... ADN 2 HUIDGENTLEN
#T7H ... SBN 3 HUIDGENTLEN
#T7N ... BNZ 3 THISENTRY [J IF MORE TO EXAMINE
#T7T ...SCHECKLEN
#T82 ... LDX 3 A1(1)
#T87 ... SBN 3 2
#T8# ... BZE 3 SFREECONS [J IF NO USED ENTRIES
#T8F ... LDX 2 ALOGLEN(1)
#T8L ... SBX 2 A1(1) [IF MORE THAN 5 UNUSED ENTRIES
#T8R ... SBN 2 5*HUIDGENTLEN+1 [CHANGE LOGICAL LENGTH
#T8Y ... BNG 2 SNOMINIDF
#T95 ... LDX 2 A1(1) [SET LOGICAL LENGTH EQUAL TO
#T9= ... ALTLENG 1,2 [NO OF USED WORDS
#T9C ... BRN SNOMINIDF
#T9J ...SFREECONS
#T9P ... FREECORE 1 [FREE APERI/CONSOLE BLOCK
#T=B ...SNOMINIDF
#T?3 ... ACROSS IDFCONFA,1
#T?N ...#
#T#* ...XDELETE
#T*2 ... LDX 6 BRECNO(2)
#T*M ... SLL 6 9
#TB# ... ADX 6 3 [IDF PTR TO CI UNIT CELL (B0 CLEAR)
#TB^ ... LDN 0 0
#TCL ... CALL 7 YNEW [FIND RECORD ZERO
#TD? ... LDN 3 BIPB [PTR TO BASE OF IPB CHAIN
#TDY ...YNEXUN
#TFK ... SMO 3
#TG= ... LDX 4 0(2) [PTR TO NEXT UNIT
#TGX ... BZE 4 XERR [J IF NOT FOUND TO GEOERR
#THJ ... LDXC 0 4 [UNSET B0 IF NECESSARY
#TJ9 ... BCS £
#TJW ... BXE 0 6,UFOUND [J IF PTR TO UNIT CELL FOUND
#TKH ... BPZ 4 UNEXT [J IF NEXT UNIT IN CURRENT RECORD
#TL8 ... SRL 0 9
#TLT ... CALL 7 YNEW [FIND REC CONTAINING NEXT UNIT CELL
#TMG ...UNEXT
#TN7 ... LDEX 3 4 [CELL PTR WITHIN RECORD
#TNS ... BRN YNEXUN
#TPF ...UFOUND
#TQ6 ... CALL 5 YFREE
#TQR ...#
#TRD ...XFINISH
#TS5 ...ZENCN ACROSS IDFCONFA,2
#TSQ ...#
#WCN ...#
#WCT ...#
#WL= #
#X5W ...XNOENT
#XKG ...[ IREPORT WITH NO ENTRIES
#Y56 ... FREECORE 1
#YJQ ... BZE 7 XFINISH [J IF NO IDENT CELLS
#^4B ... BRN SALDL
#^J2 ...[
*23L ...YNOBLK
*2H= ...[ NO IREPORT
*32W ... BZE 7 XDELETE [J IF NO IDENT CELLS
*3GG ... LDCT 0 #200
*426 ... SMO FX2
*4FQ ... ORS 0 AWORK2 [REMEMBER FREE UNIT CELL
*4^B ...SALDL
*5F2 ...[ SET "ALL IDENTS DELETED"
*5WQ ... LDCT 1 #400
*5YL ... BRN TEACO
*MJN ...[
*ML= ...[ TABLE OF IDENTIFIERS TO BE MADE 7502 LP
*MMS ...[
*MNK ...XERR GEOERR 1,UNITILL
*MPB ...#OPT IDF7502IDS = 20
*MXL ... SEGENTRY K90IDFCONF
*N5W ...TABLE7502ID 0
*N#6 ...#GAP IDF7502IDS
*NGB #END
^^^^ ...243402650001