(George Source)
Macros used: ACROSS, AND, APPEND, APROPNAME, GEOERR, HUNT2OPT, LGEOG, MASK, MENDAREA, MHUNTW, MXB, OR, PROPERTY, SEGENTRY, SETNCORE, TESTREP, TRACE, VFREE
22FL #OPT K0LISTAST=0 22^= ...#SEG LISTAST [LEN WAGSTAFF 2394 ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982 23DW #LIS K0LISTAST>K0ALLGEO>K0GREATGEO>K0COMMAND 23YG 8HLISTAST 24D6 #OPT K6LISTAST=K6ALLGEO 24XQ # 25CB # 25X2 # THIS SEGMENT LISTS THE ATTRIBUTIONS AND ASSOCIATIONS OF LINES 26BL # AND IDENTIFIERS IN THE IDF. THE SEGMENT IS ENTERED FROM SEGMENT 26W= # LISTIDF, AND EXPECTS SYSTEM.PROPERTIES TO BE OPEN AT LEVEL 2, 27*W # THE OUTPUT FILE AT LEVEL 1, AND THE IDF AT LEVEL 0. 27TG # 28*6 # 28SQ # 29#B SEGENTRY K1LISTAST,X1LISTAST 29S2 # 2=?L # 2=R= WLINE 4H---- 2?=W THEAD 32HATTRIBUTIONS AND ASSOCIATIONS 2?QG TSUB 16HCONSOLE PROPERTY 2#=6 XLIN 4HLINE 2#PQ ...ZIDEN 12HIDENTIFIER 2*9B ZOTH 8H OTHER 2*P2 UNIT 4H MX 2B8L 4H UX 2BN= 4H CC 2C7W 4H CI 2CMG XIDEN 4H I 2D76 XLF 4H,LF 2DLQ XTP 4H*TP 2F6B XLP 4H*LP 2FL2 XCP 4H*CP 2G5L SUNIT 4HLP 2GK= 4HCR 2H4W 4HTW 2HJG 4HTR 2J46 4HTP 2JHQ XCON +10000 2K3B MASK #77000000 2KH2 SPD 12HASSOCIATIONS 2L2L XMESS 40HNO CURRENT ATTRIBUTIONS OR ASSOCIATIONS 2LG= X1LISTAST 2L^W CALL 7 SETUP [CALL ROUTINE TO SET UP FAPB 2MFG SMO FX1 [X1 POINTS TO FAPB 2M^6 LDN 4 THEAD 2NDQ LDN 5 #51 2NYB STO 5 A1+1(1) [STORE NEW PAGE CONTROL 2PD2 LDN 5 A1+13(1) 2PXL MOVE 4 8 [MOVE IN TITLE LINE 2QC= CALL 7 WRITE [WRITE TITLE LINE AWAY 2QWW SMO FX1 2RBG LDX 0 WLINE 2RW6 STO 0 A1+13(1) 2S*Q LDN 5 A1+13(1) 2STB LDN 6 A1+14(1) [AND UNDERLINE IT 2T*2 MOVE 5 6 2TSL DCH 0 A1+20(1) 2W#= LDN 0 #41 2WRW STO 0 A1+1(1) 2X?G CALL 7 WRITE 2XR6 SMO FX1 2Y=Q LDN 5 TSUB 2YQB LDN 6 A1+12(1) 2^=2 MOVE 5 4 [MOVE IN SUB-TITLE 2^PL SMO FX1 329= LDN 5 ZOTH 32NW LDN 6 A1+18(1) 338G MOVE 5 2 33N6 CALL 7 WRITE [WRITE SUB-TITLE LINE AWAY 347Q LDN 5 #41 [SET UP FAPB 34MB STO 5 A1+1(1) [STORE PFFC 3572 SMO FX1 35LL LDN 5 THEAD 366= LDN 6 A1+12(1) 36KW MOVE 5 3 375G SMO FX1 37K6 LDN 5 THEAD 384Q LDN 6 A1+18(1) 38JB MOVE 5 3 3942 SMO FX1 39HL LDN 5 SPD 3=3= LDN 6 A1+22(1) 3=GW MOVE 5 3 3?2G CALL 7 WRITE [WRITE LAST TITLE LINE AWAY 3?G6 SMO FX1 3?^Q LDX 0 WLINE 3#FB STO 0 A1+12(1) 3#^2 STO 0 A1+18(1) 3*DL STO 0 A1+22(1) 3*Y= LDN 0 #41 3BCW STO 0 A1+1(1) [ & 3BXG LDN 5 A1+12(1) 3CC6 LDN 6 A1+13(1) 3CWQ MOVE 5 3 [ UNDERLINE THEM 3DBB LDN 5 A1+18(1) 3DW2 LDN 6 A1+19(1) 3F*L MOVE 5 2 [ ALL 3FT= LDN 5 A1+22(1) 3G#W LDN 6 A1+23(1) 3GSG MOVE 5 2 3H#6 CALL 7 WRITE 3HRQ # 3J?B # MAIN ROUTINE 3JR2 # 3K=L LDX 0 GSIGN [SET "NO ATTRIBS OR ASSOCS FOUND YET" 3KQ= ORS 0 A1+1(1) [MARKER 3L9W LDX 2 FX2 3LPG LDN 0 0 3M96 CALL 7 XMXB [GET POINTER TO IDF BASE CELL 3MNQ LDX 3 BUNIT(3) [LOAD BASE OF UNIT CHAIN 3N8B STO 3 AWORK1(2) [STORE IT IN AWORK1 3NN2 # 3P7L # INITIALISATION NOW COMPLETE. WE NOW ENTER THE MAIN ROUTINE 3PM= # FOR MULTIPLEXORS AND UNIPLEXORS 3Q6W # 3QLG ZUNIT [UNIT CHAIN LOOP 3R66 ZJPQ 3RKQ LDX 4 AWORK1(2) [RESTORE UNIT CHAIN POINTER 3S5B BZE 4 UNITEND [BR IF NO MORE UNITS 3SK2 CALL 7 SPACES 3T4L LDX 0 4 3TJ= CALL 7 XMXB [ACCESS NEXT UNIT CELL FROM IDF 3W3W CALL 4 X659 3WHG BRN ZJPQ 3X36 LDX 4 BTYPE(3) 3XGQ LDN 2 0 3Y2B LDCH 5 4(2) [LOAD UNIT TYPE 3YG2 SBN 5 10 3Y^L BZE 5 ZUPX [BRANCH IF UNIPLEXOR 3^F= SMO FX1 3^YW LDX 0 UNIT [LOAD UNIT NAME (MPX) 42DG STO 0 A1+3(1) [STORE IT IN FAPB 42Y6 SMO FX1 43CQ LDX 0 XLIN 43XB STO 0 A1+6(1) [STORE "LINE" IN FAPB 44C2 BRN XNORM [JUMP OVER UNIPLEXOR 44WL ZUPX 45B= SMO FX1 45TW LDX 0 UNIT+1 46*G STO 0 A1+3(1) [MOVE IN UNIT NAME (UPK) 46T6 XNORM 47#Q LDN 5 #7777 47SB ANDX 5 4 [GEOG NO. TO X5 48#2 ADN 1 A1+4 48RL CALL 7 XCBD [CONVERT TO DECIMAL AND STORE 49?= SBN 1 A1+5 49QW LDX 0 BLINE(3) [STORE POINTER TO LINE CHAIN 4==G SMO FX2 4=Q6 STO 0 AWORK2 [IN AWORK2 4?9Q ZLINE [LINE CHAIN LOOP 4?PB LDX 2 FX2 4#92 LDX 0 ACES [OVERWRITE VARIABLE DETAILS OF 4#NL STO 0 A1+7(1) 4*8= LDN 4 A1+7(1) [ OUTPUT LINE WITH 4*MW LDN 5 A1+8(1) 4B7G MOVE 4 3 [ SPACES 4BM6 LDX 0 AWORK2(2) 4C6Q BZE 0 ZUNIT 4CLB CALL 7 XMXB [ACCESS NEXT LINE CELL 4D62 LDX 0 0(3) [LOAD NEXT LINE CELL POINTER 4DKL STO 0 AWORK2(2) [STORE IN AWORK2 4F5= LDX 0 BLINE(3) [LOAD BASE OF 7020 CHAIN 4FJW STO 0 AWORK3(2) [STORE IN AWORK3 4G4G LDX 0 A1+6(1) 4GJ6 SBX 0 ACES [TEST FOR UNIPLEXOR 4H3Q BZE 0 PUPX 4HHB LDX 5 BNO(3) [MPX - LOAD LINE NUMBER 4J32 ADN 1 A1+7 4JGL CALL 7 XCBD [CONVERT AND STORE 4K2= SBN 1 A1+8 [RESET POINTER 4KFW PUPX 4K^G LDX 0 BASS(3) [LOAD POINTER TO ASSOCIATE CELL AND 4LF6 STO 0 AWORK4(2) [STORE IN AWORK4 4LYQ LDX 4 BATT(3) [PTR TO ATT CELL TO X4 4MDB ADX 0 4 4MY2 BZE 0 X7020 [BR IF NO ASS OR ATT ON THIS LINE 4NCL CALL 6 XLASAT [LIST ASS. AND ATT. FOR THIS LINE 4NX= X7020 [7020 LOOP 4PBW LDX 0 AWORK3(2) [LOAD NEXT 7020 CELL POINTER 4PWG BZE 0 ZLINE [NO MORE 7020'S ON THIS LINE 4QB6 CALL 7 XMXB [ACCESS NEXT 7020 CELL 4QTQ LDX 0 0(3) 4R*B STO 0 AWORK3(2) [STORE NEXT 7020 CELL PTR IN AWORK3 4RT2 SMO FX1 4S#L LDX 0 XIDEN [INSERT CHAR "I" IN FAPB 4SS= STO 0 A1+8(1) 4T?W LDX 0 BNO(3) 4TRG SRL 0 12 4W?6 SLL 0 12 [IDENTIFIER TO L.H.S. OF X0 4WQQ LDX 4 BTYPE(3) 4X=B ANDN 4 #77 [GET INTERFACE NO 4XQ2 SLL 4 6 [MOVE UP FOR INSERTION IN FAPB 4Y9L ADN 4 #34 [INSERT "," 4YP= ADX 0 4 [AMALGAMATE WITH IDENTIFIER & STORE 4^8W STO 0 A1+9(1) [IN FAPB 4^NG LDN 2 0 5286 SMO 3 52MQ LDCH 0 BTYPE(2) [LOAD DEVICE TYPE INTO X0 537B LDX 2 FX1 53M2 SMO 0 546L LDX 4 SUNIT-1(2) [LOAD RELEVANT CHARS. INTO X4 54L= SBN 0 3 555W LDX 2 FX2 55KG BNZ 0 XNCON [BR IF NOT CONSOLE TW 5656 LDX 0 BTYPE+1(3) [OBTAIN INTERFACE NO. OF OTHER 56JQ ANDN 0 #77 [HALF OF CONSOLE TW 574B SBN 4 #20 57J2 ADX 4 0 [AND INSERT IT 583L XNCON 58H= STO 4 A1+10(1) [PUT LINE IN FAPB 592W LDX 4 BASS(3) [LOAD POINTER TO ASSOC. CELL AND 59GG STO 4 AWORK4(2) [STORE IT IN AWORK4 5=26 LDX 0 4 5=FQ LDX 4 BATT(3) [LOAD PTR. TO ATT. CELL INTO X4 5=^B ADX 0 4 5?F2 BZE 0 X7020 [BR IF NO ASS OR ATT ON THIS 7020 5?YL CALL 6 XLASAT [LIST ASSOCS. AND ATTS. 5#D= BRN X7020 [GO BACK DOWN 7020 CELL 5#XW UNITEND [END OF MPX/UPX CHAIN 5*CG # 5*X6 # NOW TO DO 7900'S 5BBQ # 5BWB LDX 2 FX2 5CB2 STOZ ACOMMUNE3(2) 5CTL LDX 3 FX2 5D*= MXB 3 [ACCESS IDF BASE CELL 5DSW LDX 0 BIPB(3) [LOAD BASE OF 7900 CHAIN 5F#G STO 0 AWORK1(2) [STORE IT IN AWORK1 5FS6 X7900 [7900 LOOP 5G?Q XMIPB 5GRB LDX 4 AWORK1(2) [LOAD PTR TO NEXT 7900 CELL 5H?2 BZE 4 XNO7900 [NO MORE 7900'S 5HQL CALL 7 SPACES [BPACEFILL FAPB 5J== LDX 0 4 5JPW CALL 7 XMXB [GET NEXT 7900 CELL 5K9G LDX 0 BTYPE(3) [GEOG.NO 5KF# ... ANDN 0 #7777 5KP6 BNZ 0 XNOTCI [J. IF NOT CI 5L8Q SMO FX1 5LNB LDX 0 UNIT+3 [INSERT "CI" IN FAPB 5M82 STO 0 A1+3(1) 5MML LDX 0 CIPROPNO(3) [CONVERT PROPNO. 5N7= ANDX 0 BITS22LS [INTO NAME 5NLW APROPNAME 0,1,NOPR 5P6G MHUNTW 1,FILE,FAPB [APROPNAME COORS 5PL6 LDN 4 ACOMMUNE1(2) [PUT NAME IN FAPB 5Q5Q LDCT 5 #400 5QKB ORN 5 A1+4(1) 5R52 MVCH 4 12 5RJL LDN 0 #2020 [CUPLA SPACES 5S4= ORS 0 A1+7(1) 5WGB LDX 0 AWORK1(2) [RE-HUNT IDF CELL 5X22 CALL 7 XMXB 5X78 ... LDX 0 0(3) [PT TO NEXT IPB CELL 5X#B ... STO 0 AWORK1(2) 5XFL BRN XCCCI [BACK TO COMMON PATH 5X^= XNOTCI 5YDW CALL 4 X659 5YYG BRN XMIPB 5^D6 SMO FX1 5^XQ LDX 0 UNIT+2 [INSERT CHARS "CC" IN FAPB 62CB STO 0 A1+3(1) 62X2 LDN 5 #7777 63BL ANDX 5 BTYPE(3) [ACCESS GEOG. NO 63W= ADN 1 A1+4 64*W CALL 7 XCBD [CONVERT TO DECIMAL AND 64TG SBN 1 A1+5 [STORE IT 67?L XCCCI 67BQ ... SMO FX1 [STORE "IDENTIFIER" 67FW ... LDN 4 ZIDEN 67K2 ... LDN 5 A1+8(1) 67N6 ... MOVE 4 3 67R= LDX 0 BLINE(3) [LOAD POINTER TO IDENTIFIER CELL 68=W STO 0 AWORK2(2) [& STORE IT IN AWORK2 68QG LDX 4 BASS(3) [LOAD ASSOC CELL POINTER 69=6 STO 4 AWORK4(2) [& STORE IT IN AWORK4 69PQ LDX 0 4 6=9B LDX 4 BATT(3) [ATT CELL POINTER TO X4 6=P2 ADX 0 4 6?8L BZE 0 YIDEN [BR IF NO ASS OR ATT ON THIS CELL 6?N= CALL 6 XLASAT [LIST ASS AND ATT. 6#7W YIDEN [IDENTIFIER CHAIN LOOP 6#MG LDX 2 FX2 6*76 LDX 0 AWORK2(2) [RESTORE CELL POINTER 6*LQ BZE 0 X7900 [END OF IDENTIFIER CHAIN 6B6B CALL 7 XMXB [ACCESS NEXT IDENTIFIER CELL 6BL2 LDX 5 BNO(3) [LOAD IDENTIFIER NO INTO X5 6BS= ... ADN 1 A1+10 6C2G ... BCHX 1 £ 6C8Q ... BCHX 1 £ 6CC2 ... BCHX 1 £ 6CK= CALL 7 XCBD [CONVERT AND STORE 6CXM ... SBN 1 A1+11 6D=4 ... ANDX 1 BITS22LS 6DJG LDX 0 0(3) [STORE POINTER TO NEXT IDENTIFIER 6F46 STO 0 AWORK2(2) [CELL IN AWORK2 6FHQ LDX 0 BASS(3) [LOAD POINTER TO ASSOC CELL 6G3B STO 0 AWORK4(2) [& STORE IT IN AWORK4 6GH2 LDX 4 BATT(3) [LOAD POINTER TO ATT CELL 6H2L ADX 0 4 6HG= BZE 0 YIDEN [BR IF NO ASS OR ATT ON THIS IDEN 6H^W CALL 6 XLASAT [LIST ASS AND ATT 6JFG BRN YIDEN 6J^6 XNO7900 6KDQ MHUNTW 3,FILE,FAPB 6KYB LDX 0 A1+1(3) [TEST IF "NO ASSOCS OR ATTRIBS" 6LD2 BPZ 0 XAC [MARKER SET, AND BR IF NOT 6LXL SMO FX1 6MC= LDN 4 XMESS 6MWW LDN 5 A1+3(3) 6NBG MOVE 4 10 [MOVE IN MESSAGE 6NW6 CALL 7 WRITE [WRITE BLOCK AWAY 6P*Q XAC 6PTB VFREE FILE,FAPB 6Q*2 ACROSS LISTPROP,1 6QSL ZFULL [FILEFULL ERROR LABEL 6R#= GEOERR 1,LIFFULL 6RRW YERR [MASTER FAPB LOST IN XLASAT 6S?G GEOERR 1,FAPBLOST 6SR6 NOPR 6T=Q GEOERR 1,LOSTPROP 6TQB WRITE 6W=2 # 6WPL # THRS SUBROUTINE IS AN EXTENSION TO THE SUBROUTINE SETUP TO APPEND 6X9= # A FILE/FAPB, AND TO TEST THE REPLY AND THEN FREE RT 6XNW # 6Y8G SBX 7 FX1 6YN6 APPEND 2,XREFU [WRITE LINE AWAY 6^7Q TESTREP REFUSED,XREFU 6^MB TESTREP FILEFULL,ZFULL [TEST REPLY 7272 MHUNTW 1,FILE,FAPB [HUNT FAPB (POINTER IN X1) 72LL LDX 2 FX2 736= BRN XWRIT 73KW SETUP 745G SBX 7 FX1 [RELATIVISE LINK 74K6 LDX 2 FX2 754Q SETNCORE 32,1,FILE,FAPB [SET UP AN APPEND BLFCK 75JB XWRIT 7642 LDN 5 32 76HL STO 5 A1(1) [STORE WORDCOUNT 773= LDN 5 #42 [PFFC 77GW STO 5 A1+1(1) 782G BRN X1 78G6 SPACES 78^Q # THIS SECTION SPACEFILLS THE FAPB 79FB SBX 7 FX1 79^2 MHUNTW 1,FILE,FAPB 7=DL X1 7=Y= LDX 5 ACES 7?CW STO 5 A1+2(1) 7?XG LDN 5 A1+2(1) [SPACEFILL FAPB 7#C6 LDN 6 A1+3(1) 7#WQ MOVE 5 29 7*BB ADX 7 FX1 [REFIX LINK 7*W2 EXIT 7 0 7B*L XREFU ACROSS LISTSTAR,30 7BT= XCBD [CONVERT BINARY TO DECIMAL AND 7C#W LDN 6 0 [STORE IN ADDRESS HELD IN X1 7CSG SMO FX1 7D#6 DVR 5 XCON [NUMBER TO BE CONVERTED IN X5 7DRQ LDX 5 6 7F?B LDCT 6 #200 7FR2 MODE 1 [SET ZERO SUPPRESSION MODE 7G=L LDN 0 4 [4 CHARACTERS TO CONVERT 7GQ= XBDC 7H9W CBD 5 0(1) [X1 HOLDS DESTINATION ADDRESS 7HPG BCHX 1 £ 7J96 BCT 0 XBDC 7JNQ EXIT 7 0 7K8B XMXB [SUBROUTINE ACCESSES A RECORD IN THE 7KN2 # [IDF WHOSE POINTER IS IN ACOMMUNE3 7L7L SBX 7 FX1 [AND GIVES A POINTER TO IT (IN CORE) 7LM= LDX 3 FX2 [IN X3 7M6W LDX 4 0 7MLG #SKIP K6LISTAST>199$199 7N66 TRACE 4,CELLPTR 7NKQ SLL 0 1 [REMOVE BIT 0 7P5B SRL 0 10 [RECORD POINTER TO X0 7PK2 STO 0 ACOMMUNE3(3) 7Q4L MXB 3 [ACCESS RECORD 7QJ= ANDN 4 #777 [MASK IN CELL POINTER 7R3W ADX 3 4 [CELL(CORE) POINTER IN X3 7RHG MHUNTW 1,FILE,FAPB [PRESERVE POINTER TO FAPB IN X1 7S36 ADX 7 FX1 7SGQ EXIT 7 0 7T2B XLASAT [SUBROUTINE LISTS THE ASSOCIATIONS 7TG2 # AND ATTRIBUTIONS CONTAINED IN THE CELLS POINTED AT BY 7T^L # AWORK4 (ASSOC) AND X4 (ATT).AN FAPB IS EXPECTED, HOLDING 7WF= # DETAILS TO BE PRINTED ON THE FIRST LINE. THIS BLOCK IS 7WYW # PRESERVED. AN ADATA CSTORE BLOCK IS CREATED TO HOLD THE 7XDG # TWO CELLS IN THE FIRST INSTANCE 7XY6 SMO FX2 7YCQ LDX 3 AWORK4 [RESTORE ASSOC. CELL POINTER 7YXB SBX 6 FX1 [LINK IN X6 7^C2 SMO FX2 7^WL STO 6 AWORK4 [STORE LINK 82B= CALL 7 SETUP [SET UP SUBS. FAPB BLOCK 82TW LDX 2 1 [SUBS. FAPB PTR. TO X2 83*G HUNT2OPT 1,FILE,FAPB [PTR. TO MASTER FAPB IN X1 83T6 BNG 1 YERR [IT'S NOT THERE 84#Q LDN 5 A1+2(1) 84SB LDN 6 A1+2(2) 85#2 ... MOVE 5 10 [MOVE IN UNIT DETAILS FROM MASTER 85RL LDX 5 3 [PRESERVE POINTER TO ASSOC. CELL 86?= SETNCORE 16,3,ADATA,CSTORE [GET ADATA/CSTORE BLOCK, PTR. IN X3 86QW LDX 0 5 87=G LDX 5 4 [POINTER TO ATT CELL TO X6 87Q6 BZE 0 XNOASS 889Q CALL 7 XMXB [GET ASSOCIATION CELL INTO CORE 88PB LDX 4 5 8992 MHUNTW 2,ADATA,CSTORE [FIND ADATA/CSTORE 89NL LDN 5 0(3) 8=8= LDN 6 A1(2) 8=MW MOVE 5 8 [MOVE ASSOC CELL INTO ADATA/CSTORE 8?7G BRN XQRL 8?M6 XNOASS [NO ASSOCIATIONS, SO ZEROISE 1ST 8 8#6Q LDX 4 5 8#LB STOZ A1(3) [WORDS OF ADATA/CSTORE 8*62 LDN 5 A1(3) 8*KL LDN 6 A1+1(3) 8B5= MOVE 5 7 8BJW LDX 2 3 8C4G XQRL 8CJ6 BZE 4 XNOATT [BR. IF NO ATTRIBUTIONS 8D3Q LDX 0 4 8DHB CALL 7 XMXB [ACCESS ATTRIBUTION CELL 8F32 MHUNTW 2,ADATA,CSTORE [FIND ADATA/CSTORE 8FGL LDN 5 0(3) 8G2= LDN 6 A1+8(2) 8GFW MOVE 5 8 [MOVE ATT CELL INTO ADATA/CSTORE 8G^G BRN YQRL 8HF6 XNOATT [NO ATTRIBUTIONS, SO ZEROISE LAST 8HYQ STOZ A1+8(2) [8 WORDS OF ADATA/CSTORE 8JDB LDN 5 A1+8(2) 8JY2 LDN 6 A1+9(2) 8KCL MOVE 5 7 8KX= YQRL 8LBW LDX 7 A1+8(2) [LOAD ATT CELL INTERNAL POINTER 8LWG BNG 7 XNOTFIN [BR. IF NO MORE ATTRIBUTIONS 8MB6 SMO 7 8MTQ LDX 6 A1+10(2) [LOAD ATTRIBUTION WORD 8N*B BNZ 6 ZETA 8NT2 BZE 7 XLMN 8P#L ZETA 8PS= BZE 6 ZNOATT [BR. IF NO MORE ATTRIBUTIONS 8Q?W CALL 5 XPROP [ACCESS PROPERTY NAME 8QRG LDN 5 A1+12(1) 8R?6 BZE 7 ZCONS [BR. IF CONSOLE PROPERTY 8RQQ ADN 5 6 8S=B ZCONS 8SQ2 MOVE 4 3 [MOVE IN PROPERTY 8T9L XLMN 8TP= LDX 0 7 8W8W ADN 7 1 8WNG STO 7 A1+8(2) [UPDATE POINTER 8X86 BZE 0 YQRL [LAST ATT WAS CONSOLE, SO GO AND DO 8XMQ SBN 0 5 [ANOTHER ONE 8Y7B BNZ 0 XZYW 8YM2 ZNOATT 8^6L NGS 1 A1+8(2) [NO MORE ATTRIBUTIONS: SET PTR -VE 8^L= XZYW 925W # NOW TO DO AN ASSOCIATION 92KG # 9356 LDX 7 A1(2) [LOAD INTERNAL ASSOC CELL POINTER 93JQ BNG 7 ZNOASS [BR. IF NO MORE ASSOCIATIONS 944B SMO 7 94J2 LDX 6 A1+2(2) [LOAD NEXT ASSOCIATE WORD 953L BZE 6 ZNOASS [BR. IF NO MORE 95H= SMO FX1 [MK.6 - ASSUME LF ASSOCIATED 962W LDX 4 XLF [MOVE CHARACTERS ",LF " INTO 96GG STO 4 A1+25(1) [FAPB 9726 ANDN 6 #3200 [MASK IN *LP,*TP*CP BITS 97FQ BNZ 6 ZOK 97^B GEOERR 1,IDF CLTP 98F2 ZOK 98YL LDX 3 FX1 99D= LDN 5 0 99XW SLL 6 13 [*TP BIT TO B0 9=CG BPZ 6 XNTP [BR IF NOT *TP ASSOCIATED 9=X6 LDX 0 XTP(3) 9?BQ STO 0 A1+26(1) [STORE *TP IN FAPB 9?WB ADN 5 1 9#B2 XNTP 9#TL SLL 6 1 [*LP BIT TTO B0 9**= BPZ 6 XNLP [BR IF NOT *LP ASSOCIATED 9*SW LDX 0 XLP(3) 9B#G SMO 5 9BS6 STO 0 A1+26(1) [STORE *LP IN FAPB 9C?Q ADN 5 1 9CRB XNLP 9D?2 SLL 6 2 [*CP BIT TO B0 9DQL BPZ 6 XNCP [BR IF NOT *CP ASSOCIATED 9F== LDX 0 XCP(3) 9FPW SMO 5 9G9G STO 0 A1+26(1) [STORE *CP IN FAPB 9GP6 XNCP 9H8Q SMO 7 9HNB LDX 6 A1+3(2) [LOAD PROPERTY NUMBER 9J82 CALL 5 XPROP [ACCESS PROPERTY NAME 9JML LDN 5 A1+22(1) 9K7= MOVE 4 3 [MOVE PROPERTY INTO FAPB 9KLW ADN 7 2 9L6G STO 7 A1(2) [UPDATE ASSOC CELL POINTER 9LL6 SBN 7 5 9M5Q BNG 7 XNOTFIN 9MKB ZNOASS 9N52 NGS 2 A1(2) [END OF ASSOC. CELL REACHED 9NJL XNOTFIN 9P4= CALL 7 WRITE [WRITE LINE AWAY 9PHW MHUNTW 2,ADATA,CSTORE [HUNT ADATA/CSTORE 9Q3G LDN 0 #41 [SINGLE LINE PFFC 9QH6 STO 0 A1+1(1) 9R2Q LDX 0 A1+8(2) 9RGB BNG 0 WEST [BR. IF NO MORE ASSOCS TO DO 9S22 BRN YQRL 9SFL WEST 9S^= LDX 0 A1(2) 9TDW BNG 0 QUIT [BR IF NO MORE ASSOCS EITHER 9TYG BRN XZYW 9WD6 QUIT [IT'S ALL OVER 9WXQ VFREE ADATA,CSTORE 9XCB VFREE FILE,FAPB 9XX2 MHUNTW 1,FILE,FAPB [HUNT MASTER FAPB 9YBL LDX 2 FX2 9YW= LDX 6 AWORK4(2) 9^*W ADX 6 FX1 9^TG EXIT 6 0 =2*6 XPROP =2SQ # THIS SUBROUTINE ISSUES THE MACRO APROPNAME TO ACCESS, AND STORE =3#B # IN ACOMMUNE1,2,3, THE PROPNRTY WHOSE NUMBER IS PROVIDED IN X6 =3S2 # =4?L SBX 5 FX1 [RELATIVISE LINK IN X5 =4R= ANDX 6 BITS22LS [MASK OUT EXCL/PERM BITS =4S^ ...[ =4WN ...[ FOR SHFS IF A PROPERTY WAS CANCELLED WHILE THE LINK WAS DOWN THERE =4YC ...[ MAY STILL BE REFERENCES IN IDFB TO PROP. NOS. THAT NO LONGER EXIST =526 ...[ =57? ...SNOMATTER =5=W APROPNAME 6,1,NOPR [GET PROP NAME =5QG MHUNTW 2,ADATA,CSTORE [HUNT ADATA/CSTORE =6=6 MHUNTW 1,FILE,FAPB [HUNT FILE/FAPB =6PQ HUNT2OPT 3,FILE,FAPB,1 [HUNT MASTER FAPB =79B LDX 0 BITS22LS [UNSET "NO ASSOCS OR ATTRIBS FOUND =7P2 ANDS 0 A1+1(3) [YET" MARKER =88L SMO FX2 =8N= LDN 4 ACOMMUNE1 [ADDRESS OF PROPERTY NAME LOCATION =97W ADX 5 FX1 [REFIX LINK =9MG EXIT 5 0 ==76 X659 ==LQ LDX 0 0(3) =?6B STO 0 AWORK1(2) =?L2 LDCH 0 BNUMB(3) =#5L ANDN 0 #20 =#K= BZE 0 REX =*4W LDEX 7 BTYPE(3) =*82 ...#UNS AV7900S =*?6 ... FINDPERE 2,APGEOG,7,,AV7900 [FIND DEVICE LIST.(INCLUDE V7900 DLS) =*B= ...#UNS AV7900S =*FB ...#SKI =*JG FINDPERE 2,APGEOG,7 =B46 BNG 2 XIT1 =BHQ LDEX 0 BTYPE(3) =C3B LGEOG 2,7 =CH2 TXU 0 7 =D2L BCC REX =DG= XIT1 =D^W LDX 2 FX2 =FFG EXIT 4 0 =F^6 REX =GDQ LDX 2 FX2 =GYB EXIT 4 1 =HD2 #PAGE =HXL MENDAREA 19,K100LISTAST =JC= #END ^^^^ ...74011112000100000000