IDFASAT867
(George Source)
Macros used: ALTLEN, AND, BXE, CHAIN, CLOSE, DOWN, ERRORX, FI, FINDPEREC, FREECORE, GEOERR, HUNT2, HUNTMISB, IDFOPEN, IDFWRITE, IF, LFAT, LGEOG, LTYPE, MENDAREA, MFREEALL, MGETCELL, MHUNTW, MSEARCH, MXB, OPEN, OUTNUM, PARSORT, SEGENTRY, SETNCORE, THEN, TRACE, UP, UPPLUS
- IDFASAT867.txt
22FL #SEG IDFASAT8 [G CONSTANTINIDES 22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982 22^= #OPT K0IDFASAT=0 23DW #LIS K0IDFASAT>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF 23YG 8HIDFASAT8 24D6 # ENTRY POINTS 24XQ SEGENTRY K10IDFASAT,Z10IDFASAT 25CB SEGENTRY K20IDFASAT,Z20IDFASAT 25X2 SEGENTRY K30IDFASAT,Z30IDFASAT 26BL MENDAREA 50,K100IDFASAT 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 XJASSOCA +JASSOCA [ASSOCIATION ALREADY DEFINED 29#B XJASSOCB +JASSOCB [ONLY 3 ASSOCIATIONS ALLOWED 29S2 # 2=?L PARSORT [CPAR/JSCE MUST ALREADY EXIST 2=R= [AND IT MUST DESCRIBE AN IPB,UX,MPX 2?=W MHUNTW 3,CPAR,JSCE 2?QG LDX 1 JSCEP(3) [DEVICE LIST POINTER 2#=6 LGEOG 1,6 [GEOG NUMBER 2#PQ LDX 4 JSCEB(3) [LINE NO FOR MX,UX 2*9B BNG 4 XREMDEV [J IF REMOTE 2*P2 LDN 5 0 2B8L BRN XFINI [FINISHED 2BN= XREMDEV [NOTE THAT MOP WOULD BE REMOTE IN 2C7W SLL 4 1 [THIS CONTEXT 2CMG LDX 5 JSCEA(3) 2D76 BPZ 4 XONUXMX [J IF ON MX,UX 2DLQ LDCT 0 #400 [B0=1 TO INDICATE IPB 2F6B ORX 6 0 [GEOG NO 2FL2 ANDN 5 #7777 [IDENTIFIER NO 2G5L BRN XFINI 2GK= XONUXMX [MPX,UPX 2H4W SLL 5 6 [IDENT-INTERFACE NO 2HJG BZE 5 XNOID [JUST LINE 2J46 LDCT 0 #200 [B1=1 FOR MPX,UX IF IDENTIFIER 2JHQ ORX 6 0 [SPECIFIED 2K3B XNOID 2KH2 SRL 4 10 2L2L DCH 4 5 [LINE NO 2LG= XFINI STO 5 ACOMMUNE4(2) 2L^W STO 6 ACOMMUNE3(2) 2MFG LDX 1 FX1 2M^6 EXIT 7 0 2NDQ OPEN SBX 6 FX1 [OPEN IDF 2NNJ ... IDFOPEN XBRK 2PD2 ADX 6 FX1 2PXL EXIT 6 0 2Q7D ...XBRK UP 2QC= # 2QWW WRITECLOSE 2RBG SBX 7 FX1 2RW6 IDFWRITE 2S*Q BRN WR 2STB ZCLOSE 2T*2 SBX 7 FX1 2TSL MFREEALL FILE,FRRB 2W#= WR CLOSE 2WRW ADX 7 FX1 2X?G EXIT 7 0 2XR6 # 2Y=Q SELL SBX 7 FX1 2YQB MGETCELL 2,3 2^=2 ADX 7 FX1 2^PL EXIT 7 0 329= # 32NW SEARCH 338G SBX 6 FX1 33N6 MSEARCH 2,3,4 347Q SMO FX2 34MB LDX 0 ACOMMUNE1 3572 ADX 6 FX1 35LL EXIT 6 0 366= # 36KW RECFIND 375G LDX 2 FX2 37K6 REC HUNT2 2,FILE,FRRB 384Q TXU 6 BRECNO+A1(2) 38JB BCS REC 3942 ADN 2 A1 39HL EXIT 7 0 3=3= # 3=GW YREC BPZ 3 SAME [FIND CELL X3 POINTS TO 3?2G YREC1 SBX 6 FX1 3?G6 LDX 0 3 3?^Q SRL 0 9 3#FB ANDN 0 #7777 3#^2 LDX 2 FX2 3*DL STO 0 ACOMMUNE3(2) 3*Y= MXB 2 3BCW ADX 6 FX1 3BXG SAME ANDN 3 #777 3CC6 EXIT 6 0 3CWQ # 3DBB TRACE LDX 4 ACOMMUNE3(2) [UNIT NO 3DW2 LDX 5 ACOMMUNE4(2) [LINE/IDENTIFIER NO 3F*L TRAC2 SBX 7 FX1 3FT= LDX 0 ACOMMUNE2(2) 3G#W STO 0 AWORK2(2) [KEEP PROPERTY PARAMETER 3GSG CALL 6 OPEN 3H#6 BNG 4 T7900 [J.IF 7900 3HRQ LDN 3 BUNIT 3J?B CALL 6 SEARCH 3JR2 BZE 0 UINV [J.IF NOT FOUND-INVALID UNIT 3K=L LDN 3 BLINE(3) 3KQ= SLL 4 1 [MOVE UP B1(SET IF 7020 INFO. IN X5) 3L9W ANDX 4 GSIGN [AND ONLY KEEP B1 3LPG DCH 5 4 [LINE NO INTO X4 3M96 CALL 6 SEARCH 3MNQ BZE 0 MINV [J.IF NOT FOUND-INVALID LINE 3N8B BPZ 4 TR1 [J.IF NO IDENTIFIER 3NN2 SMO 2 [NOW KEEP X4 AS MARKER 3P7L LDX 3 BLINE(3) 3PM= TR3 BZE 3 TINV [J.FOR INVALID TERMINAL 3Q6W CALL 6 YREC 3QLG ADX 3 2 3R66 LDX 0 BNO(3) [IDENTIFIER/POLLING ADDRESS 3RKQ ERX 0 5 3S5B ANDX 0 HALFTOP [ONLY IDENTIFIER SIGNIFICANT 3SK2 BZE 0 TR2 [J.IF RIGHT IDENTIFIER 3T4L LDX 3 0(3) 3TJ= BRN TR3 3W3W TR2 ANDN 5 #7700 [MASK OUT INTERFACE NO 3WHG BZE 5 TR11 [J.IF INTERFACE NOT REQUIRED 3X36 SRL 5 6 [INTERFACE NO INTO CHAR3 3XGQ TR4 LDX 0 BTYPE(3) 3Y2B LDCH 6 0 3YG2 ERX 6 5 3Y^L BZE 6 TR11 [J.IF CORRECT INTERFACE 3^F= LDX 0 BTYPE+1(3) 3^YW LDCH 6 0 [CHECK POSSIBLE CONSOLE INTERFACE 42DG ERX 6 5 42Y6 BZE 6 TR11 [J.IF CORRECT INTERFACE 43CQ LDX 0 BTYPE+2(3) 43XB BNG 0 TINV [J.FOR INVALID TERMINAL INTERFACE 44C2 LDX 3 0(3) 44WL BNZ 3 TR5 45B= TGEO GEOERR 1,IDF7020 [SOMETHING UP WITH 7020'S IN IDF 45TW TR5 CALL 6 YREC 46*G ADX 3 2 46T6 BRN TR4 47#Q TR11 SBX 3 2 47SB TR1 ADX 7 FX1 48#2 EXIT 7 0 [ON EXIT X4 NEG IF 7020 IDENTIFIER EXISTED 48RL T7900 LDN 3 BIPB 49?= CALL 6 SEARCH 49QW BZE 0 UINV [J.FOR INVALID UNIT 4==G LDN 3 BLINE(3) 4=Q6 LDX 4 5 4?9Q CALL 6 SEARCH 4?PB BZE 0 RINV [J.FOR INVALID IDENTIFIER 4#92 BRN TR1 4#NL # 4*8= # ERRORS!!!! 4*MW UINV LDX 3 XILLUN(1) [ILLEGAL UNIT 4B7G ONVMA ANDN 4 #7777 4BM6 ONUM 4C45 ... OUTNUM 4,0 4C6Q YERC CALL 7 ZCLOSE 4CLB ERRORX 3 4CW8 ... UPPLUS 1 4DKL MINV LDX 3 XILLINE(1) [ILLEGAL LINE 4F5= BRN ONVMA 4FJW RINV LDX 3 XILLIDE(1) [ILLEGAL IDENTIFIER 4G4G BRN ONVMA 4GJ6 TINV LDX 3 XINTEM(1) [7020 TERM/INTERFACE NOT IN IDF 4H3Q BRN YERC 4HHB XERR LDX 3 XJASSOCA(1) [ASSOCIATION ALREADY DEFINED 4J32 BRN YERC 4JGL YERR LDN 4 ASSMAX [GOT 3 ASSFCIATIONS ALREADY 4K2= LDX 3 XJASSOCB(1) 4KFW BRN ONUM 4K^G # 4LF6 # 4LYQ Z10IDFASAT [MIDFAS ENTRY(ASSMAX MUST BE <4) 4MDB CALL 7 PARSORT 4MY2 LDX 0 ACOMMUNE1(2) 4NCL STO 0 AWORK1(2) [KEEP "BIT" WORD PARAMETER 4NX= CALL 7 TRACE [TRACE REQUIRED CELL 4PBW SMO 2 4PWG LDX 6 BASS(3) 4QB6 BNZ 6 NOMAK [J IF GOT ASSOCIATE CELL ALREADY 4QTQ LDN 3 BASS(3) 4R*B CALL 7 SELL [GET CELL FOR ASSOCIATES 4RT2 ADN 3 BTYPE(2) 4S#L LDN 1 0 4SS= TIDY SMO FX2 4T?W LDN 2 AWORK1 4TRG MOVE 2 2 [MOVE IN ASSOCIATIONS 4W?6 SBN 3 BTYPE(1) 4WQQ LDN 0 1 [FOR UPDATING COUNT OF ASSOCIATIONS 4X=B ADS 0 BNO(3) 4XQ2 WRITE CALL 7 WRITECLOSE 4X^S ... UPPLUS 2 4YP= NOMAK LDX 3 6 4^8W CALL 6 YREC 4^NG ADN 3 BTYPE(2) [X3 POINTS TO FIRST ASSOCIATE RECORD 5286 LDN 6 0 [USE X6 AS SWITCH-ZERO FOR PASS 1 52MQ ZIP LDN 7 ASSMAX [X7 IS COUNT OF MAX NO OF ASSOCIATES 537B SMO FX2 53M2 LDX 5 AWORK1 [NEW "BIT" WORD IN X5 546L ZOOP LDX 4 0(3) [IDF "BIT" WORD IN X4 54L= BNZ 4 ZA 555W BNZ 6 ZB [J.IF SWITCH SET INDICATING PASS 2 55KG LDCT 0 #200 5656 ORX 7 0 [SET B1 OF X7 AS MARKER 56JQ BRN UPDAT 574B ZB BNG 6 UPDAT 57J2 LDN 1 ASSMAX 583L SBX 1 7 [SO ASSOCIATIONS GO IN RIGHT PLACE 58H= SLL 1 1 [MULT.BY 2 592W BRN TIDY [TO PUT ASSOCIATION IN IDF 59GG ZA ORX 4 5 5=26 TXU 4 0(3) 5=FQ BCC XERR 5=^B ERX 4 5 5?F2 ANDX 4 HALFTOP 5?YL BNZ 4 UPDAT [J.IF COMMANDS DO NOT M&TCH 5#D= SMO FX2 5#XW LDX 0 AWORK2 5*CG TXU 0 1(3) [COMPARE PROPERTY NUMBERS 5*X6 BCC ZF [J.IF PROPS.SAME 5BBQ LDX 4 0(3) [AND IF PROPS DIFFER MAKE SURE- 5BWB ANDX 4 5 [PERIPHERALS DIFFER 5CB2 ANDN 4 #7777 5CTL BNZ 4 XERR ["ALREADY GOT THIS ASSOCIATION" 5D*= BRN UPDAT 5DSW ZF BZE 6 ZC [J IF PROPERTIES DIFFER 5F#G ORS 5 0(3) [OTHERWISE BUNG IN NEW ASSOCIATION 5FS6 BRN WRITE 5G?Q ZC ORX 7 GSIGN [SET B0 OF X7 AS MARKER 5GRB UPDAT ADN 3 2 [UPDATE IDF POINTER 5H?2 BCT 7 ZOOP 5HQL BPZ 7 ZD 5J== LDX 6 7 [MAKE SWITCH(X6) NEG 5JPW BRN ZE 5K9G ZD LDCT 0 #200 5KP6 ANDX 0 7 5L8Q BZE 0 YERR [ERROR-NO ROOM FOR THIS ASSOCIATION 5LNB LDX 6 0 [MAKE SWITCH(X6) POSITIVE 5M82 ZE SBN 3 2*ASSMAX [UPDATE X3 TO POINT TO FIRST ASSOC. 5MML BRN ZIP [J.FOR PASS 2 5N7= # 5NLW # 5P6G Z20IDFASAT [PUTCONS ENTRY 5PL6 CALL 7 PARSORT 5Q5Q LDX 4 ACOMMUNE3(2) [UNIT NO 5QKB STO 4 AWORK3(2) [USED FOR HUIDGE 5R52 BZE 4 OPCON [J.IF CENTRAC OPERATORS CONSOLE 5RJL LDX 5 ACOMMUNE4(2) [IDENTIFIER/LINE NO ETC. 5S4= STO 5 AWORK4(2) [USED FOR HUIDGE 5SHW BNG 4 P7900 [J.IF A 7900 DEVICE 5T3G CALL 7 TRAC2 [TRACE CELL 5TH6 BNG 4 P1 [J.IF 7020 CELL 5W2Q P4 CALL 7 ZCLOSE [ERROR ROUTE 5W=J ... UPPLUS 2 5X22 P1 ADX 3 2 5XFL LDCH 0 BTYPE(3) 5X^= SBN 0 3 5YDW BZE 0 P2 [J IF THIS CONSOLE OKAY 5YYG LDX 0 BTYPE+2(3) 5^D6 BNG 0 P4 [J TO ERROR IF THIS 7020 FINISHED 5^XQ LDX 3 0(3) 62CB BZE 3 TGEO [SOMETHING UP-SO GEOERR 62X2 CALL 6 YREC 63BL BRN P1 63W= OPCON LDX 5 ACOMMUNE2(2) [PROPERTY PARAMETER 64*W CALL 6 OPEN 64TG BRN P18 65*6 P7900 CALL 7 TRAC2 [TRACE CELL 65SQ ADX 3 2 66#B LDCH 0 BTYPE(3) 66S2 SBN 0 5 67?L BNZ 0 P4 [J.IF NOT 7023 CONSOLE TO ERROR 67R= P2 LDCT 0 #40 68=W ORS 0 BTYPE+1(3) [SET "THIS IS CLUSTER CONSOLE"BIT 68QG SBX 3 2 69=6 LDX 4 BRECNO(2) [RECORD NUMBER 69PQ SLL 4 9 6=9B ORX 4 3 [IDF POINTER(EXCEPT B0)TO CONSOLE 6=P2 LDN 6 0 6?8L CALL 7 RECFIND [FIND RECORD ZERO 6?N= SMO FX2 6#7W LDX 5 AWORK2 [PICK UP CONSOLE PROPERTY NUMBER 6#MG P18 LDX 6 BEXOT(2) [BASE OF CONSOLE PROPERTY CHAIN 6*76 LDN 3 BEXOT [IN CASE X6 IS ZERO 6*LQ BZE 6 P5 6B6B P7 LDX 3 6 6BL2 CALL 6 YREC 6C5L ADX 3 2 6CK= LDX 0 BNO(3) [NOW COMPARE PROPERTY NOS. 6D4W ERX 0 5 6DJG ANDX 0 BITS22LS [ONLY BOTTOM 22 BITS FOR PROP NO 6F46 BZE 0 P6 [J.IF NOS.ARE SIMILAR 6FHQ LDX 6 0(3) 6G3B BNZ 6 P7 6GH2 SBX 3 2 6H2L P5 CALL 7 SELL [GET NEW CONSOLE PROPERTY CELL 6HG= ADX 3 2 6H^W STO 5 BNO(3) [STORE PROPERTY NUMBER 6JFG P6 BZE 4 P8 [J IF OPS CONSOLE 6J^6 LDX 0 4 [OTHERWISE SEE IF B0 OF IDF POINTER- 6KDQ SRL 0 9 [MUST BE SET 6KYB TXU 0 BRECNO(2) 6LD2 BCC P8 6LXL ORX 4 GSIGN [SET B0 6MC= P8 LDX 7 BTYPE(3) [OLD CONSOLE IF NOT NEW CELL 6MWW STO 4 BTYPE(3) [STORE POINTER(OR ZERO)IN CELL 6NBG LDX 6 7 [SO X6 ONLY ZERO IF NEW CELL OR OLD CONSOLE WAS- 6NW6 [OPS CONS:OTHERWISE X6 POINTS TO OLD CONSOLE 6P*Q ANDX 5 BITS22LS [CONSOLE PROP.NUMBER 6PTB P13 HUNTMISB 2,APERI,CONSOLE [NOTE APERI/CONSOLE WAS CALLED- 6Q*2 [HUIDGE & HENCE LATER COMMENTS! 6QSL BZE 4 P20 [J.IF NEW CONSOLE IS OPS CONSOLE 6R#= BNG 2 P10 [J.IF NO HUIDGE BLOCK 6RRW LDX 3 2 [KEEX COPY OF X2LEAST X6>0 6S?G BNZ 6 P11 [J.IF NOT NEW CONSOLE-PROP(X6 SWITCH) 6SR6 LDN 0 2 [X0=2 IS USED AT P12 6T=Q LDX 7 ALOGLEN(2) [INVESTIGATE HUIDGE LENGTH 6TQB SBX 7 A1(2) 6W=2 SBX 7 0 6WPL BPZ 7 P12 [J.IF LENGTH OKAY 6X9= LDN 7 4 [MAKE CONSOLE BLOCK 4 WORDS LONGER 6XNW ADX 7 ALOGLEN(2) 6Y8G ALTLEN 3,7 [INCREASE APERI/CONSOLE BLOCK 6YN6 BRN P13 6^7Q # CREATE A APERI/CONSOLE BLK & CHAIN IT IN END OF MISC.CHAIN 6^MB P10 BNZ 6 UGEO 7272 ...P101 SETNCORE 4,1,APERI,CONSOLE 72LL LDX 2 BMISC+1 736= CHAIN 1,2 73KW LDX 2 BMISC+1 745G LDN 0 2 74K6 STO 0 A1(2) 754Q P12 LDX 3 2 [KEEP COPY OF POINTER TO HUIDGE 75JB ADS 0 A1(2) [COUNT OF NO.RELEVANT WORDS IN HUIDGE 7642 ADX 2 A1(2) 76HL STOZ A1-2(2) [ZEROIZE POSITION OF "OLD CONSOLE 773= [DESCRIPTION"AS THIS IS NEW ENTRY 77GW STOZ A1-1(2) [ZEROIZE LAST WORD 782G SBN 2 2 78G6 # NOW SET UP AND STORE NEW ENTRY IN APERI/CONSOLE BLOCK 78^Q P16 LDCT 0 #400 79FB LDX 1 FX2 79^2 ANDX 0 AWORK3(1) 7=DL ORX 5 0 7=Y= STO 5 A1-1(2) 7?CW BNG 0 P14 7?XG LDN 7 #7700 [MASK OUT INTERFACE NO.TO MAKE B0-11 7#C6 ORX 7 AWORK4(1) [2 CHAR IDENT & B12-23 LINE NO. 7#WQ ERN 7 #7700 7*BB P15 LDX 4 A1(2) [KEEP OLD CONSOLE'S DESCRIPTION-ZERO? 7*W2 STO 7 A1(2) [STORE NEW CONSOLE'S DESCRIPTION 7B*L # NOW FOLLOWS CODE TO SET/UNSET B1 OF CONS.PROP.NO.IN HUIDGE BLOCK 7BT= # FOR NEW AND OLD CONSOLE:NEW CONSOLE IS INVESIGATED FIRST 7C#W P25 LDX 2 3 [PTR TO HUIDGE INTO X2 & PRESERVE X3 7CSG LDN 5 0 [AS "CONSOLE NOT YET FOUND" SWITCH 7D#6 P23 TXU 7 A1+2(2) [COMPARE CONSOLES 7DRQ BCS P22 [J.IF DIFFERENT 7F?B BNZ 5 P24 [J.IF B1 IS TO BE SET IN HUIDGE BLK 7FR2 LDCT 5 #200 [OTHERWISE MAKE SURE B1 UNSET 7G=L ORS 5 A1+1(2) 7GQ= ERS 5 A1+1(2) 7H9W BRN P22 7HPG P24 ORS 5 A1+1(2) [SET B1 AS INDICATOR IN HUIDGE BLOCK 7J96 P22 ADN 2 2 [UPDATE X2 FOR NEXT HUIDGE INQUIRY 7JNQ LDX 0 A1+1(2) 7K8B BNZ 0 P23 [AND J.FOR NEXT HUIDGE INQUIRY 7KN2 P17 BZE 4 P26 [J.IF OLD CONSOLE NON-EXISTENT IN- 7L7L LDX 7 4 [HUIDGE OR DONE P25 CODE TWICE,OTHER 7LM= LDN 4 0 [WISE SET X4 ZERO &- 7M6W BRN P25 [J.TO DO P25 CODE AGAIN 7MLG # SEE IF "THIS IS CLUSTER CONSOLE" BIT IN IDF MUST BE UNSET 7N66 P26 BZE 6 P21 [J IF NEW CONS.PROP,OR OLD CONS.WAS OPS.CONSOLE 7NKQ BNZ 5 P21 [J.IF CONS.STILL USED-DO NOT UNSET 7P5B P17A LDX 3 6 [OTHERWISE UNSET"THIS IS CLUSTER- 7PK2 CALL 6 YREC1 [CONSOLE"BIT USING IDF POINTER IN X6 7Q4L LDCT 0 #40 7QJ= SMO 2 7R3W ERS 0 BTYPE+1(3) [UNSET BIT 7RHG P21 CALL 7 WRITECLOSE 7RR# ... UPPLUS 3 7SGQ P14 LDN 7 #777 7T2B ANDX 7 AWORK3(1) ["AND" OUT GEOG.NO & MOVE UP GEOG.NO. 7TG2 SLL 7 12 7T^L ORX 7 AWORK4(1) 7WF= BRN P15 7WYW P20 BZE 6 P21 [J.IF OLD CONSOLE WAS OPERATORS OR- 7XDG [THIS IS NEW CONSOLE PROP & DO NOWT 7XY6 BPZ 2 P19 7XYK ...# 7X^4 ...# ENTRY TO THIS POINT MEANS THINGS DONT MATCH BETWEEN THE IDF AND TH 7X^H ...# APERI-CONSOLE BLOCK. IT IS POSSIPLE FOR A CONSOLE PROPERTY TO BE 7Y22 ...# FOR A PERIPHERAL NOT CURRENTLY ON THE INSTALLATION, HOWEVER A REQU 7Y2F ...# HAS BEEN RECIEVED FOR THE PROPERTY TO HAVE A DIFFERENT CONSOLE. T 7Y2Y ...# SITUATION IS CATERED FOR BY THE FOLLOWING CODE. 7Y3C ...# ENTRY FROM:- P10,P11 OR P20 7Y3W ...# VALUES ON ENTRY - X6 = IDF PTR. TO OLD CONSOLE CELL 7Y4* ...# X4 = IDF PTR. LESS B0 OF NEW CONSOLE CELL OR ZER 7Y4S ...# X2 = PTR. TO APERI-CONSOLE BLK 7Y5? ...# OR 7Y5Q ...# NEGATIVE NO BLOCK 7Y69 ...UGEO LDX 1 4 [SV X4 IN X1 7Y6N ... LDX 5 6 [SV X6 IN X5 7Y77 ... LDX 3 6 [LD. PTR. TO OLD CONSOLE 7Y7L ... CALL 6 YREC1 [HUNT BLK. 7Y85 ... SMO 2 7Y8J ... LDX 6 BNUMB(3) 7Y93 ... SLL 6 1 7Y9G ... BNG 6 UGEO1 [J. IDENTIFIER CELL 7Y9^ ... SMO 2 7Y=D ... LDX 4 4(3) [LD. WD. CONTAIN GEOG.NO. OF UNIT 7Y=X ... SRL 4 6 7Y?B ... LDN 3 BUNIT [LD. BASE OF UNIT CHAIN 7Y?T ... BRN UGEO2 7Y## ...UGEO1 SMO 2 7Y#R ... LDX 4 BTYPE(3) [LD. GEOG.NO. 7Y*= ... LDN 3 BIPB [LD. BASE OF UNIT CHAIN-7900 7Y*P ...UGEO2 ANDN 4 #777 [MASK OUT GEOG. NO. 7YB8 ... LDN 6 0 7YBM ... CALL 7 RECFIND [FIND RECORD ZERO 7YC6 ... LDX 7 1 7YCK ... CALL 6 SEARCH [SEARCH FOR UNIT CELL 7YD4 ... LDX 1 7 7YDH ... SMO 3 7YF2 ... LDX 0 BNUMB(2) 7YFF ... SLL 0 1 7YFY ... BNG 0 UGEO3 [J. IF UNIT WRONG 7YGC ...UGEOE GEOERR 1,HUIDGE [FAILED - SOMETHING A MISS 7YGW ...UGEO3 SMO 2 7YH* ... LDX 7 BTYPE(3) [LD. DEVICE TYPE OF IDF UNIT 7YHS ... SRC 7 6 7YJ? ... ANDN 7 #77 [MASK OUT DEVICE TYPE 7YJQ ... FINDPEREC 3,APGEOG,4 [FIND DEVICE LIST 7YK9 ... BNG 3 UGEO4 [J. GEOG. NO. DEVICE LIST NOT FOUND 7YKN ... LTYPE 3,4 [X4 = DEVICE TYPE 7YL7 ... BXE 2 7,UGEOE [J. SOMETHING WRONG 7YLL ...UGEO4 LDX 6 4 [RE-LOAD VALUE OF X6 7YM5 ... SMO FX2 7YMJ ... LDX 5 AWORK2 7YN3 ... ANDX 5 BITS22LS [RE-LOAD CONSOLE PROP.NO. 7YNG ... LDX 4 1 [RE-LOAD IDF PTR. NEW CONSOLE CELL. 7YN^ ...UGEO5 HUNTMISB 2,APERI,CONSOLE [HUNT APERI-CONSOLE 7YPD ... BNG 2 P101 [J. TO SET UP A BLOCK 7YPX ... BZE 4 P17A [J. NEW CONSOLE = OPERATORS 7YQB ... LDN 0 2 7YQT ... LDX 7 ALOGLEN(2) [INVESTIGATE LENGTH OF BLOCK 7YR# ... SBX 7 A1(2) 7YRR ... SBX 7 0 7YS= ... BPZ 7 P12 [J. ENOUGH ROOM. 7YSP ... LDN 7 4 [INCREASE LENGTH OF APERI-CONSOLE 7YT8 ... ADX 7 ALOGLEN(2) 7YTM ... ALTLEN 2,7 [ALTER LENGTH OF BLK 7YW6 ... BRN UGEO5 [J. BACK TO RE-HUNT 7YXB P19 LDX 1 2 [EXTRA COPY OF POINTER INTO X1:NEED- 7^C2 LDX 7 A1(1) [IT ANYWAY & SO MAY FREECORE 7^WL SBN 7 4 82B= BNZ 7 P3 82TW FREECORE 1 [& IF IT WILL BE EMPTY FREE IT! 83*G BRN P17A 83T6 P3 SBX 7 ALOGLEN(1) [OTHERWISE PREPARE X7 FOR ALTLEN- 84#Q ADN 7 16 [TEST(ONLY ALTLEN IF 16 WORDS SPARE). 84SB LDX 3 2 [YET ANOTHER COPY OF HUIDGE POINTER 85#2 P11 ADN 2 2 [NOW HUNT DOWN HUIDGE BLOCK 85RL LDX 0 BITS22LS 86?= ANDX 0 A1-1(2) [PROPERTY NUMBER CONTAINED IN X5 86QW BZE 0 UGEO [SOMETHING UP! 87=G TXU 0 5 [COMPARE 87Q6 BCS P11 [& J.IF NOT THIS ONE 889Q BNZ 4 P16 [J.IF NEW CONSOLE NOT OPERATORS 88PB # THIS CODING DEALS WITH CASE WHEN THE NEW CONSOLE IS OPERATORS 8992 LDX 4 A1(2) [PICK UP OLD CONSOLE DESCRIPTION 89NL LDN 2 A1-1(2) 8=8= LDN 0 2 8=MW SBS 0 A1(1) 8?7G ADX 1 A1(1) 8?M6 LDN 1 A1-1(1) 8#6Q MOVE 1 2 8#LB STOZ 0(1) 8*62 BPZ 7 P17 [DON'T ALTER LENGTH 8*KL LDX 7 A1(3) 8B5= ALTLEN 3,7 [MAKE APERI/CONSOLE SMALLER 8BJW BRN P17 8C4G # 8CJ6 # 8D3Q Z30IDFASAT [IDFAT ENTRY(ATTMAX MUST BE <7) 8DHB CALL 7 PARSORT 8F32 [MPX OR IPB -JUST GEOG NO 8FGL LDX 0 ACOMMUNE1(2) [KEEP WORD INDICATING WHETHER THIS- 8G2= STO 0 AWORK1(2) [IS A CONSOLE PROPERTY 8GFW CALL 7 TRACE [FIND DEVICE CELL 8G^G SMO FX2 8HF6 LDX 5 AWORK1 [RESCUE INDICATOR WORD 8HYQ BPZ 5 Q3 [J.IF NOT CONSOLE PROP 8JDB LDX 0 BRECNO(2) [OTHERWISE KEEP POINTER TO DEVICE CEL 8JY2 SLL 0 9 8KCL ORX 0 3 8KX= SMO FX2 8LBW STO 0 AWORK4 [STORE POINTER IN AWORK4 8LWG Q3 SMO 2 8MB6 LDX 6 BATT(3) [ATTRIBUTION POINTER 8MTQ SMO FX2 8N*B LDX 7 JSOURCE3 8NT2 BNZ 7 Q20 [J.IF NOT CENTRAL 8P#L SMO FX2 8PS= LDX 0 JSOURCE2 8Q?W BNG 0 Q17 [J.IF NOT LOCAL OPS.CONSOLE 8Q*9 ...Q20 8QBJ ... LDX 1 2 8QCX ... ADX 1 3 8QF= ... SMO FX2 8QGK ... LDX 0 AWORK2 8QK? ... SLL 0 1 8QLL ... IF 0,PZ [ TEMPORARY 8QM^ ... AND BS,1,IDF7502LP [ 7502 LP 8QP# ... THEN 8QPJ ... LDX 0 BRECNO(2) 8QPS ... SLL 0 9 8QQ4 ... ORX 3 0 [MAKE FULL IDF PTR FOR YREC1.. 8QQ# ...[ NOTE BIT 0 NOT VALID 8QQM ... DOWN FORMLOOP,1 8QS2 ... IF REP2,WRONG 8QT* ... THEN 8QWN ... CALL 7 ZCLOSE 8QY3 ... UPPLUS 1 8Q^B ... [------- 8R2P ... FI 8R44 ... CALL 6 YREC1 [ REFIND IDENTIFIER CELL 8R5C ... SMO 2 8R6Q ... LDX 6 BATT(3) 8R85 ... FI 8R9D ... BNZ 6 QNMAK [J.IF ATTRIBUTION CELL ALREADY EXISTS 8R?6 BNZ 7 Q17 [ERROR WROOG CLUSTER 8RQQ LDN 3 BATT(3) [OTHERWISE MAKE ONE 8S=B CALL 7 SELL 8SQ2 ADX 3 2 8T9L Q5 LDN 0 1 8TP= ADS 0 BNO(3) [UPDATE COUNT OF ATTRIBUTIONS 8W8W LDX 0 BTYPE(3) [PICK UP CONSOLE PROP WORD 8WNG BNG 5 Q1 [J.IF NEW PROP.IS CONSOLE PROPERTY 8X86 BZE 0 Q2 [OTHERWISE ADJUST X3 TO INDICATE- 8XMQ LDN 0 1 [WHERE NEW PROPERTY IS TO GO IN CELL. 8Y7B Q2 ADX 3 BNO(3) 8YM2 SBX 3 0 8^6L Q4 SMO FX2 8^L= LDX 4 AWORK2 [PICK UP NEW PROPERTY 925W STO 4 BTYPE(3) [STORE NEW PROPERTY IN CELL 92KG BNG 5 QCONS [J.TO UPDATE CONSOLE CHAIN IF NEC. 9356 QXIT 93JQ LFAT 944B CALL 7 WRITECLOSE [OTHERWISE FINISH 94#8 ... UPPLUS 6 953L Q1 BZE 0 Q4 [J.IF NO CONSOLE PROP.YET ATTRIBUTED 95H= CALL 7 ZCLOSE [ALREADY GOT CONSOLE PROP SO ERROR 95R4 ... UPPLUS 3 96GG QNMAK LDX 3 6 9726 CALL 6 YREC [FIND ATTRIBUTION CELL 97FQ ADX 3 2 97^B BRN Q14 98F2 Q17 CALL 7 ZCLOSE 98NS ... UPPLUS 5 99D= Q14 BNG 5 Q18 [IF CONSOLE PROP.DON'T CHECK PRIOR- 99XW SMO FX2 [ATTRIBUTIONS:OTHERWISE CHECK THIS- 9=CG LDX 4 AWORK2 [IS A NEW ATTRIBUTION 9=X6 ANDX 4 BITS22LS 9?BQ LDN 7 5 [COUNT OF POSSIBLE ATTRIBUTIONS 9?WB Q16 SMO 7 9#B2 LDX 0 BTYPE(3) [PICK UP AN ATTRIBUTION(OR ZERO) 9#TL ERX 0 4 9**= ANDX 0 BITS22LS 9*SW BNZ 0 Q15 [J.IF DIFFERENT ATTRIBUTION 9B#G CALL 7 ZCLOSE [OTHERWISE ERROR 9BJ# ... UPPLUS 4 9C?Q Q15 SBN 7 1 9CRB BNZ 7 Q16 [J.FOR NEXT COMPARISON 9D?2 Q18 LDX 0 BNO(3) 9DQL SBN 0 ATTMAX 9F== BNG 0 Q5 [J.IF ROOM FOR ANOTHER ATTRIBUTION 9FPW CALL 7 ZCLOSE [OTHERWISE ERROR 9F^N ... UPPLUS 2 9GP6 QCONS [UPDATE CONSOLE CHAIN 9H8Q ANDX 4 BITS22LS [CLEAR OUT TOP 2 BITS 9HNB LDN 6 0 9J82 CALL 7 RECFIND [FIND RECORD ZERO 9JML LDX 3 BEXOT(2) [CONSOLE PROPERTY CHAIN BASE 9K7= BNZ 3 Q6 9KLW QGEO GEOERR 1,CLUSTERC [ERROR CONSOLE PROP.NOT FOUND 9L6G Q6 CALL 6 YREC 9LL6 ADX 3 2 9M5Q LDX 5 BNO(3) 9MKB ANDX 5 BITS22LS 9N52 TXU 4 5 [COMPARE PROPERTY NUMBERS 9NJL BCC Q7 [J.IF SAME 9P4= LDX 3 0(3) 9PHW BNZ 3 Q6 [J.FOR NEXT CONSOLE PROP 9Q3G BRN QGEO 9QH6 Q7 LDX 5 3(3) [GOT CONSOLE PROP SO GET NO.OF ATTRIB 9R2Q LDN 0 1 9RGB ADS 0 3(3) [UPDATE NO OF ATTRIB 9S22 SBN 5 3 9SFL BNG 5 Q8 [J.IF ROOM IN FIRST CELL 9S^= ADN 3 4 [OTHERWISE MAKE X3 POINT TO FORWARD- 9TDW BNZ 5 Q9 [PTR & J.IF SUBSID CELL MUST EXIST 9TYG Q11 SBX 3 2 [MAKE SUBSID.CELL 9WD6 CALL 7 SELL 9WXQ ADN 3 1(2) 9XCB BRN Q10 [J.TO FILL IN ATTRIB.PTR 9XX2 Q9 LDX 3 0(3) 9YBL BZE 3 QGEO [ERROR! 9YW= CALL 6 YREC 9^*W ADX 3 2 9^TG SBN 5 7 =2*6 BZE 5 Q11 [J.TO MAKE NEW SUBSID.CELL =2SQ BPZ 5 Q9 [J.TO FIND NEXT SUBSID CELL =3#B Q8 ADN 5 8 =3S2 ADX 3 5 [NOW X3 PTS TO POSITION WHERE- =4?L Q10 SMO FX2 [ATTRIB.PTR IS TO BE PLACED =4R= LDX 0 AWORK4 =5=W LDX 7 0 [NOW SEE IF B0 OF IDF PTR NEED BE SET =5QG SRL 7 9 =6=6 TXU 7 BRECNO(2) =6PQ BCC Q12 [J.IF B0 NEED NOT BE SET =79B ORX 0 GSIGN =7P2 Q12 =88L STO 0 0(3) =8N= BRN QXIT [ALL DONE! =97W #END ^^^^ ...05720347000100000000