1000 REMark ------------------------------
1010 REMark      NO_TAS_bas - Mark J Swift
1020 REMark ...Turbo tweaks - SNG
1030 :
1040 REMark   Replace TAS with Line-A
1050 REMark     (1010111X XXXXXXXX)
1060 REMark    emulation instruction.
1070 :
1080 REMark Uses ALCHP, CLCHP, FLEN, FTYP
1090 REMark Uses FDAT, HEX, HEX$, D68K
1100 REMark Uses CURSEN, CURDIS
1110 REMark ------------------------------
1120 :
1130 REMark DATA_AREA 2
1140 REMark WHEN ERRor
1150 REMark PRINT #3\\"Error: "
1160 REMark REPORT #3,ERNUM
1170 REMark INPUT #3;\" Press ENTER to re-start.";Rplc$
1180 REMark RETRY
1190 REMark END WHEN
1200 :
1210 DIM InFile$(100),OutFile$(100),Rplc$(1),P$(256),Src$(5),Dst$(40),Name$(40),Space$(40),temp$(40)
1220 Buff=ALCHP(256)
1230 Rows=14
1240 DIM D(Rows/2)
1250 OPEN#3;"Con_456x234a28x12"
1260 OPEN#4;"Scr_104x12a362x20"
1270 OPEN#5;"Scr_436x142a38x99"
1280 InFlg%=0
1290 temp$=DATE$:Name$="ram1_NO_TAS_log"
1300 DELETE Name$
1310 OPEN_NEW#8;Name$
1320 PRINT#8;"NO_TAS started at ";temp$(13 TO 20);" on";temp$(5 TO 12);temp$(1 TO 4)\\
1330 REPeat outer_loop
1340  WINDOW#3;456,234,28,12:PAPER#3;0:INK#3;7:CLS#3:BORDER#3;3,2:BORDER#3;2,0:BORDER#3;1,2:WINDOW#3;438,220,36,19:BORDER#5;1,4:INK#5;4:PAPER#5;0
1350  CSIZE#3;2,1:PRINT#3;"NO_TAS V1.12":CSIZE#3;0,0
1360  PRINT#3;" AMIGA-FRIENDLY PATCHER";
1370  CLS#4:BORDER#4;1,7:INK#4;4:CLS#5
1380  WINDOW#3;438,40,36,59
1390  IF InFlg%=0 THEN 
1400   INK#5;7:PRINT#5;"PROBLEM:";:INK#5;4
1410   PRINT#5;" The Amiga hardware does not allow the CPU two contiguous bus"
1420   PRINT#5;" cycles. This means that any READ-MODIFY-WRITE cycle doesn't work, and"
1430   PRINT#5;" as a result the machine code instruction 'TAS' doesn't function"
1440   PRINT#5;" correctly on the Amiga. (can mess up the next instruction fetch)"
1450   INK#5;7:PRINT#5;"SOLUTION:";:INK#5;4
1460   PRINT#5;" This program removes TAS instructions in recognised TURBO'ed"
1470   PRINT#5;" and QLIB'ed tasks, substituting equivalent code. If the code is not"
1480   PRINT#5;" thus recognised, TAS will be replaced by a Line-A instruction (which is"
1490   PRINT#5;" programmed to emulate TAS but is not QL-compatible) or by extending the"
1500   PRINT#5;" code (which might confuse tasks that assume their own length). Under"
1510   PRINT#5;" such circumstances a disassembly is shown and you will be asked whether"
1520   PRINT#5;" or not to replace the code. The program may display TAS instructions"
1530   PRINT#5;" where none are present (i.e. within program DATA). A good rule-of-thumb"
1540   PRINT#5;" is that true CODE will usually be surrounded by other machine code"
1550   PRINT#5;" instructions, whereas DATA will be liberally sprinkled with DC.Ws";
1560   INPUT#3;\"Input FILE or VOLUME name  >";InFile$
1570   IF InFile$="" THEN EXIT outer_loop
1580   IF LEN(InFile$)=5 THEN 
1590    InFlg%=INT(((InFile$ INSTR "flp1_flp2_flp3_flp4_ram1_ram2_")+4)/5)
1600   ELSE 
1610    InFlg%=0
1620   END IF 
1630   IF InFlg%=0 THEN 
1640    INPUT#3;"         Output FILE name  >";OutFile$
1650    IF OutFile$="" THEN EXIT outer_loop
1660   ELSE 
1670    INPUT#3;"       Output VOLUME name  >";OutFile$
1680    IF OutFile$="" THEN InFlg%=0:EXIT outer_loop
1690    Src$=InFile$:Dst$=OutFile$
1700    DELETE Dst$&"NO_TAS_dat"
1710    OPEN_NEW#7;Dst$&"NO_TAS_dat"
1720    DIR#7;Src$:CLOSE#7
1730    OPEN_IN#7;Dst$&"NO_TAS_dat"
1740    INPUT#7;Name$,Space$
1750   END IF 
1760   CLS#5
1770  END IF 
1780  REPeat main_loop
1790   REPeat in_loop
1800    CLS#4:CLS#3:RPORT CHR$(10)
1810    IF InFlg%<>0 THEN 
1820     IF EOF(#7) THEN 
1830      EXIT main_loop
1840     ELSE 
1850      INPUT#7;InFile$
1860      OutFile$=Dst$&InFile$
1870      InFile$=Src$&InFile$
1880     END IF 
1890    END IF 
1900    OPEN_IN#6;InFile$
1910    fl=FLEN(#6):ft=FTYP(#6):IF ft THEN fd=FDAT(#6)
1920    CLOSE#6
1930    RPORT "FILE: "&InFile$&CHR$(10)
1940    IF fl=0 THEN 
1950     RPORT "File empty!"&CHR$(10)
1960     IF InFlg%=0 THEN EXIT main_loop
1970    ELSE 
1980     temp$=FILE_CLASS$(InFile$)
1990     IF temp$<>"" THEN 
2000      INK#3;4:RPORT "Possible "&temp$&CHR$(10):INK#3;7
2010     END IF 
2020     IF InFlg%=0 THEN 
2030      EXIT in_loop
2040     ELSE 
2050      RPORT "TAS replace :":Rplc$=WAITKEY$(3,"ynq")
2060      IF Rplc$=="y" THEN EXIT in_loop
2070      IF Rplc$=="q" THEN EXIT main_loop
2080     END IF 
2090    END IF 
2100   END REPeat in_loop
2110   CLS#5
2120   base=ALCHP(fl+1024)
2130   IF base>0 THEN 
2140    LBYTES InFile$,base
2150   ELSE 
2160    PRINT#3;\"Out of memory!"
2170    EXIT outer_loop
2180   END IF 
2190   REMark do it
2200   NoRpc%=0:RecogFlg%=0
2210   IF PEEK_W(base+6)<>HEX("4AFB") THEN 
2220    fixQLIB
2230    IF RecogFlg%=0 THEN 
2240     RPORT "UNRECOGNISED CODE:..."&CHR$(10)
2250    END IF 
2260   ELSE 
2270    fixTURBO
2280    IF RecogFlg%=0 THEN 
2290     fixQLIB
2300     IF RecogFlg%=0 THEN 
2310      RPORT "UNRECOGNISED TASK:..."&CHR$(10)
2320     END IF 
2330    END IF 
2340   END IF 
2350   IF RecogFlg%=0 THEN 
2360    Flg%=-1
2370    IF fl<32768 THEN 
2380     RPORT "SMALL CODE: do you want to try QL-Compatible TAS replacement ":Rplc$=WAITKEY$(3,"ynq")
2390     IF Rplc$=="q" THEN EXIT main_loop
2400     IF Rplc$=="y" THEN 
2410      treatTAS
2420      IF Flg%=0 THEN 
2430       fl=LastByte-base
2440      ELSE 
2450       RPORT "THERE WERE ERRORS: re-loading CODE"&CHR$(10)
2460       LBYTES InFile$,base
2470      END IF 
2480     END IF 
2490    END IF 
2500    IF Flg%<>0 THEN 
2510     RPORT "Attempting A-Line TAS replacement"&CHR$(10)
2520     fixTAS
2530    END IF 
2540   END IF 
2550   IF NoRpc% THEN 
2560    RPORT "Saving..."&CHR$(10)
2570    IF ft THEN 
2580     DELETE OutFile$
2590     SEXEC OutFile$,base,fl,fd
2600    ELSE 
2610     DELETE OutFile$
2620     SBYTES OutFile$,base,fl
2630    END IF 
2640   ELSE 
2650    RPORT "No changes."&CHR$(10)
2660   END IF 
2670   RECHP(base)
2680   IF (InFlg%=0) OR (NoRplc%=0) THEN 
2690    Rplc$=INKEY$(#3,200)
2700    IF InFlg%=0 THEN EXIT main_loop
2710   END IF 
2720  END REPeat main_loop
2730  REMark RETRY_HERE
2740  IF InFlg%<>0 THEN CLOSE#7:DELETE Dst$&"NO_TAS_dat":InFlg%=0
2750 END REPeat outer_loop
2760 CLOSE#8
2770 RECHP(Buff)
2780 CLOSE#3
2790 CLOSE#4
2800 CLOSE#5
2810 IF InFlg%<>0 THEN CLOSE#7:DELETE OutFile$&"NO_TAS_dat":InFlg%=0
2820 STOP
2830 :
2840 DEFine PROCedure fixSYSV
2850  LOCal a,p,i,N
2860  CLS#4
2870  p=0
2880  REPeat find_loop
2890   BLOCK#4;(p/fl)*100,10,0,0,4
2900   pk=PEEK_L(base+p)
2910   IF (pk>HEX("28000")) AND (pk<=HEX("28200")) THEN 
2920    DISOUT
2930   Rplc$=WAITKEY$(3,"ynaq")
2940   END IF 
2950   p=p+2
2960   IF p>fl THEN EXIT find_loop
2970  END REPeat find_loop
2980 END DEFine 
2990 :
3000 DEFine PROCedure fixTURBO
3010  LOCal a,p,i,N,pk,dt
3020  CLS#4
3030  RecogFlg%=0:p=0
3040  REPeat find_loop
3050   IF p>fl THEN EXIT find_loop
3060   FOR N=1 TO 256
3070    pk=PEEK_W(base+p)
3080    IF (pk=19182) OR (pk=-4050) OR (pk=-466) THEN 
3090     RESTORE 3530
3100     FOR i=0 TO 13 STEP 2
3110      READ dt
3120      IF i<>0 THEN 
3130       IF PEEK_W(base+p+i)<>dt THEN i=0:EXIT i:END IF 
3140      END IF 
3150     END FOR i
3160     IF i<>0 THEN 
3170      RESTORE 3550
3180      FOR i=0 TO 13 STEP 2
3190       READ dt:POKE_W base+p+i,dt
3200      END FOR i
3210      IF RecogFlg%=0 THEN RPORT "TURBO TASK:..."&CHR$(10):RecogFlg%=-1
3220      RPORT "patched at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
3230     END IF 
3240    END IF 
3250    IF (pk=19178) OR (pk=-4054) OR (pk=-470) THEN 
3260     RESTORE 3570
3270     FOR i=-10 TO 9 STEP 2
3280      READ dt
3290      IF i<>0 THEN 
3300       IF PEEK_W(base+p+i)<>dt THEN i=0:EXIT i:END IF 
3310      END IF 
3320     END FOR i
3330     IF i<>0 THEN 
3340      RESTORE 3590
3350      FOR i=-10 TO 9 STEP 2
3360       READ dt:POKE_W base+p+i,dt
3370      END FOR i
3380      IF RecogFlg%=0 THEN RPORT "TURBO TASK:..."&CHR$(10):RecogFlg%=-1
3390      RPORT "Patched at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
3400     END IF 
3410    END IF 
3420    p=p+2
3430    IF p>=fl THEN EXIT N
3440   END FOR N
3450   IF p>fl THEN 
3460    BLOCK#4;100,10,0,0,4
3470   ELSE 
3480    BLOCK#4;INT((p/fl)*100),10,0,0,4
3490   END IF 
3500  END REPeat find_loop
3510 END DEFine 
3520 :
3530 DATA 19182,143,32256,29184,20112,17393,-6144
3540 :
3550 DATA 2286,7,143,32256,29184,20112,-11314
3560 :
3570 DATA 12842,34,8775,19008,26410,19178,23,26404,10249,14849
3580 :
3590 DATA 14890,34,8775,19008,26410,2282,7,23,26402,10249
3600 :
3610 DEFine PROCedure fixQLIB
3620  LOCal l,N,i,X
3630  RecogFlg%=0
3640  X=find("Q_Libe"&"rator ",FILL$(CHR$(223),12),base,0,fl)
3650  IF X<>-1 THEN 
3660   IF PEEK_W(base+6)<>HEX("4AFB") THEN 
3670    RPORT "QLIB CODE: "
3680   ELSE 
3690    RPORT "QLIB TASK: "
3700   END IF 
3710   RPORT "initial scan OK at "&X&"..."&CHR$(10):RecogFlg%=-1
3720   N=find(CHR$(HEX("4A"))&CHR$(HEX("EE"))&CHR$(HEX("00"))&CHR$(HEX("8f")),CHR$(HEX("FF"))&CHR$(HEX("F8"))&CHR$(HEX("FF"))&CHR$(HEX("FF")),base,0,fl)
3730   IF N<>-1 THEN 
3740    REMark Truncate copyright notice
3750    REMark to make room for m/c sub
3760    l=PEEK_W(base+X-2)-12:POKE_W base+X-2,l
3770    FOR i=0 TO l-1
3780     POKE base+X+i,PEEK(base+X+i+12)
3790    END FOR i
3800    REMark Create subroutine:
3810    REMark BSET #7,$8F(A0)
3820    REMark RTS
3830    POKE base+X+l,HEX('08')
3840    POKE base+X+l+1,HEX('E8')
3850    POKE base+X+l+2,HEX('00')
3860    POKE base+X+l+3,HEX('07')
3870    POKE base+X+l+4,HEX('00')
3880    POKE base+X+l+5,HEX('8F')
3890    POKE base+X+l+6,HEX('4E')
3900    POKE base+X+l+7,HEX('75')
3910    REMark Customize subroutine
3920    POKE base+X+l+1,PEEK(base+N+1)
3930    REMark Overwrite TAS $8F(An)
3940    REMark with a BSR instruction
3950    POKE base+N,HEX("61"):POKE base+N+1,HEX("00")
3960    POKE_W base+N+2,X+l-N-2
3970    RPORT "Patched at $"&HEX$(N,32)&CHR$(10):NoRpc%=NoRpc%+1
3980   END IF 
3990  END IF 
4000 END DEFine 
4010 :
4020 DEFine PROCedure fixTAS
4030  CLS#4
4040  EA_mask=HEX('003F')
4050  TAS_mask=HEX('FFC0')-HEX('10000')
4060  LINEF_7_inst=HEX('AE00')-HEX('10000')
4070  TAS_inst=HEX('4AC0')
4080  p=0
4090  REPeat Replace_loop
4100   IF p>=fl THEN EXIT Replace_loop
4110   FOR N=1 TO 256
4120    pk=PEEK_W(base+p)
4130    IF ((pk && TAS_mask)=TAS_inst) THEN 
4140     ea=pk && EA_mask
4150     SELect ON ea
4160     =0 TO 7 : REMark dn - can handle this!
4170      REMark RPORT HEX$(p,32)&" TAS d"&(ea&&7)
4180      REMark Replace_TAS
4190     =16 TO 23 : REMark  (an)
4200      RPORT HEX$(p,32)&" TAS (a"&(ea&&7)&")"
4210      Replace_TAS
4220     =24 TO 31 : REMark  (an)+
4230      RPORT HEX$(p,32)&" TAS (a"&(ea&&7)&")+"
4240      Replace_TAS
4250     =32 TO 39 : REMark  -(an)
4260      RPORT HEX$(p,32)&" TAS -(a"&(ea&&7)&")"
4270      Replace_TAS
4280     =40 TO 47 : REMark d(an)
4290      RPORT HEX$(p,32)&" TAS "&HEX$(PEEK_W(base+p+2),16)&"(a"&(ea&&7)&")"
4300      Replace_TAS
4310     =48 TO 55 : REMark d(an,a/dn)
4320      RPORT HEX$(p,32)&" TAS $"&HEX$(PEEK(base+p+3),8)&"(a"&(ea&&7)&","&("da"(1+(INT(PEEK(base+p+2)/128)&&1)))&INT(PEEK(base+p+2)/16)&&7&"."&("wl"(1+(INT(PEEK(base+p+2)/8)&&1)))&")"
4330      Replace_TAS
4340     =56 : REMark $.w
4350      RPORT HEX$(p,32)&" TAS $"&HEX$(PEEK_W(base+p+2),16)
4360      Replace_TAS
4370     =57 : REMark $.l
4380      RPORT HEX$(p,32)&" TAS $"&HEX$(PEEK_L(base+p+2),32)
4390      Replace_TAS
4400     =REMAINDER : REMark impossible
4410      REMark ignore illegal address modes
4420     END SELect 
4430     IF Rplc$=="Q" THEN NoRpc%=0:EXIT Replace_loop
4440    END IF 
4450    p=p+2
4460    IF p>=fl THEN EXIT N
4470   END FOR N
4480   IF p>fl THEN 
4490    BLOCK#4;100,10,0,0,4
4500   ELSE 
4510    BLOCK#4;INT((p/fl)*100),10,0,0,4
4520   END IF 
4530  END REPeat Replace_loop
4540 END DEFine 
4550 :
4560 DEFine PROCedure Replace_TAS
4570  LOCal get_loop
4580  IF NOT(Rplc$=="a")
4590   DISOUT
4600   Rplc$=WAITKEY$(3,"ynaq")
4610   CLS#5
4620  ELSE 
4630   RPORT " replaced."&CHR$(10)
4640  END IF 
4650  IF Rplc$=="y" OR Rplc$=="a" THEN 
4660   POKE_W base+p,LINEF_7_inst||ea
4670   NoRpc%=NoRpc%+1
4680  END IF 
4690 END DEFine 
4700 :
4710 DEFine PROCedure treatTAS
4720  REMark Replace TAS instructions in a QL-friendly way.
4730  REMark Extends the code, so may not be reliable with
4740  REMark tasks that assume their own size.
4750  CLS#4
4760  EA_mask=HEX('003F')
4770  TST_mask=HEX('4A00'):BSET_mask=HEX('08C0')
4780  TAS_mask=HEX('FFC0')-HEX('10000')
4790  TAS_inst=HEX('4AC0')
4800  BSR_inst=HEX('6100')
4810  RTS_inst=HEX('4E75')
4820  NOP_inst=HEX('4E71')
4830  LastByte=base+fl
4840  Rplc$=""
4850  p=0:Flg%=0
4860  REPeat Replace_loop
4870   IF p>=fl THEN EXIT Replace_loop
4880   FOR N=1 TO 256
4890    pk=PEEK_W(base+p)
4900    IF ((pk && TAS_mask)=TAS_inst) THEN 
4910     ea=pk && EA_mask
4920     SELect ON ea
4930     =0 TO 7 : REMark dn - can handle this!
4940      REMark RPORT HEX$(p,32)&" TAS d"&ea&&7
4950      REMark Treat_ARI
4960     =16 TO 23 : REMark  (an)
4970      RPORT HEX$(p,32)&" TAS (a"&(ea&&7)&")"
4980      Treat_ARI
4990     =24 TO 31 : REMark  (an)+
5000      RPORT HEX$(p,32)&" TAS (a"&(ea&&7)&")+"
5010      Treat_ARI
5020     =32 TO 39 : REMark  -(an)
5030      RPORT HEX$(p,32)&" TAS -(a"&(ea&&7)&")"
5040      Treat_ARI
5050     =40 TO 47 : REMark d(an)
5060      RPORT HEX$(p,32)&" TAS "&HEX$(PEEK_W(base+p+2),16)&"(a"&(ea&&7)&")"
5070      Treat_ARID
5080     =48 TO 55 : REMark d(an,a/dn)
5090      RPORT HEX$(p,32)&" TAS $"&HEX$(PEEK(base+p+3),8)&"(a"&(ea&&7)&","&("da"(1+(INT(PEEK(base+p+2)/128)&&1)))&INT(PEEK(base+p+2)/16)&&7&"."&("wl"(1+(INT(PEEK(base+p+2)/8)&&1)))&")"
5100      Treat_ARID
5110     =56 : REMark $.w
5120      RPORT HEX$(p,32)&" TAS $"&HEX$(PEEK_W(base+p+2),16)
5130      Treat_ARID
5140     =57 : REMark $.l
5150      RPORT HEX$(p,32)&" TAS $"&HEX$(PEEK_W(base+p+2),32)
5160      Treat_ABSL
5170     =REMAINDER : REMark impossible ea
5180      REMark ignore illegal address modes
5190     END SELect 
5200     IF Rplc$=="Q" OR Flg%=-1 THEN NoRpc%=0:EXIT Replace_loop
5210    END IF 
5220    p=p+2
5230    IF p>=fl THEN EXIT N
5240   END FOR N
5250   IF p>fl THEN 
5260    BLOCK#4;100,10,0,0,4
5270   ELSE 
5280    BLOCK#4;INT((p/fl)*100),10,0,0,4
5290   END IF 
5300  END REPeat Replace_loop
5310 END DEFine 
5320 :
5330 DEFine PROCedure Treat_ARI
5340  LOCal disp,get_loop
5350  disp=LastByte-(base+p+2)
5360  IF NOT(Rplc$=="a")
5370   DISOUT
5380   Rplc$=WAITKEY$(3,"ynaq")
5390   CLS#5
5400  END IF 
5410  IF Rplc$=="y" OR Rplc$=="a" THEN 
5420   IF disp>126 THEN 
5430    RPORT " ERROR: OFFSET TOO LARGE"&CHR$(10):Flg%=-1
5440   ELSE 
5450    POKE_W LastByte,TST_mask&&ea:LastByte=LastByte+2
5460    POKE_W LastByte,BSET_mask||ea:LastByte=LastByte+2
5470    POKE_W LastByte,7:LastByte=LastByte+2
5480    POKE_W LastByte,RTS_inst:LastByte=LastByte+2
5490    POKE_W base+p,BSR_inst||disp
5500    NoRpc%=NoRpc%+1
5510    IF Rplc$=="a" THEN RPORT " replaced."&CHR$(10)
5520   END IF 
5530  END IF 
5540 END DEFine 
5550 :
5560 DEFine PROCedure Treat_ARID
5570  LOCal disp
5580  disp=LastByte-(base+p+2)
5590  IF NOT(Rplc$=="a")
5600   DISOUT
5610   Rplc$=WAITKEY$(3,"ynaq")
5620   CLS#5
5630  END IF 
5640  IF Rplc$=="y" OR Rplc$=="a" THEN 
5650   IF disp>32766 THEN 
5660    RPORT " ERROR: FILE TOO BIG"&CHR$(10):Flg%=-1
5670   ELSE 
5680    POKE_W LastByte,TST_mask||ea:LastByte=LastByte+2
5690    POKE_W LastByte,PEEK_W(base+p+2):LastByte=LastByte+2
5700    POKE_W LastByte,BSET_mask||ea:LastByte=LastByte+2
5710    POKE_W LastByte,7:LastByte=LastByte+2
5720    POKE_W LastByte,PEEK_W(base+p+2):LastByte=LastByte+2
5730    POKE_W LastByte,RTS_inst:LastByte=LastByte+2
5740    POKE_W base+p,BSR_inst
5750    POKE_W base+p+2,disp
5760    NoRpc%=NoRpc%+1
5770    IF Rplc$=="a" THEN RPORT " replaced."&CHR$(10)
5780   END IF 
5790  END IF 
5800 END DEFine 
5810 :
5820 DEFine PROCedure Treat_ABSL
5830  LOCal disp
5840  disp=LastByte-(base+p+2)
5850  IF NOT(Rplc$=="a")
5860   DISOUT
5870   Rplc$=WAITKEY$(3,"ynaq")
5880   CLS#5
5890  END IF 
5900  IF Rplc$=="y" OR Rplc$=="a" THEN 
5910   IF disp>32766 THEN 
5920    RPORT " ERROR: FILE TOO BIG"&CHR$(10):Flg%=-1
5930   ELSE 
5940    POKE_W LastByte,TST_mask||ea:LastByte=LastByte+2
5950    POKE_L LastByte,PEEK_L(base+p+2):LastByte=LastByte+4
5960    POKE_W LastByte,BSET_mask||ea:LastByte=LastByte+2
5970    POKE_W LastByte,7:LastByte=LastByte+2
5980    POKE_L LastByte,PEEK_L(base+p+2):LastByte=LastByte+4
5990    POKE_W LastByte,RTS_inst:LastByte=LastByte+2
6000    POKE_W base+p,BSR_inst
6010    POKE_W base+p+2,disp
6020    POKE_W base+p+4,NOP_inst
6030    NoRpc%=NoRpc%+1
6040    IF Rplc$=="a" THEN RPORT " replaced."&CHR$(10)
6050   END IF 
6060  END IF 
6070 END DEFine 
6080 :
6090 DEFine PROCedure DISOUT
6100  LOCal loop, preLoop, disLoop
6110  LOCal r, Ds, Q, N, c, i
6120  r=Rows/2
6130  Ds=0
6140  FOR i=1 TO r
6150   D(i)=0
6160  END FOR i
6170  Q=p-8*r
6180  IF Q<0 THEN Q=0
6190  REPeat preLoop
6200   N=D68K(base+Q,Q\Buff)
6210   Q=Q+N
6220   Ds=Ds-D(i)+N
6230   D(i)=N
6240   REPeat loop
6250    i=1+(i MOD r)
6260    N=N-6
6270    IF N<=0 THEN EXIT loop
6280    Ds=Ds-D(i)
6290    D(i)=0
6300   END REPeat loop
6310   IF Q>=p THEN EXIT preLoop
6320  END REPeat preLoop
6330  CLS#5
6340  Q=Q-Ds
6350  r=Rows
6360  dflag=0
6370  REPeat disLoop
6380   N=D68K(base+Q,Q\Buff)
6390   i=0:P$=" "
6400   REPeat loop
6410    c=PEEK(Buff+i)
6420    IF c=0 THEN EXIT loop
6430    i=i+1
6440    P$=P$(1 TO LEN(P$))&CHR$(c)
6450   END REPeat loop
6460   IF (Q<=p) AND ((Q+N)>p) THEN 
6470    IF dflag AND NOT("tas" INSTR P$(1 TO LEN(P$)))
6480     P$=P$(1 TO 14)&"         dc.w      $"&P$(11 TO 14)&CHR$(10):dflag=1:N=2
6490     INK#5;4
6500    ELSE 
6510     INK#5;7
6520    END IF 
6530   ELSE 
6540    INK#5;4
6550     dflag="dc." INSTR P$(1 TO LEN(P$))
6560   END IF 
6570   Q=Q+N
6580   r=r-((N+5) DIV 6)
6590   IF r<0 THEN EXIT disLoop
6600   PRINT#5;P$(1 TO LEN(P$));
6610  END REPeat disLoop
6620 END DEFine 
6630 :
6640 DEFine FuNction FILE_CLASS$(i$)
6650  i=0
6660  REPeat check_loop
6670   j="_" INSTR i$(i+1 TO LEN(i$))
6680   IF j=0 THEN EXIT check_loop
6690   i=i+j
6700   IF i=LEN(i$) THEN RETurn ""
6710  END REPeat check_loop
6720  IF i=0 THEN 
6730   j=-1
6740  ELSE 
6750   IF (i=5) AND (i$(1 TO i) INSTR "ram1_ram2_flp1_flp2_mdv1_mdv2_") THEN 
6760    j=-1
6770   END IF 
6780  END IF 
6790  IF j<>0 THEN 
6800   j="_"&i$(i+1 TO LEN(i$))&"_" INSTR "_BOOT_"
6810   SELect ON j
6820   =1:a$="SuperBASIC boot program"
6830   =REMAINDER :a$=""
6840   END SELect 
6850   RETurn a$
6860  ELSE 
6870   a$=""
6880   j=(i$(i TO LEN(i$))&"_") INSTR "_c_h_bas_fth_asm_list_txt_text_scr_doc_aba_prg_grf_hob_arc_zip_font_fnt_boot_asc_screen_dbf_scn_log_task_job_"
6890   SELect ON j
6900   =1:a$="C source"
6910   =3:a$="C header file"
6920   =5:a$="SuperBASIC program"
6930   =9:a$="FORTH program"
6940   =13:a$="Assembler source"
6950   =17:a$="Assembler list file"
6960   =22,26,77,96:a$="ASCII text file"
6970   =31,81:a$="Screen-save"
6980   =35:a$="QUILL wordprocess document"
6990   =39:a$="ABACUS spreadsheet document"
7000   =43:a$="ARCHIVE program document"
7010   =88:a$="ARCHIVE database file"
7020   =92:a$="ARCHIVE screen layout"
7030   =47:a$="EASEL chart document"
7040   =51:a$="Psion help file"
7050   =55:a$="ARC file archive"
7060   =59:a$="ZIP file archive"
7070   =63,68:a$="Alternative font character set"
7080   =72:a$="SuperBASIC boot program"
7090   =100,105:a$="executable TASK"
7100   =REMAINDER :a$=""
7110   END SELect 
7120  END IF 
7130  RETurn a$
7140 END DEFine 
7150 :
7160 DEFine FuNction WAITKEY$(Chan%,i$)
7170  LOCal K$(1),i,l,prompt_loop,get_loop
7180  RPORT " ("
7190  i=1:l=LEN(i$)
7200  REPeat prompt_loop
7210   RPORT i$(i):i=i+1
7220   IF i>l THEN EXIT prompt_loop
7230   RPORT "/"
7240  END REPeat prompt_loop
7250  RPORT ")? >"
7260  CURSEN#Chan%
7270  REPeat get_loop
7280   K$=INKEY$(#Chan%,-1)
7290   IF K$ INSTR i$ THEN EXIT get_loop
7300  END REPeat get_loop
7310  CURDIS#Chan%
7320  RPORT K$&CHR$(10)
7330  RETurn K$
7340 END DEFine 
7350 :
7360 DEFine PROCedure RPORT(temp$)
7370  PRINT#3;temp$;:PRINT#8;temp$;
7380 END DEFine 
7390 :
7400 DEFine FuNction find(txt$,msk$,base,s,e)
7410  LOCal i,j,K,l
7420  CLS#4
7430  l=-1
7440  i=s
7450  REPeat i_loop
7460   j=0
7470   REPeat j_loop
7480    K=0
7490    REPeat k_loop
7500     IF (PEEK(base+i+j+K)&&CODE(msk$(K+1)))<>(CODE(txt$(K+1))&&CODE(msk$(K+1))) THEN EXIT k_loop
7510     K=K+1
7520     IF K=LEN(txt$) THEN 
7530      l=i+j:EXIT i_loop
7540     END IF 
7550    END REPeat k_loop
7560    j=j+1
7570    IF j=256 THEN EXIT j_loop
7580   END REPeat j_loop
7590   IF i>=e THEN 
7600    BLOCK #4,100,10,0,0,4
7610   ELSE 
7620    BLOCK#4;((i-s)/(e-s))*100,10,0,0,4
7630   END IF 
7640   i=i+256
7650   IF (i-e)>=256 THEN EXIT i_loop
7660  END REPeat i_loop
7670  RETurn l
7680 END DEFine 
7690 :
