20 ! +---------------------------------------------------+
30 ! ! AVASS Ver 5.3 - 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.3 / 87-06-19 / SKE / .BAC ver 2, Ej Err 191 i FNGetdirekt,
142 ! JR r{tt vid cross (FNAsmpiff1)
150 !
160 INTEGER : EXTEND : ! NO RESUME
170 ; CHR$(12) "Avassemblering Z80 ABC800 Ver 5.3" : ;
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 Bpos