1000 REMark ------------------------------
1010 REMark    PATCHREF_bas - Mark J Swift
1020 :
1030 REMark Uses ALCHP, CLCHP, FLEN, FTYP
1040 REMark Uses FDAT, HEX, HEX$, D68K
1050 REMark Uses CURSEN, CURDIS
1060 REMark uses STRINGL
1070 REMark ------------------------------
1080 :
1090 REMark DATA_AREA 2
1100 REMark WHEN ERRor
1110 REMark PRINT #3\\"Error: "
1120 REMark REPORT #3,ERNUM
1130 REMark INPUT #3;\" Press ENTER to re-start.";Rplc$
1140 REMark RETRY
1150 REMark END WHEN
1160 :
1170 DIM InFile$(100),OutFile$(100),Rplc$(1),P$(256),Src$(5),Dst$(40),Name$(40),Space$(40),temp$(40),nam$(64),pch$(256),a$(100),verstag$(4)
1180 verstag$="1.04":REMark this version
1190 Buff=ALCHP(256)
1200 Rows=14
1210 DIM D(Rows/2)
1220 OPEN#3;"Con_456x234a28x12"
1230 OPEN#4;"Scr_104x12a362x20"
1240 OPEN#5;"Scr_436x142a38x99"
1250 InFlg%=0
1260 REPeat outer_loop
1270  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
1280  CSIZE#3;2,1:PRINT#3;"SYS_REF v";verstag$:CSIZE#3;0,0
1290  PRINT#3;"CODE-PATCHER by MARK J SWIFT";
1300  CLS#4:BORDER#4;1,7:INK#4;4:CLS#5
1310  WINDOW#3;438,40,36,59
1320  IF InFlg%=0 THEN 
1330   INK#5;4
1340   PRINT#5;" SYS_REF is a utility that patches tasks & M/C which rely on the system"
1350   PRINT#5;" variables being at $28000, to work when the sys vars are elsewhere."
1360   PRINT#5;" It has been tested on several programs (even TURBO) under Minerva and"
1370   PRINT#5;" Amiga-QDOS (with 2nd screen enabled), and WORKS!"
1380   PRINT#5;\" When patching CODEGEN_task of the TURBO compiler, patch all references"
1390   PRINT#5;" EXCEPT the two that refer to $28010. These are not part of the CODEGEN"
1400   PRINT#5;" code, but are included in all TURBO compiled programs. When patching"
1410   PRINT#5;" PARSER_task, or any other TURBO program replace ALL references."
1420   PRINT#5;" The patched version of TURBO produces code identical to the unpatched"
1430   PRINT#5;" version, so remember to patch all those TURBO-compiled tasks!"
1440   PRINT#5;\" Addendum: SYS_REF makes TURBO & TURBO-compiled programs 32-bit clean."
1450   INPUT#3;\"Input FILE or VOLUME name  >";InFile$
1460   IF InFile$="" THEN EXIT outer_loop
1470   IF LEN(InFile$)=5 THEN 
1480    InFlg%=INT(((InFile$ INSTR "flp1_flp2_flp3_flp4_ram1_ram2_")+4)/5)
1490   ELSE 
1500    InFlg%=0
1510   END IF 
1520   IF InFlg%=0 THEN 
1530    INPUT#3;"         Output FILE name  >";OutFile$
1540    IF OutFile$="" THEN EXIT outer_loop
1550   ELSE 
1560    INPUT#3;"       Output VOLUME name  >";OutFile$
1570    IF OutFile$="" THEN InFlg%=0:EXIT outer_loop
1580    Src$=InFile$:Dst$=OutFile$
1590    DELETE Dst$&"SYS_REF_dat"
1600    OPEN_NEW#7;Dst$&"SYS_REF_dat"
1610    DIR#7;Src$:CLOSE#7
1620    OPEN_IN#7;Dst$&"SYS_REF_dat"
1630    INPUT#7;Name$,Space$
1640   END IF 
1650   CLS#5
1660  END IF 
1670  REPeat main_loop
1680   REPeat in_loop
1690    CLS#4:CLS#3:RPORT CHR$(10)
1700    IF InFlg%<>0 THEN 
1710     IF EOF(#7) THEN 
1720      EXIT main_loop
1730     ELSE 
1740      INPUT#7;InFile$
1750      OutFile$=Dst$&InFile$
1760      InFile$=Src$&InFile$
1770     END IF 
1780    END IF 
1790    OPEN_IN#6;InFile$
1800    fl=FLEN(#6):ft=FTYP(#6):IF ft THEN fd=FDAT(#6)
1810    CLOSE#6
1820    RPORT "File: "&InFile$&CHR$(10)
1830    IF fl=0 THEN 
1840     RPORT "File empty!"&CHR$(10)
1850     IF InFlg%=0 THEN EXIT main_loop
1860    ELSE 
1870     temp$=FILE_CLASS$(InFile$)
1880     IF temp$<>"" THEN 
1890      INK#3;4:RPORT "Possible "&temp$&CHR$(10):INK#3;7
1900     END IF 
1910     IF InFlg%=0 THEN 
1920      EXIT in_loop
1930     ELSE 
1940      RPORT "Patch":Rplc$=WAITKEY$(3,"ynq")
1950      IF Rplc$=="y" THEN EXIT in_loop
1960      IF Rplc$=="q" THEN EXIT main_loop
1970     END IF 
1980    END IF 
1990   END REPeat in_loop
2000   CLS#5
2010   base=ALCHP(fl)
2020   IF base>0 THEN 
2030    LBYTES InFile$,base
2040   ELSE 
2050    PRINT#3;\"Out of memory!"
2060    EXIT outer_loop
2070   END IF 
2080   REMark do it
2090   NoRpc%=0
2100   fixSYSV
2110   IF NoRpc% THEN 
2120    RPORT "Saving..."&CHR$(10)
2130    IF ft THEN 
2140     DELETE OutFile$
2150     SEXEC OutFile$,base,fl,fd
2160    ELSE 
2170     DELETE OutFile$
2180     SBYTES OutFile$,base,fl
2190    END IF 
2200   ELSE 
2210    RPORT "No changes."&CHR$(10)
2220   END IF 
2230   RECHP(base)
2240   IF (InFlg%=0) OR (NoRpc%=0) THEN 
2250    Rplc$=INKEY$(#3,200)
2260    IF InFlg%=0 THEN EXIT main_loop
2270   END IF 
2280  END REPeat main_loop
2290  REMark RETRY_HERE
2300  IF InFlg%<>0 THEN CLOSE#7:DELETE Dst$&"SYS_REF_dat":InFlg%=0
2310 END REPeat outer_loop
2320 RECHP(Buff)
2330 CLOSE#3
2340 CLOSE#4
2350 CLOSE#5
2360 IF InFlg%<>0 THEN CLOSE#7:DELETE OutFile$&"SYS_REF_dat":InFlg%=0
2370 STOP
2380 :
2390 DEFine PROCedure fixSYSV
2400  LOCal a,p,i,N,pk
2410  CLS#4
2420  tskFlg%=((PEEK_W(base+6)=HEX("4AFB")) AND (ft<>0))
2430  IF tskFlg% THEN 
2440   nam$=""
2450   pk=PEEK_W(base+8)
2460   FOR i=0 TO pk-1
2470    nam$=nam$&CHR$(PEEK(base+10+i))
2480   END FOR i
2490   p=base+4+(6+2*INT((LEN(nam$)+1)/2))
2500  ELSE 
2510   p=base+4
2520  END IF 
2530  IF PEEK_L(p)=HEX("50544348") THEN 
2540   RPORT "...already patched"&CHR$(10)
2550   IF tskFlg% THEN 
2560    xl=78+4*PEEK_W(p+8)+2*INT((LEN(nam$)+1)/2)
2620   ELSE 
2630    xl=60+4*PEEK_W(p+8)
2640   END IF 
2650  ELSE 
2660   p=0:pch$="":Rplc$=""
2670   REPeat find_loop
2680    IF p>fl THEN EXIT find_loop
2690    FOR N=1 TO 256
2700     pk=PEEK_L(base+p)
2710     IF (pk>=HEX("28000")) AND (pk<HEX("28200")) THEN 
2720      DISOUT
2730      IF NOT(Rplc$=="a") THEN 
2740       RPORT "REPLACE":Rplc$=WAITKEY$(3,"ynaq")
2750       IF Rplc$=="q" THEN 
2760        pch$="":EXIT find_loop
2770       END IF 
2780      END IF 
2790      IF (Rplc$=="y") OR (Rplc$=="a") THEN 
2800       pch$=pch$&LONGINT$(p)
2810       NoRpc%=NoRpc%+1
2820      END IF 
2830     END IF 
2840     p=p+2
2850     IF p>=fl THEN EXIT N
2860    END FOR N
2870    IF p>fl THEN 
2880     BLOCK#4;100,10,0,0,4
2890    ELSE 
2900     BLOCK#4;INT((p/fl)*100),10,0,0,4
2910    END IF 
2920   END REPeat find_loop
2930   IF pch$<>"" THEN 
2940    IF tskFlg% THEN 
2950     xl=78+LEN(pch$)+2*INT((LEN(nam$)+1)/2)
2960    ELSE 
2970     xl=60+LEN(pch$)
2980    END IF 
2990    RECHP(base):fl=fl+xl:base=ALCHP(fl)
3000    RPORT "Extending file by $"&HEX$(xl,32)&" bytes"&CHR$(10)
3010    LBYTES InFile$,base+xl
3020    p=0
3030    REMark start:
3040    po "6000":POKE_W base+p,10+tskFlg%*(2+2+2+2*INT((LEN(nam$)+1)/2))+2+LEN(pch$):p=p+2:REMark bra skip
3050    IF tskFlg% THEN 
3060     po "0000"
3070     po "4AFB":REMark dc.w $4afb
3080     REMark jobname:
3090     POKE_W base+p,LEN(nam$):p=p+2
3100     FOR i=1 TO LEN(nam$):POKE base+p+i-1,CODE(nam$(i)):NEXT i:p=p+2*INT((LEN(nam$)+1)/2)
3110    END IF 
3120    po "5054":po "4348":POKE_L base+p,STRINGL(verstag$):p=p+4:REMark dc.b 'PTCHx.xx'
3130    REMark patch_tbl:
3140    POKE_W base+p,LEN(pch$)/4:p=p+2
3150    FOR i=1 TO LEN(pch$)-3 STEP 4:POKE_L base+p,STRINGL(pch$(i TO i+3)):p=p+4:NEXT i
3160    REMark skip:
3170    po "48E7":po "E0F0": REMark movem.l d0-d2/a0-a3,-(a7)
3180    po "7000":REMark moveq #0,d0
3190    po "4E41":REMark trap #1
3200    po "45FA":POKE_W base+p,36+12*tskFlg%:p=p+2:REMark lea patch_end(pc),a1
3210    po "43FA":POKE_W base+p,HEX("FFF0")-LEN(pch$):p=p+2:REMark lea patch_tbl(pc),a1
3220    po "3219":REMark move.w (a1)+,d1
3230    po "6012":REMark bra.s svdbra
3240    REMark svloop:
3250    po "2419":REMark move.l (a1)+,d2
3260    po "2032":po "2800":REMark move.l (a2,d2),d0
3270    po "0280":po "0000":po "7FFF":REMark andi.l #$7FFF,d0
3280    po "D088":REMark add.l a0,d0
3290    po "2580":po "2800":REMark move.l d0,(a2,d2)
3300    REMark svdbra:
3310    po "51C9":po "FFEC":REMark dbra d1,svloop
3320    IF tskFlg% THEN 
3330     po "203C":po "0000":POKE_W base+p,xl:p=p+2:REMark move.l #patch_end-start,d0
3340     po "DDC0":REMark adda.l d0,a6
3350     po "99C0":REMark suba.l d0,a4
3360     po "9BC0":REMark suba.l d0,a5
3370    END IF 
3380    po "4CDF":po "0F07":REMark movem.l (a7)+,d0-d2/a0-a3
3390    REMark patch_end:
3420   END IF 
3430  END IF 
3435  fixTURBO
3436  IF RecogFlg%=0 THEN fixQLIB
3440 END DEFine 
3450 :
3460 DEFine PROCedure fixTURBO
3470  RecogFlg%=0
3480  IF PEEK_L(base+xl+32)=STRINGL("e Tu") OR PEEK_L(base+xl+32)=STRINGL("D.P.") THEN 
3490   RecogFlg%=-1
3500   RPORT "CHECKING TURBO TASK..."&CHR$(10)
3510   p=0:CLS#4:CLS#5
3520   REPeat find_loop
3530    IF p>fl THEN EXIT find_loop
3540    FOR N=1 TO 256
3550     temp$=HEX$(PEEK_L(base+p),32)
3560     IF temp$=="422E8AD4" THEN 
3570      POKE_L base+p,HEX("08920007"):DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
3580     ELSE 
3590      IF temp$=="57EE8AD4" THEN 
3600       POKE_L base+p,HEX("660203D2"):DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
3610      ELSE 
3620       IF temp$(1 TO 6)=="8AD466" THEN 
3630        p=p+2:POKE base+p,HEX("6D"):DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
3640       END IF 
3650      END IF 
3660     END IF 
3670     p=p+2
3680     IF p>=fl THEN EXIT N
3690    END FOR N
3700    IF p>fl THEN 
3710     BLOCK#4;100,10,0,0,4
3720    ELSE 
3730     BLOCK#4;INT((p/fl)*100),10,0,0,4
3740    END IF 
3750   END REPeat find_loop
3760  END IF 
3770 END DEFine 
3780 :
3790 DEFine PROCedure fixQLIB
3800  LOCal l,N,i,X
3810  RecogFlg%=0
3820  X=find("Libe"&"rati",FILL$(CHR$(223),8),base,0,fl)
3830  RecogFlg%=-1
3840  IF X<>-1 THEN 
3850   REPeat loop
3860    X=X-1:IF PEEK(base+X)=0 THEN EXIT loop
3870   END REPeat loop
3880   l=PEEK_W(base+X)
3890   RESTORE 4700
3900   READ N:l=l-N-N:POKE_W base+X,l:POKE_L base+X+2,STRINGL(":-)"&CHR$(10)):X=X+l+2
3910   FOR i=0 TO N-1
3920    READ temp$:POKE_W base+X+i+i,HEX(temp$)
3930   NEXT i
3940   IF PEEK_W(base+6)<>HEX("4AFB") THEN 
3950    RPORT "CHECKING QLIB CODE: "&CHR$(10)
3960   ELSE 
3970    RPORT "CHECKING QLIB TASK: "&CHR$(10)
3980   END IF 
3990   p=X+48:CLS#4:CLS#5
4000   REPeat find_loop
4010    IF p>fl THEN EXIT find_loop
4020    FOR N=1 TO 256
4030     temp$=HEX$(PEEK_L(base+p),32)
4040     IF temp$=="46FC0000" THEN 
4050      POKE_L base+p,HEX("027CC0FF"):DISOUT:RPORT "tidying code at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
4060     ELSE 
4070      IF (temp$=="20728004") THEN 
4080       POKE_W base+p,HEX("6100"):POKE_W base+p+2,(X+26)-(p+2):DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
4090      ELSE 
4100       IF (temp$=="26725004") THEN 
4110        POKE_W base+p,HEX("6100"):POKE_W base+p+2,(X+12)-(p+2):DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
4120       ELSE 
4130        IF (temp$=="26722004") THEN 
4140         POKE_W base+p,HEX("6100"):POKE_W base+p+2,X-(p+2)
4150         IF (HEX$(PEEK_W(base+p+4),32)=="200B") THEN 
4160          POKE_W base+p+4,HEX("4E71")
4170         END IF 
4180         DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
4190        ELSE 
4200         IF (temp$=="26724004") THEN 
4210          POKE_W base+p,HEX("6100"):POKE_W base+p+2,(X+6)-(p+2)
4220          IF PEEK(base+p+18)=HEX("67") THEN 
4230           IF PEEK(base+p+20)=HEX("65") THEN 
4240            i=p+22+PEEK(base+p+21)
4250            IF (PEEK_W(base+i)==HEX("2A0B")) THEN 
4260             POKE_W base+i,HEX("2A00")
4270            END IF 
4280           END IF 
4290          END IF 
4300          DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
4310         ELSE 
4320          IF (temp$=="20322004") THEN 
4330           POKE_W base+p,HEX("6100"):POKE_W base+p+2,(X+32)-(p+2)
4340           IF (PEEK_W(base+p+6)==HEX("2040")) THEN 
4350            POKE_W base+p+6,HEX("4E71")
4360           END IF 
4370           DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
4380          ELSE 
4390           IF (temp$=="24321004") THEN 
4400            IF (HEX$(PEEK_L(base+p+4),32)=="6A080C82") AND (HEX$(PEEK_L(base+p+8),32)=="FFFFFFFF") AND (HEX$(PEEK_W(base+p+12),16)=="6710") THEN 
4410             p=p+4:POKE_L base+p,HEX("70FFB480"):POKE_L base+p+4,HEX("6714E98A"):POKE_W base+p+8,HEX("E88A")
4420            END IF 
4430            DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
4440           ELSE 
4450            IF (temp$=="2640586B") THEN 
4460             IF (HEX$(PEEK_L(base+p+4),32)=="00120800") AND (HEX$(PEEK_L(base+p+8),32)=="001D6714") THEN 
4470              POKE_W base+p,HEX("6100"):POKE_W base+p+2,(X+16)-(p+2):POKE_L base+p+4,HEX("586B0012"):POKE_L base+p+8,HEX("E5886A14")
4480              DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
4490             END IF 
4500            END IF 
4510           END IF 
4520          END IF 
4530         END IF 
4540        END IF 
4550       END IF 
4560      END IF 
4570     END IF 
4580     p=p+2
4590     IF p>=fl THEN EXIT N
4600    END FOR N
4610    IF p>fl THEN 
4620     BLOCK#4;100,10,0,0,4
4630    ELSE 
4640     BLOCK#4;INT((p/fl)*100),10,0,0,4
4650    END IF 
4660   END REPeat find_loop
4670  END IF 
4680 END DEFine 
4690 :
4700 DATA 24
4710 DATA "2032","2004","600A","2032","4004","6004","2032","5004"
4720 DATA "2640","E988","E888","C18B","4E75","2032","8004","6004"
4730 DATA "2032","2004","2040","E988","E888","C188","4A80","4E75"
4740 :
4750 DEFine PROCedure po(a$)
4760  POKE_W base+p,HEX(a$):p=p+2
4770 END DEFine 
4780 :
4790 DEFine PROCedure DISOUT
4800  LOCal loop, preLoop, disLoop
4810  LOCal r, Ds, Q, N, c, i
4820  r=Rows/2
4830  Ds=0
4840  FOR i=1 TO r
4850   D(i)=0
4860  END FOR i
4870  Q=p-8*r
4880  IF Q<0 THEN Q=0
4890  REPeat preLoop
4900   N=D68K(base+Q,Q\Buff)
4910   Q=Q+N
4920   Ds=Ds-D(i)+N
4930   D(i)=N
4940   REPeat loop
4950    i=1+(i MOD r)
4960    N=N-6
4970    IF N<=0 THEN EXIT loop
4980    Ds=Ds-D(i)
4990    D(i)=0
5000   END REPeat loop
5010   IF Q>=p THEN EXIT preLoop
5020  END REPeat preLoop
5030  CLS#5
5040  Q=Q-Ds
5050  r=Rows
5060  dflag=0
5070  REPeat disLoop
5080   N=D68K(base+Q,Q\Buff)
5090   i=0:P$=" "
5100   REPeat loop
5110    c=PEEK(Buff+i)
5120    IF c=0 THEN EXIT loop
5130    i=i+1
5140    P$=P$(1 TO LEN(P$))&CHR$(c)
5150   END REPeat loop
5160   IF (Q<=p) AND ((Q+N)>p) THEN 
5170    IF dflag AND NOT("tas" INSTR P$(1 TO LEN(P$)))
5180     P$=P$(1 TO 14)&"         dc.w      $"&P$(11 TO 14)&CHR$(10):dflag=1:N=2
5190     INK#5;4
5200    ELSE 
5210     INK#5;7
5220    END IF 
5230   ELSE 
5240    INK#5;4
5250     dflag="dc." INSTR P$(1 TO LEN(P$))
5260   END IF 
5270   Q=Q+N
5280   r=r-((N+5) DIV 6)
5290   IF r<0 THEN EXIT disLoop
5300   PRINT#5;P$(1 TO LEN(P$));
5310  END REPeat disLoop
5320 END DEFine 
5330 :
5340 DEFine FuNction FILE_CLASS$(i$)
5350  i=0
5360  REPeat check_loop
5370   j="_" INSTR i$(i+1 TO LEN(i$))
5380   IF j=0 THEN EXIT check_loop
5390   i=i+j
5400   IF i=LEN(i$) THEN RETurn ""
5410  END REPeat check_loop
5420  IF i=0 THEN 
5430   j=-1
5440  ELSE 
5450   IF (i=5) AND (i$(1 TO i) INSTR "ram1_ram2_flp1_flp2_mdv1_mdv2_") THEN 
5460    j=-1
5470   END IF 
5480  END IF 
5490  IF j<>0 THEN 
5500   j="_"&i$(i+1 TO LEN(i$))&"_" INSTR "_BOOT_"
5510   SELect ON j
5520   =1:a$="SuperBASIC boot program"
5530   =REMAINDER :a$=""
5540   END SELect 
5550   RETurn a$
5560  ELSE 
5570   a$=""
5580   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_"
5590   SELect ON j
5600   =1:a$="C source"
5610   =3:a$="C header file"
5620   =5:a$="SuperBASIC program"
5630   =9:a$="FORTH program"
5640   =13:a$="Assembler source"
5650   =17:a$="Assembler list file"
5660   =22,26,77,96:a$="ASCII text file"
5670   =31,81:a$="Screen-save"
5680   =35:a$="QUILL wordprocess document"
5690   =39:a$="ABACUS spreadsheet document"
5700   =43:a$="ARCHIVE program document"
5710   =88:a$="ARCHIVE database file"
5720   =92:a$="ARCHIVE screen layout"
5730   =47:a$="EASEL chart document"
5740   =51:a$="Psion help file"
5750   =55:a$="ARC file archive"
5760   =59:a$="ZIP file archive"
5770   =63,68:a$="Alternative font character set"
5780   =72:a$="SuperBASIC boot program"
5790   =100,105:a$="executable TASK"
5800   =REMAINDER :a$=""
5810   END SELect 
5820  END IF 
5830  RETurn a$
5840 END DEFine 
5850 :
5860 DEFine FuNction WAITKEY$(Chan%,i$)
5870  LOCal K$(1),i,l,prompt_loop,get_loop
5880  RPORT " ("
5890  i=1:l=LEN(i$)
5900  REPeat prompt_loop
5910   RPORT i$(i):i=i+1
5920   IF i>l THEN EXIT prompt_loop
5930   RPORT "/"
5940  END REPeat prompt_loop
5950  RPORT ")? >"
5960  CURSEN#Chan%
5970  REPeat get_loop
5980   K$=INKEY$(#Chan%,-1)
5990   IF K$ INSTR i$ THEN EXIT get_loop
6000  END REPeat get_loop
6010  CURDIS#Chan%
6020  RPORT K$&CHR$(10)
6030  RETurn K$
6040 END DEFine 
6050 :
6060 DEFine PROCedure RPORT(temp$)
6070  PRINT#3;temp$;
6080 END DEFine 
6090 :
6100 DEFine FuNction find(txt$,msk$,base,s,e)
6110  LOCal i,j,K,l
6120  CLS#4
6130  l=-1
6140  i=s
6150  REPeat i_loop
6160   j=0
6170   REPeat j_loop
6180    K=0
6190    REPeat k_loop
6200     IF (PEEK(base+i+j+K)&&CODE(msk$(K+1)))<>(CODE(txt$(K+1))&&CODE(msk$(K+1))) THEN EXIT k_loop
6210     K=K+1
6220     IF K=LEN(txt$) THEN 
6230      l=i+j:EXIT i_loop
6240     END IF 
6250    END REPeat k_loop
6260    j=j+1
6270    IF j=256 THEN EXIT j_loop
6280   END REPeat j_loop
6290   IF i>=e THEN 
6300    BLOCK #4,100,10,0,0,4
6310   ELSE 
6320    BLOCK#4;((i-s)/(e-s))*100,10,0,0,4
6330   END IF 
6340   i=i+256
6350   IF (i-e)>=256 THEN EXIT i_loop
6360  END REPeat i_loop
6370  RETurn l
6380 END DEFine 
6390 :
