22FL #SEG IDFPROP8 [G CONSTANTINIDES 22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982 22^= #OPT K0IDFPROP=0 23DW #LIS K0IDFPROP>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF 23YG # 24D6 # THIS SEGMENT COMPARES SYSTEM.PROPERTY AND THE IDF TO MAKE SURE THAT 24XQ # THEY ARE COMPATIBLE:THE IDF IS CHANGED TO MATCH SYSTEM.PROPERTY 25CB # 25X2 # 26BL 8HIDFPROP8 26W= # ENTRY POINTS 27*W SEGENTRY K1IDFPROP,Z1IDFPROP 27TG SEGENTRY K20IDFPROP,Z20IDFPROP 28*6 SEGENTRY K30IDFPROP,Z30IDFPROP 28SQ # 29S2 MENDAREA 50,K100IDFPROP 2=?L #SKI EMSJNL<1$1 2=R= ( 2?=W MSGE 32HUNIT HAS BEEN RECONSTRUCTED 2?QG 32HPLEASE REISSUE IDF COMMANDS 2#=6 ) 2#PQ XPAIR PAIR IDFPROP,20 2*9B MPROP +10 2*P2 12HSYSTEM 2B8L 12HPROPERTY 2BN= +0 2C7W +1 2CMG 4HB1 2D76 XMAJ +10000 2DLQ # 2F6B # 2FL2 YREC [A NON-COORD.ROUTINE(ALL IDF IN CORE) 2G5L BPZ 3 SAME [TO FIND CELL X3 POINTS TO:X2- 2GK= YREC1 LDX 6 3 [IS POINTER TO CURRENT FILE/FRRB 2H4W SRL 6 9 2HJG ANDN 6 #7777 [RECORD NO INTO X6 2J46 LDX 2 FX2 [X1=FX2 2JHQ YR HUNT2 2,FILE,FRRB 2K3B TXU 6 A1+BRECNO(2) 2KH2 BCS YR 2L2L ADN 2 A1 2LG= SAME ANDN 3 #777 [MAKE X3 RELATIVE POINTER 2L^W ADX 3 2 2MFG EXIT 7 0 2M^6 # 2NDQ # 2NYB REC1 LDN 6 0 [FIND RECORD ZERO 2PD2 LDX 2 FX2 2PXL REC HUNT2 2,FILE,FRRB 2QC= TXU 6 A1+BRECNO(2) 2QWW BCS REC 2RBG ADN 2 A1 2RW6 EXIT 7 0 2S*Q # 2STB # 2T*2 SELL SBX 7 FX1 [ROUTINE TO FREE CELL 2TSL MFREECEL 2,3 2W#= ADX 7 FX1 2WRW EXIT 7 0 2X?G # 2XR6 # 2Y=Q ZASAT [ROUTINE TO CLEAR OUT ASSOCS & ATTS IF NECESSARY 2YQB [X2&X3(ABS.) POINT TO PARENT CELL 2^=2 [X1 POINTS TO IDF/APROPNOS BLOCK 2^PL SBX 5 FX1 [ADJUST LINK-FREECELL CO-ORDINATES 329= LDX 4 BATT(3) 32NW LDX 3 BASS(3) 338G BNZ 3 ZA1 [J.IF THERE ARE ASSOCIATIONS 33N6 BNZ 4 ZA2 [J.IF THERE ARE ATTRIBUTIONS 347Q ZAXIT ADX 5 FX1 34MB EXIT 5 0 3572 # 35LL # NOW DEAL WITH GETTING RID OF ASSOCIATIONS 366= # 36KW ZA1 CALL 7 YREC 375G LDX 7 BNO(3) [LOAD NO OF ASSOCS 37*# ... BZE 7 XA2F 37K6 SLL 7 1 [& MULT.BY 2,FOR USE AS PREMODIFIER 39HL ZA7 SMO 7 3=3= LDX 6 BNO(3) [PICK UP PROP.NO 3=GW LDX 0 6 [AND MAKE SURE IT IS IN CURRENT 3?2G ANDX 0 BITS22LS [LIMITS OF IDF/APROPNOS BLOCK 3?G6 SBX 0 A1(1) 3?^Q BNG 0 ZA4 [J.IF NOT 3#FB SBN 0 1000 3#^2 BNG 0 XA1 3*DL LDX 0 A1+1001(1) 3*Y= BNG 0 XA2 3BCW BRN ZA4 3BXG XA1 3CC6 ADN 0 1001 3CWQ SMO 0 [OTHERWISE CHECK NO.IS IN BLOCK 3DBB ERX 6 A1(1) 3DW2 ANDX 6 BITS22LS 3F*L BZE 6 ZA4 [J.IF ALL OKAY 3L9W XA2 3LPG ON G4SUDBIT [TO INDICATE"SEND MESSAGE" 3M96 LDX 0 BNO(3) 3MNQ SBN 0 1 [SUBTRACT 1 FROM NO.OF ASSOCS 3N8B BNZ 0 ZA5 [J.IF NOT ZERO AS WILL KEEP CELL 3ND8 ...XA2F 3NN2 SMO FX2 3P7L LDX 3 AWORK4 3PM= CALL 7 YREC1 3Q6W SBX 3 2 3QLG ADN 3 BASS 3R66 CALL 7 SELL [CLEAR CELL 3RKQ MHUNTW 1,IDF,APROPNOS [REHUNT IDF/APROPNOS BLOCK 3S5B BNZ 4 ZA3 [J.FOR ATTRIBUTIONS 3SK2 BRN ZAXIT [OTHERWISE EXIT 3T4L ZA5 STO 0 BNO(3) [ADJUST ASSOCS COUNT 3TJ= SMO 7 3W3W STOZ BNO-1(3) [CLEAR ASSOCS 3WHG SMO 7 3X36 STOZ BNO(3) 3XGQ ZA4 SBN 7 2 3Y2B BNZ 7 ZA7 [J.FOR NEXT ASSOCS 3YG2 # 3Y^L # NOW DEAL WITH GETTING RID OF ATTRIBUTIONS 3^F= # 3^YW BZE 4 ZAXIT 42DG ZA2 42Y6 ZA3 LDX 3 4 43CQ CALL 7 YREC1 43XB LDX 7 BNO(3) [NO.OF ATTRIBS 4478 ... BZE 7 ZA15F 45TW ZA9 SMO 7 46*G LDX 6 BTYPE(3) [PICK UP POSSIBLE ATTRIB 46T6 BZE 6 ZA8 [J.IF NULL 47#Q LDX 0 6 [OTHERWISE SEE IF NO.IN BLOCK LIMITS 47SB ANDX 0 BITS22LS 48#2 SBX 0 A1(1) 48RL BNG 0 ZA8 [J.IF NOT 49?= SBN 0 1000 49QW BNG 0 XA3 4==G LDX 0 A1+1001(1) 4=Q6 BNG 0 ZA15 4?9Q BRN ZA8 4?PB XA3 4#92 ADN 0 1001 4#NL SMO 0 4*8= LDX 0 A1(1) [PICK UP APROPRIATE BLOCK ENTRY 4*MW BZE 0 ZA15 [J.IF NON-EXISTENT:THAT IS NO PROP. 4B7G SMO 7 [OTHERWISE RE-STORE PROP.NO IN CASE 4BM6 STO 0 BTYPE(3) [PERM/TEMP/EXCL/INCL DISCREPANCY 4C6Q BRN ZA8 [J.TO LOOK AT NEXT ATTRIB IF NEC. 4CLB ZA15 ON G4SUDBIT 4D62 LDX 0 BNO(3) 4DKL SBN 0 1 [INVESTIGATE COUNT 4F5= BNZ 0 ZA10 [J.IF NO NEED TO FREE CELL 4F*4 ...ZA15F 4FJW SMO FX2 [OTHERWISE FREE CELL 4G4G LDX 3 AWORK4 4GJ6 CALL 7 YREC1 4H3Q SBX 3 2 4HHB ADN 3 BATT 4J32 CALL 7 SELL 4JGL MHUNTW 1,IDF,APROPNOS [REHUNT BLOCK & EXIT 4K2= BRN ZAXIT 4^NG ZA10 STO 0 BNO(3) [STORE ADJUSTED COUNT 5286 SMO 7 52MQ STOZ BTYPE(3) [CLEAR ATTRIBUTION 537B ZA8 SBN 7 1 53M2 BPZ 7 ZA9 [J.FOR NEXT ATTRIBUTION 546L LDX 0 BTYPE(3) [OTHERWISE BEGIN "MOVE UP"------ 54L= LDX 7 BNO(3) 555W BZE 0 ZA11 [J.IF NO CONSOLE PROP 55KG SBN 7 1 [OTHERWISE ADJUST COUNT 5656 BZE 7 ZAXIT 56JQ ZA11 LDX 6 3 574B ZA14 LDX 0 BTYPE+1(3) 57J2 BNZ 0 ZA12 [J.IF FOUND A "MOVING"CANDIDATE 583L ADN 3 1 58H= BRN ZA14 [& IF NOT J.TO LOOK AGAIN IN NXT WORD 5=FQ ZA12 STOZ BTYPE+1(3) [CLEAR OLD POSITION 5=^B SMO 6 5?F2 STO 0 BTYPE+1 [AND STORE IN NEW POSITION 5?YL SBN 7 1 5#D= BZE 7 ZAXIT [J.TO EXIT IF ALL DONE 5#XW ADN 6 1 5*CG ADN 3 1 5*X6 BRN ZA14 [OTHERWISE CONTINUE MOVING 5BBQ # 5BWB # 5W2Q Z1IDFPROP 5WGB OFF G4SUDBIT [MAKE SURE SWITCH CLEAR 5X22 SETNCORE 10,3,FILE,FABSNB [TO OPEN SYSTEM.PROPERTY 5XFL LDN 4 A1(3) 5X^= LDN 3 MPROP(1) 5YDW MOVE 3 10 5YYG SETMODE 4,GENERAL,QUERY,CAREFUL [TO OPEN SYSPROP 5^D6 OPEND PCERR,4 5^XQ TESTREP OK,PC1 62CB PCERR GEOERR 1,PROPFILE 62X2 PC1 MHUNT 3,FILE,FABSNB [FREE FABSNB-NO GOOD FOR IDFOPEN 63BL FREECORE 3 63W= IDFOPEN [OPEN IDF 64*W LDN 4 2 [NOW READ WHOLE IDF INTO CORE 64TG PC2 READED 4,4 65*6 ADN 4 1 65SQ TESTREP OK,PC2 [J.TO READ NEXT BLOCK IF NECESSARY 65YM ... TESTREPNOT NORIT,PC2A 664J ... MFREE FILE,FRRB 668F ...PC2A 66#B STEP 1 66S2 BZE 3 PCERR [J.TO ERROR NO CENTRAL 67?L PC4 STEP 1 67R= BZE 3 PC3 68=W LDX 5 APROPGROUP(3) 68QG BPZ 5 PC4 [J.IF NOT CONSOLE PROP TO STEP AGAIN 69=6 LDX 5 APROPNO(3) [LOAD ACTUAL PROPERTY NUMBER 69PQ CALL 7 REC1 [FIND RECORD ZERO 6=9B LDN 4 BEXOT [IN CASE NEED TO GET NEW CELL 6=P2 LDX 3 BEXOT(2) [CONTENTS INTO X3 6?8L BZE 3 PC5 [J.IF NO CONSOLE PROPS IN IDF 6?N= PC6 LDX 4 3 [OTHERWISE SEARCH CHAIN FOR NO.IN X5 6#7W CALL 7 YREC [FIND CONSOLE CELL 6#MG LDX 0 BNO(3) 6*76 ERX 0 5 6*LQ ANDX 0 BITS22LS [COMPARE ACTUAL NOS-BOTTOM 22 BITS 6B6B BZE 0 PC15 [J.IF SAME 6BL2 LDX 3 0(3) [IF FOUND:OTHERWISE ADD ENTRY TO- 6C5L BNZ 3 PC6 [CONSOLE CHAIN WITH U0 AS CONSOLE 6CK= PC5 LDX 3 4 6D4W ANDN 3 #777 6DJG MGETCELL 2,3 [GET NEW CELL 6F46 ON G4SUDBIT [ON"MESSAGE"SWITCH 6FHQ ADX 3 2 6G3B PC15 STO 5 BNO(3) [STORE IN PROP NO(& MAKE SURE TEMP/ 6GH2 BRN PC4 [PERM/INCL/EXCL)& J.FOR NXT CONS PROP 6H2L # 6HG= # NOW START INVERSE CHECKING:THAT IS REMOVE EXTRA PROPS FROM IDF. 6H^W # REMEMBER THAT PROPERTIES DO NOT HAVE TO BE IN 6JFG # ASCENDING NUMBER ORDER IN :SYSTEM.PROPERTY 6J^6 # 6KDQ PC3 REWIND 1 [PUT SYPROP BACK TO START 6KYB SETNCORE 1003,1,IDF,APROPNOS 6LD2 LDN 0 1 6LXL STO 0 A1(1) 6MC= PC22 STOZ A1+1(1) [ZEROIZE IDF/APROPNOS BLOCK 6MWW LDN 4 A1+1(1) 6NBG LDN 5 A1+2(1) 6NW6 MOVE 4 500 [TO ZEROIZE 1000 WORDS TWO "MOVES"- 6P*Q ADN 4 500 [ARE NEEDED!! 6PTB ADN 5 500 6Q*2 MOVE 4 501 6S?G PC11 STEP 1 [STEP SYSPROP 6SR6 MHUNTW 1,IDF,APROPNOS [OTHERWISE PUT ENTRY IN BLOCK IF NEC. 6T=Q BZE 3 PCX10 [J.IF ALL DONE 6TQB LDX 6 APROPNO(3) 6W=2 ANDX 6 BITS22LS [DON'T WANT TEMP/PERM BITS ETC. 6WPL SBX 6 A1(1) 6X9= BNG 6 PC11 6XNW SBN 6 1000 6Y8G BPZ 6 PCX12 [J.IF TOO BIG 6YN6 ADN 6 1000 6^7Q LDX 0 APROPNO(3) 6^MB SMO 6 7272 STO 0 A1+1(1) [OTHERWISE STORE AWAY NUMBER 72LL SBN 6 999 736= BNZ 6 PC11 [J.IF STILL MORE ROOM IN BLOCK 73KW LDX 0 A1+1002(1) 745G BNG 0 PC12 74K6 BRN PC14 7*W2 PCX10 LDX 0 A1+1002(1) 7B*L BNG 0 PC12 7BT= PC10 NGS 1 A1+1001(1) [MARK NEG TO SHOW LAST TIME THROUGH 7C#W BRN PC14 7CSG PCX12 NGS 1 A1+1002(1) 7D#6 BRN PC11 7DRQ PC12 REWIND 1 [SO THAT WE'LL GET THIS PROP NEXT GO 7F?B MHUNTW 1,IDF,APROPNOS 7FR2 # 7G=L # NOW CHECK CONSOLE PROP.CHAIN FOR SUPPOSEDLY UNKNOWN CONSOLE PROPERTIES 7GQ= # 7H9W PC14 CALL 7 REC1 [TO FIND RECORD ZERO 7HPG LDX 3 BEXOT(2) 7J96 BZE 3 MPX1 [J.IF NO CONSOLE PROPS 7JNQ LDN 4 BEXOT [KEEP PTR TO POSITION OF PTR TO CONS. 7LM= PR4 LDX 5 3 [KEEP PTR TO CURRENT CONSOLE CELL 7M6W CALL 7 YREC 7MLG PR8 LDX 0 BNO(3) [NOW CHECK NUMBER IS IN BLOCKS LIMITS 7N66 ANDX 0 BITS22LS 7NKQ SBX 0 A1(1) 7P5B BNG 0 PR1 [J.IF NOT 7PK2 SBN 0 1000 7Q4L BNG 0 XA4 7QJ= LDX 0 A1+1001(1) 7R3W BNG 0 XA5 7RHG BRN PR1 7S36 XA4 7SGQ LDX 6 BNO(3) 7T2B ADN 0 1000 7TG2 SMO 0 7T^L ERX 6 A1+1(1) 7WF= BZE 6 PR1 [J.ALL OKAY-PROP EXISTS 84SB XA5 85#2 LDX 5 BTYPE(3) [PICK UP CONSOLE POINTER 85RL LDX 0 4(3) [OTHERWISE INVESTIGATE SUBSID.CELLS 86?= BZE 0 PR2 [J.IF NONE 86QW SBX 3 2 [OTHERWISE FREE THEM ALL 87=G LDN 3 4(3) 87Q6 PR3 CALL 7 SELL 889Q SMO 2 88PB LDX 0 0(3) 8992 BNZ 0 PR3 [J.FOR NEXT SUBSID CELL 89NL PR2 [NOW FREE CONSOLE CELL ITSELF 8=8= ON G4SUDBIT 8=MW LDX 3 4 [X4 IS 8?7G CALL 7 YREC1 [COPY OF A PTR KEPT FOR THIS PURPOSE 8?M6 SBX 3 2 8#6Q CALL 7 SELL 8#LB MHUNTW 1,IDF,APROPNOS 8*62 ADX 3 2 8*KL BZE 5 PR5 [J.IF U0:NOTHING TO DO 8B5= LDX 0 0(3) [OTHERWISE KEEP PTR TO NEXT CONSOLE- 8BJW SMO FX2 [PROPERTY CELL IN AWORK4 8C4G STO 0 AWORK4 8CJ6 CALL 7 REC1 [FIND RECORD ZERO & SEARCH CONS.CHAIN 8D3Q LDX 3 BEXOT(2) [TO CHECK UNSETTING OF"THIS IS CLUST 8DHB BZE 3 PR9 8F32 PR7 CALL 7 YREC [CONSOLE" BIT 8FGL LDX 0 BTYPE(3) 8G2= ERX 0 5 [TO COMPARE CONSOLES WITH ONE IN X5 8GFW ANDX 0 BITS22LS 8G^G BZE 0 PR6 [J.AS THIS CONSOLE STILL USED 8HF6 LDX 3 0(3) 8HYQ BNZ 3 PR7 [J.FOR NEXT CONSOLE PROP 8JDB PR9 LDX 3 5 [OTHERWISE CLEAN OUT"THIS IS CLUSTER 8JY2 CALL 7 YREC1 [CONSOLE"BIT 8KCL LDCT 0 #40 8KX= ERS 0 BNUMB(3) 8MTQ PR6 SMO FX2 8N*B LDX 3 AWORK4 [GO BACK TO CONSOLE CELLS NOW 8NT2 BZE 3 MPX6 [J.NO MORE CONSOLE CELLS 8P#L LDX 5 3 8PS= CALL 7 YREC1 [& CONTINUE SEARCH 8Q?W BRN PR8 8^6L PR1 LDX 4 5 [FOR FREEING A POSIBLE CONSOLE CELL 8^L= PR5 LDX 3 0(3) 925W BNZ 3 PR4 [J.FOR NEXT CONSOLE PROP COMPARISON 92KG # 9356 # NOW CHECK 7007 CHAIN FOR ATT.& ASS.OF UNKNOWN PROPERTIES 93JQ # 944B MPX6 CALL 7 REC1 [TO FIND RECORD ZERO 94J2 MPX1 LDX 3 BUNIT(2) 953L BZE 3 TP1 [J.TO SEARCH IPB CHAIN IF NO MPX 95H= CALL 7 YREC [OTHERWISE FIND MPX/UPX CELL 962W MPX5 LDX 0 0(3) 96GG SMO FX2 9726 STO 0 AWORK1 [KEEP POINTER TO NEXT UNIT CELL 97FQ LDX 0 BLINE(3) 97^B SMO FX2 98F2 STO 0 AWORK2 [KEEP POINTER TO LINE CELL 98YL CALL 5 ZASAT [CALL"CANCEL"ROUTINE FOR UNIT 99D= MPX3 SMO FX2 99XW LDX 3 AWORK2 [PICK UP LINE CELL POINTER 9=CG BZE 3 MPX2 [J.FOR NEXT UNIT IF NO MORE LINES 9=X6 SMO FX2 9?BQ STO 3 AWORK4 9?WB CALL 7 YREC1 [OTHERWISE FIND LINE CELL 9#B2 LDX 0 0(3) 9#TL SMO FX2 9**= STO 0 AWORK2 [KEEP POINTER TO NEXT LINE 9*SW LDX 0 BLINE(3) 9B#G MPX4 SMO FX2 9BS6 STO 0 AWORK3 [& KEEP POINTER TO POSSIBLE 7020 CELL 9C?Q CALL 5 ZASAT [& "CANCEL" 9CRB SMO FX2 9D?2 LDX 3 AWORK3 9DQL BZE 3 MPX3 [J.IF NO 7020'S FOR NEXT LINE 9F== SMO FX2 9FPW STO 3 AWORK4 9G9G CALL 7 YREC1 [OTHERWISE FIND 7020 CELL 9GP6 LDX 0 0(3) 9H8Q BRN MPX4 [AND J.FOR"CANCEL"FOR 7020 9HNB MPX2 SMO FX2 9J82 LDX 3 AWORK1 [PICK UP UNIT POINTER 9JML BZE 3 TP5 [J.AS NO MORE 7007 UNITS 9K7= CALL 7 YREC1 9KLW BRN MPX5 [J.FOR NEXT 7007 9L6G # 9LL6 # NOW CHECK IPB CHAIN FOR ATT.& ASS.OF UNKNOWN PROPERTIES 9M5Q # 9MKB TP5 CALL 7 REC1 [TO FIND RECORD ZERO 9N52 TP1 LDX 3 BIPB(2) 9NJL BZE 3 PC20 [J.TO POSSIBLE REFILL ETC.OF BLOCK 9P4= CALL 7 YREC [FIND IPB CELL 9R2Q TP4 LDX 0 0(3) 9RGB SMO FX2 9S22 STO 0 AWORK1 [STORE POINTER TO NEXT IPB UNIT 9SFL LDX 0 BLINE(3) =6=6 TP3 SMO FX2 =6PQ STO 0 AWORK2 [STORE POINTER TO IDENTIFIER =79B CALL 5 ZASAT [&"CANCEL" =7P2 SMO FX2 =88L LDX 3 AWORK2 =8N= BZE 3 TP2 [J.FOR NEXT IPB UNIT IF NO MORE IDENT =97W SMO FX2 =9MG STO 3 AWORK4 ==76 CALL 7 YREC1 [OTHERWISE FIND IDENTIFIER CELL ==LQ LDX 0 0(3) =?6B BRN TP3 [J.TO"CANCEL" FOR THIS IDENTIFIER =?L2 TP2 SMO FX2 =#5L LDX 3 AWORK1 [PICK UP NEXT IPB UNIT CELL PTR =#K= BZE 3 PC20 [J.AS NO MORE IPB'S =*4W CALL 7 YREC1 =*JG BRN TP4 [J.FOR NEXT IPB =B46 BNZ 3 TP4 [& J.FOR NEXT UNIT =BHQ PC20 LDX 0 A1+1001(1) [NOW HAVE WE FINISHED YET? =C3B BNG 0 PC21 [J.IF YES =CH2 LDN 0 1000 =D2L ADS 0 A1(1) [UPDATE A1 OF IDF/APROPNOS BLOCK =DG= BRN PC22 [J.TO REFILL BLOCK =D^W # =FFG # SCAN OF IDF COMPLETED NOW:JUST SEE IF MESSAGE IS NEEDED =F^6 # =GDQ PC21 FREECORE 1 [FREE IDF/APRONOS BLOCK =GYB BSOFF G4SUDBIT,PC23 [J.IF SWITCH IS OFF:NO MESSAGE =HD2 GETACT GENERAL,APROPNOS [OTHERWISE CREATE ACTIVITY =HXL LDX 2 BPTR(2) =JC= LINKSET 2,XPAIR(1) =JWW FWAIT #54 =KBG OFF G4SUDBIT [LEAVE SWITCH CLEAR =KW6 PC23 =L*Q CLOSE 1 =LTB ACROSS IDFCLEAN,10 =M*2 # =MSL # =N#= # =NRW #SKI EMSJNL<1$1 =P?G ( =PR6 MESS 52HSYSTEM.IDF HAS BEEN ADJUSTED TO MAKE IT COMPATIBLE W =Q=Q 44HITH SYSTEM.PROPERTY(AN IDFLIST IS ADVISED). =QQB ) =R=2 # =RPL Z20IDFPROP [ENTRY POINT TO SEND MESSAGE =S9= #SKI EMSJNL<1$1 =SNW ( =T8G SETNCORE 26,3,CONBUFF,COUT [THAT IDF HAS BEEN CHANGED =TN6 LDN 0 25 =W7Q STO 0 A1(3) =WMB LDN 6 MESS(1) =X72 LDN 7 A1+1(3) =XLL MOVE 6 24 =Y6= CONSOUT =YKW ) =^5G #SKI EMSJNL =^K6 INFORM 1,EMSIDF,1 ?24Q XSUI ACROSS SUICIDE,1 ?2JB Z30IDFPROP ?342 STOZ AWORK1(2) ?3HL XLOPP ?43= MHUNTW 3,AMXOR,AMESS [HUNT MESS BLOCK. ?4GW LDX 6 AWORK1(2) ?52G BXE 6 A1(3),XEND ?5G6 XCO ?5^Q #SKI EMSJNL ?6FB ( ?6^2 SMO 6 ?7DL LDX 6 A1+1(3) ?7Y= GEOPACK 5,6,1 ?8CW OUTP ?8XG OUTPACK 5,1,GEOPER,OUTP ?9C6 ... INFORM 1,IDFPROP,1 ?9WQ ) ?=BB #SKI EMSJNL<1$1 ?=W2 ( ??*L SMO 6 ??T= LDX 5 A1+1(3) ?##W LDN 6 0 ?#SG LDN 4 4 ?*#6 DVD 5 XMAJ(1) [CONVERT GEO.NO. TO PRINT FORM. ?*RQ LDX 5 6 ?B?B ADN 5 1 ?BR2 LDN 6 0 ?C=L MODE 1 ?CQ= XUSA ?D9W CBD 5 MSGE+1(1) [CONVERT GEO.NO. ?DPG BCHX 1 £ ?F96 BCT 4 XUSA ?FNQ SETNCORE 17,3,CONBUFF,COUT [MOVE INFO. INTO BLK. TO BE OUTPUT ?G8B LDN 0 17 ?GN2 STO 0 A1(3) ?H7L LDN 6 MSGE(1) ?HM= LDN 7 A1+1(3) ?J6W MOVE 6 16 ?JLG CONSOUT [OUTPUT MESSAGE ?K66 ) ?KKQ LDN 0 1 ?L5B ADS 0 AWORK1(2) ?LK2 BRN XLOPP [J.BACK DEAL WITH NEXT GEO.NO. ?M4L XEND ?MJ= FREECORE 3 ?N3W BRN XSUI ?NHG #END ?P36 ^^^^ ...413271530002