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