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