{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: GROPE867)}}
====== GROPE867 ======
(George Source)
**Macros used:** [[george:macro:BXL|BXL]], [[george:macro:CLBGROP|CLBGROP]], [[george:macro:CLOSE|CLOSE]], [[george:macro:CLRGROP|CLRGROP]], [[george:macro:CLSWOVER|CLSWOVER]], [[george:macro:COOR3|COOR3]], [[george:macro:FON|FON]], [[george:macro:FPUT|FPUT]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETACT|GETACT]], [[george:macro:GROPE|GROPE]], [[george:macro:HDWRTE|HDWRTE]], [[george:macro:HLSINFORM|HLSINFORM]], [[george:macro:INFORMX|INFORMX]], [[george:macro:JANON|JANON]], [[george:macro:JBGROP|JBGROP]], [[george:macro:JENV|JENV]], [[george:macro:JILLMS|JILLMS]], [[george:macro:JMNBWR|JMNBWR]], [[george:macro:JNANON|JNANON]], [[george:macro:JNBGROP|JNBGROP]], [[george:macro:JNRGROP|JNRGROP]], [[george:macro:JRGROP|JRGROP]], [[george:macro:JSBUSY|JSBUSY]], [[george:macro:JSWIN|JSWIN]], [[george:macro:JSWOUT|JSWOUT]], [[george:macro:JWRONG|JWRONG]], [[george:macro:LADDP|LADDP]], [[george:macro:LAMOP|LAMOP]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LINKSET|LINKSET]], [[george:macro:LOCKC|LOCKC]], [[george:macro:LONGON1|LONGON1]], [[george:macro:LPROP|LPROP]], [[george:macro:LTYPE|LTYPE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:OPEN|OPEN]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:OUTPARN|OUTPARN]], [[george:macro:PAIR|PAIR]], [[george:macro:PROPCODE|PROPCODE]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETBGROP|SETBGROP]], [[george:macro:SETILLMS|SETILLMS]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETSWOVER|SETSWOVER]], [[george:macro:STEP|STEP]], [[george:macro:SUICIDE|SUICIDE]], [[george:macro:SWOUT|SWOUT]], [[george:macro:UNLOCK|UNLOCK]], [[george:macro:UP|UP]], [[george:macro:WRONG|WRONG]]
22FL #SEG GROPE
22^= 8HGROPE
23DW # (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982.
23YG #OPT K0GROPE=0
24D6 #LIS K0GROPE>K0ALLGEO>K0GREATGEO>K0COMMAND
24XQ [
25CB [
25X2 SEGENTRY K1GROPE,X1GROPE
26BL SEGENTRY K2GROPE,X2GROPE
26W= [
27*W [
27TG [ K1 IMPLEMENTS THE GROPEREC MACRO - TO SEARCH THE DEVICE LISTS
28*6 [ AND INITIATE A GROPE WHEN NECESSARY.
28SQ [
29#B [ K2 PERFORMS THE GROPE. IT IS ENTERED DIRECTLY FROM K1 WHEN
29S2 [ ONLY ONE DEVICE LIST IS TO BE GROPED
2=?L [ OTHERWISE A GENERAL AGROPE ACTIVITY IS SET UP WITH LINK
2=R= [ TO K2 AND FPUT. A GENERAL AGROPE GROPES ONE DEVICE LIST
2?=W [ AND THEN SUICIDES.
2?QG [
2#=6 [
2#PQ #DEF BASEOPSN=200
2*9B PTEN
2*P2 PFABS +10
2B8L 12HSYSTEM
2BN= 12HPROPERTY
2C7W +0
2CMG +1
2D76 4HB1
2DLQ P64 +64
2F6B PDA +26
2FL2 PIPB +24
2G5L P5 +5
2GK= PTABLE
2H4W +BILEN
2HJG +BOLEN
2J46 +BLLEN
2JHQ +BOLEN
2K3B +COMLEN
2KH2 PLINK1
2L2L PAIR GROPE,2
2LG= PJILL +JUNILL [DUPLICATE,ILLEGAL UNIT NO
2L^W PJDUPL +JUNDUPL [DUPLICATE UNIT NO.
2MFG PJSWOVER +JSWOVER
2MLN ...PJGRFL +JGRFL
2MRW ...PJUNEQL +JUNEQL
2M^6 [
2NDQ [
2NYB X1GROPE
2PD2 LDX 0 ACOMMUNE1(2)
2PXL LDX 4 ACOMMUNE2(2)
2Q7D ... LDX 5 ACOMMUNE3(2)
2QC= STO 0 AWORK1(2)
2QWW STO 4 AWORK2(2)
2RBG BZE 0 WINT [KEY = INTERNAL NUMBER
2RW6 SBN 0 1
2S*Q BZE 0 WGEOG [KEY = GEOGRAPHIC UNIT NUMBER
2STB SBN 0 1
2T*2 BZE 0 WTYPE [KEY = DEVICE TYPE
2TG8 ... SBN 0 1
2TMB ... BZE 0 WDEV
2TSL [
2W#= [
2WRW [ INTERNAL NO. SEARCH
2X?G [
2XR6 WINT
2Y=Q TXL 4 BDTL
2YQB BCC WIFAIL
2^=2 LDX 3 BDTP
2^PL SMO 4
329= LDX 3 0(3)
32*7 ... JENV WINT0,CME,EXCL
32F4 ... JANON 3,WINT2
32J^ ...WINT0
32NW JANON 3,WINT1
338G JNRGROP 3,WIN
33N6 WINT1
347Q JBGROP 3,WI2 [J IF BEING GROPED
34MB SETBGROP 3
34X8 ...WINT2
3572 CALL 7 Z2GROPE
35LL WI1
366= JANON 3,WIFAIL [J IF DEVICE STILL ANON
36KW BRN WIN
375G WI2
37K6 COOR3 GROPEWS [WAIT UNTIL GROPE FINISHED
384Q JBGROP 3,WI2
38JB BRN WI1
3942 [
39HL WIN
3=3= STO 3 ACOMMUNE1(2)
3=GW BRN WUP
3?2G [
3?G6 WIFAIL
3?^Q NGN 4 4095
3#FB WFAIL
3#^2 STO 4 ACOMMUNE1(2)
3*DL WUP
3*Y= UP
3BCW [
3BXG [
3CC6 [ GEOGRAPHIC NO. SEARCH
3CWQ [
3DBB WGEOG
3DW2 LDX 6 4 [SET X6 +VE
3F*L LDX 4 GANON
3FT= BZE 4 WG3 [J IF NO ANON DEVICES
3G#W SBN 4 1
3GSG BZE 4 WG1 [J IF ONLY 1 ANON
3H#6 STOZ 6
3HRQ WG1
3J?B LDX 5 BDTP [BASE OF BDT
3JR2 ADX 5 BDTL [PLUS LENGTH = END
3K=L SBN 5 1 [STEP OVER OPER
3KQ= WG11
3L9W SBN 5 1 [STEP BACK 1
3LPG SMO 5
3M96 LDX 3 0 [DEVICE LIST POINTER
3MNQ JNANON 3,WG12 [J IF NOT ANON
3N8B JNBGROP 3,WG2 [J IF NOT BEING GROPED
3NN2 STOZ AWORK4(2) [CLEAR GROPE MARKER
3P7L BRN WG13
3PM= WG12
3Q6W LGEOG 3,4
3QLG TXU 4 AWORK2(2) [IS THIS UNIT WE WANT?
3R66 BCC WIN [J IF YES
3RKQ WG13
3S5B TXU 5 BDTP
3SK2 BCS WG11 [J IF NOT BACK TO BASE
3T4L BRN WG3
3TJ= WG2
3W3W BNG 6 WG13
3WHG BZE 6 WG21 [J IF FIRST PASS OF DEVICE LISTS
3X36 SETBGROP 3
3XGQ CALL 7 Z2GROPE
3Y2B LGEOG 3,4
3YG2 TXU 4 AWORK2(2)
3Y^L BCC WIN
3^F= BRN WG31
3^YW WG21
42DG CALL 7 ZGROPE
42Y6 BRN WG13
43CQ WG3
43XB BNZ 6 WG4
44C2 WG31
44WL NGN 6 4095
45B= STO 6 AWORK4(2) [SET GROPE MARKER
45TW BRN WG1
46*G WG4
46T6 LDX 4 AWORK4(2)
47#Q BNG 4 WFAIL
47SB COOR3 GROPEWS
48#2 BRN WG31
48RL [
49?= [
49QW [ DEVICE TYPE SEARCH
4==G [
4=Q6 WTYPE
4?9Q STOZ 6
4?PB WT1
4#92 STOZ 4 [INITIALISE ANON COUNT
4#NL SMO AWORK2(2) [PTR TO BDT FOR FIRST OF TYPE
4*8= LDX 5 JPTI
4*MW BRN WT21
4B7G WT2
4BM6 ADN 5 1
4C6Q WT21
4CLB SMO AWORK2(2)
4D62 LDX 0 JPTI+1 [END ADDRESS OF TYPE
4DKL TXU 5 0
4F5= BCC WT4 [J IF END OF TYPE
4FJW SMO 5
4G4G LDX 3 0 [DEVICE LIST POINTER
4GJ6 JNANON 3,WT2 [J IF NOT ANON
4H3Q ADN 4 1 [ADD 1 TO ANON COUNT
4HHB JNBGROP 3,WT3 [J IF NOT BEING GROPED
4J32 STOZ AWORK4(2)
4JGL BRN WT2
4K2= WT3
4KFW BNG 6 WT2 [J IF NOT FIRST PASS OF D.L.
4K^G CALL 7 ZGROPE
4LF6 BRN WT2
4LYQ WT4
4MDB BNG 6 WT6 [J IF NOT FIRST PASS
4MY2 STO 4 AWORK3(2) [KEEP COUNT OF ANON DEVICES 1ST TIME
4NCL WT5
4NX= NGN 6 4095 [X6 -VE = 2ND PASS OF D.L.
4PBW STO 6 AWORK4(2) [SET GROPING MARKER
4PWG BRN WT1
4QB6 WT6
4QTQ LDX 0 AWORK4(2)
4R*B BNG 0 WT7
4RT2 COOR3 GROPEWS
4S#L BRN WT5
4SS= WT7
4T?W TXL 4 AWORK3(2)
4TRG BCS WT8 [J IF FEWER ANON DEVICES
4W?6 LDX 4 0
4WQQ BRN WFAIL
4X=B WT8
4XQ2 LDX 5 AWORK2(2)
4Y9L CALL 7 ZHLS
4YP= LDN 3 1
4^8W BRN WIN
4^9N ...
4^=G ...
4^?# ...
4^#6 ...
4^#Y ...WDEV
4^*Q ... LDX 3 BDTP
4^BJ ... ADX 3 BDTL
4^CB ... SBN 3 1
4^D8 ... LDX 3 0(3)
4^F2 ... TXL 5 3
4^FS ... BCC WIFAIL
4^GL ... LDX 3 5
4^HD ... JBGROP 3,WD1
4^J= ... SETBGROP 3
4^K4 ...WD1
4^KW ... CALL 7 Z2GROPE
4^LN ... JANON 3,WIFAIL
4^MG ... BRN WIN
4^NG [
5286 [
52MQ [
537B [ ENTRY FOR GROPE ACTIVITY
53M2 [
546L X2GROPE
54L= SETNCORE 1,3,ADATA,AGROP,1 [SET UP GROPE BUFFER BLOCK
555W STOZ A1(3)
55KG LOCKC 3,ZHUNT [LOCK BUFFER
5656 LOCKC 2,£ [LOCK ACTIVITY
56JQ CALL 1 ZHUNT
574B LDX 3 2
57J2 LDX 2 FX2
583L GROPE ,3,XREJ
58H= UNLOCK 2
592W UNLOCK 3
59GG JANON ,X01
5=26 LDX 3 CPPTR(2)
5=FQ BRN X14 [IF NOT ANON MUST BE REGROPE ON LP
5=^B X01
5?F2 [
5?YL [ CONVERT OPS. UNIT NO.
5#D= LDX 4 A1(3)
5#XW SRL 4 8
5*CG ANDN 4 #377
5*X6 LDX 5 4 [OPS NO FROM GROPE DATA
5BBQ ANDN 5 #17
5BWB BXL 5 PTEN(1),X1 [J IF NOT ALPHA HEX
5CB2 ADN 5 BASEOPSN-10 [ELSE ADJUST
5CTL X1
5D*= SRL 4 4
5DSW MPA 4 PTEN(1) [X5 = DECIMAL OPS NO.
5F#G LTYPE ,4
5FBD ... LDX 0 ACOMMUNE1(2)
5FDB ... SBN 0 3
5FG# ... BNG 0 X10
5FJ= ... TXU 5 AWORK2(2)
5FL8 ... BCS XUNEQL
5FN6 ... BRN X13
5FQ4 ...X10
5FS6 TXL 5 P64(1)
5G?Q BCS X11 [J IF LESS THAN 64
5GRB TXU 4 PDA(1)
5H?2 BCS XILL [J IF NOT DA
5HQL X11
5J== ... BZE 5 XILL
5JPW [ SEARCH FOR DUPLICATE UNIT NO
5K9G LDX 0 BDTP
5KP6 ADX 0 BDTL
5L8Q SBN 0 1
5LNB X12
5M82 SBN 0 1
5MML TXL 0 BDTP
5N7= BCS X13
5NLW SMO 0
5P6G LDX 3 0
5PL6 LGEOG 3,6
5Q5Q TXU 5 6
5QKB BCS X12
5R52 BRN XDUPL
5RJL X13
5S4= LDX 3 CPPTR(2)
5SHW STO 5 AWORK4(2) [SAVE DEC. UNIT NO.
5T3G SBN 4 2
5TH6 BNZ 4 X3 [J IF NOT LP
5W2Q X14
5WGB LPROP 3,5
5X22 LDN 7 160
5XFL SRC 5 5
5X^= BNG 5 X2
5YDW LDN 7 132
5YYG SLC 5 3
5^D6 BNG 5 X2
5^XQ LDN 7 120
62CB SRC 5 2
62X2 BNG 5 X2
63BL LDN 7 96
63W= X2
64*W LADDP 3,2 [GET APERI APIA
64TG STO 7 AREPERT(2) [SET PRINT WIDTH
65*6 LDN 0 65
65SQ SLL 0 12
66#B ADS 0 AREPERT(2) [ADD IN PAGE LENGTH
66S2 LDX 2 FX2
67?L CLBGROP 3
67R= JNANON 3,X4
68=W X3
68GN ... CLBGROP 3
68QG LDN 0 1
69=6 SBS 0 GANON [DECREMENT ANON COUNT
69PQ LDX 5 AWORK4(2)
6=9B [
6=P2 DEX 5 JK52C(3) [PUT UNIT NO. IN DEVICE LIST!
6?8L [
6?N= SBN 4 3
6#7W BPZ 4 X4 [J IF NOT TR,TP,LP,CR,CP
6#MG SETNCORE 10,2,FILE,FABSNB
6*76 ADN 1 PFABS
6*LQ ADN 2 A1
6B6B MOVE 1 10
6BL2 OPEN YOPEN,READ [OPEN :SYSTEM.PROPERTY
6C5L TESTREPN OK,YOPEN
6CK= LDX 7 AWORK4(2) [UNIT NO. IN X7
6D4W LTYPE 3,4
6DJG STEP
6F46 BZE 3 X35
6FHQ LADDP ,2 [GET APIA ADDRESS
6G3B BZE 4 X31 [J IF TR
6GH2 SBN 4 3
6H2L BNZ 4 X311 [J IF NOT CR
6HG= X31
6H^W ADN 2 1
6JFG X311
6J^6 LDX 4 APERPROP(2)
6KDQ BNZ 4 X31
6KYB SMO FX2
6LD2 STO 2 AWORK4
6LXL X32
6MC= STEP
6MWW BZE 3 X35 [J IF END OF FILE
6NBG LDX 5 APROPNO(3)
6NW6 ... SLC 5 1
6P*Q BPZ 5 X32 [J IF PROPERTY TEMPORARY
6PTB ... SRC 5 1
6Q*2 LDX 6 APROPGROUP(3)
6QSL LDX 1 ATTCOUNT(3)
6R#= X33
6RRW BZE 1 X32 [J IF NO AU7S OR AE'S LEFT
6S?G LDXC 4 APROPATT(3)
6SR6 SBX 4 7
6T=Q BZE 4 X34 [J IF SAME UNIT NO.
6TQB LDXC 4 APROPATT(3)
6W=2 BCC X331
6WPL ADN 3 1
6X9= SBN 1 1
6XNW X331
6Y8G ADN 3 1
6YN6 SBN 1 1
6^7Q BRN X33 [J TO LOOK AT NEXT AU OR AE
6^MB X34
7272 LDX 2 AWORK4(2) [APIA POINTER
72LL LDXC 4 APROPATT(3)
736= BCC X341 [J IF ATTRIBUTION
73KW LDX 4 APROPATT+1(3)
745G STO 4 APERPROP(2) [ASSOCIATION WORD
74K6 ADN 2 1
74Q# ... SLL 5 1
74XG ... SRL 5 1
754Q X341
75JB BPZ 6 X342 [J IF NOT CONSOLE PROPERTY
7642 ORX 5 GSIGN
76HL X342
773= STO 5 APERPROP(2)
77GW ADN 2 1
782G SMO FX2
78G6 STO 2 AWORK4 [SAVE APIA POINTER
78^Q BRN X32 [GET NEXT RECORD
79FB X35
79^2 CLOSE [CLOSE :SYSTEM.PROPERTY
7=DL X4
7=Y= LDX 3 CPPTR(2) [GET DEVICE LIST ADDRESS
7?CW JSWOUT 3,X5
7?XG LDX 0 AWORK3(2)
7#C6 SBN 0 2
7#WQ BZE 0 X5
7*BB LTYPE 3,5
7*W2 CALL 7 ZHLS
7B*L X5
7BT= LTYPE 3,4
7C#W TXU 4 PIPB(1)
7CSG BCS X52
7D#6 LAMOP 3,2
7DRQ LDX 0 CHAINADD(2)
7F?B BPZ 0 X51
7FR2 JSBUSY 3,X51
7G=L FPUT
7GQ= BRN X52
7H9W X51
7HPG LGEOG 3,5
7J96 LONGON1 #77,5
7JNQ X52
7K8B MFREEW ADATA,AGROP
7KN2 LDX 0 ATYPE(2)
7L7L SRL 0 12
7LM= SBN 0 GENERAL+AGROPE
7M6W BNZ 0 Z3EX
7MLG FON GROPEWS
7N66 SUICIDE
7NKQ XREJ
7P5B UNLOCK 2
7PK2 UNLOCK 3
7PLP ... LDX 0 ACOMMUNE1(2)
7PND ... SBN 0 3
7PQ7 ... BNG 0 XCL
7PRW ... LDX 6 PJGRFL(1)
7PTK ... CALL 7 ZMESS
7PX# ... LDX 3 CPPTR(2)
7Q2Q ... BRN XIL4
7Q4L XCL
7QJ= LDX 3 CPPTR(2)
7R3W CLBGROP 3
7RHG BRN X52
7S36 XDUPL
7SGQ [
7T2B [ THE FOLLOWING CODE IMPLEMENTS THE CHANGEOVER OF DEVICE
7TG2 [ LISTS FOR PERIPHERALS WITH DUAL INTERFACES.
7T^L [ THE INTERFACE ALREADY IN USE (DUPLICATE) = A
7WF= [ THE INTERFACE JUST GROPED = B
7WYW [
7X8N ... JENV XDPEND,CMESTAR
7XDG JSWIN 3,XDPEND [J IF A IS SW IN
7XY6 STO 3 AWORK4(2) [KEEP D. L. POINTER OF A
7YCQ SETSWOVER 3 [SET SW OVER BIT IN A
7YXB MHUNTW 3,ADATA,AGROP
7^C2 STOZ A1(3)
7^WL LOCKC 3,ZHUNT
82B= LOCKC 2,£
82TW CALL 1 ZHUNT
83*G LDX 3 2
83T6 LDX 2 FX2
84#Q GROPE AWORK4(2),3,XDP2 [J IF GROPE OF A IS REJECTED
84SB UNLOCK 2
85#2 UNLOCK 3
85RL XDP1
86?= LDX 3 AWORK4(2)
86QW CLSWOVER 3
87=G BRN XDPEND
87Q6 XDP2
889Q UNLOCK 2
88PB UNLOCK 3
8992 LDX 3 AWORK4(2)
89NL PROPCODE 3,4 [GIVE DEVICE PROPERTIES OF A
8=8= PROPCODE ,5 [GET DEVICE PROPERTIES OF B
8=MW TXU 4 5
8?7G BCS XDP1 [J IF PROPERTIES NOT IDENTICAL
8?M6 LTYPE 3,6
8#6Q TXL 6 P5(1)
8#LB BCS XDP3 [J IF TYPE 0,1,2,3,4
8*62 TXU 6 PIPB(1)
8*KL BCS XDP4 [J IF NOT TYPE 24
8B5= LDN 6 5
8BJW XDP3
8C4G LADDP 3,4 [APIA ADDRESS OF A
8CJ6 LADDP ,5 [APIA ADDRESS OF B
8D3Q SMO 6
8DHB LDX 7 PTABLE(1)
8F32 SMO 7
8FGL MOVE 4 0 [COPY APIA ENTRY FROM A TO B
8G2= SBN 6 2
8GFW BNZ 6 XDP4 [J IF NOT LP
8G^G JRGROP 3,XDP4 [J IF REGROPE SET IN A
8HF6 CLRGROP [CLEAR REGROPE IN B
8HYQ XDP4
8JDB LGEOG 3,5
8JY2 SMO CPPTR(2)
8KCL DEX 5 JK52C [PUT UNIT NO. IN B
8KX= STOZ 4
8LBW DEX 4 JK52C(3) [MAKE A ANONYMOUS
8LWG CLSWOVER 3 [CLEAR MARKER IN A
8MB6 LDN 4 2
8MTQ BRN XIL0
8N*B XDPEND
8NT2 [
8P#L [
8PS= LDN 4 1
8Q?W BRN XID
8QRG XILL
8R?6 STOZ 4
8RQQ XID
8S=B LDX 0 AWORK3(2)
8SQ2 SBN 0 2
8T9L BNZ 0 XIL0
8TP= JILLMS ,XCL
8W8W SETILLMS
8WNG XIL0
8X86 STO 5 AWORK4(2)
8XMQ HDWRTE ,6
8Y7B LDN 3 3
8YM2 XIL1
8^6L STOZ 5
8^L= SLL 56 4
925W TXL 5 PTEN(1)
92KG BCS XIL2
9356 ADN 5 #27
93JQ XIL2
944B SLL 5 2
94J2 SLL 56 4
953L LDX 7 5
95H= ANDN 7 #17
962W TXL 7 PTEN(1)
96GG BCS XIL3
9726 ADN 5 #27
97FQ XIL3
97^B SLL 5 12
98F2 STO 5 ACOMMUNE1(2)
98YL OUTPARN 2,ACOMMUNE1
99D= BCT 3 XIL1
99XW SMO 4
9=CG LDX 6 PJILL(1)
9=X6 LDX 4 AWORK4(2)
9?BQ CALL 7 ZMSIL
9?WB LDX 3 CPPTR(2)
9#B2 DISENGPE 3
9#KS ...XIL4
9#TL JWRONG 3,XILSW
9**= JMNBWR 3,XILSW
9*SW WRONG 3
9B#G XILSW
9BS6 JSWOUT 3,XCL
9C?Q SWOUT 3,YBRKN,XCL
9CRB BRN XCL
9CTK ...XUNEQL
9CXS ... LDX 6 PJUNEQL(1)
9D23 ... CALL 7 ZMESS
9D4= ... LDX 3 CPPTR(2)
9D8N ... BRN XIL4
9D?2 [
9DQL YBRKN
9F== GEOERR 1,BIGROPE
9FPW YOPEN
9G9G GEOERR 1,SWOPEN
9GP6 [
9H8Q [
9HNB [ SUBROUTINES
9J82 [
9JML [
9K7= ZMSIL
9KLW SBX 7 FX1
9L6G OUTNUM 4,0
9LB# ...ZMSIL1
9LL6 LDN 5 0
9M5Q INFORMX 5,6,1
9MKB ADX 7 FX1
9N52 EXIT 7 0
9N6Y ...ZMESS
9N8W ... SBX 7 FX1
9N=S ... MHUNTW 1,CPAR,JSCE
9N#Q ... LDX 0 JSCEQ(1)
9NBN ... ANDN 0 #7777
9NDL ... OUTPARAM 0,JSCER,CPAR,JSCE
9NGJ ... BRN ZMSIL1
9NJL [
9P4= ZGROPE
9PHW [
9Q3G SBX 7 FX1
9QH6 SETBGROP 3
9R2Q GETACT GENERAL,AGROPE,1
9RGB LDX 4 AWORK1(2)
9S22 LDX 2 BPTR(2)
9SFL STO 3 CPPTR(2)
9S^= STO 4 AWORK3(2)
9TDW LDN 1 PLINK1(1)
9TYG LINKSET 2,0(1) [LINK TO K2GROPE
9WD6 FPUT
9WXQ ADX 7 FX1
9XCB EXIT 7 0
9XX2 ZHUNT
9YBL MHUNTW 2,ADATA,AGROP
9YW= EXIT 1 0
9^*W [
9^TG Z2GROPE
=2*6 [
=2SQ SBX 7 FX1
=3#B STO 7 AWORK3(2)
=3S2 LDX 0 CPPTR(2)
=4?L STO 0 AWORK1(2) [SAVE ORIGINAL CONTENTS OF CPPTR
=4R= STO 3 CPPTR(2)
=5=W BRN X2GROPE
=5QG Z3EX
=6=6 LDX 0 AWORK1(2)
=6PQ STO 0 CPPTR(2) [RESTORE ORIGINAL CONTENTS OF CPPTR
=79B LDX 7 AWORK3(2)
=7P2 ADX 7 FX1
=88L EXIT 7 0
=8N= [
=97W ZHLS
=9MG SBX 7 FX1
==76 HLSINFORM YBRKN,GEOGNO,,5
==LQ ADX 7 FX1
=?6B EXIT 7 0
=?L2 [
=#5L #END
^^^^ ...131334410008