1000 INTEGER : EXTEND
1010 ON ERROR GOTO 1380
1020 ! 2-pass
1030 OPTION BASE 0
1040 DIM Label$(500)=8 ! 500 labels a 8 tkn
1050 DIM Asscode$=160,Reg$(7)
1060 Reg$(6)=" " : DIM Reg$(7)=1
1070 FOR I=0 TO 7 : READ Reg$(I) : NEXT I
1080 DATA B,C,D,E,H,L,(HL),A
1090 Defut$="MEM:" ! P} ABC806 l{mpligen RAM: etc
1100 DEF FNSysrad$(Exe$) LOCAL Utstr$=161
1110 Utstr$=CHR$(12)+" ASSEMBLE.800 (C) Peter ""HPA"" Anvin <4642> "+FNLeft$(Exe$+SPACE$(30),30)+" "+STRING$(80,61)
1120 IF PEEK(65364)<80 THEN Utstr$=CHR$(12)+" ASSEMBLE.800 "+FNLeft$(Exe$+SPACE$(21),21)+" "+STRING$(40,61) ! 40 tkn
1130 RETURN Utstr$
1140 FNEND
1150 DEF FNLeft$(Str$,Wid)=LEFT$(Str$+STRING$(Wid,255),Wid) ! LEFT$ utan ERR 134
1160 DEF FNMid$(Str$,Pos,Wid)=RIGHT$(FNLeft$(Str$,Pos+Wid-1),Pos)
1170 DEF FNRight$(Str$,Wid)
1180 IF LEN(Str$)"
1250 ; CUR(13,20-Prtoff) "Utfil:" : IF Defut$<>"" THEN ; CUR(13,0) "<" Defut$ ">"
1260 ; CUR(9,30-Prtoff); : INPUT ""Infil$
1270 ; CUR(11,30-Prtoff); : INPUT ""Listfil$
1280 IF Listfil$="" THEN Listfil$="CON:" : ; CUR(11,30-Prtoff) Listfil$
1290 ; CUR(13,30-Prtoff); : INPUT ""Utfil$
1300 IF Utfil$="" IF Defut$<>"" THEN Utfil$=Defut$ : ; CUR(13,30-Prtoff) Utfil$
1310 ON ERROR GOTO 1390
1320 OPEN Infil$ AS FILE 1
1330 ON ERROR GOTO
1340 PREPARE Listfil$ AS FILE 2
1350 PREPARE Utfil$ AS FILE 3
1360 Lables=0
1370 GOTO 1390
1380 ; CHR$(7); : RESUME 1210
1390 ! ---- Utskrifter:
1400 ! Pass 1 skrivs labeladresserna
1410 ! Pass 2 skrivs adress, objektprg och k{llprg
1420 ; FNSysrad$("Verkst{ller pass 1")
1430 Pass=1
1440 ; #2 : ; #2 "******* ASSEMBLE.800 assemblerar " Infil$
1450 ; #2 "******* till PAH-filen " Utfil$
1460 ; #2
1470 ; #2 : ; #2 "----- PASS 1" : ; #2
1480 Adress=0
1490 INPUT LINE #1,Assline$
1500 Assline$=FNLeft$(Assline$,LEN(Assline$)-2)
1510 ; FNComprow$;
1520 ! Uppdelat i: Label$ Opcode$ Argument$
1530 IF Label$="" THEN 1590
1540 Label$(Lables)=Label$ : Labadr(Lables)=Adress
1550 IF Opcode$<>"EQU" THEN 1570
1560 Labadr(Lables)=FNComptal16(Argument$)
1570 ; #2 Label$(Lables) TAB(10) FNHex16$(Labadr(Lables))+" "+NUM$(Labadr(Lables))
1580 Lables=Lables+1
1590 Q$=FNCompile$ : Adress=Adress+LEN(Q$) ! Spara ej v{rden--bara adress
1600 IF Endnow=0 THEN 1490
1610 CLOSE 1
1620 IF FNBig$(Listfil$)="CON:" THEN ; : ; "Tryck p} n}gon tangent:" CHR$(7) : GET Key$
1630 ; FNSysrad$("Verkst{ller pass 2")
1640 Pass=2
1650 OPEN Infil$ AS FILE 1
1660 ; #2 : ; #2 : ; #2 "----- PASS 2" : ; #2
1670 Adress=0
1680 INPUT LINE #1,Assline$
1690 Assline$=FNLeft$(Assline$,LEN(Assline$)-2)
1700 ; FNComprow$;
1710 Kepadr=Adress
1720 Q$=FNCompile$ : Adress=Adress+LEN(Q$)
1730 IF Q$<>"" THEN ; #3 FNHex16$(Kepadr) ":";
1740 ; #2 FNHex16$(Kepadr) " ";
1750 FOR I=1 TO LEN(Q$)
1760 ; #3 FNHex8$(ASCII(MID$(Q$,I,1)));
1770 ; #2 FNHex8$(ASCII(MID$(Q$,I,1)));
1780 NEXT I
1790 FOR I=LEN(Q$) TO 3
1800 ; #2 " ";
1810 NEXT I
1820 IF Q$<>"" THEN ; #3
1830 ; #2 " "+Assline$
1840 IF Endnow THEN 1860
1850 GOTO 1680
1860 CLOSE 1,3
1870 ; #2 : ; #2 : ; #2 "Assemblering avslutad"
1880 IF FNBig$(Listfil$)="CON:" THEN ; : ; "Tryck p} n}gon tangent:" CHR$(7) : GET Key$
1890 ; FNSysrad$("Assemblering avslutad")
1900 CLOSE 2
1910 END
1920 DEF FNHex8$(Tal)=RIGHT$("00"+HEX$(Tal),LEN(HEX$(Tal))+1)
1930 DEF FNHex16$(Tal)=RIGHT$("0000"+HEX$(Tal),LEN(HEX$(Tal))+1)
1940 DEF FNComprow$
1950 Pos=1 : Label$="" : Opcode$="" : Argument$="" : Smarg$=""
1960 ON ERROR GOTO 2130 ! F|r test av slut-p}-str{ng
1970 IF MID$(Assline$,Pos,1)=" " THEN 2000
1980 Label$=Label$+MID$(Assline$,Pos,1)
1990 Pos=Pos+1 : GOTO 1970
2000 Pos=Pos+1 : IF MID$(Assline$,Pos,1)=" " THEN 2000 ! Flera SPACE i rad?
2010 IF MID$(Assline$,Pos,1)=";" THEN 2080 ! Kommentar redan?
2020 Opcode$=Opcode$+MID$(Assline$,Pos,1) : Pos=Pos+1
2030 IF MID$(Assline$,Pos,1)<>" " THEN 2020
2040 Pos=Pos+1 : IF MID$(Assline$,Pos,1)=" " THEN 2040
2050 IF MID$(Assline$,Pos,1)=";" THEN 2080
2060 Smarg$=Smarg$+MID$(Assline$,Pos,1) : IF FNCita(Smarg$) THEN Smarg$=FNSkipcita$(Smarg$)
2070 Pos=Pos+1 : IF MID$(Assline$,Pos,1)<>" " THEN 2060
2080 Label$=FNBig$(Label$)
2090 IF FNRight$(Label$,1)=":" THEN Label$=LEFT$(Label$,LEN(Label$)-1)
2100 Opcode$=FNBig$(Opcode$)
2110 Argument$=FNBig$(Smarg$)
2120 RETURN ""
2130 IF ERRCODE=134 THEN RESUME 2080 ELSE ; "ERROR" ERRCODE : STOP
2140 FNEND
2150 DEF FNComptal16(Str$) LOCAL Label,Base$=16,Loop,M}l,Tal
2160 IF INSTR(1,"0123456789",FNLeft$(Str$,1)) THEN 2240 ! Tal--ej label
2170 IF Pass=1 THEN RETURN 0
2180 Label=0
2190 WHILE Label"_" THEN Utstr$=Utstr$+CHR$(ASCII(MID$(Str$,Loop,1))-32) ELSE Utstr$=Utstr$+MID$(Str$,Loop,1)
2460 Loop=Loop+1
2470 WEND
2480 RETURN Utstr$
2490 FNEND
2500 DEF FNCompile$
2510 Endnow=0
2520 IF Opcode$="" THEN RETURN ""
2521 IF Opcode$="?ORG" AND Pass=1 THEN INPUT "Basadress f|r ?ORG: "Argument$ : Conorg=FNComptal16(Argument$)
2522 IF Opcode$="?ORG" THEN Adress=Conorg : RETURN ""
2530 IF Opcode$="DEFM" THEN RETURN FNDefm$
2540 IF Opcode$="DEFS" THEN Adress=Adress+FNComptal16(Argument$) : RETURN ""
2550 IF Opcode$="ORG" THEN Adress=FNComptal16(Argument$) : RETURN ""
2560 IF Opcode$="EQU" THEN RETURN ""
2570 IF Opcode$="DEFW" THEN RETURN CVT%$(FNComptal16(Argument$))
2580 IF Opcode$="DEFB" THEN RETURN CHR$(FNComptal8(Smarg$)) ! Sm} tecken till 8
2590 IF Opcode$="END" THEN Endnow=-1 : RETURN ""
2600 IF Opcode$="ADC" THEN RETURN FNAdccomp$
2610 IF Opcode$="ADD" THEN RETURN FNAddcomp$
2620 IF Opcode$="AND" THEN RETURN FNEvalucmp$(160)
2630 IF Opcode$="BIT" THEN RETURN FNBitcomp$(64)
2640 IF Opcode$="CALL" THEN RETURN FNCallcomp$
2650 IF Opcode$="CP" THEN RETURN FNEvalucmp$(184)
2660 IF Opcode$="DEC" THEN RETURN FNIncdeccmp$(5)
2670 IF Opcode$="DJNZ" THEN RETURN FNDjnzcomp$
2680 IF Opcode$="EX" THEN RETURN FNExcomp$
2690 IF Opcode$="IN" THEN RETURN FNIncomp$
2700 IF Opcode$="INC" THEN RETURN FNIncdeccmp$(4)
2710 IF Opcode$="JP" THEN RETURN FNJpcomp$
2720 IF Opcode$="JR" THEN RETURN FNJrcomp$
2730 IF Opcode$="LD" THEN RETURN FNLdcomp$
2740 IF Opcode$="OR" THEN RETURN FNEvalucmp$(176)
2750 IF Opcode$="OUT" THEN RETURN FNOutcomp$
2760 IF Opcode$="POP" THEN RETURN FNStackcmp$(193)
2770 IF Opcode$="PUSH" THEN RETURN FNStackcmp$(197)
2780 IF Opcode$="RES" THEN RETURN FNBitcomp$(128)
2790 IF Opcode$="RET" THEN RETURN FNRetcomp$
2800 IF Opcode$="RL" THEN RETURN FNCb00comp$(16)
2810 IF Opcode$="RLC" THEN RETURN FNCb00comp$(0)
2820 IF Opcode$="RR" THEN RETURN FNCb00comp$(24)
2830 IF Opcode$="RRC" THEN RETURN FNCb00comp$(8)
2840 IF Opcode$="RST" THEN RETURN FNRstcomp$
2850 IF Opcode$="SBC" THEN RETURN FNSbccomp$
2860 IF Opcode$="SET" THEN RETURN FNBitcomp$(192)
2870 IF Opcode$="SLA" THEN RETURN FNCb00comp$(32)
2880 IF Opcode$="SRA" THEN RETURN FNCb00comp$(40)
2890 IF Opcode$="SRL" THEN RETURN FNCb00comp$(56)
2900 IF Opcode$="SUB" THEN RETURN FNEvalucmp$(144)
2910 IF Opcode$="XOR" THEN RETURN FNEvalucmp$(168)
2920 IF Argument$<>"" THEN ; #2 Assline$ : ; #2 "ERROR: Undefined instruction" : CLOSE : STOP
2930 RESTORE 2980
2940 READ Opcod$,Nr$ : IF Opcod$="" THEN ; #2 Assline$ : ; #2 "ERROR: Undefinied opcode" : CLOSE : STOP
2950 IF Opcod$<>Opcode$ THEN 2940
2960 IF INSTR(1,Nr$,":") THEN RETURN CHR$(VAL(FNLeft$(Nr$,INSTR(1,Nr$,":")-1)),VAL(RIGHT$(Nr$,INSTR(1,Nr$,":")+1)))
2970 IF Nr$="" THEN RETURN Nr$ ELSE RETURN CHR$(VAL(Nr$))
2980 DATA CCF,63,CPD,237:169,CPDR,237:185,CPI,237:161,CPIR,237:177
2990 DATA CPL,47,DAA,39,DI,243,EI,251,EXX,217,HALT,118,IM0,237:70
3000 DATA IM1,237:86,IM2,237:94,IND,237:170,INDR,237:186,INI,237:162
3010 DATA INIR,237:178,LDD,237:168,LDDR,237:184,LDI,237:160,LDIR,237:176
3020 DATA NEG,237:68,NOP,0,OUTD,237:171,OTDR,237:187,OUTI,237:163,OTIR,237:179
3030 DATA RETI,237:77,RETN,237:69,RLA,23,RLCA,7,RLD,237:111,RRA,31,RRCA,15
3040 DATA RRD,237:103,SCF,55,,
3050 FNEND
3060 DEF FNComptal8(Smarg$) LOCAL Arg$=50
3070 Arg$=FNBig$(Smarg$)
3080 IF (FNLeft$(Arg$,1)="'" OR FNLeft$(Arg$,1)='"') AND FNLeft$(Arg$,1)=FNMid$(Arg$,3,1) THEN RETURN ASCII(MID$(Smarg$,2,1)) ! Str{nguttryck?
3090 IF FNLeft$(Arg$,3)="HB:" THEN RETURN SWAP%(FNComptal16(RIGHT$(Arg$,4))) AND 255 ! High Byte of...?
3100 IF FNLeft$(Arg$,3)="LB:" THEN RETURN FNComptal16(RIGHT$(Arg$,4)) AND 255 ! - Low byte of...?
3110 IF INSTR(1,"0123456789",FNLeft$(Arg$,1))<>0 AND INSTR(1,"0123456789DOQHB",RIGHT$(Arg$,LEN(Arg$)))<>0 THEN RETURN FNComptal16(Arg$) AND 255
3120 ; #2 Assline$ : ; #2 "ERROR: Not an eight-bit number"
3130 CLOSE : STOP
3140 FNEND
3150 DEF FNDefm$
3160 IF (FNLeft$(Argument$,1)="'" OR FNLeft$(Argument$,1)='"') AND FNLeft$(Argument$,1)=RIGHT$(Argument$,LEN(Argument$)) THEN 3190
3170 ; #2 Assline$ : ; #2 "ERROR: Illegal DEFM instruction"
3180 CLOSE : STOP
3190 RETURN MID$(Smarg$,2,LEN(Smarg$)-2)
3200 FNEND
3210 DEF FNCita(Str{ng$)=INSTR(1,"""'",RIGHT$(Str{ng$,LEN(Str{ng$)))<>0
3220 DEF FNSkipcita$(Str{ng$) LOCAL Newstring$=100,Cita$=1
3230 Newstring$=Str{ng$
3240 IF NOT FNCita(Newstring$) THEN ; #2 "SYSTEM ERROR In FNSkipcita$/FNComprow$" : CLOSE : STOP
3250 Cita$=RIGHT$(Newstring$,LEN(Newstring$))
3260 Pos=Pos+1 : Newstring$=Newstring$+MID$(Assline$,Pos,1)
3270 IF RIGHT$(Newstring$,LEN(Newstring$))=Cita$ THEN RETURN Newstring$
3280 GOTO 3260
3290 FNEND
3300 DEF FNEvalucmp$(Nr) LOCAL Loop
3310 IF FNLeft$(Argument$,2)="A," THEN Argument$=RIGHT$(Argument$,3) : Smarg$=RIGHT$(Smarg$,3)
3320 Loop=0
3330 WHILE Loop<8
3340 IF Argument$=Reg$(Loop) THEN RETURN CHR$(Nr+Loop)
3350 Loop=Loop+1
3360 WEND
3370 IF RIGHT$(Argument$,LEN(Argument$))<>")" THEN RETURN CHR$(Nr+70,FNComptal8(Smarg$))
3380 Argument$=FNLeft$(Argument$,LEN(Argument$)-1)
3390 IF FNLeft$(Argument$,4)="(IX+" THEN RETURN CHR$(221,Nr+6,FNComptal8(RIGHT$(Smarg$,5)))
3400 IF FNLeft$(Argument$,4)="(IX-" THEN RETURN CHR$(221,Nr+6,-FNComptal8(RIGHT$(Smarg$,5)))
3410 IF FNLeft$(Argument$,4)="(IY+" THEN RETURN CHR$(253,Nr+6,FNComptal8(RIGHT$(Smarg$,5)))
3420 IF FNLeft$(Argument$,4)="(IY-" THEN RETURN CHR$(253,Nr+6,FNComptal8(RIGHT$(Smarg$,5)))
3430 ; #2 Assline$ : ; #2 "ERROR: Illegal " Opcode$ " instruction"
3440 CLOSE : STOP
3450 FNEND
3460 DEF FNAddcomp$ LOCAL Rp$=8,Leftarg$=3,Nr
3470 Leftarg$=FNLeft$(Argument$,3)
3480 Rp$="BCDE"+FNLeft$(Leftarg$,2)+"SP"
3490 IF INSTR(1,"HL,IX,IY,",Leftarg$)=0 THEN RETURN FNEvalucmp$(128)
3500 IF Leftarg$="HL," THEN Nr=INSTR(1,Rp$,RIGHT$(Argument$,4)) : IF Nr/2.=INT(Nr/2.) THEN 3530 ELSE RETURN CHR$(9+(Nr-1)*8)
3510 IF Leftarg$="IX," THEN Nr=INSTR(1,Rp$,RIGHT$(Argument$,4)) : IF Nr/2.=INT(Nr/2.) THEN 3530 ELSE RETURN CHR$(221,9+(Nr-1)*8)
3520 IF Leftarg$="IY," THEN Nr=INSTR(1,Rp$,RIGHT$(Argument$,4)) : IF Nr/2.=INT(Nr/2.) THEN 3530 ELSE RETURN CHR$(253,9+(Nr-1)*8)
3530 ; #2 Assline$ : ; #2 "Illegal ADD instruction"
3540 CLOSE : STOP
3550 FNEND
3560 DEF FNAdccomp$ LOCAL Rp$=8,Nr
3570 Rp$="BCDEHLSP"
3580 IF FNLeft$(Argument$,3)<>"HL," THEN RETURN FNEvalucmp$(136)
3590 Nr=INSTR(1,Rp$,RIGHT$(Argument$,4))
3600 IF Nr/2.=INT(Nr/2.) THEN ; #2 Assline$ : ; #2 "Illegal ADC instruction" : CLOSE : STOP
3610 RETURN CHR$(237,74+(Nr-1)*8)
3620 FNEND
3630 DEF FNSbccomp$ LOCAL Rp$=8,Nr
3640 Rp$="BCDEHLSP"
3650 ON ERROR GOTO 3700
3660 IF FNLeft$(Argument$,3)<>"HL," THEN RETURN FNEvalucmp$(152)
3670 Nr=INSTR(1,Rp$,RIGHT$(Argument$,4))
3680 IF Nr/2.=INT(Nr/2.) THEN ; #2 Assline$ : ; #2 "Illegal SBC instruction" : CLOSE : STOP
3690 RETURN CHR$(66+(Nr-1)*8)
3700 RESUME 3710
3710 RETURN FNEvalucmp$(152)
3720 FNEND
3730 DEF FNBitcomp$(Offset) LOCAL Loop,Ln
3740 IF INSTR(1,"01234567",FNLeft$(Argument$,1))=0 THEN 3820 ! Error
3750 Offset=Offset+VAL(FNLeft$(Argument$,1))*8 ! Place bit nr in bit 3-5
3760 Loop=0
3770 WHILE Loop<8
3780 IF FNMid$(Argument$,2,1+LEN(Reg$(Loop)))=","+Reg$(Loop) THEN 3840
3790 Loop=Loop+1
3800 WEND
3810 IF FNMid$(Argument$,2,3)=",(I" THEN 3850
3820 ; #2 Assline$ : ; #2 "Illegal " Opcode$ " instruction"
3830 CLOSE : STOP
3840 RETURN CHR$(203,Loop+Offset)
3850 Ln=LEN(Argument$)
3860 IF FNMid$(Argument$,2,5)=",(IX+" AND RIGHT$(Argument$,Ln)=")" THEN RETURN CHR$(221,203,FNComptal8(FNMid$(Smarg$,7,Ln-7)),Offset+6)
3870 IF FNMid$(Argument$,2,5)=",(IX-" AND RIGHT$(Argument$,Ln)=")" THEN RETURN CHR$(221,203,-FNComptal8(FNMid$(Smarg$,7,Ln-7)),Offset+6)
3880 IF FNMid$(Argument$,2,5)=",(IY+" AND RIGHT$(Argument$,Ln)=")" THEN RETURN CHR$(253,203,FNComptal8(FNMid$(Smarg$,7,Ln-7)),Offset+6)
3890 IF FNMid$(Argument$,2,5)=",(IY-" AND RIGHT$(Argument$,Ln)=")" THEN RETURN CHR$(253,203,-FNComptal8(FNMid$(Smarg$,7,Ln-7)),Offset+6)
3900 GOTO 3820
3910 FNEND
3920 DEF FNCb00comp$(Offset) LOCAL Loop,Ln
3930 Argument$="*,"+Argument$ ! Resten kopierat fr}n Bitcomp
3940 Smarg$="*,"+Smarg$ ! [ven "lilla" argumentet
3950 Loop=0
3960 WHILE Loop<8
3970 IF FNMid$(Argument$,2,1+LEN(Reg$(Loop)))=","+Reg$(Loop) THEN 4030
3980 Loop=Loop+1
3990 WEND
4000 IF FNMid$(Argument$,2,3)=",(I" THEN 4040
4010 ; #2 Assline$ : ; #2 "Illegal " Opcode$ " instruction"
4020 CLOSE : STOP
4030 RETURN CHR$(203,Loop+Offset)
4040 Ln=LEN(Argument$)
4050 IF FNMid$(Argument$,2,5)=",(IX+" AND RIGHT$(Argument$,Ln)=")" THEN RETURN CHR$(221,203,FNComptal8(FNMid$(Smarg$,7,Ln-7)),Offset+6)
4060 IF FNMid$(Argument$,2,5)=",(IX-" AND RIGHT$(Argument$,Ln)=")" THEN RETURN CHR$(221,203,-FNComptal8(FNMid$(Smarg$,7,Ln-7)),Offset+6)
4070 IF FNMid$(Argument$,2,5)=",(IY+" AND RIGHT$(Argument$,Ln)=")" THEN RETURN CHR$(253,203,FNComptal8(FNMid$(Smarg$,7,Ln-7)),Offset+6)
4080 IF FNMid$(Argument$,2,5)=",(IY-" AND RIGHT$(Argument$,Ln)=")" THEN RETURN CHR$(253,203,-FNComptal8(FNMid$(Smarg$,7,Ln-7)),Offset+6)
4090 GOTO 4010
4100 FNEND
4110 DEF FNStackcmp$(Offset)
4120 IF Argument$="IX" THEN RETURN CHR$(221,Offset+32)
4130 IF Argument$="IY" THEN RETURN CHR$(253,Offset+32)
4140 IF Argument$="BC" THEN RETURN CHR$(Offset)
4150 IF Argument$="DE" THEN RETURN CHR$(Offset+16)
4160 IF Argument$="HL" THEN RETURN CHR$(Offset+32)
4170 IF Argument$="AF" THEN RETURN CHR$(Offset+48)
4180 ; #2 Assline$ : ; #2 "Illegal " Opcode$ " instruction"
4190 CLOSE : STOP
4200 FNEND
4210 DEF FNRetcomp$
4220 IF Argument$="" THEN RETURN CHR$(201)
4230 RETURN CHR$(FNFlag(Argument$)*8+192)
4240 FNEND
4250 DEF FNFlag(Str$) LOCAL Loop,Flg$=2
4260 RESTORE 4270
4270 DATA NZ,Z,NC,C,PO,PE,P,M
4280 Loop=0
4290 WHILE Loop<8
4300 READ Flg$ : IF Flg$=Str$ THEN RETURN Loop
4310 Loop=Loop+1
4320 WEND
4330 ; #2 Assline$ : ; #2 "Illegal condition"
4340 CLOSE : STOP
4350 FNEND
4360 DEF FNCallcomp$ LOCAL Complac
4370 IF INSTR(1,Argument$,",")=0 THEN RETURN CHR$(205)+CVT%$(FNComptal16(Argument$))
4380 Complac=INSTR(1,Argument$,",")
4390 RETURN CHR$(196+FNFlag(LEFT$(Argument$,Complac-1)))+CVT%$(FNComptal16(RIGHT$(Argument$,Complac+1)))
4400 FNEND
4410 DEF FNRstcomp$ LOCAL Arg
4420 Arg=FNComptal16(Argument$)
4430 IF Arg AND 65479 THEN ; #2 Assline$ : ; #2 "Illegal RST instruction" : CLOSE : STOP
4440 RETURN CHR$(199+Arg)
4450 FNEND
4460 DEF FNJpcomp$ LOCAL Complac
4470 IF Argument$="(HL)" THEN RETURN CHR$(233)
4480 IF Argument$="(IX)" THEN RETURN CHR$(221,233)
4490 IF Argument$="(IY)" THEN RETURN CHR$(253,233)
4500 Complac=INSTR(1,Argument$,",")
4510 IF Complac=0 THEN RETURN CHR$(195)+CVT%$(FNComptal16(Argument$))
4520 RETURN CHR$(194+8*FNFlag(LEFT$(Argument$,Complac-1)))+CVT%$(FNComptal16(RIGHT$(Argument$,Complac+1)))
4530 FNEND
4540 DEF FNRelative(M}l.) LOCAL Adress.
4550 IF Pass=1 THEN RETURN 0 ! Ej ERROR under pass 1
4560 Adress.=Adress : IF Adress.<0 THEN Adress.=Adress.+65536.
4570 IF M}l.<0 THEN M}l.=M}l.+65536.
4580 IF M}l.>Adress.+129 OR M}l." M}l. : CLOSE : STOP
4590 RETURN (M}l.-Adress.-2) AND 255
4600 FNEND
4610 DEF FNJrcomp$ LOCAL Complac,Cond
4620 Complac=INSTR(1,Argument$,",")
4630 IF Complac=0 THEN RETURN CHR$(24,FNRelative(FNComptal16(Argument$)))
4640 Cond=FNFlag(LEFT$(Argument$,Complac-1))
4650 IF Cond>3 THEN ; #2 "Illegal JR instruction" : CLOSE : STOP
4660 RETURN CHR$(32+Cond*8,FNRelative(FNComptal16(RIGHT$(Argument$,Complac+1))))
4670 FNEND
4680 DEF FNDjnzcomp$=CHR$(16,FNRelative(FNComptal16(Argument$)))
4690 DEF FNExcomp$
4700 IF Argument$="AF,AF'" THEN RETURN CHR$(8)
4710 IF Argument$="DE,HL" THEN RETURN CHR$(235)
4720 IF Argument$="(SP),HL" THEN RETURN CHR$(227)
4730 IF Argument$="(SP),IX" THEN RETURN CHR$(221,227)
4740 IF Argument$="(SP),IY" THEN RETURN CHR$(253,227)
4750 ; #2 Assline$ : ; #2 "Illegal EX instruction"
4760 CLOSE : STOP
4770 FNEND
4780 DEF FNIncdeccmp$(Offset)
4790 IF Argument$="BC" THEN RETURN CHR$(3+8*(Offset-4))
4800 IF Argument$="DE" THEN RETURN CHR$(19+8*(Offset-4))
4810 IF Argument$="HL" THEN RETURN CHR$(35+8*(Offset-4))
4820 IF Argument$="SP" THEN RETURN CHR$(51+8*(Offset-4))
4830 IF Argument$="IX" THEN RETURN CHR$(221,35+8*(Offset-4))
4840 IF Argument$="IY" THEN RETURN CHR$(253,35+8*(Offset-4))
4850 Loop=0
4860 WHILE Loop<8
4870 IF Argument$=Reg$(Loop) THEN RETURN CHR$(Offset+8*Loop)
4880 Loop=Loop+1
4890 WEND
4900 IF LEN(Argument$)<5 THEN 4990
4910 IF RIGHT$(Argument$,LEN(Argument$))<>")" THEN 4990 ! Error
4920 Opstr$=FNLeft$(Argument$,4)
4930 Nrstr$=RIGHT$(Argument$,5)
4940 Nrstr$=LEFT$(Nrstr$,LEN(Nrstr$)-1)
4950 IF Opstr$="(IX+" THEN RETURN CHR$(221,48+Offset,FNComptal8(Nrstr$))
4960 IF Opstr$="(IX-" THEN RETURN CHR$(221,48+Offset,-FNComptal8(Nrstr$))
4970 IF Opstr$="(IY+" THEN RETURN CHR$(253,48+Offset,FNComptal8(Nrstr$))
4980 IF Opstr$="(IY-" THEN RETURN CHR$(253,48+Offset,-FNComptal8(Nrstr$))
4990 ; #2 Assline$ : ; #2 "Illegal " Opcode$ " instruction"
5000 CLOSE : STOP
5010 FNEND
5020 DEF FNIncomp$ LOCAL Loop
5030 Loop=0
5040 WHILE Loop<8
5050 IF Loop=6 THEN 5070 ! Ej IN (HL),C
5060 IF Argument$=Reg$(Loop)+",(C)" THEN RETURN CHR$(237,64+8*Loop)
5070 Loop=Loop+1
5080 WEND
5090 IF FNLeft$(Argument$,3)<>"A,(" THEN 5120
5100 IF RIGHT$(Argument$,LEN(Argument$))<>")" THEN 5120
5110 RETURN CHR$(219,FNComptal8(FNMid$(Smarg$,4,LEN(Smarg$)-4)))
5120 ; #2 Assline$ : ; #2 "Illegal IN insruction"
5130 CLOSE : STOP
5140 FNEND
5150 DEF FNOutcomp$ LOCAL Loop
5160 Loop=0
5170 WHILE Loop<8
5180 IF Loop=6 THEN 5200
5190 IF Argument$="(C),"+Reg$(Loop) THEN RETURN CHR$(237,65+8*Loop)
5200 Loop=Loop+1
5210 WEND
5220 IF FNLeft$(Argument$,1)<>"(" OR FNRight$(Argument$,3)<>"),A" THEN ; #2 Assline$ : ; #2 "Illegal OUT instruction" : CLOSE : STOP
5230 RETURN CHR$(211,FNComptal8(FNMid$(Smarg$,2,LEN(Smarg$)-4)))
5240 FNEND
5250 DEF FNLdcomp$ LOCAL Loop,Loop2
5260 Loop=0
5270 Loop=0 : Loop2=0
5280 WHILE Loop<8
5290 Loop2=0
5300 WHILE Loop2<8
5310 IF Loop=6 AND Loop2=6 THEN 5330
5320 IF Argument$=Reg$(Loop)+","+Reg$(Loop2) THEN RETURN CHR$(64+Loop*8+Loop2)
5330 Loop2=Loop2+1
5340 WEND
5350 Loop=Loop+1
5360 WEND
5370 ! LD A,I A,R I,A R,A ?
5380 IF Argument$="A,I" THEN RETURN CHR$(237,87)
5390 IF Argument$="A,R" THEN RETURN CHR$(237,95)
5400 IF Argument$="R,A" THEN RETURN CHR$(237,79)
5410 IF Argument$="I,A" THEN RETURN CHR$(237,71)
5420 ! LD A,(rp) ?
5430 IF Argument$="A,(BC)" THEN RETURN CHR$(10)
5440 IF Argument$="A,(DE)" THEN RETURN CHR$(26)
5450 ! LD (rp),A ?
5460 IF Argument$="(BC),A" THEN RETURN CHR$(2)
5470 IF Argument$="(DE),A" THEN RETURN CHR$(18)
5480 ! LD SP, ?
5490 IF Argument$="SP,HL" THEN RETURN CHR$(249)
5500 IF Argument$="SP,IX" THEN RETURN CHR$(221,249)
5510 IF Argument$="SP,IY" THEN RETURN CHR$(253,249)
5520 ! LD reg,(+-disp) ?
5530 IF RIGHT$(Argument$,LEN(Argument$))<>")" THEN 5630
5540 Loop=0
5550 WHILE Loop<8
5560 IF Loop=6 THEN 5610
5570 IF FNLeft$(Argument$,6)=Reg$(Loop)+",(IX+" THEN RETURN CHR$(221,70+8*Loop,FNComptal8(FNMid$(Smarg$,7,LEN(Smarg$)-7)))
5580 IF FNLeft$(Argument$,6)=Reg$(Loop)+",(IX-" THEN RETURN CHR$(221,70+8*Loop,-FNComptal8(FNMid$(Smarg$,7,LEN(Smarg$)-7)))
5590 IF FNLeft$(Argument$,6)=Reg$(Loop)+",(IY+" THEN RETURN CHR$(253,70+8*Loop,FNComptal8(FNMid$(Smarg$,7,LEN(Smarg$)-7)))
5600 IF FNLeft$(Argument$,6)=Reg$(Loop)+",(IY-" THEN RETURN CHR$(253,70+8*Loop,-FNComptal8(FNMid$(Smarg$,7,LEN(Smarg$)-7)))
5610 Loop=Loop+1
5620 WEND
5630 ! LD (+-disp),reg ?
5640 IF FNLeft$(Argument$,2)<>"(I" THEN 5750
5650 Loop=0
5660 WHILE Loop<8
5670 IF Loop=6 THEN 5730
5680 IF FNRight$(Argument$,3)<>"),"+Reg$(Loop) THEN 5730
5690 IF FNLeft$(Argument$,4)="(IX+" THEN RETURN CHR$(221,112+Loop,FNComptal8(FNMid$(Smarg$,5,LEN(Smarg$)-7)))
5700 IF FNLeft$(Argument$,4)="(IX-" THEN RETURN CHR$(221,112+Loop,-FNComptal8(FNMid$(Smarg$,5,LEN(Smarg$)-7)))
5710 IF FNLeft$(Argument$,4)="(IY+" THEN RETURN CHR$(253,112+Loop,FNComptal8(FNMid$(Smarg$,5,LEN(Smarg$)-7)))
5720 IF FNLeft$(Argument$,4)="(IY-" THEN RETURN CHR$(253,112+Loop,-FNComptal8(FNMid$(Smarg$,5,LEN(Smarg$)-7)))
5730 Loop=Loop+1
5740 WEND
5750 ! LD A,(adr) ?
5760 IF FNLeft$(Argument$,3)<>"A,(" OR FNRight$(Argument$,1)<>")" THEN 5780
5770 RETURN CHR$(58)+CVT%$(FNComptal16(FNMid$(Argument$,4,LEN(Argument$)-4)))
5780 ! LD reg,data ?
5790 Loop=0
5800 WHILE Loop<8
5810 IF FNLeft$(Argument$,1+LEN(Reg$(Loop)))=Reg$(Loop)+"," THEN RETURN CHR$(6+8*Loop,FNComptal8(RIGHT$(Smarg$,3)))
5820 Loop=Loop+1
5830 WEND
5840 ! LD (+disp),data
5850 Loop2=INSTR(1,Argument$,"),")
5860 IF Loop2=0 THEN 5910
5870 IF FNLeft$(Argument$,4)="(IX+" THEN RETURN CHR$(221,54,FNComptal8(FNMid$(Smarg$,5,Loop2-5)),FNComptal8(RIGHT$(Smarg$,Loop2+2)))
5880 IF FNLeft$(Argument$,4)="(IX-" THEN RETURN CHR$(221,54,-FNComptal8(FNMid$(Smarg$,5,Loop2-5)),FNComptal8(RIGHT$(Smarg$,Loop2+2)))
5890 IF FNLeft$(Argument$,4)="(IY+" THEN RETURN CHR$(253,54,FNComptal8(FNMid$(Smarg$,5,Loop2-5)),FNComptal8(RIGHT$(Smarg$,Loop2+2)))
5900 IF FNLeft$(Argument$,4)="(IY-" THEN RETURN CHR$(253,54,-FNComptal8(FNMid$(Smarg$,5,Loop2-5)),FNComptal8(RIGHT$(Smarg$,Loop2+2)))
5910 ! LD (adr),A ?
5920 IF FNLeft$(Argument$,1)<>"(" OR FNRight$(Argument$,3)<>"),A" THEN 5940
5930 RETURN CHR$(50)+CVT%$(FNComptal16(FNMid$(Argument$,2,LEN(Argument$)-4)))
5940 ! LD (adr),
5950 IF FNLeft$(Argument$,1)<>"(" THEN 6020
5960 IF FNRight$(Argument$,4)="),HL" THEN RETURN CHR$(34)+CVT%$(FNComptal16(FNMid$(Argument$,2,LEN(Argument$)-5)))
5970 IF FNRight$(Argument$,4)="),BC" THEN RETURN CHR$(237,67)+CVT%$(FNComptal16(FNMid$(Argument$,2,LEN(Argument$)-5)))
5980 IF FNRight$(Argument$,4)="),DE" THEN RETURN CHR$(237,83)+CVT%$(FNComptal16(FNMid$(Argument$,2,LEN(Argument$)-5)))
5990 IF FNRight$(Argument$,4)="),SP" THEN RETURN CHR$(237,115)+CVT%$(FNComptal16(FNMid$(Argument$,2,LEN(Argument$)-5)))
6000 IF FNRight$(Argument$,4)="),IX" THEN RETURN CHR$(221,34)+CVT%$(FNComptal16(FNMid$(Argument$,2,LEN(Argument$)-5)))
6010 IF FNRight$(Argument$,4)="),IY" THEN RETURN CHR$(253,34)+CVT%$(FNComptal16(FNMid$(Argument$,2,LEN(Argument$)-5)))
6020 ! LD ,(adr) ?
6030 IF FNRight$(Argument$,1)<>")" THEN 6100
6040 IF FNLeft$(Argument$,4)="HL,(" THEN RETURN CHR$(42)+CVT%$(FNComptal16(FNMid$(Argument$,5,LEN(Argument$)-5)))
6050 IF FNLeft$(Argument$,4)="BC,(" THEN RETURN CHR$(237,75)+CVT%$(FNComptal16(FNMid$(Argument$,5,LEN(Argument$)-5)))
6060 IF FNLeft$(Argument$,4)="DE,(" THEN RETURN CHR$(237,91)+CVT%$(FNComptal16(FNMid$(Argument$,5,LEN(Argument$)-5)))
6070 IF FNLeft$(Argument$,4)="SP,(" THEN RETURN CHR$(237,123)+CVT%$(FNComptal16(FNMid$(Argument$,5,LEN(Argument$)-5)))
6080 IF FNLeft$(Argument$,4)="IX,(" THEN RETURN CHR$(221,42)+CVT%$(FNComptal16(FNMid$(Argument$,5,LEN(Argument$)-5)))
6090 IF FNLeft$(Agrument$,4)="IY,(" THEN RETURN CHR$(253,42)+CVT%$(FNComptal16(FNMid$(Argument$,5,LEN(Argument$)-5)))
6100 ! Sista chansen: LD