IDFCONF867
(George Source)
Macros used: ACROSS, ALTLENG, AND, BITDEFS, BS, BXE, BXU, DO, ELSE, FI, FIXTRA, FREECORE, GEOERR, HUNTMISB, HUNTW, IDFOPEN, IF, LGEOG, MFREECELL, MGETCELL, MHUNTW, MSEARCH, MXB, NEW, REPEAT, SEGENTRY, SETUPCORE, THEN, UP, WHILE
- IDFCONF867.txt
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