16 22FL #SEG IDFCANC8 [G CONSTANTINIDES 13 22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982 8 22_= #OPT K0IDFCANC=0 16 23DW #LIS K0IDFCANC>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF 10 23YG 8HIDFCANC8 7 24D6 # ENTRY POINTS 12 24XQ SEGENTRY K1IDFCANC,Z1IDFCANC 12 25CB SEGENTRY K2IDFCANC,Z2IDFCANC 12 25X2 SEGENTRY K3IDFCANC,Z3IDFCANC 4 26#J ...# 11 26BL MENDAREA 50,K100IDFCANC 16 26W= XILLUN +ILLUN [ILLEGAL UNIT NO 16 27*W XILLINE +ILLINE [ILLEGAL LINE NO 17 27TG XILLIDE +ILLIDE [ILLEGAL IDENTIFIER 20 28*6 XINTEM +INTERM [7020 TERM/INTERFACE NOT IN IDF 4 28SQ # 19 29#B # THIS IS EXACTLY THE SAME IN IDFASAT-SEE IDFASAT FOR COMMENTS 19 29S2 PARSORT [CPAR/JSCE MUST ALREADY EXIST 21 2=?L [AND IT MUST DESCRIBE AN IPB,UX,MPX 10 2=R= MHUNTW 3,CPAR,JSCE 17 2?=W LDX 1 JSCEP(3) [DEVICE LIST POINTER 8 2?QG LGEOG 1,6 9 2#=6 LDX 4 JSCEB(3) 9 2#PQ BNG 4 XREMDEV 7 2*9B LDN 5 0 8 2*P2 BRN XFINI 5 2B8L XREMDEV 7 2BN= SLL 4 1 9 2C7W LDX 5 JSCEA(3) 9 2CMG BPZ 4 XONUXMX 8 2D76 LDCT 0 #400 7 2DLQ ORX 6 0 8 2F6B ANDN 5 #7777 8 2FL2 BRN XFINI 5 2G5L XONUXMX 7 2GK= SLL 5 6 8 2H4W BZE 5 XNOID 8 2HJG LDCT 0 #200 7 2J46 ORX 6 0 5 2JHQ XNOID 8 2K3B SRL 4 10 7 2KH2 DCH 4 5 10 2L2L XFINI STO 5 ACOMMUNE4(2) 10 2LG= STO 6 ACOMMUNE3(2) 8 2L_W LDX 1 FX1 7 2MFG EXIT 7 0 14 2M_6 OPEN SBX 6 FX1 [OPEN IDF 8 2N8Y ... IDFOPEN XBRK 8 2NYB ADX 6 FX1 7 2PD2 EXIT 6 0 5 2PMS ...XBRK UP 4 2PXL # 6 2QC= WRITECLOSE 8 2QWW SBX 7 FX1 7 2RBG IDFWRITE 8 2RW6 BRN WR 5 2S*Q ZCLOSE 8 2STB SBX 7 FX1 9 2T*2 MFREEALL FILE,FRRB 6 2TSL WR CLOSE 8 2W#= ADX 7 FX1 7 2WRW EXIT 7 0 4 2X?G # 8 2XR6 SELL SBX 7 FX1 8 2Y=Q MGETCELL 2,3 8 2YQB ADX 7 FX1 7 2_=2 EXIT 7 0 4 2_PL # 19 329= SFREE SBX 6 FX1 [FREE CELL ONTO FREE CHAIN 8 32NW MFREECEL 2,3 8 338G ADX 6 FX1 7 33N6 EXIT 6 0 4 347Q # 5 34MB SEARCH 8 3572 SBX 6 FX1 8 35LL MSEARCH 2,3,4 8 366= SMO FX2 9 36KW LDX 0 ACOMMUNE1 8 375G ADX 6 FX1 7 37K6 EXIT 6 0 4 384Q # 5 38JB RECFIND 8 3942 LDX 2 FX2 10 39HL REC HUNT2 2,FILE,FRRB 10 3=3= TXU 6 BRECNO+A1(2) 8 3=GW BCS REC 8 3?2G ADN 2 A1 7 3?G6 EXIT 7 0 4 3?_Q # 18 3#FB YREC BPZ 3 SAME [FIND CELL X3 POINTS TO 8 3#_2 YREC1 SBX 6 FX1 7 3*DL LDX 0 3 7 3*Y= SRL 0 9 8 3BCW ANDN 0 #7777 8 3BXG LDX 2 FX2 10 3CC6 STO 0 ACOMMUNE3(2) 7 3CWQ MXB 2 8 3DBB ADX 6 FX1 8 3DW2 SAME ANDN 3 #777 7 3F*L EXIT 6 0 4 3FT= # 14 3G#W TRACE LDX 4 ACOMMUNE3(2) [UNIT NO 17 3GSG LDX 5 ACOMMUNE4(2) [LINE/IDENTIFIER NO 8 3H#6 SBX 7 FX1 10 3HRQ LDX 0 ACOMMUNE2(2) 18 3J?B STO 0 AWORK2(2) [KEEP PROPERTY PARAMETER 8 3JR2 CALL 6 OPEN 15 3K=L BNG 4 T7900 [J.IF 7900 8 3KQ= LDN 3 BUNIT 9 3L9W CALL 6 SEARCH 19 3LPG BZE 0 UINV [J.IF NOT FOUND-INVALID UNIT 9 3M96 LDN 3 BLINE(3) 21 3MNQ SLL 4 1 [MOVE UP B1(SET IF 7020 INFO. IN X5) 16 3N8B ANDX 4 GSIGN [AND ONLY KEEP B1 16 3NN2 DCH 5 4 [LINE NO INTO X4 9 3P7L CALL 6 SEARCH 19 3PM= BZE 0 MINV [J.IF NOT FOUND-INVALID LINE 17 3Q6W BPZ 4 TR1 [J.IF NO IDENTIFIER 18 3QLG SMO 2 [NOW KEEP X4 AS MARKER 9 3R66 LDX 3 BLINE(3) 18 3RKQ TR3 BZE 3 TINV [J.FOR INVALID TERMINAL 8 3S5B CALL 6 YREC 7 3SK2 ADX 3 2 19 3T4L LDX 0 BNO(3) [IDENTIFIER/POLLING ADDRESS 7 3TJ= ERX 0 5 19 3W3W ANDX 0 HALFTOP [ONLY IDENTIFIER SIGNIFICANT 18 3WHG BZE 0 TR2 [J.IF RIGHT IDENTIFIER 8 3X36 LDX 3 0(3) 8 3XGQ BRN TR3 18 3Y2B TR2 ANDN 5 #7700 [MASK OUT INTERFACE NO 19 3YG2 BZE 5 TR11 [J.IF INTERFACE NOT REQUIRED 18 3Y_L SRL 5 6 [INTERFACE NO INTO CHAR3 9 3_F= TR4 LDX 0 BTYPE(3) 7 3_YW LDCH 6 0 7 42DG ERX 6 5 18 42Y6 BZE 6 TR11 [J.IF CORRECT INTERFACE 10 43CQ LDX 0 BTYPE+1(3) 20 43XB LDCH 6 0 [CHECK POSSIBLE CONSOLE INTERFACE 7 44C2 ERX 6 5 18 44WL BZE 6 TR11 [J.IF CORRECT INTERFACE 10 45B= LDX 0 BTYPE+2(3) 20 45TW BNG 0 TINV [J.FOR INVALID TERMINAL INTERFACE 8 46*G LDX 3 0(3) 8 46T6 BNZ 3 TR5 20 47#Q TGEO GEOERR 1,IDF7020 [SOMETHING UP WITH 7020'S IN IDF 8 47SB TR5 CALL 6 YREC 7 48#2 ADX 3 2 8 48RL BRN TR4 7 49?= TR11 SBX 3 2 8 49QW TR1 ADX 7 FX1 20 4==G EXIT 7 0 [ON EXIT X4 NEG IF 7020 IDENTIFIER EXISTED 8 4=Q6 T7900 LDN 3 BIPB 9 4?9Q CALL 6 SEARCH 17 4?PB BZE 0 UINV [J.FOR INVALID UNIT 9 4#92 LDN 3 BLINE(3) 7 4#NL LDX 4 5 9 4*8= CALL 6 SEARCH 18 4*MW BZE 0 RINV [J.FOR INVALID IDENTIFIER 8 4B7G BRN TR1 4 4BM6 # 7 4C6Q # ERRORS!!!! 15 4CLB UINV LDX 3 XILLUN(1) [ILLEGAL UNIT 8 4D62 ONVMA ANDN 4 #7777 8 4DKL ONUM OUTNUM 4,0 9 4F5= YERC CALL 7 ZCLOSE 7 4FJW ERRORX 3 7 4FSN ... UPPLUS 1 15 4GJ6 MINV LDX 3 XILLINE(1) [ILLEGAL LINE 8 4H3Q BRN ONVMA 17 4HHB RINV LDX 3 XILLIDE(1) [ILLEGAL IDENTIFIER 8 4J32 BRN ONVMA 20 4JGL TINV LDX 3 XINTEM(1) [7020 TERM/INTERFACE NOT IN IDF 8 4K2= BRN YERC 4 4KFW # 4 4K_G # 21 4LF6 ZACAN1 [PRE-ZACAN ENTRY:USE X4 TO SET UP X3 & X2 WITHOUT CO-ORD. 7 4LYQ LDX 3 4 8 4MDB CALL 6 YREC1 21 4MY2 ZACAN [ROUTINE TO CANCEL ASSOCIATES(IF X7=0) OR ATTRIBUTES(IF- 21 4NCL [X7=1.X2 & X3 POINT TO PARENT CELL:X4=IDF PTR TO PARENT 8 4NX= SBX 5 FX1 7 4PBW ADX 3 2 7 4PWG SMO 7 19 4QB6 LDX 3 BASS(3) [PICK UP ASS/ATT IDF POINTER 16 4QTQ BZE 3 ZC1 [J.NOTHING TO DO 17 4R*B CALL 6 YREC [FIND ASS/ATT CELL 7 4RT2 ADX 3 2 20 4S#L LDX 2 3 [EXTRA COPY OF ABSOLUTE POINTER 8 4SS= SMO FX2 21 4T?W LDX 6 AWORK2 [PICK UP PROPERTY NUMBER PARAMETER 16 4TRG BNZ 7 ZCATT [J.FOR ATT.CANCEL 9 4W?6 LDN 1 ASSMAX 21 4WQQ ZC3 ADN 3 2 [LOOK FOR PROPERTY THIS ASSOCIATION- 14 4X=B LDX 0 1(3) [CONCERNS 7 4XQ2 ERX 0 6 9 4Y9L ANDX 0 BITS22LS 17 4YP= BZE 0 ZC2 [J.IF PROPERTY FOUND 19 4_8W ZC11 BCT 1 ZC3 [OTHERWISE J.FOR NEXT PERHAPS 20 4_NG ZC1 ADX 5 FX1 [EXIT:REQUIRED ASS/ATT NOT FOUND 7 5286 EXIT 5 0 4 52MQ # 21 537B ZC2 SMO FX2 [REQUIRED ASSOC.FOUND PERHAPS:CLEAR!! 16 53M2 LDX 0 AWORK1 [PICK UP BIT WORD 18 546L ANDX 0 0(3) [MAKE SURE COMMANDS MATCH 9 54L= ANDX 0 HALFTOP 17 555W BZE 0 ZC11 [J.IF COMMANDS DIFFER 8 55KG SMO FX2 18 5656 LDX 0 AWORK1 [PICK UP BIT WORD AGAIN 8 56JQ ANDN 0 #7777 21 574B ORS 0 0(3) [MAKE SURE REQUIRED BITS SET AND SO- 18 57J2 ERS 0 0(3) [CLEAR OUT REQUIRED BITS 17 583L LDX 0 0(3) [PICK UP^ASSOC^WORD 21 58H= ANDN 0 #7777 [ONLY LOOK AT DEVICES-COMMAND IS SET! 21 592W BNZ 0 ZC4 [& J.IF SOME ASSOCS STILL EXIST:DONE! 18 59GG STOZ 0(3) [TO CLEAR OUT COMMAND BIT 14 5=26 ZC5 STOZ 1(3) [CLEAR 9 5=FQ ZC10 LDX 0 BNO(2) 7 5=_B SBN 0 1 15 5?F2 STO 0 BNO(2) [ADJUST COUNT 20 5?YL BNZ 0 ZC4 [& J.IF STILL SOME ASS/ATT LEFT 15 5#D= [OTHERWISE- 17 5#XW LDX 3 4 [FREE ASS/ATT CELL 8 5*CG CALL 6 YREC1 7 5*X6 SMO 7 8 5BBQ ADN 3 BASS 8 5BWB CALL 6 SFREE 8 5CB2 ZC4 ADX 5 FX1 7 5CTL EXIT 5 1 5 5D*= ZCATT 21 5DSW ADN 3 1 [ADJUST X3 FOR CONVENIENCE OF LOOP 18 5F#G BPZ 6 ZC6 [J.IF NON-CONSOLE PROP. 21 5FS6 ERX 6 1(3) [OTHERWISE INVESTIGATE CONSOLE PROP. 9 5G?Q ANDX 6 BITS22LS 20 5GRB BNZ 6 ZC1 [J.IF THIS CONSOLE PROP NOT ATT. 21 5H?2 BRN ZC5 [OTHERWISE GO & CANCEL ATTRIBUTION 16 5HQL ZC6 LDN 1 ATTMAX [ATTMAX<6 I HOPE! 7 5J== ZC7 ADN 3 1 21 5JPW LDX 0 1(3) [PICK UP NO.OF ATTRIBUTED PROPERTY 7 5K9G ERX 0 6 9 5KP6 ANDX 0 BITS22LS 19 5L8Q BZE 0 ZC8 [J.IF SAME AS REQUIRED NO. 18 5LNB BCT 1 ZC7 [J.FOR NEXT ATTRIBUTION 19 5M82 BRN ZC1 [EXIT-ATTRIBUTION NOT FOUND 14 5MML ZC8 SMO 1 [NOW MOVE 8 5N7= LDX 0 0(3) 8 5NLW BNZ 0 ZC9 8 5P6G BCT 1 ZC8 19 5PL6 GEOERR 1,ZEROPROP [ERROR CANCEL OF ZERO PROP.NO 8 5Q5Q ZC9 STO 0 1(3) 7 5QKB SMO 1 8 5R52 STOZ 0(3) 8 5RJL BRN ZC10 4 5S4= # 4 5SHW # 4 5T3G # 18 5TH6 Z1IDFCANC [CANCEL PROPERTY ENTRY 10 5W2Q LDX 7 ACOMMUNE2(2) 17 5WGB STO 7 AWORK2(2) [STORE PROPERTY NO 7 5X22 NGN 0 1 20 5XFL STO 0 AWORK1(2) [ASSOCIATES WORD FOR CANCELLING 8 5X_= CALL 6 OPEN 18 5YDW BPZ 7 YP1 [J.IF NOT CONSOLE PROP 21 5YYG LDN 5 BEXOT [X5 INITIALIZED:NEEDED FOR FREEING- 17 5_D6 LDX 4 BEXOT(2) [CONSOLE PROP.CELL 8 5_XQ BZE 4 YGEO 7 62CB YP2 LDX 3 4 18 62X2 CALL 6 YREC [FIND CONSOLE PROP CELL 7 63BL ADX 3 2 9 63W= LDX 0 BNO(3) 17 64*W ERX 0 7 [COMPARE PROP.NOS. 9 64TG ANDX 0 BITS22LS 16 65*6 BZE 0 YP3 [AND J.IF SAME 17 65SQ LDX 5 4 [OTHERWISE UPDATE X5 15 66#B LDX 4 0(3) [UPDATE X4 19 66S2 BNZ 4 YP2 [AND J.FOR NEXT CONSOLE PROP. 10 67?L YGEO GEOERR 1,CLUSTERC 4 67?_ ...# 21 67## ...# ENTRY IF PROPERTY NO. NOT FOUND IN APERI-CONSOLE BLOCK OR BLOCK 9 67#M ...# DOES NOT EXIST. 4 67*2 ...# 19 67** ...# VALUES ON ENTRY X4 = POINTER TO NOMINATED CONSOLE CELL 18 67*N ...# X5 = POINTER TO CONSOLE PROPERTY CELL 7 67B3 ...YGEO1 LDX 3 4 19 67BB ... CALL 6 YREC1 [FIND NOMINATED CONSOLE CELL 15 67BP ... LDX 1 4 [SV X4 IN X1 7 67C4 ... SMO 2 9 67CC ... LDX 6 BNUMB(3) 7 67CQ ... SLL 6 1 17 67D5 ... BNG 6 YGEO2 [J. IDENTIFIER CELL 7 67DD ... SMO 2 21 67DR ... LDX 4 4(3) [LD. WD. CONTAINING GEOG.NO. OF UNIT 7 67F6 ... SRL 4 6 18 67FF ... LDN 3 BUNIT [LD. BASE OF UNIT CELL 8 67FS ... BRN YGEO3 7 67G7 ...YGEO2 SMO 2 15 67GG ... LDX 4 BTYPE(3) [LD. GEOG.NO. 20 67GT ... LDN 3 BIPB [LD. BASE OF UNIT CHAIN - 7900. 8 67H8 ...YGEO3 ANDN 4 #7777 7 67HH ... LDN 6 0 17 67HW ... CALL 7 RECFIND [FIND RECORD ZERO. 19 67J9 ... LDX 7 1 [SV X1 WHICH HOLDS X4 IN X7 17 67JJ ... CALL 6 SEARCH [SEARCH FOR UNIT CELL 19 67JX ... LDX 1 7 [RELOAD X7 TO X1 WHICH IS X4 7 67K= ... SMO 3 9 67KK ... LDX 0 BNUMB(2) 7 67KY ... SLL 0 1 18 67L? ... BPZ 0 YGEO [J. ERROR UNIT RIGHTED. 7 67LL ... SMO 2 19 67L_ ... LDX 7 BTYPE(3) [LD. DEVICE TYPE OF IDF UNIT 7 67M# ... SLC 7 6 8 67MM ... ANDN 7 #77 16 67N2 ... FINDPEREC 3,APGEOG,4 [FIND DEVICE LIST 21 67N* ... BNG 3 YGEO4 [J. GEOG.NOS. DEVICE LIST NOT FOUND 17 67NN ... LTYPE 3,4 [X4 = DEVICE TYPE. 21 67P3 ... BXE 4 7,YGEO [J. SOMETHING WRONG - DEVICES MATCH 17 67PB ...YGEO4 LDX 4 1 [RE-LOAD VALUE OF X4 17 67PP ... BRN YP44 [J. TO REMOVE ENTRY. 21 67R= YP3 LDX 0 BLINE(3) [INVESTIGATE ANY ATTRIBUTIONS CELLS 16 68=W BZE 0 YP4 [AND J.IF NONE 18 68QG SBX 3 2 [OTHERWISE FREE THEM ALL 8 69=6 ADN 3 BLINE 8 69PQ YP5 CALL 6 SFREE 7 6=9B SMO 2 8 6=P2 LDX 0 0(3) 19 6?8L BNZ 0 YP5 [J.TO FREE NEXT SUBSID.CELL 8 6?N= SBN 3 BLINE 7 6#7W ADX 3 2 21 6#MG YP4 LDX 4 BTYPE(3) [NOW INVESTIGATE APERI/CONSOLE BLK?? 20 6*76 BZE 4 YP41 [J.IF INVESTIGATION NOT NEEDED 11 6*LQ HUNTMISB 2,APERI,CONSOLE 17 6B6B ... BNG 2 YGEO1 [BLOCK SHOULD EXIST! 17 6BL2 ... LDX 1 2 [KEEP COPY OF X2 16 6GH2 LDX 3 2 [KEEP COPY OF X2 7 6H2L YP42 ADN 2 2 21 6HG= LDX 0 A1-1(2) [PICK UP PROP.NO & COMPARE WITH X7 21 6H_W ... BZE 0 YGEO1 [BUT BIG ERROR IF AT END OF CONS.BLK 7 6JFG ERX 0 7 9 6J_6 ANDX 0 BITS22LS 18 6KDQ BNZ 0 YP42 [J.IF NOT SAME PROP.NO 19 6KYB LDX 7 A1(2) [KEEP DESCRIPTION OF CONSOLE 19 6LD2 LDN 2 A1-1(2) [NOW OVERWRITE OLD ENTRY IN- 21 6LXL LDN 0 2 [APERI/CONSOLE BLOCK(IF NECESSARY) 8 6MC= SBS 0 A1(1) 8 6MWW ADX 1 A1(1) 9 6NBG LDN 1 A1-1(1) 7 6NW6 MOVE 1 2 8 6P*Q STOZ 0(1) 20 6PCF ... LDX 1 3 [ADDITIONAL COPY OF X2 INTO X1 21 6PF8 ... LDX 6 A1(3) [PICK UP COUNT OF NO OF WORDS USED 7 6PGX ... SBN 6 2 20 6PJL ... BNZ 6 YP43 [J.IF CONSOLE BLOCK WONT BE EMPTY 17 6PL* ... FREECORE 1 [OTHERWISE FREE IT 21 6PN4 ... BRN YP44 [J.TO UNSET^THIS IS CLUSTER CONS^BIT. 10 6PPR ...YP43 SBX 6 ALOGLEN(1) 19 6PRG ... ADN 6 16 [PREPARE X6 FOR ALTLEN TEST 17 6PTB BPZ 6 YP45 [DONT ALTER LENGTH 8 6Q*2 LDX 6 A1(3) 8 6QSL ALTLEN 3,6 21 6R4D ... HUNTMISB 3,APERI,CONSOLE [RE-HUNT APERI-CONSOLE AFTER ALTLEN 20 6R#= YP45 LDN 6 0 [AS^CONSOLE NOT YET FOUND^SWITCH 21 6RRW YP48 TXU 7 A1+2(3) [NOW GO THROUGH APERI/CONSOLE BLOCK- 21 6S?G BCS YP46 [TO SET/UNSET B1 OF ENTRIES USING- 18 6SR6 BNZ 6 YP47 [CONSOLE DESCRIBED IN X7 8 6T=Q LDCT 6 #200 9 6TQB ORS 6 A1+1(3) 17 6W=2 ERS 6 A1+1(3) [MAKE SURE B1 UNSET 8 6WPL BRN YP46 9 6X9= YP47 ORS 6 A1+1(3) 7 6XNW YP46 ADN 3 2 9 6Y8G LDX 0 A1+1(3) 8 6YN6 BNZ 0 YP48 21 6_7Q BNZ 6 YP41 [J.AS NO NEED TO UNSET^THIS IS CLUS- 20 6_MB [CONS.^BIT,FOR CONSOLE STILL USED 7 7272 YP44 LDX 3 4 21 72LL CALL 6 YREC1 [NOW FIND CLUSTER CONSOLE CELL IN IDF 8 736= LDCT 0 #40 7 73KW SMO 2 10 745G ERS 0 BTYPE+1(3) 21 74K6 YP41 LDX 3 5 [NOW FREE CONSOLE PROPERTY CELL USING 17 754Q CALL 6 YREC1 [-PTR PRESERVED IN X5 8 75JB CALL 6 SFREE 7 7642 YP1 LDN 6 0 16 76HL CALL 7 RECFIND [FIND RECORD ZERO 18 773= LDX 3 BUNIT(2) [INVESTIGATE 7007'S FIRST 8 77GW BZE 3 YP6 8 782G CALL 6 YREC 7 78G6 YP12 ADX 3 2 8 78_Q LDX 0 0(3) 8 79FB SMO FX2 20 79_2 STO 0 AWORK3 [POINTER TO NEXT UNIT IN AWORK3 9 7=DL LDX 4 BLINE(3) 8 7=Y= BZE 4 YGEO 18 7?CW YP10 LDX 3 4 [KEEP X4 SAFE FOR ZACAN 8 7?XG CALL 6 YREC 7 7#C6 LDN 7 0 8 7#WQ CALL 5 ZACAN 7 7*BB BRN / 17 7*W2 LDN 7 BATT-BASS [ASSUMES BATT>BASS! 9 7B*L CALL 5 ZACAN1 7 7BT= BRN / 7 7C#W LDX 3 4 17 7CSG CALL 6 YREC1 [GO BACK TO LINE CELL 7 7D#6 ADX 3 2 9 7DRQ LDX 4 BLINE(3) 15 7F?B BZE 4 YP7 [J.IF NO 7020 8 7FR2 LDX 0 0(3) 8 7G=L SMO FX2 20 7GQ= STO 0 AWORK4 [STORE POINTER TO NEXT LINE CELL 7 7H9W YP8 LDX 3 4 8 7HPG CALL 6 YREC 7 7J96 LDN 7 0 8 7JNQ CALL 5 ZACAN 7 7K8B BRN / 9 7KN2 LDN 7 BATT-BASS 9 7L7L CALL 5 ZACAN1 7 7LM= BRN / 7 7M6W LDX 3 4 17 7MLG CALL 6 YREC1 [FIND 7020 CELL AGAIN 7 7N66 ADX 3 2 8 7NKQ LDX 4 0(3) 17 7P5B BNZ 4 YP8 [J FOR NEXT 7020 CELL 8 7PK2 SMO FX2 17 7Q4L LDX 4 AWORK4 [RESCE^NEXT LINE PTR^ 16 7QJ= BNZ 4 YP10 [J.FOR NEXT LINE 17 7R3W BRN YP9 [OTHERWISE NEXT UNIT 8 7RHG YP7 LDX 4 0(3) 16 7S36 BNZ 4 YP10 [J.FOR NEXT LINE 20 7SGQ YP9 SMO FX2 [OTHERWISE INVESTIGATE NEXT UNIT 9 7T2B LDX 3 AWORK3 17 7TG2 BZE 3 YP11 [J.IF NO MORE UNITS 8 7T_L CALL 6 YREC1 8 7WF= BRN YP12 16 7WYW YP11 LDN 6 0 [SEARCH IPB CHAIN 9 7XDG CALL 7 RECFIND 9 7XY6 YP6 LDX 3 BIPB(2) 16 7YCQ BZE 3 YP21 [J.IF NO IPB'S 20 7YXB CALL 6 YREC [OTHERWISE FIND FIRST IPB UNIT 7 7_C2 YP15 ADX 3 2 8 7_WL LDX 0 0(3) 8 82B= SMO FX2 20 82TW STO 0 AWORK3 [STORE POINTER TO NEXT IPB UNIT 9 83*G LDX 4 BLINE(3) 17 83T6 BZE 4 YP16 [J.IF NO IDENTIFIERS 7 84#Q LDX 3 4 8 84SB CALL 6 YREC 7 85#2 YP14 SMO 2 8 85RL LDX 0 0(3) 8 86?= SMO FX2 9 86QW STO 0 AWORK4 7 87=G LDN 7 0 8 87Q6 CALL 5 ZACAN 7 889Q BRN / 9 88PB LDN 7 BATT-BASS 9 8992 CALL 5 ZACAN1 7 89NL BRN / 8 8=8= SMO FX2 9 8=MW LDX 4 AWORK4 8 8?7G BZE 4 YP16 7 8?M6 LDX 3 4 8 8#6Q CALL 6 YREC1 8 8#LB BRN YP14 8 8*62 YP16 SMO FX2 9 8*KL LDX 3 AWORK3 8 8B5= BNZ 3 YP20 6 8BJW YP21 LFCCAT 10 8C4G CALL 7 WRITECLOSE 7 8C## ... UPPLUS 1 8 8D3Q YP20 CALL 6 YREC1 8 8DHB BRN YP15 4 8F32 # 4 8FGL # 18 8G2= Z2IDFCANC [CANCEL ASSOCIATE ENTRY 9 8GFW CALL 7 PARSORT 10 8G_G LDX 0 ACOMMUNE1(2) 16 8HF6 STO 0 AWORK1(2) [KEEP ^BITS^ WORD 16 8HYQ CALL 7 TRACE [FIND PARENT CELL 9 8JDB LDX 4 BRECNO(2) 7 8JY2 SLL 4 9 21 8KCL ORX 4 3 [MAKE IDF POINTER IN X4 TO PARENT CEL 17 8KX= LDN 7 0 [^ASSOCIATE^ SWITCH 15 8LBW CALL 5 ZACAN [CANCEL ASSOC 17 8LWG BRN ZA1 [NOTHING DONE EXIT 10 8MB6 CALL 7 WRITECLOSE 7 8MKY ... UPPLUS 2 9 8N*B ZA1 CALL 7 ZCLOSE 7 8NK8 ... UPPLUS 2 4 8P#L # 4 8PS= # 18 8Q?W Z3IDFCANC [CANCEL ATTRIBUTE ENTRY 9 8QRG CALL 7 PARSORT 16 8R?6 CALL 7 TRACE [FIND PARENT CELL 21 8RQQ LDX 4 BRECNO(2) [CREATE IDF POINTER TO PARENT CELL 7 8S=B SLL 4 9 7 8SQ2 ORX 4 3 16 8T9L LDN 7 BATT-BASS [SET X7 FOR ZACAN 8 8TP= CALL 5 ZACAN 19 8W8W BRN ZT1 [J.IF ATTRIBUTION NOT FOUND 8 8WNG SMO FX2 9 8X86 LDX 5 AWORK2 17 8XMQ BNG 5 ZT2 [J.IF CONSOLE PROP 5 8Y7B ZTXIT 6 8YM2 LFCCAT 10 8_6L CALL 7 WRITECLOSE 7 8_BD ... UPPLUS 3 9 925W ZT1 CALL 7 ZCLOSE 7 92*N ... UPPLUS 2 21 9356 ZT2 LDN 6 0 [NOW REMOVE ATT FROM PROP.CONS.CELL 9 93JQ CALL 7 RECFIND 9 944B LDX 3 BEXOT(2) 8 94J2 BZE 3 YGEO 21 953L ZT4 LDN 5 BLINE(3) [LEAST THIS NEXT IS RIGHT CONS.PROP. 19 95H= CALL 6 YREC [FIND NEW CONSOLE PROP CELL 7 962W ADX 3 2 9 96GG LDX 0 BNO(3) 8 9726 SMO FX2 17 97FQ ERX 0 AWORK2 [TO COMPARE PROP.NOS 9 97_B ANDX 0 BITS22LS 18 98F2 BZE 0 ZT3 [J.IF PROPERTIES THE SAME 8 98YL LDX 3 0(3) 19 99D= BNZ 3 ZT4 [OTHERWISE J.FOR NEXT PROP. 8 99XW BRN YGEO 21 9=CG ZT3 LDN 6 5 [SET X6 AS CELL PTR TO FIRST ATT.PTR 19 9=X6 LDX 0 BNUMB(3) [COUVT OF NO OF ATTRIBUTIONS 15 9?BQ SBN 0 1 [ADJUST COUNT 16 9?WB STO 0 BNUMB(3) [STORE COUNT BACK 20 9#B2 BZE 0 ZT11 [& IF COUNT ZERO J.AS LESS TO DO 9 9#TL LDX 7 BLINE(3) 8 9**= SMO FX2 9 9*SW STO 5 AWORK3 21 9B#G LDN 5 3 [X5 IS CT.OF NO.OF ATTS LEFT IN CELL 7 9BS6 ZT6 SMO 6 17 9C?Q LDX 0 0(3) [PICK UP ATTRIB.PTR 19 9CRB ERX 0 4 [COMPARE WITH POINTER IN X4 9 9D?2 ANDX 0 BITS22LS 15 9DQL BZE 0 ZT5 [J.IF SAME 15 9F== ADN 6 1 [UPDATE X6 21 9FPW BCT 5 ZT6 [J.FOR NEXT POINTER IF NOT IN NEW CEL 8 9G9G BZE 7 YGEO 18 9GP6 LDX 3 7 [OTHERWISE GET NEW CELL 8 9H8Q LDX 1 FX2 21 9HNB LDX 0 AWORK3(1) [SWAP AROUND AND SO UPDATE ^PREVIOUS^ 15 9J82 STO 0 AWORK4(1) [-POINTERS 9 9JML STO 7 AWORK3(1) 8 9K7= CALL 6 YREC 7 9KLW ADX 3 2 17 9L6G LDX 7 0(3) [UPDATE X7,X6 & X5 7 9LL6 LDN 6 1 7 9M5Q LDN 5 7 18 9MKB BRN ZT6 [J.FOR NEXT COMPARISON 21 9N52 ZT5 LDX 4 BRECNO(2) [NOW MAKE IDF POINTER TO ATTRIB.PTR 7 9NJL SLL 4 9 20 9P4= SBX 3 2 [ADJUST X3 TO MAKE IDF POINTER 7 9PHW ORX 4 3 21 9Q3G ADX 4 6 [MAKE PTR POINT TO RIGHT PART OF CELL 7 9QH6 ADX 3 2 19 9R2Q BNZ 7 ZT7 [J.IF STILL MORE SUBSID.CELLS 19 9RGB BCT 5 ZT8 [J.IF NOT AT END OF CELL YET 7 9S22 ZT11 SMO 6 19 9SFL STOZ 0(3) [ZEROIZE ATT.PTR(LAST ENTRY) 15 9S_= BRN ZTXIT [ALL DONE! 19 9TDW ZT7 LDX 3 7 [NOW FIND LAST SUBSID CELL 8 9TYG LDX 1 FX2 21 9WD6 LDX 0 AWORK3(1) [SWAP TO UPDATE ^PREVIOUS^POINTERS 9 9WXQ STO 0 AWORK4(1) 9 9XCB STO 7 AWORK3(1) 8 9XX2 CALL 6 YREC 7 9YBL ADX 3 2 8 9YW= LDX 7 0(3) 19 9_*W BNZ 7 ZT7 [J.IF LAST CELL NOT YET FOUND 7 9_TG LDN 6 0 7 =2*6 LDN 5 6 7 =2SQ LDN 5 7 21 =3#B ZT8 ADN 6 1 [INVESTIGATE LAST CELL TO FIND LAST- 14 =3S2 SMO 6 [POINTER 8 =4?L LDX 7 0(3) 18 =4R= BZE 7 ZT9 [J.IF PAST LAST POINTER 20 =5=W BCT 5 ZT8 [OTHERWISE CONTINUE INVESTIGATION 7 =5QG SMO 6 8 =6=6 STOZ 0(3) 8 =6PQ BRN ZT12 7 =79B ZT9 SBN 6 1 7 =7P2 SMO 6 17 =88L LDX 7 0(3) [PICK UP LAST POINTER 15 =8N= SBN 6 1 [ADJUST X6 19 =97W BZE 6 ZT10 [& J.IF CELL MUST BE FREED 19 =9MG SMO 6 [OTHERWISE ZEROIZE LAST ENTRY 8 ==76 STOZ 1(3) 21 ==LQ ZT12 LDX 3 4 [AND PUT LAST ENTRY ON TOP OF CANCEL 15 =?6B CALL 6 YREC1 [LED ENTRY 7 =?L2 ADX 3 2 20 =#5L LDX 0 0(3) [MAKE SURE THIS IS NOT LAST ENTRY 15 =#K= BZE 0 ZTXIT [& J.IF IT IS 21 =*4W ANDX 7 BITS22LS [NOW CHECK IF B0 OF X7 SHOULD BE SET 18 =*JG ERX 4 7 [TO COMPARE RECORD NOS 7 =B46 SRL 4 9 8 =BHQ ANDN 4 #7777 18 =C3B BZE 4 ZT14 [J.IF RECORD NOS EQUAL 16 =CH2 ORX 7 GSIGN [OTHERWISE SET B0 8 =D2L ZT14 STO 7 0(3) 14 =DG= BRN ZTXIT [ALL DONE 18 =D_W ZT10 SMO FX2 [FREE LAST SUBSID.CELL 9 =FFG LDX 3 AWORK4 8 =F_6 CALL 6 YREC1 8 =GDQ CALL 6 SFREE 21 =GYB BRN ZT12 [J.TO PLACE LAST ENTRY IN NEW POSN. 4 =GYH ...[ 4 =H*_ ...[ 4 =HD2 #END 8 ____ ...42553145000100000000