{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: IDFOFF867)}}
====== IDFOFF867 ======
(George Source)
**Macros used:** [[george:macro:BSON|BSON]], [[george:macro:BXE|BXE]], [[george:macro:CLOSE|CLOSE]], [[george:macro:FMOPG|FMOPG]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNT2|HUNT2]], [[george:macro:IDFOPEN|IDFOPEN]], [[george:macro:IDFWRITE|IDFWRITE]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LTYPE|LTYPE]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEALL|MFREEALL]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MNAME|MNAME]], [[george:macro:MSEARCH|MSEARCH]], [[george:macro:MXB|MXB]], [[george:macro:NAME|NAME]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP2|SETREP2]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]]
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