10 ! List80 20 INTEGER : EXTEND : OPTION BASE 0 30 COMMON Asm$=1900 40 DIM Pcode$=253,Text$=253,Buffer$=253,Workline$=516,Dummy$=1 50 Wid=PEEK(65364) 60 True=-1 : False=0 70 ! 80 ! Ver-/-Datum----/-Kommentar----------------------------------------- 90 ! 1.00 1990-10-05 <6057> Jan-Olof Svensson 500 ! 510 Dummy$=FNSetmembuf$(5) ! 9 om diskettstation ej {r ansluten. 520 Dummy$=FNInitasm$ 530 ; : ; '* List80 *' 540 WHILE NOT Quit 550 Dummy$=FNEnterdata$ 560 IF Continue THEN Dummy$=FNProcessfile$+FNTerminate$ 570 WEND 580 END 590 ! 600 DEF FNWherex=PEEK(65362) 610 ! 620 DEF FNWherey=PEEK(65363) 630 ! 640 DEF FNSetmembuf$(Dosbuf) 650 ON ERROR GOTO 690 660 OPEN 'MEM:0' AS FILE 99 : CLOSE 99 670 POKE 65502,62720+Dosbuf*256,SWAP%(62720+Dosbuf*256) 680 RETURN '' 690 RESUME 680 700 FNEND 710 ! 720 DEF FNInitasm$ LOCAL Addr,Length$=2 730 ON ERROR GOTO 840 740 OPEN 'LIST80.DAT' AS FILE 3 750 GET #3,Length$ COUNT 2 760 GET #3,Asm$ COUNT CVT$%(Length$) 770 CLOSE 3 780 Pcode$=SPACE$(253) : Text$=SPACE$(117)+CHR$(13,10) 790 Addr=VARPTR(Asm$) 800 IF Addr<>-32758 THEN ; 'Det finns n}gonting i minnet redan. Tryck p} Reset!' : STOP 810 POKE Addr+1,VARPTR(Pcode$),SWAP%(VARPTR(Pcode$)) 820 POKE Addr+4,VARPTR(Text$),SWAP%(VARPTR(Text$)) 830 RETURN '' 840 IF ERRCODE=21 THEN ; 'Hittar ej filen LIST80.DAT' : GET Dummy$ : RESUME 730 ELSE ; 'Fel nr ' ERRCODE : GET Dummy$ : RESUME 830 850 FNEND 860 ! 870 DEF FNUpcase$(Ch$) 880 IF Ch$>="`" AND Ch$<="~" THEN RETURN CHR$(ASCII(Ch$) AND 223) 890 RETURN Ch$ 900 FNEND 910 ! 920 DEF FNCaps$(Txt$) LOCAL Newtxt$=160,Pos 930 Newtxt$="" : Pos=1 940 WHILE Pos<=LEN(Txt$) 950 Newtxt$=Newtxt$+FNUpcase$(MID$(Txt$,Pos,1)) 960 Pos=Pos+1 970 WEND 980 RETURN Newtxt$ 990 FNEND 1000 ! 1010 DEF FNAddext$(Filename$,Ext$) LOCAL Cpos 1020 IF Filename$="" THEN RETURN "" 1030 IF INSTR(1,Filename$,".")>0 THEN RETURN Filename$ 1040 Cpos=INSTR(1,Filename$,":") 1050 IF Cpos>0 THEN IF Filename$="CAS:" OR INSTR(1," MEM: PR: V24: CON: NUL:"," "+LEFT$(Filename$,Cpos))>0 THEN RETURN Filename$ 1060 IF ASCII(Ext$)=46 THEN RETURN Filename$+Ext$ 1070 RETURN Filename$+"."+Ext$ 1080 FNEND 1090 ! 1100 DEF FNConnected 1110 OUT 33,16 : RETURN ((INP(33) AND 32)=32) 1120 FNEND 1130 ! 1140 DEF FNAssignpr$ 1150 IF FNConnected THEN PREPARE Outfile$ AS FILE Lst : RETURN '' 1160 Ec800=42 : Continue=False 1170 RETURN '' 1180 FNEND 1190 ! 1200 DEF FNAssignfile$(Outfile$) 1210 IF Lst=0 THEN ; CHR$(12); : RETURN '' 1220 PREPARE Outfile$ AS FILE Lst 1230 RETURN '' 1240 FNEND 1250 ! 1260 DEF FNEnterdata$ LOCAL Infile$=16,Outfile$=16,Comma 1270 Continue=True 1280 ON ERROR GOTO 1390 1290 ; 'Infil '; : INPUT Infile$; : ; CUR(FNWherey,FNWherex-LEN(Infile$)); 1300 IF Infile$='' THEN Continue=False : Quit=True : RETURN '' 1310 Infile$=FNAddext$(FNCaps$(Infile$),'BAC') : ; Infile$ 1320 ; 'Utfil '; : INPUT Outfile$; : ; CUR(FNWherey,FNWherex-LEN(Outfile$)); 1330 IF Outfile$='' THEN Lst=0 ELSE Lst=2 1340 Outfile$=FNAddext$(FNCaps$(Outfile$),'BAS') : ; Outfile$ 1350 OPEN Infile$ AS FILE 1 1360 IF LEFT$(Outfile$+SPACE$(3),3)='PR:' THEN Dummy$=FNAssignpr$ ELSE Dummy$=FNAssignfile$(Outfile$) 1370 IF Ec800>0 THEN RETURN FNErrmessage$ 1380 RETURN '' 1390 ; 'Fel nr' ERRCODE '(se datorns fellista)' : RESUME 1280 1400 FNEND 1410 ! 1420 DEF FNBlockread$ 1430 GET #1,Buffer$ COUNT 253 1440 Block=Block+1 1450 RETURN '' 1460 FNEND 1470 ! 1480 DEF FNCodelength 1490 Workline$=RIGHT$(Buffer$,Blockpos) 1500 RETURN ASCII(Workline$) 1510 FNEND 1520 ! 1530 DEF FNEndofbac=(Length=1) 1540 ! 1550 DEF FNGetblock$ 1560 Dummy$=FNBlockread$ 1570 Blockpos=1 1580 Length=FNCodelength 1590 RETURN '' 1600 FNEND 1610 ! 1620 DEF FNExtbacline$ 1630 Workline$=LEFT$(Workline$,Length) 1640 IF ASCII(RIGHT$(Workline$,Length))<>13 THEN Continue=False : RETURN '' 1650 Blockpos=Blockpos+Length 1660 IF Blockpos>253 THEN Continue=False 1670 RETURN '' 1680 FNEND 1690 ! 1700 DEF FNWrite$ 1710 IF Block=1 THEN IF INSTR(1,Workline$,' ')=0 THEN Ec80=16 : Continue=False : RETURN '' 1720 ; #Lst,Workline$ 1730 IF Lst=0 THEN IF FNWherey>21 THEN GET Dummy$ 1740 RETURN '' 1750 FNEND 1760 ! 1770 DEF FNProcessline$ LOCAL Pos 1780 Pcode$=Workline$ 1790 Ec80=CALL(VARPTR(Asm$)) 1800 IF Ec80>0 THEN Continue=False : RETURN '' 1810 Pos=INSTR(1,Text$,CHR$(13)) 1820 IF Pos=0 THEN Continue=False : RETURN '' 1830 IF Pos>119 THEN ; 'F|r l}ng rad: ' LEFT$(Text$,INSTR(1,Text$,' ')) CHR$(7) 1840 Workline$=LEFT$(Text$,Pos-1) 1850 Dummy$=FNWrite$ 1860 Length=FNCodelength 1870 RETURN '' 1880 FNEND 1890 ! 1900 DEF FNProcessblock$ 1910 IF Length=0 THEN RETURN FNGetblock$ 1920 Dummy$=FNExtbacline$ 1930 IF Continue THEN RETURN FNProcessline$ 1940 RETURN '' 1950 FNEND 1960 ! 1970 DEF FNListbac$ 1980 Workline$='' : Blockpos=2 1990 Length=FNCodelength 2000 WHILE Continue AND NOT FNEndofbac 2010 Dummy$=FNProcessblock$ 2020 WEND 2030 RETURN '' 2040 FNEND 2050 ! 2060 DEF FNEndofbas=(LEFT$(Buffer$,7)=CHR$(0,0,0,0,0,0,3)) 2070 ! 2080 DEF FNAddblock$ 2090 Continue=(ASCII(RIGHT$(Workline$,LEN(Workline$)))=3) 2100 IF Continue THEN Workline$=LEFT$(Workline$,LEN(Workline$)-1) : Blockpos=1 : Dummy$=FNBlockread$ 2110 RETURN '' 2120 FNEND 2130 ! 2140 DEF FNExtbasline$ LOCAL Pos 2150 Pos=INSTR(1,Workline$,CHR$(13)) 2160 IF Pos>1 THEN IF ASCII(RIGHT$(Workline$,Pos-1))=9 THEN Pos=INSTR(Pos+1,Workline$,CHR$(13)) : GOTO 2160 2170 IF Pos=0 THEN Ok=False : Dummy$=FNAddblock$ ELSE Workline$=LEFT$(Workline$,Pos-1) : Blockpos=Blockpos+Pos-Offset 2180 RETURN '' 2190 FNEND 2200 ! 2210 DEF FNExpandtabs$ LOCAL Pos,Spc 2220 Pos=INSTR(1,Workline$,CHR$(9)) 2230 WHILE Pos>0 2240 Spc=ASCII(RIGHT$(Workline$,Pos+1)) 2250 Workline$=LEFT$(Workline$,Pos-1)+SPACE$(Spc)+RIGHT$(Workline$,Pos+2) 2260 Pos=INSTR(1,Workline$,CHR$(9)) 2270 WEND 2280 RETURN '' 2290 FNEND 2300 ! 2310 DEF FNListbas$ 2320 Workline$='' : Blockpos=1 2330 WHILE NOT FNEndofbas 2340 Offset=LEN(Workline$) : Ok=True 2350 Workline$=Workline$+RIGHT$(Buffer$,Blockpos) 2360 IF ASCII(Workline$)=3 THEN Dummy$=FNBlockread$ : Blockpos=1 : GOTO 2430 2370 Dummy$=FNExtbasline$ 2380 IF NOT Ok THEN 2440 2390 ! Process line 2400 Dummy$=FNExpandtabs$ 2410 IF Pos>119 THEN ; 'F|r l}ng rad: ' LEFT$(Text$,INSTR(1,Text$,' ')) CHR$(7) 2420 Dummy$=FNWrite$ 2430 Workline$='' 2440 IF NOT Continue THEN 2460 2450 WEND 2460 RETURN '' 2470 FNEND 2480 ! 2490 DEF FNProcessfile$ 2500 ON ERROR GOTO 2560 2510 Dummy$=FNBlockread$ : Code=ASCII(Buffer$) 2520 IF (Code OR 1)=131 THEN RETURN FNListbac$ 2530 IF Code>0 AND Code<128 THEN RETURN FNListbas$ 2540 Ec80=59 : Continue=False 2550 RETURN '' 2560 Ec800=ERRCODE : Continue=False : RESUME 2550 2570 FNEND 2580 ! 2590 DEF FNErrmessage$ 2600 ; : ; 2610 IF Ec800>0 THEN ; 'Fel nr' Ec800 '(se datorns fellista)' : GOTO 2660 2620 ON INSTR(1,CHR$(16,59),CHR$(Ec80))+1 GOTO 2630,2640,2650 2630 ; 'Fel nr' Ec80 '(se ABC80:s fellista)' : GOTO 2660 2640 ; 'Radnummer saknas.' : GOTO 2660 2650 ; 'Fel programformat.' : GOTO 2660 2660 Ec80=0 : Ec800=0 : GET Dummy$ 2670 RETURN '' 2680 FNEND 2690 ! 2700 DEF FNTerminate$ 2710 CLOSE 2720 Infile$='' : Outfile$='' 2730 ; 2740 IF NOT Continue THEN RETURN FNErrmessage$ 2750 RETURN '' 2760 FNEND