IDFOFF867
(George Source)
Macros used: BSON, BXE, CLOSE, FMOPG, FREECORE, GEOERR, HUNT, HUNT2, IDFOPEN, IDFWRITE, LGEOG, LTYPE, MENDAREA, MFREEALL, MHUNTW, MNAME, MSEARCH, MXB, NAME, SEG, SEGENTRY, SETNCORE, SETREP2, TRACE, UP, UPPLUS
- IDFOFF867.txt
22FL ... SEG IDFOFF,,ANDREW PUTMAN 22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982 22^= #OPT K0IDFOFF=0 23DW #LIS K0IDFOFF>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF 23YG SEGENTRY K1IDFOFF,XIDF1 24D6 SEGENTRY K21IDFOFF,XIDF21 24XQ SEGENTRY K2IDFOFF,XIDF2 25CB SEGENTRY K22IDFOFF,XIDF22 25X2 SEGENTRY K20IDFOFF,XIDF20 26BL SEGENTRY K40IDFOFF,XIDF40 26W= SEGENTRY K81IDFOFF,XIDF81 27*W SEGENTRY K80IDFOFF,XIDF80 27TG SEGENTRY K91IDFOFF,XIDF91 28*6 SEGENTRY K90IDFOFF,XIDF90 28CP ...#UNS ISUMBI 28G# ...( 28JX ... SEGENTRY K70IDFOFF,XIDF70 [IRIGHT 28MG ... SEGENTRY K75IDFOFF,XIDF75 [IWRONG 28Q5 ...) 28RC ... SEGENTRY K23IDFOFF,XIDF23 28SQ [THIS SEGMENT NEUTRALISES ONLINE/MOP MARKERS IN CONCEPTUAL BLOCKS 29#B [AND THEIR ASSOCIATED LINE CELLS 29S2 [ 2=?L [ 2=R= TALL #7777777 2?=W RECFIND 2?QG HUNT2 2,FILE,FRRB 2#=6 TXU 6 BRECNO+A1(2) 2#PQ BCS RECFIND 2*9B ADN 2 A1 2*P2 EXIT 7 0 2B8L [ 2BN= XNAME SBX 7 FX1 [FREES ALL BUT UNIT CELL 2C7W SBN 2 A1 2CMG NAME 2,FILE,FRWB 2D76 OT HUNT 2,FILE,FRRB 2DLQ BNG 2 OUT 2F6B FREECORE 2 2FL2 BRN OT 2G5L OUT 2GK= MHUNTW 2,FILE,FRWB 2H4W NAME 2,FILE,FRRB 2HJG ADN 2 A1 2J46 ADX 7 FX1 2JHQ EXIT 7 0 2K3B [ 2KH2 [ 2L2L [THIS SUBROUTINE LOCATES THE FILESTORE RECORD WHOSE POINTER IS IN IDF 2LG= [FORMAT IN X3.THE RESULT IS A POINTER IN X2 TO A1+START OF APPROPRIATE 2L^W [FILE/FRRB,X3 POINTS TO CELL WITHIN THE RECORD 2MFG YREC 2M^6 BPZ 3 YSAME [J IF POINTER IN SAME RECORD 2NDQ YREC1 SBX 7 FX1 [ADJUST LINK 2NYB LDX 0 3 2PD2 SRL 0 9 2PXL ANDN 0 #777 2QC= LDX 2 FX2 2QWW STO 0 ACOMMUNE3(2) 2RBG MXB 2 [LOCATE CORRECT RECORD 2RW6 ADX 7 FX1 [READJUST LINK 2S*Q YSAME 2STB ANDN 3 #777 [CELL POINTER 2T*2 EXIT 7 0 2TSL ZIDF 2W#= SBX 7 FX1 2WRW IDFOPEN XBRK 2X?G ADX 7 FX1 2XR6 EXIT 7 0 2Y2Y XBRK UP [BRK-IN 2Y=Q [ 2YQB SEARCH [LOCATE UNIT/LINE 2^=2 SBX 7 FX1 2^PL MSEARCH 2,3,4 329= SMO FX2 32NW LDX 0 ACOMMUNE1 338G BNZ 0 S1 33N6 GEOERR 1,UNIT 347Q S1 34MB ADX 7 FX1 3572 EXIT 7 0 35LL [ 366= [ 367S ...TEIDF SMO FX2 [TEST IF IDF TO BE LEFT OPEN 369B ... LDX 0 AWORK4 [AW4 = 0 IF SO 36=Y ... BZE 0 (7) 36#G ... EXIT 6 0 36B4 ...ZCLOSE1 36CL ... CALL 6 TEIDF 36F8 ... BRN ZCLOSE 36GQ ...WRITE1 36J# ... CALL 6 TEIDF [DO NOT WRITE IDF IF OPEN ON ENTRY 36KW [ 375G WRITE 37K6 SBX 7 FX1 384Q IDFWRITE 38JB BRN ZCL 3942 ZCLOSE 39HL SBX 7 FX1 3=3= MFREEALL FILE,FRRB 3=GW ZCL CLOSE 3?2G ADX 7 FX1 3?G6 EXIT 7 0 3?^Q [ 3#FB [ 3#^2 [ENTRY POINT FORM IDFOFF MACRO 3*DL XIDF1 3*Y= LDX 6 ACOMMUNE1(2) [EITHER ZERO OR BLOCK TYPE WORD 3BCW LDX 5 ACOMMUNE2(2) [POSITION DOWN BLOCK 3BXG LDX 4 ACOMMUNE4(2) 3CC6 ... CALL 7 ZIDF 3CWQ SMO FX2 3DBB STO 6 ACOMMUNE1 3DW2 LDX 2 5 [IN CASE NEEDED 3F*L LDN 3 0 [SEARCH CONCEPTUAL CHAIN 3FT= MNAME 2,3 [SEARCH FOR CONCEPTUAL 3G#W SMO FX2 3GSG LDX 0 ACOMMUNE1 3H#6 BNZ 0 T40 [OK CONCEPTUAL 3HRQ GEOERR 1,NAME 3J?B [ 3JR2 [ 3K=L [ 3KQ= T40 3L9W SMO 2 3LPG LDX 0 4(3) 3M96 BNG 0 T45 3MNQ CALL 7 ZCLOSE 3MYJ ... UPPLUS 1 3NN2 T45 3P7L LDX 5 TALL(1) 3PM= SMO 2 3Q6W ANDS 5 4(3) 3QLG BZE 4 XWRT 3R66 SMO 2 3RKQ STOZ 5(3) 3S5B SMO 2 3SK2 LDX 0 6(3) 3T4L ANDN 0 #7777 3TJ= BCT 0 XIPB 3W3W LDN 0 1 3WHG SMO 2 3X36 STO 0 6(3) 3XGQ XIPB SMO 2 3Y2B LDX 3 7(3) [LD. PTR. TO USER NAME. 3YG2 CALL 7 YREC 3Y^L XST SMO 2 3^F= LDX 3 7(3) 3^YW BZE 3 XWRT [J.END OF CONCEPTUAL. 42DG LDN 6 0 42Y6 ANDX 3 BITS22LS 43CQ SMO FX2 43XB STO 3 AWORK1 [ST. AWORK1 = CURRENT CELL PTR. 44C2 CALL 7 YREC1 44WL XCONT SMO 2 45B= LDX 0 0(3) 45TW BZE 0 XPOS 46*G SMO 2 46T6 STOZ 0(3) 47#Q LDX 3 0 47SB CALL 7 YREC 48#2 SMO 2 48RL STOZ CONTCEP(3) [ZEROISE PTR. CONCEPTUAL. 49?= SMO FX2 49QW LDX 3 AWORK1 4==G CALL 7 YREC1 [HUNT FOR CURRENT CONCEPTUAL 4=Q6 ADX 3 6 4?9Q XPOS SBN 6 6 4?PB BZE 6 XRET 4#92 ADN 6 7 4#NL ADN 3 1 [INCREASE POSITION DOWN CELL 4*8= BRN XCONT 4*MW XRET SBN 3 6 4B7G BRN XST 4BM6 XWRT CALL 7 WRITE 4BWY ... UPPLUS 2 4CLB [ 4D62 [ 4DKL ...[RELEASE A UNIT AFTER ONLINE.DEVICE LIST PTR IN ACOMMUNE1 4F5= [ 4FJW XIDF21 4G4G LDN 3 BIPB [BASE OF IPB CHAIN 4GJ6 BRN Q1 4H3Q XIDF2 4HHB LDN 3 BUNIT [BASE OF UNIT CHAIN 4J32 Q1 LGEOG ACOMMUNE1(2),4 [GET GEOG NO. 4JGL ... CALL 7 ZIDF [OPEN IDF 4K2= CALL 7 SEARCH [LOCATE UNIT 4KFW LDX 0 TALL(1) 4K^G SMO 2 4LF6 ANDS 0 BNUMB(3) [REMOVE OL BIT-NO MOPPED ON 4LYQ [OR WRONGED BITS THERE 4MDB CALL 7 XNAME 4MY2 CALL 7 WRITE [WRITE IT BACK 4N7S ... UPPLUS 1 4NX= [ 4PBW [ENTRY POINT FROM MOPOFF MACRO 4PD7 ...XIDF23 [ ZMOPOFF MACRO 4PFD ... LDX 3 ACOMMUNE1(2) [GET IDF POINTER 4PGP ... STOZ AWORK4(2) [SHOW IDF NOT TO BE CLOSED 4PJ2 ... CALL 7 YREC1 [FIND UNIT CELL 4PK? ... LDX 0 BRECNO(2) 4PLJ ... SMO FX2 4PMT ... STO 0 AWORK1 [SAVE PTRS TO UNIT CELL 4PP6 ... SMO FX2 4PQC ... STO 3 AWORK2 4PRN ... BRN R01 4PS^ ...[ 4PWG XIDF22 4QB6 LDN 3 BIPB [BASE OF IPB CHAIN 4QTQ BRN Q2 4R*B XIDF20 4RT2 LDN 3 BUNIT [BASE OF UNIT CHAIN 4RXM ...Q2 4RY^ ... STO 1 AWORK4(2) [SHOW IDF TO BE CLOSED AT END 4S25 ... STOZ AWORK3(2) 4S39 ... SEGENTRY K92IDFOFF 4S4* ... LDN 0 AHRETAIN 4S5F ... BZE 0 XNOTRE 4S6K ... HUNT 2,CPB,CUNI 4S7P ... BNG 2 XNOTRE 4S8T ... LDX 0 ANUM(2) 4S9^ ... BNG 0 XNOTRE 4S?5 ... SMO FX2 4S#9 ... STO 2 AWORK3 4S** ...XNOTRE 4SBF ... LDX 2 FX2 4SCN ... LGEOG ACOMMUNE1(2),4 4T56 ...Q2NCI CALL 7 ZIDF [OPEN IDF 4T?W CALL 7 SEARCH [LOCATE UNIT CELL 4TRG SMO FX2 4W?6 STO 3 AWORK2 4WQQ LDX 0 BRECNO(2) 4X=B SMO FX2 4XQ2 STO 0 AWORK1 4XWD ... FMOPG 1,4,IPB [HUNT IPB 4Y2W ... BNG 1 R01 [NOT IPB GEOG. NO. 4Y7# ... LDCT 0 #20 4Y?Q ... ANDX 0 IPBSW(1) [TEST BIT 4 - BEING MOPPED OFF 4YD8 ... BNZ 0 R02 [J. IF SET ERROR 4YJL ...R01 SMO 2 4YP= LDX 0 BNUMB(3) 4^8W ... BNG 0 R10 [MOPPED ON 4^GL ...R02 CALL 7 ZCLOSE1 5286 UPPLUS 1 [NOT MOPPED 52MQ R10 537B SMO 2 53M2 LDX 3 BLINE(3) 53S8 ...#UNS CRAMP 53^B ... BZE 3 R42 [J IF NO IDENTS 546L R25 54L= CALL 7 YREC [LOCATE LINE CELL 555W STO 3 4 [KEEP LINE CELL POINTER 55KG SMO 2 5656 LDX 3 CONTCEP(3) 56JQ BZE 3 R40 [J.IF NOT ATTACHED 574B LDX 6 BRECNO(2) [KEEP LINE RECORD NO 57J2 CALL 7 YREC 57MX ... BSON EMSBIT,R30 [NO CL ONLINE AT EMS... 57RS ... [BUT ONLINE BIT MAY BE SET... 57XP ... [IF IDFCLEAN NOT YET ENTERED 583L SMO 2 58H= LDX 0 4(3) 592W BPZ 0 R30 [J.IF CONCEP NOT O 59?^ ... CALL 7 ZCLOSE1 [OTHERWISE ERROR 59K5 ...#UNS CRAMP 59MN ... SETREP2 CONCONL [SET REPLY FOR MOPCOM TO CHECK 5=26 UPPLUS 1 5=FQ R40 LDX 3 4 5=^B BRN R41 5?5? ...R30 SMO FX2 5?98 ... LDX 5 AWORK3 5?*5 ... BZE 5 R30A 5?F2 ... LDX 2 FX2 5?JX ... CALL 7 RECFIND 5?NS ... BRN R40 5?SP ...R30A LDX 5 6 5?YL SLL 5 9 5#D= ADX 5 4 5#XW LDN 0 1 5*CG SMO 2 5*X6 SBS 0 5(3) 5BBQ SMO 2 5BWB LDX 0 5(3) 5CB2 BNZ 0 R301 [J. LNS. STILL ATTACHED. 5CFX ... SMO 2 5CKS ... LDX 0 6(3) 5CPP ... BPZ 0 R300 [J. IF MPX CONCEPTUAL 5CTL ... ANDN 0 #7777 5C^H ... SBN 0 1 5D5D ... BNZ 0 R301 [J. IF LOWEST IDENTIFIER NOT = 1 5D9* ...R300 LDN 0 #7777 5D*= SMO 2 5DSW ANDS 0 6(3) [SET CONCEPTUAL NEUTRAL 5F#G R301 SMO 2 5FS6 LDX 3 7(3) 5G?Q CALL 7 YREC 5GRB R31 SMO 3 5H?2 LDX 3 7(2) 5HQL BZE 3 R33 5J== CALL 7 YREC 5JPW LDN 7 7 5K9G R32 SMO 2 5KP6 LDX 0 0(3) 5L8Q ANDX 0 BITS22LS 5LNB BXE 0 5,R34 5M82 ADN 3 1 5MML SBN 7 1 5N7= BNZ 7 R32 5NLW SBN 3 7 5P6G BRN R31 5PL6 R33 GEOERR 1,LINEERR 5Q5Q R34 SMO 2 5QKB STOZ 0(3) 5R52 LDX 2 FX2 5RJL CALL 7 RECFIND 5S4= LDX 3 4 5SHW SMO 2 5T3G STOZ CONTCEP(3) 5TH6 R41 5W2Q SMO 2 5WGB LDX 3 0(3) [FORWARD POINTER 5X22 BNZ 3 R25 [J.FOR NEXT LINE 5X78 ...#UNS CRAMP 5X#B ...R42 5XFL LDX 2 FX2 [OTHERWISE NO LINES OL AS CONCEP 5X^= LDX 6 AWORK1(2) 5YDW LDX 3 AWORK2(2) 5YYG CALL 7 RECFIND [FIND UNIT RECORD 5^D6 ADX 3 2 5^XQ NGNC 6 1 62CB ANDS 6 BNUMB(3) [CLEAR MOP BIT 62X2 LDCH 4 BTYPE(3) [PICK UP TYPE 63BL SBN 4 #30 [USE X4 AS SWITCH:ZERO FOR 7900 63W= LDX 3 BLINE(3) 643D ...#UNS CRAMP 648L ... BZE 3 R80 [J IF NO IDENTS 64*W R70 64TG CALL 7 YREC [FIND LINE CELL 65*6 R72 ADX 3 2 65SQ ANDS 6 BNUMB(3) [CLEAR MOP BIT 66#B BZE 4 R75 66S2 LDX 5 0(3) [PTR TO NEXT LINE 67?L LDX 3 BLINE(3) [7020 PTR 67R= BZE 3 R74 [J.IF NO 7020'S 68=W R76 CALL 7 YREC [OTHERWISE MARK 7020'S MOPPED OFF 68QG ADX 3 2 69=6 ANDS 6 BTYPE+1(3) 69PQ LDX 3 0(3) 6=9B BNZ 3 R76 [J.FOR NEXT 7020 CELL 6=P2 BZE 5 R80 [J.IF NO MORE LINES 6?8L LDX 3 5 [GET BACK TO LINE CELLS 6?N= CALL 7 YREC1 6#7W BRN R72 6#MG R74 BZE 5 R80 [J.TO END IF NO MORE LINES 6*76 LDX 3 5 6*LQ BRN R70 [J FOR NEXT LINE 6B6B R75 LDX 3 0(3) 6BL2 BNZ 3 R70 [J FOR NEXT IDENTIFINR 6C5L R80 6CK= [END OF LIST 6CY8 ... CALL 7 WRITE1 6DTW ... UPPLUS 2 [ALL OK 6F46 [ 6FHQ XIDF40 6G3B LGEOG ACOMMUNE1(2),4 6GH2 LDX 5 ACOMMUNE2(2) [LINE NO 6H2L LTYPE ACOMMUNE1(2),6 [LD. TYPE OF THE UNIT INTO X6 6HG= SBN 6 #30 6H^W BZE 6 W1 [J. THIS IS IPB 6JFG LDN 3 BUNIT [LD. BASE OF MULT. CHAIN. 6J^6 ... BRN W2 6KDQ W1 LDN 3 BIPB [LD. BASE OF IPB CHAIN 6KYB ...W2 CALL 7 ZIDF 6LD2 CALL 7 SEARCH [LOCATE UNIT 6LXL LDN 3 BLINE(3) 6MC= LDX 4 5 6MWW CALL 7 SEARCH [LOCATE LINE 6NBG LDX 0 BRECNO(2) 6NW6 SLL 0 9 6P*Q ADX 0 3 6PTB SMO FX2 6Q*2 STO 0 AWORK2 [ST. REC.NO. 6QSL SMO 2 6R#= LDX 3 CONTCEP(3) [CONCEPTUAL POINTER 6RRW BNZ 3 W5 6S?G CALL 7 ZCLOSE 6SH# ... UPPLUS 1 6T=Q W5 6TQB LDX 6 BRECNO(2) [PICK UP RECORD NO 6W=2 SETNCORE 4,1,IDF,CONNAME 6WPL CALL 7 RECFIND 6X9= CALL 7 YREC [LOCATE CONCEPTUAL BLOCK 6XNW SMO 2 6Y8G LDX 0 4(3) 6YN6 BPZ 0 W10 [NOT ONLINED 6^7Q LDX 0 GSIGN [ONLINED 6^MB BRN XZ656 7272 W10 72LL STOZ 0 [NOT ONLINED 736= XZ656 73KW SMO FX2 745G STO 0 ACOMMUNE1 74K6 ADX 2 3 754Q ADN 2 1 75JB MHUNTW 3,IDF,CONNAME 7642 ADN 3 A1+1 76HL MOVE 2 3 [MOVE CONCEPTUAL NAME INTO DATA BLOK 773= LDX 4 3(2) 77GW ANDN 4 #7777 [NO. LINE 782G SMO FX2 78G6 LDX 6 AWORK2 78^Q ... LDX 0 5(2) [LOWEST IDENT. NO. 79FB ANDN 0 #7777 79^2 SBN 0 1 7=DL SMO FX2 7=Y= STO 0 AWORK1 7?CW ... LDX 3 6(2) 7?XG CALL 7 YREC1 [HUNT NEXT CELL USER NAME 7#C6 SMO 2 7#WQ LDX 3 7(3) 7*BB XA CALL 7 YREC [HUNT LINE CELL 7*W2 XB LDN 0 1 7B*L SMO FX2 7BT= ADS 0 AWORK1 7C#W SMO 2 7CSG LDX 0 0(3) 7D#6 ANDX 0 BITS22LS 7DRQ BXE 0 6,XE [J. IF EQUAL 7F?B LDX 0 4 7FR2 LDCT 7 #700 7G=L ANDX 7 0 7GQ= ANDN 4 #7777 7H9W SBN 4 1 7HPG BZE 4 XD [DECREASE CT. 7J96 SLC 7 3 7JNQ ADN 7 1 7K8B LDN 0 7 7KN2 SBX 0 7 7L7L BZE 0 XC 7LM= SRC 7 3 7M6W ADX 4 7 7MLG ADN 3 1 7N66 BRN XB 7NKQ XC SMO 2 7P5B LDX 3 1(3) 7PK2 BRN XA 7Q4L XD GEOERR 1,LOSTLINE 7QJ= XE MHUNTW 1,IDF,CONNAME 7R3W SMO FX2 7RHG LDX 0 AWORK1 7S36 STO 0 A1(1) 7SGQ CALL 7 ZCLOSE 7SQJ ... UPPLUS 2 7TG2 [ 7T^L [ 7WF= [ 7WYW XIDF81 7XDG LDN 3 BIPB [BASE OF IPB CHAIN 7XY6 BRN Q4 7YCQ XIDF80 7YXB LDN 3 BUNIT [BASE OF UNIT CHAIN 7^23 ...Q4 7^HD ... LGEOG ACOMMUNE1(2),4 7^LR ... LDCT 5 #500 [CHECK B0,2 (NOT CI) 827G Q4NCI CALL 7 ZIDF [OPEN IDF 82B= CALL 7 SEARCH [LOCATE UNIT 83*G SMO 2 83T6 ... ANDX 5 BNUMB(3) 84#Q ... BZE 5 XW20 84FY ...#UNS CRAMP 84M6 ...XW19 84SB CALL 7 ZCLOSE 85#2 UPPLUS 1 [MOPPED ON OR ONLINE AS A WHOLE UNIT 85RL XW20 85SD ...#UNS CRAMP 85T= ...( 85W4 ...# 85WW ...# THIS CODE IS NECESSARY AS DURING MOP ON,,NS 85XN ...# THE MOPPED ON MARKER IS UNSET FOR A TIME WHILE 85YG ...# THE 'BEING MOPPED ON' MARKER IS LEFT SET 85^# ...# 8626 ... SMO 2 862Y ... LDCH 1 BTYPE(3) 863Q ... SBN 1 #30 [CHECK IF IPB 864J ... BNZ 1 XW21 [J IF NOT TO MARK UNIT WRONGED 865B ... FMOPG 1,4,IPB [FIND AMOP/IPBIN 8668 ... LDCT 6 #10 [CHECK IF 'BEING MOPPED ON' MARKER 8672 ... ANDX 6 IPBSW(1) [SET. IF IT IS,CANNOT 867S ... BNZ 6 XW19 [WRONG UNIT 868L ...XW21 869D ...# 86== ...) 86?= LDCT 1 #200 86QW SMO 2 87=G ORS 1 BNUMB(3) [MARK UNIT WRONGED 87Q6 CALL 7 XNAME 889Q CALL 7 WRITE 88PB UPPLUS 2 8992 [ 89NL [ 8=8= [ 8=MW [ 8?7G [ENTRY FROM RIGHT MACRO 8?M6 WRONGB #57777777 8#6Q XIDF91 8#LB LDN 3 BIPB [BASE OF IPB CHAIN 8*62 BRN Q5 8*KL XIDF90 8B5= LDN 3 BUNIT [BASE OF UNIT CHAIN 8BJW Q5 LGEOG ACOMMUNE1(2),4 8C4G ... CALL 7 ZIDF [OPEN IDF. 8CJ6 CALL 7 SEARCH [LOCATE UNIT 8D3Q SMO FX1 8DHB LDX 0 WRONGB 8F32 SMO 2 8FGL ANDS 0 BNUMB(3) [CANCEL WRONGED BIT 8G2= CALL 7 XNAME 8GFW CALL 7 WRITE 8GPN ... UPPLUS 1 8HF6 # 8HYQ MENDAREA 40,K99IDFOFF 8JDB # 8JY2 [ 8KCL [ 8KCS ...#UNS ISUMBI 8KD2 ...( 8KD8 ...[ 8KDB ...[ 8KDJ ...ZMSEARCH 8KDQ ... SBX 7 FX1 8KDY ... TRACE 4,SEARCH 8KF6 ... MSEARCH 2,3,4 8KF# ... ADX 7 FX1 8KFG ... EXIT 7 0 8KFN ...[ 8KFW ...[ 8KG4 ...[ IRIGHT MACRO 8KG= ...XIDF70 8KGD ... LDN 0 0 8KGL ... BRN X7A 8KGS ...[ 8KH2 ...[ 8KH8 ...[ IWRONG MACRO 8KHB ...XIDF75 8KHJ ... LDCT 0 #400 8KHQ ...X7A 8KHY ... STO 0 AWORK4(2) [SAVE RI OR WR MARKER 8KJ6 ... LDX 0 ACOMMUNE1(2) 8KJ# ... STO 0 AWORK3(2) [IDENTIFIER NUMBER 8KJG ... TRACE ACOMMUNE2(2),DEVLIST 8KJN ... TRACE ACOMMUNE1(2),IDENTIFR 8KJW ... LDN 3 BIPB 8KL2 ... LGEOG ACOMMUNE2(2),4 [GET GEOG NO 8KL8 ...X7B 8KLB ... CALL 7 ZIDF 8KLJ ... CALL 7 ZMSEARCH [AND LOOK FOR 'UNIT' 8KLQ ... SMO FX2 8KLY ... LDX 6 ACOMMUNE1 8KM6 ... BNZ 6 X7C [J IF FOUND 8KM# ... GEOERR 1,UNITILL 8KMG ...X7C 8KMN ... SMO FX2 8KMW ... LDX 4 AWORK3 [ID NO 8KN4 ... ADN 3 BLINE 8KN= ... CALL 7 ZMSEARCH [SEARCH FOR ID CELL 8KND ... SMO FX2 8KNL ... LDX 0 ACOMMUNE1 8KNS ... BNZ 0 X7D [J IF FOUND 8KP2 ... GEOERR 1,IDENTILL 8KP8 ...X7D 8KPB ... ADX 3 2 8KPJ ... LDX 6 BTYPE(3) 8KPQ ... SRL 6 18 8KPY ... ANDN 6 #17 8KQ6 ... BZE 6 X7E [J IF MOP - OK 8KQ# ... SBN 6 10 8KQG ... BNZ 6 X7F [J IF NOT VDU 8KQN ...X7E 8KQW ... LDCT 5 #400 8KR4 ... ORS 5 BTYPE(3) 8KR= ... ERS 5 BTYPE(3) [CLEAR RI-WR BIT 8KRD ... SMO FX2 8KRL ... LDX 5 AWORK4 8KRS ... ORS 5 BTYPE(3) [AND SET AS REQUESTED 8KS2 ... CALL 7 WRITE 8KS8 ... UPPLUS 2 8KSB ...X7F 8KSJ ... CALL 7 ZCLOSE 8KSQ ... UPPLUS 1 8KSY ...[ 8KT6 ...[ 8KT# ...) 8KX= #END ^^^^ ...33364334000400000000