1 REM Ins{nd av: Kristoffer Eriksson <5357> 1987-08-24 23.03.08 (WRITE) 20 ! +---------------------------------------------------+ 30 ! ! AVASS Ver 5.4 - Flexibelt avassembleringsprogram ! 40 ! ! F|r ABC800-serien (dvs DBASIC-II och Z80-CPU) ! 50 ! ! Tillbeh|rsprogram: AVCROSS ! 60 ! ! Av Kristoffer Eriksson "SKE" ABC <5357>, 1982-1987! 70 ! ! F}r fritt kopieras f|r icke-kommersiella syften ! 80 ! +---------------------------------------------------+ 90 ! 100 ! Ver-/-Datum----/-Sign-/-Kommentar----- 110 ! 1.1 / 82-09-22 / SKE / F|r ABC80 120 ! 4.6 / 84-11-02 / SKE / Korsreferens med AVCROSS 130 ! 4.7 / 85-03-07 / SKE / 140 ! 5.1 / 87-03-22 / SKE / Rej{l modernisering 141 ! 5.4 / 87-08-20 / SKE / .BAC ver 2, Ej Err 191 i FNGetdirekt, 142 ! JR r{tt vid cross (FNAsmpiff1), HALT, RLA osv 150 ! 160 INTEGER : EXTEND : ! NO RESUME 170 ; CHR$(12) "Avassemblering Z80 ABC800 Ver 5.4" : ; 180 DIM Buf$=256,Dig$=16,Diglen$=34,P$=30,F$=40,S(1:300),Prfil$=16,Tab2$=10 190 Dig$="0123456789ABCDEF" : Diglen$=" 008@6;48474736363635353535353524" 200 Tab2$=" " 210 Basi=16 ! Talsystem instruktionskoder 220 Basa=10 ! Adresser 230 Prfil$="PR:VSA56" 240 DIM Prinit$=20 : Prinit$=CHR$(15) ! CHR$(27,80,15) 250 DIM Prvmrg$=20 : Prvmarg$=SPACE$(10) 260 Radstart=-1 270 Z=FNAsminit 280 IF PEEK(65364)=80 THEN T1=1 ELSE T1=0 290 ! S(S9)=Stack och stackpekare 300 ! Fcr= Cross-fil 310 ! Fin= Infil att tolka 320 ! F= Skrivarfil 330 ! Adr= Adress inom instruktion 340 ! Fadr=N{sta filadress 350 ! Badr=N{sta m}ladress i Buf$ 360 ! Ityp=Typ av avkodning 370 ! Buf$=Buffert med avkodade indata fr}n fil 380 ! Bpos=Position i Buf$ (0-255) 390 ! Eof= Indata slut 400 ! Sof= Indata b|rjar 410 ! Feof=Fysiskt filslut 420 ! Rf= Radbytesflagga 430 ! W= Best{ndig variabel f|r FNGetxxx 440 ! Ba= Basadress f|r REL/BAC 450 ! 460 REM ---------- FR]GOR -------------- 470 Basi=FNFr}gabas("Talsystem f|r instruktionskoder",Basi) 480 Basa=FNFr}gabas("Talsystem f|r adresser",Basa) 490 ! ___ 500 Fpr=0 510 ; "Utskrift p} skrivare (J/N,RET=N) ? "; 520 GET P$ : ON FNJnkoll(P$,"N")+1 GOTO 520,530,550 530 Fpr=1 : PREPARE Prfil$ AS FILE Fpr : ; #Fpr Prinit$ : T1=1 540 ! 550 ! ___ 560 ; "M=Minnet, O=Optionsprom, F=Fil, A=ABS, R=REL, P=P-Data," 570 ; "B=BAC relokerande, I=Inmatning (RET=M) ? "; 580 WHILE 1 590 GET P$ 600 IF P$=CHR$(13) THEN P$="M" ELSE P$=FNCaps$(P$) 610 Ityp=INSTR(1,"MIOFARPB",P$) 620 IF Ityp=0 WEND 630 ; P$ 640 Flgfa=(Ityp>4) 650 ! 660 ! ___ 670 WHILE Ityp>3 680 ON ERROR GOTO 680 690 IF Ityp>4 THEN P$=MID$("ABSRELABSBAC",(Ityp-5)*3+1,3) ELSE P$="" 700 ; "Fil som ska avkodas "; 710 IF LEN(P$) THEN ; "(." P$ ")"; ELSE ; " "; 720 ; SPACE$(29); : INPUT F$; 730 ; STRING$(LEN(F$),8); 740 F$=FNCaps$(F$) 750 IF INSTR(1.,F$,".")=0 AND LEN(P$) THEN F$=F$+"."+P$ 760 ; F$ 770 Fin=2 780 IF FNOpen(F$,Fin,0) THEN 560 790 Sof=-1 800 IF Fpr<>0 THEN ; #Fpr Prvmarg$ "Avkodning av " F$ " med hj{lp av AVASS." : ; #Fpr 810 IF 0 WEND 820 ! 830 ! ___ 840 B3=0 850 WHILE Ityp=6 OR Ityp=8 ! REL, BAC 860 ; "Ska styrkoderna ocks} skrivas ut (J/N/Bas,RET=N)? "; 870 ON ERROR GOTO 870 : INPUT "";P$; 880 ; STRING$(LEN(P$),8); 890 ON ERROR GOTO 900 : B3=VAL(P$) : IF B3>=2 AND B3<=16 THEN ; : GOTO 920 900 B3=0 : ON FNJnkoll(P$,"N")+1 GOTO 870,910,920 910 B3=Basi 920 ON ERROR GOTO 930 IF 0 WEND 940 ! 950 ! ___ 960 Fcr=0 970 ; "Kors-referens (J/N,RET=N) ? "; 980 GET P$ : ON FNJnkoll(P$,"N")+1 GOTO 980,990,1020 990 Fcr=5 : PREPARE "AVCROSS.TMP" AS FILE Fcr 1000 PUT #Fcr CVT%$(Basa)+F$+SPACE$(16-LEN(F$))+STRING$(50,0) 1010 ! 1020 ! ___ 1030 IF Ityp>3 THEN ; "Startadress = nummer p} |nskad byte i filen, 0 = filens b|rjan." 1040 ON ERROR GOTO 1040 1050 INPUT "Startadress (decimalt,RET=0) ? ";P$; 1060 IF P$="" THEN ; "0" : A.=0. ELSE A.=FNUs.(VAL(P$)) : ; 1070 REM AV KRISTOFFER ERIKSSON 1080 ! 1090 ! ___ 1100 Fadr=0 : Badr=0 : Bpos=0 : Buf$="" : Z=FNPosit(A.)+FNWr("",-1) 1110 ON ERROR GOTO 1120 ! 1130 ! ___F|rberedelser 1140 ; : ; "Mellanslag = Paus, --> = Stegning, PF1 = Stopp." 1150 Lena=LEN(FNNumber$(-1,Basa,2,1)) 1160 Leni=LEN(FNNumber$(255,Basi,1,1))+1 1170 IF Flgfa THEN Z=FNWr(FNHjust$("("+NUM$(Basa)+")",Lena)+" ",0) 1180 Z=FNWr(FNHjust$("("+NUM$(Basa)+")",Lena)+" ",0) 1190 Z=FNWr(SPACE$(5+2*T1)+FNVjust$("("+NUM$(Basi)+")",5*Leni+2*T1)+"("+NUM$(Basa)+")",1) 1200 ; CHR$(138,13); ! ULN 1210 IF Flgfa THEN Z=FNWr(FNHjust$("Pos",Lena)+" ",0) 1220 Z=FNWr(FNHjust$("Adr",Lena)+" ",0) 1230 Z=FNWr(FNVjust$("Text",5+2*T1)+FNVjust$("Kod",5*Leni+2*T1)+"Betyder",1) 1240 ; CHR$(139,13); ! NULN 1250 ! 1260 ! ___Avassembleringsloop 1270 WHILE NOT Feof AND NOT Flgavbryt 1280 Bytesav$="" : Adr=0 : B=FNGetbyte 1290 Flgavbryt=0 1300 WHILE NOT FNPaus AND NOT Eof 1310 Adrstart=Badr-1 : Fadrstart=Fadr-1 1320 Z=FNAsmnem(B) 1330 IF Flgfa THEN Z=FNWr(FNNumber$(Fadrstart,Basa,2,1)+": ",0) 1340 Z=FNWr(FNNumber$(Adrstart,Basa,2,1)+": ",0) 1350 Z=FNWr(FNFilter$(Bytesav$)+SPACE$(5-LEN(Bytesav$)+T1+T1),0) 1360 FOR I=1 TO LEN(Bytesav$) 1370 Z=FNWr(FNNumber$(ASCII(RIGHT$(Bytesav$,I)),Basi,1,1)+" ",0) 1380 NEXT I 1390 Z=FNWr(SPACE$((5-LEN(Bytesav$))*Leni+T1+T1)+Asm$,1) 1400 Bytesav$="" : Adr=0 : B=FNGetbyte 1410 WEND 1420 ! 1430 WHILE NOT Feof AND NOT Flgavbryt 1440 ; "Forts{tt till fysiskt filslut?" 1450 ; "J=Ja, F=Ja som strukturl|s fil, N=Nej: "; 1460 Z=0 : WHILE Z=0 1470 GET P$ : P$=FNCaps$(P$) 1480 Z=INSTR(1,"JFN",P$) 1490 WEND 1500 ; P$ 1510 IF Z<3 THEN Eof=0 ELSE Feof=-1 1520 IF Z=2 THEN Ityp=4 : Flgfa=0 : Badr=Fadr 1530 IF 0 WEND 1540 WHILE Flgavbryt 1550 ON ERROR GOTO 1550 : INPUT "Ny adress: ";P$; 1560 IF P$="" THEN ; "Stopp" : WHILE 0 1570 ; : A.=FNUs.(VAL(P$)) : Z=FNPosit(A.)+FNWr("",-1) 1580 Flgavbryt=0 1590 WEND 1600 ON ERROR GOTO 1610 IF 0 WEND 1620 WEND 1630 ! 1640 ! ___Avslutning 1650 IF Fpr THEN ; #Fpr CHR$(12); 1660 IF Fcr THEN PUT #Fcr "stopp" 1670 CLOSE 1680 IF Fcr THEN CHAIN "AVCROSS" 1690 END 1700 ! 1710 ! ___ 1720 ! 1730 DEF FNFr}gabas(Fr}ga$,Default) LOCAL Bas,I$=10 1740 ON ERROR GOTO 1740 1750 ; Fr}ga$ SPACE$(40-LEN(Fr}ga$)) "(2-16,RET=" NUM$(Default) ") "; 1760 INPUT I$; 1770 ON ERROR GOTO 1820 1780 IF LEN(I$) THEN Bas=VAL(I$) : ; ELSE Bas=Default : ; NUM$(Bas) 1790 IF Bas<2 OR Bas>16 THEN ; "Bara mellan 2 och 16." CHR$(7) : GOTO 1750 1800 RETURN Bas 1810 ! 1820 Bas=INSTR(1,"BbQqKkDdHh",I$) 1830 IF Bas=0 OR LEN(I$)>1 THEN ; " Va?" CHR$(7) : GOTO 1740 1840 Bas=VAL(MID$(" 2 8 81016",(Bas+1) AND 254,2)) 1850 ; "=" NUM$(Bas) 1860 RETURN Bas 1870 FNEND 1880 ! 1890 DEF FNVjust$(S$,L)=S$+SPACE$(L-LEN(S$) AND L>LEN(S$)) 1900 DEF FNHjust$(S$,L)=SPACE$(L-LEN(S$) AND L>LEN(S$))+S$ 1910 ! 1920 DEF FNJnkoll(T$,Deflt$) LOCAL S,S$=1 1930 IF T$="" OR ASCII(T$)=13 THEN S$=Deflt$ ELSE S$=LEFT$(T$,1) 1940 S=INSTR(2," JjNn",S$)/2 1950 IF S=1 THEN ; "Ja" ELSE IF S=2 THEN ; "Nej" ELSE ; CHR$(7); 1960 RETURN S 1970 FNEND 1980 ! 1990 DEF FNFilter$(S$) LOCAL T$=80,P,K 2000 T$=SPACE$(LEN(S$)) 2010 P=LEN(S$) : WHILE P 2020 K=ASCII(RIGHT$(S$,P)) AND 127 2030 IF K>32 AND K<127 THEN MID$(T$,P,1)=CHR$(K) 2040 P=P-1 : WEND 2050 RETURN T$ 2060 FNEND 2070 ! 2080 DEF FNInputbyte 2090 IF Eof THEN RETURN 0 2100 ; CHR$(13) SPACE$(20) CHR$(13) "Byte " NUM$(Badr) ": "; 2110 Z=FNFr}gabyte : Feof=Eof 2120 ; CHR$(13) SPACE$(39) CHR$(13); 2130 RETURN Z 2140 FNEND 2150 ! 2160 DEF FNFr}gabyte LOCAL I$=10 2170 WHILE 1 2180 ON ERROR GOTO 2240 : INPUT "";I$; 2190 IF I$="." THEN Eof=-1 : RETURN 0 2200 Z=VAL(I$) 2210 IF Z<0 THEN Eof=-1 : RETURN 0 2220 IF Z>=0 AND Z<256 THEN RETURN Z 2230 WHILE 1 2240 IF ERRCODE=53 AND PEEK(65507)=192 THEN Eof=-1 : RETURN 0 2250 IF ERRCODE=58 THEN Eof=-1 : RETURN 0 2260 IF 0 WEND 2270 ; STRING$(LEN(I$),8) SPACE$(LEN(I$)) STRING$(LEN(I$),8) CHR$(7); 2280 WEND 2290 FNEND 2300 ! 2310 ! G} s} n{ra m|jligt till viss position i indata bak}t eller fram}t. 2320 ! St{ll Fadr, Badr, Bpos, Buf$, Sof 2330 DEF FNPosit(Pos.) LOCAL X,Y 2340 ON Ityp GOTO 2350,2350,2350,2360,2370,2370,2370,2370 2350 Badr=Pos. : Buf$="" : RETURN 0 ! 1-3 2360 POSIT #Fin,Pos. : Fadr=Pos. : Badr=Pos. : Buf$="" : RETURN 0 ! 4 2370 IF Bpos THEN Fadr=Fadr-Bpos : Badr=Badr-Bpos : Bpos=0 ! 5-8 2380 IF POSIT(Fin)-LEN(Buf$)>Pos. THEN POSIT #Fin,0 : Fadr=0 : Badr=0 : Buf$="" : Sof=-1 2390 X=B3 : B3=0 : Y=Fpr : Fpr=0 2400 WHILE POSIT(Fin)<=Pos. 2410 Fadr=Fadr+LEN(Buf$) : Badr=Badr+LEN(Buf$) 2420 IF FNGetbuf THEN 2440 ELSE IF Rf THEN Z=FNWr("",-1) : Rf=0 2430 WEND 2440 IF Pos.>FNUs.(Fadr) THEN Bpos=Pos.-FNUs.(Fadr) : Badr=Badr+Bpos : Fadr=Fadr+Bpos 2450 B3=X : Fpr=Y 2460 RETURN 0 2470 FNEND 2480 ! 2490 DEF FNGetbuf 2500 IF Eof THEN RETURN -1 2510 Bpos=0 : Buf$="" 2520 ON Ityp GOTO 2530,2530,2540,2550,2560,2570,2580,2590 2530 RETURN -1 2540 RETURN FNGetprom(Badr) ! 3 OptProm 2550 RETURN FNGetdirekt(253) ! 4 Direktfil 2560 RETURN FNGetabs ! 5 ABS 2570 RETURN FNGetrel ! 6 REL 2580 RETURN FNGetpdata ! 7 P-Data 2590 RETURN FNGetkbac ! 8 K.E:s BAC 2600 RETURN 0 2610 FNEND 2620 ! 2630 DEF FNGetprom(Adr) LOCAL K$=20 2640 Buf$=STRING$(256,0) 2650 K$=CHR$(33)+CVT%$(Adr)+CHR$(1,0,1,195,253,127) 2660 Z=CALL(VARPTR(K$),VARPTR(Buf$)) : RETURN 0 2670 FNEND 2680 ! 2690 DEF FNGetdirekt(L) LOCAL L{ngd 2695 L{ngd=L 2700 ON ERROR GOTO 2710 : GET #Fin,Buf$ COUNT L{ngd : RETURN 0 2710 WHILE ERRCODE=38 AND L{ngd>1 2720 ON ERROR GOTO 2760 2730 Buf$="" : WHILE L{ngd ! L{s in s} l}ngt det g}r 2740 GET #Fin,P$ : Buf$=Buf$+P$ 2750 L{ngd=L{ngd-1 : WEND 2760 IF ERRCODE=38 THEN IF LEN(Buf$) THEN RETURN 0 ELSE 2790 2770 WEND 2780 IF ERRCODE<>38 THEN Z=FNWr("L{sfel "+NUM$(ERRCODE)+" p} "+F$,-1) 2790 Feof=-1 : Eof=-1 : RETURN -1 2800 FNEND 2810 ! 2820 ! --- Inl{sning fr}n .ABS-fil --- 2830 DEF FNGetabs LOCAL C,C1,C2,L,P 2840 P=Fadr 2850 Z=FNWr(FNNumber$(Fadr,Basa,2,1)+": ",0) : Rf=-1 2860 IF Sof THEN Sof=0 ELSE Z=FNGb(Basi) : IF Feof THEN RETURN 1 2870 C=FNGb(Basi) : IF Feof THEN RETURN 1 2880 IF C=255 THEN POSIT #Fin,INT((POSIT(Fin)-1.)/253.+1.)*253. : Fadr=POSIT(Fin) : Z=FNWr(" /",0)+FNWr(FNNumber$(Fadr,Basa,2,0)+": ",0) : GOTO 2870 2890 IF C<>0 THEN P$="Byte +1 (L{s/N{sta sektor)" : GOTO 3030 2900 L=FNGb(Basi) 2910 Z=FNGb(Basi) 2920 C1=FNGb(Basi) 2930 C=FNGb(Basi) : IF Feof THEN RETURN 1 2940 IF (C1 XOR 255)<>C THEN P$="Byte +4,5 (Adress H)" : GOTO 3030 2950 C2=FNGb(Basi) 2960 C=FNGb(Basi) : IF Feof THEN RETURN 1 2970 IF (C2 XOR 255)<>C THEN P$="Byte +6,7 (Adress L)" : GOTO 3030 2980 ! 2990 Badr=SWAP%(C1)+C2 3000 IF L=0 Z=FNWr("Slut, Anrop="+FNNumber$(Badr,Basa,2,0)+CHR$(7),1) : Eof=-1 : RETURN 1 3010 RETURN FNGetdirekt(L) 3020 ! 3030 Z=FNWr("ABS-fel: "+P$+CHR$(7),1) 3040 Eof=-1 : POSIT #Fin,POSIT(Fin)+P-Fadr : Fadr=P 3050 RETURN -1 3060 FNEND 3070 ! 3080 ! --- Inl{sning fr}n REL-fil -------- 3090 DEF FNGetrel LOCAL W.,B,C,D,B3$=2 3100 WHILE Sof 3110 Sof=0 3120 IF FNGetdirekt(256) THEN RETURN 1 3130 W=SWAP%(CVT$%(MID$(Buf$,15,2))) 3140 Z=FNWr(" W = "+NUM$(FNUs.(W)),1) 3150 IF (ASCII(MID$(Buf$,22,1)) AND 1)<>1 THEN Z=FNWr("Ej '.REL'-fil. Byte 21 bit 0 {r ej ettst{lld."+CHR$(7),1) 3160 IF ASCII(MID$(Buf$,1,1))<>2 THEN Z=FNWr("Ej '.REL'-fil. Byte 0 {r inte 2."+CHR$(7),1) 3170 Z=FNWr(" Datum = "+FNBcd$(Buf$,3)+"-"+FNBcd$(Buf$,4)+"-"+FNBcd$(Buf$,5)+" "+FNBcd$(Buf$,7)+"."+FNBcd$(Buf$,8)+"."+FNBcd$(Buf$,9),1) 3180 W.=FNUs.(SWAP%(CVT$%(MID$(Buf$,133,2)))) 3190 Z=FNWr(" "+NUM$(W.)+" bytes reserveras }t programmet.",1) 3200 Badr=INT((62460.-W.)/1000.)*1000. : Ba=Badr ! Realistisk startadr 3210 Fadr=256 : Buf$="" : S9=1 3220 WEND 3230 ! 3240 IF B3 THEN Z=FNWr(FNNumber$(Fadr,Basa,2,1)+": ",0) : B3$=", " : Rf=-1 3250 B=FNGb(B3) : D=B : IF Feof THEN RETURN 1 3260 IF B>=128 THEN RETURN FNGetdirekt(B AND 127) 3270 IF (B AND 176)<>0 THEN 3380 ELSE B=B AND 15 3280 IF B=0 THEN W.=INT((POSIT(Fin)-1.)/256.+1.)*256. : Fadr=Fadr-POSIT(Fin)+W. : POSIT #Fin,W. : GOTO 3250 3290 IF B<>1 AND B<>2 THEN 3320 3300 IF S9<=1 THEN W.=W : Eof=-1 ELSE W.=FNS 3310 Z=FNWr(" Inhopp till "+FNNumber$(W.,Basa,2,0)+B3$+CHR$(7),B3) : Rf=-1 : GOTO 3250 3320 IF INSTR(1,CHR$(3,4,5,6,7,11,12,13,14),CHR$(B))=0 THEN 3340 3330 Z=FNWr(NUM$(POSIT(Fin))+": "+NUM$(D)+"Ok{nd styrkod. Slut."+B3$+CHR$(7),B3) : Eof=-1 : RETURN 1 3340 IF B=8 THEN Z=FNWr(" (POP DEST)"+B3$,B3) : Rf=-1 : Badr=FNS : GOTO 3250 3350 IF B=9 THEN Z=FNWr(" (DEST= $AND(.+$-1))"+B3$,B3) : Rf=-1 : Z=FNS : Badr=Z AND (Badr+Z-1) : GOTO 3250 3360 IF B=10 THEN W=FNS : Z=FNWr(" (W := "+NUM$(FNUs.(W))+")"+B3$,B3) : Rf=-1 : GOTO 3250 3370 B=130 : GOTO 3410 3380 ! 3390 IF (B AND 144)<>16 THEN 3460 3400 IF B AND 8 THEN Z=FNWr(" (POP)"+B3$,B3) : Z=FNS : Rf=-1 : GOTO 3420 3410 C=FNGb(B3) AND 128 : Z=SWAP%(FNGb(B3))+FNGb(B3) : IF C THEN Z=Z+Ba 3420 IF (B AND 2)=0 THEN Z=SWAP%(Z) 3430 IF B AND 128 THEN W.=FNWr(" (PUSH "+FNNumber$(Z,Basa,2,0)+")"+B3$,B3) : GOTO 3520 3440 IF B AND 1 THEN Buf$=CHR$(Z) ELSE Buf$=CVT%$(Z) 3450 Fadr=Fadr-LEN(Buf$) : RETURN 0 3460 ! 3470 IF (B AND 176)<>32 THEN 3330 ELSE B=B AND 7 3480 IF B=0 THEN Z=FNWr(" (+)"+B3$,B3) : Z=FNS+FNS : GOTO 3520 3490 IF B=1 THEN Z=FNWr(" (-)"+B3$,B3) : Z=-FNS+FNS : GOTO 3520 3500 IF B=4 THEN Z=FNWr(" (0-)"+B3$,B3) : Z=0-FNS : GOTO 3520 3510 GOTO 3330 3520 Rf=-1 : S(S9)=Z : S9=S9+1 : GOTO 3250 3530 FNEND 3540 ! 3550 ! --- Inl{sning fr}n P-Data ABS-fil --- 3560 DEF FNGetpdata LOCAL L,X. 3570 X.=POSIT(Fin)/253. : IF X.<>INT(X.) THEN POSIT #Fin,INT(X.)*253.+253. : Fadr=POSIT(Fin) 3580 Z=FNWr(FNNumber$(Fadr,Basa,2,1)+": ",0) : Rf=-1 3590 Badr=FNGb(Basi)+SWAP%(FNGb(Basi)) : IF Feof THEN RETURN 1 3600 L=FNGb(Basi) : IF Feof THEN RETURN 1 3610 RETURN FNGetdirekt(L) 3620 FNEND 3630 ! 3640 ! --- Inl{sning fr}n SKE:s relativa BAC-filer --- 3650 DEF FNGetkbac LOCAL W.,B,C,B3$=2 3660 WHILE Sof 3670 Sof=0 3680 IF FNGetdirekt(26) THEN RETURN 1 3690 W=CVT$%(MID$(Buf$,22,2))+22 3700 Z=FNWr(" Relokerings-rutinen ligger vid position "+NUM$(FNUs.(W)),1) 3710 IF ASCII(Buf$)<>143 AND ASCII(Buf$)<>144 THEN Z=FNWr(" Ej BAC-fil"+CHR$(7),1) 3715 B=0 : IF ASCII(RIGHT$(Buf$,24))=0 THEN B=CVT$%(RIGHT$(Buf$,25))+3 3720 Badr=32768 : Ba=Badr ! Vanlig placering 3730 Fadr=23+B : Buf$="" : S9=1 : POSIT #Fin,Fadr 3740 WEND 3750 ! 3760 IF B3 THEN Z=FNWr(FNNumber$(Fadr,Basa,2,1)+": ",0) : B3$=", " : Rf=-1 3770 IF POSIT(Fin)>=FNUs.(W) THEN Ityp=4 : Flgfa=0 : Badr=Fadr : RETURN FNGetdirekt(INT(POSIT(Fin)/253.+1.)*253.-POSIT(Fin)) 3780 B=FNGb(B3) : IF Feof THEN RETURN 1 3790 IF B<239 THEN RETURN FNGetdirekt(B) 3800 IF B=239 THEN B=FNGb(B3) : Z=FNWr(" (POP)"+B3$,B3) : Z=FNS : GOTO 3830 3810 WHILE B<=246 3820 Z=FNGb(B3)+SWAP%(FNGb(B3)) 3830 IF B AND 1 THEN Z=Z+Ba 3840 IF B AND 2 THEN Z=SWAP%(Z) 3850 IF B AND 4 THEN Buf$=CVT%$(Z) ELSE Buf$=CHR$(Z) 3860 Fadr=Fadr-LEN(Buf$) : RETURN 0 3870 WEND 3880 Rf=-1 3890 ON B-246 GOTO 3900,3920,3940,3950,3960,3970,3990,4000,4010 3900 Z=FNGb(B3)+SWAP%(FNGb(B3)) : S(S9)=Z+Ba : S9=S9+1 3910 Z=FNWr(" (PUSH BASE+"+FNNumber$(Z,Basa,2,0)+" = "+FNNumber$(Z+Ba,Basa,2,0)+")"+B3$,B3) : GOTO 3770 3920 Z=FNGb(B3)+SWAP%(FNGb(B3)) : S(S9)=Z : S9=S9+1 3930 Z=FNWr(" (PUSH "+FNNumber$(Z,Basa,2,0)+")"+B3$,B3) : GOTO 3770 3940 Z=FNS+FNS : S(S9)=Z : S9=S9+1 : Z=FNWr(" (ADD = "+FNNumber$(Z,Basa,2,0)+")"+B3$,B3) : GOTO 3770 3950 Z=FNWr(" (PUSH BASE = "+FNNumber$(Ba,Basa,2,0)+")"+B3$,B3) : Z=Ba : GOTO 3980 3960 Ba=FNS : Z=FNWr(" (POP BASE = "+FNNumber$(Ba,Basa,2,0)+")"+B3$,B3) : GOTO 3770 3970 Z=FNWr(" (PUSH DEST = "+FNNumber$(Badr,Basa,2,0)+")"+B3$,B3) : Z=Badr 3980 S(S9)=Z : S9=S9+1 : GOTO 3770 3990 Z=FNWr(" (POP DEST)"+B3$,B3) : Badr=FNS : GOTO 3770 4000 Z=FNWr(" (CALL "+FNNumber$(FNS,Basa,2,0)+")"+B3$,B3) : GOTO 3770 4010 Z=FNWr(" (CHAIN Adr="+FNNumber$(FNS,Basa,2,0)+", L{ngd="+FNNumber$(FNUs.(FNS),Basa,2,0)+")"+B3$,B3) : GOTO 3770 4020 FNEND 4030 ! 4040 ! L{s fr}n stack --- 4050 DEF FNS 4060 IF S9<=1 THEN RETURN 0 ELSE S9=S9-1 : RETURN S(S9) 4070 FNEND 4080 ! 4090 ! G|r heltal positivt --- 4100 DEF FNUs.(A) 4110 IF A>=0 THEN RETURN A ELSE RETURN 65536.+A 4120 FNEND 4130 ! 4140 ! L{s en byte fr}n fil --- 4150 DEF FNGb(Radix) LOCAL C$=1 4160 IF Feof THEN RETURN 0 4170 ON ERROR GOTO 4210 : GET #Fin C$ : ON ERROR GOTO : Fadr=Fadr+1 4180 IF Radix THEN Z=FNT(ASCII(C$),Radix,1) 4190 RETURN ASCII(C$) 4200 ! 4210 Feof=-1 : Eof=-1 : RETURN 0 4220 FNEND 4230 ! 4240 ! Utskrift --- 4250 DEF FNWr(S$,Crf) 4260 ; S$; : IF Crf THEN ; 4270 IF Fpr=0 THEN RETURN 0 4280 IF Radstart THEN ; #Fpr Prvmarg$; : Radstart=0 4290 ; #Fpr S$; 4300 IF Crf THEN ; #Fpr : Radstart=-1 4310 RETURN 0 4320 FNEND 4330 ! 4340 ! Talomvandling --- 4350 DEF FNT(N,Radix,Bytes)=FNWr(FNNumber$(N,Radix,Bytes,-1)+" ",0) 4360 DEF FNBcd$(B$,P)=FNNumber$(ASCII(MID$(B$,P,1)),16,1,-1) 4370 ! 4380 DEF FNNumber$(N,Radix,Bytes,Fixd) LOCAL Res$=16,L,N2 4390 L=ASCII(RIGHT$(Diglen$,Radix+Radix+Bytes))-48 4400 ON Radix GOTO 4450,4450,4450,4450,4450,4450,4450,4430,4450,4410,4450,4450,4450,4450,4450,4420 4410 IF Fixd THEN Res$=NUM$(FNUs.(N)) : RETURN SPACE$(L-LEN(Res$))+Res$ ELSE RETURN NUM$(FNUs.(N)) 4420 Res$=HEX$(N) : RETURN STRING$(L-LEN(Res$),48)+Res$ 4430 Res$=OCT$(N) : RETURN STRING$(L-LEN(Res$),48)+Res$ 4440 ! 4450 IF N<0 THEN Z.=65536.+N : Res$=MID$(Dig$,Z.-FIX(Z./Radix)*Radix+1.,1) : N2=FIX(Z./Radix) ELSE N2=N 4460 WHILE N2 4470 Res$=MID$(Dig$,MOD(N2,Radix)+1,1)+Res$ 4480 N2=N2/Radix 4490 WEND 4500 RETURN STRING$(L-LEN(Res$),48)+Res$ 4510 FNEND 4520 ! 4530 ! 4540 DEF FNPutcross(Typ$,Ref) 4550 PUT #Fcr,Typ$+CVT%$(Ref)+CVT%$(Adrstart) 4560 RETURN 0 4570 FNEND 4580 ! 4590 DEF FNGetbyte LOCAL B 4600 ON Ityp GOSUB 4640,4650,4670,4670,4670,4670,4670,4670 4610 Bytesav$=Bytesav$+CHR$(B) 4620 RETURN B 4630 ! 4640 B=PEEK(Badr) : Badr=Badr+1 : RETURN ! 1 Minnet 4650 B=FNInputbyte : Badr=Badr+1 : RETURN ! 2 Inmatning 4660 ! 4670 IF BposBadr THEN IF Adr THEN Adr=Adr+1 : B=0 : RETURN 4700 Bpos=Bpos+1 : B=ASCII(RIGHT$(Buf$,Bpos)) : Fadr=Fadr+1 : Badr=Badr+1 : Adr=Adr+1 4710 RETURN ! 3-8 Buffert 4720 FNEND 4730 ! 4740 DEF FNAsmnem(Kod) LOCAL I,I$=1 4750 I=Kod : Indx=0 4760 ON I/64+1 GOTO 4780,4790,4800,4830 4770 ! 4780 Asm$=Mnem0$(I) : GOTO 4940 ! I<64 4790 IF I=118 THEN Asm$="HALT" : GOTO 4950 4795 Asm$="LD "+Reg$(I/8 AND 7)+","+Reg$(I AND 7) : GOTO 4950 4800 Asm$=Mnem2$(I/8 AND 7)+" "+Reg$(I AND 7) : GOTO 4950 4810 ! 4820 ! I>191 4830 IF I=221 THEN Indx=1 : I=FNGetbyte : GOTO 4760 4840 IF I=253 THEN Indx=3 : I=FNGetbyte : GOTO 4760 4850 IF I=237 THEN Asm$=Mnems$(Mnems(FNGetbyte)) : GOTO 4940 4860 IF I<>203 THEN Asm$=Mnem3$(I) : GOTO 4940 4870 ! 4880 IF Indx THEN Offs=FNGetbyte : Indx=-Indx 4890 I=FNGetbyte 4900 IF I<64 THEN Asm$=Mnemr$(I/8 AND 7)+" "+Reg$(I AND 7) : GOTO 4950 4910 Asm$=Mnemb$(I/64)+" "+NUM$(I/8 AND 7)+","+Reg$(I AND 7) 4920 GOTO 4950 4930 ! 4940 RETURN FNAsmpifityp+FNAsmpiff1 4950 RETURN FNAsmpifityp 4960 FNEND 4970 ! 4980 DEF FNAsmpiff1 LOCAL P,A,V$=20 4990 P=INSTR(1,Asm$,"m") : IF P THEN 5040 5000 P=INSTR(1,Asm$,"n") : IF P THEN 5090 5010 P=INSTR(1,Asm$,"e") : IF P THEN 5110 5020 RETURN 0 5030 ! 5040 A=FNGetbyte+SWAP%(FNGetbyte) 5050 IF Fcr THEN Z=FNPutcross(MID$(Asm$,P+1,1),A) 5060 V$=FNNumber$(A,Basa,2,0) 5070 Asm$=LEFT$(Asm$,P-1)+V$+RIGHT$(Asm$,P+2) : RETURN 0 5080 ! 5090 V$=FNNumber$(FNGetbyte,Basa,1,0) : GOTO 5160 5100 ! 5110 A=FNGetbyte 5120 IF A>127 THEN A=A-254 ELSE A=A+2 5130 ! IF A<0 THEN V$="-"+FNNumber$(-A,Basa,1,0)+" --> " ELSE V$="+"+FNNumber$(A,Basa,1,0)+" --> " 5140 IF Fcr THEN Z=FNPutcross("e",Adrstart+A) 5150 V$=V$+FNNumber$(Adrstart+A,Basa,2,0) 5160 Asm$=LEFT$(Asm$,P-1)+V$+RIGHT$(Asm$,P+1) 5170 RETURN 0 5180 FNEND 5190 ! 5200 DEF FNAsmpifityp LOCAL I$=1,P,S,T$=25 5210 WHILE Indx 5220 T$=MID$("IXIY",ABS(Indx),2) 5230 P=INSTR(1,Asm$,"HL") 5240 IF P=0 THEN Asm$=T$+" "+NUM$(Offs)+" "+Asm$ : GOTO 5310 5250 IF MID$(Asm$,P-1,1)<>"(" THEN Asm$=LEFT$(Asm$,P-1)+T$+RIGHT$(Asm$,P+2) : GOTO 5310 5260 IF Indx>0 THEN Offs=FNGetbyte 5270 IF Offs>127 THEN Offs=256-Offs : S=1 ELSE S=2 5280 Asm$=LEFT$(Asm$,P-1)+T$+MID$("-+",S,1)+FNNumber$(Offs,Basa,1,0)+RIGHT$(Asm$,P+2) 5290 IF 0 WEND 5300 ! 5310 P=INSTR(1,Asm$," ") 5320 IF P THEN Asm$=LEFT$(Asm$,P-1)+RIGHT$(Tab2$,P)+RIGHT$(Asm$,P+1) 5330 RETURN 0 5340 FNEND 5350 ! 5360 ! ___ 5370 DEF FNAsminit LOCAL J,K 5380 DIM Reg$(0:7)=4,Mnem0$(0:63)=10,Mnem2$(0:7)=3,Mnem3$(192:255)=10 5390 DIM Mnems(0:255),Mnems$(0:60)=12,Mnemb$(0:4)=3,Mnemr$(0:7)=3,Asm$=45 5400 RESTORE 5550 : FOR I=0 TO 7 : READ Reg$(I) : NEXT I 5410 RESTORE 5560 : FOR I=0 TO 7 : READ Mnem2$(I) : NEXT I 5420 RESTORE 5570 : FOR I=0 TO 4 : READ Mnemb$(I) : NEXT I 5430 RESTORE 5580 : FOR I=0 TO 7 : READ Mnemr$(I) : NEXT I 5440 RESTORE 5720 : FOR I=0 TO 63 : READ Mnem0$(I) : NEXT I 5450 RESTORE 5810 : FOR I=192 TO 255 : READ Mnem3$(I) : NEXT I 5460 RESTORE 5600 : Mnems$(0)="???" : I=1 : K=0 5470 WHILE K<256 5480 ON ERROR GOTO 5500 : READ J 5490 J=K+J : WHILE K96 THEN MID$(T$,P,1)=CHR$(K-32) 6060 P=P-1 : WEND 6070 RETURN T$ 6080 FNEND 6090 ! 6100 DEF FNPaus LOCAL I$=1 6110 WHILE SYS(5) OR Flgstega 6120 GET I$ 6130 WHILE ASCII(I$)=32 6140 WHILE NOT Flgstega 6150 ; " -Pause- "; : GET I$ 6160 ; STRING$(9,8) SPACE$(9) STRING$(9,8); 6170 IF 0 WEND 6180 Flgstega=0 6190 IF 0 WEND 6200 IF ASCII(I$)=9 THEN Flgstega=-1 6210 IF ASCII(I$)=192 THEN Flgavbryt=-1 6220 IF SYS(5) WEND 6230 RETURN Flgavbryt 6240 FNEND 6250 ! 6260 ! Prep: 0=\ppna gammal fil, 2=Alltid prepare 6270 DEF FNOpen(F$,Filnr,Prep) LOCAL P 6280 IF Prep=2 THEN 6350 6290 ! __\ppna gammal fil__ 6300 ON ERROR GOTO 6320 : OPEN F$ AS FILE Filnr 6310 RETURN 0 6320 IF ERRCODE<>21 THEN 6470 6330 IF Prep=0 THEN ; CHR$(7) 'Hittar inte filen "' F$ '".' : RETURN ERRCODE 6340 ! 6350 ! __Skapa ny fil______ 6360 ON ERROR GOTO 6430 : OPEN F$ AS FILE Filnr 6370 ; CHR$(7) 'Filen "' F$ '" finns redan. Skriv |ver J/N ? '; 6380 ON FNSvar("NJ") GOTO 6390,6400 6390 RETURN -1 6400 ON ERROR GOTO 6470 : CLOSE Filnr 6410 GOTO 6440 6420 ! 6430 IF ERRCODE<>21 THEN 6470 6440 ON ERROR GOTO 6470 : PREPARE F$ AS FILE Filnr 6450 RETURN 0 6460 ! 6470 ; CHR$(7) 'Kan inte |ppna filen "' F$ '". Felkod' ERRCODE 6480 RETURN ERRCODE 6490 FNEND