10 '****************************************
20 '******** JOYCE Z 80 - ASSEMBLER ********
30 '******* (c) 1986 Matthias Uphoff *******
40 '****************************************
50 '
60 '***** Initialisierung
70 '
80 DEFINT a-z
90 cs$=CHR$(27)+"E"+CHR$(27)+"H"
100 t0$=" LD   JR   DJNZ CALL RET  JP   INC  DEC  POP  PUSH RST  IN   OUT  IM   EX   ADD  ADC  SUB  SBC  AND  XOR  OR   CP   RLC  RRC  RL   RR   SLA  SRA  **** SRL  BIT  RES  SET "
110 t1$=" CCF  CPL  DAA  DI   EI   EXX  HALT NOP  RLA  RLCA RRA  RRCA SCF "
120 DATA 3F,2F,27,F3,FB,D9,76,00,17,07,1F,0F,37
130 t2$=" CPD  CPDR CPI  CPIR IND  INDR INI  INIR LDD  LDDR LDI  LDIR NEG  OTDR OTIR OUTD OUTI RETI RETN RLD  RRD "
140 DATA A9,B9,A1,B1,AA,BA,A2,B2,A8,B8,A0,B0,44,BB,B3,AB,A3,4D,45,6F,67
150 t3$=" EQU ORG DB  DW  DM  DS  END "
160 DIM lt$(200),wlt(200),ult$(80),uld(80,1),c1(12),c2(20),p(80)
170 FOR i=0 TO 12:READ a$:c1(i)=VAL("&H"+a$):NEXT
180 FOR i=0 TO 20:READ a$:c2(i)=VAL("&H"+a$):NEXT
190 rg$="B  C  D  E  H  L  (HL)A  (IX(IY"
200 dr$="BC DE HL SP IX IY "
210 co$="NZ Z  NC C  PO PE P  M  "
220 '
230 '***** Programmstart
240 '
250 PRINT cs$
260 PRINT STRING$(48,"-")
270 PRINT "-";SPC(5);"J O Y C E   Z 80 - A S S E M B L E R";SPC(5);"-"
280 PRINT STRING$(48,"-")
290 PRINT
300 INPUT"Filename: ",na$
310 IF na$="" THEN PRINT:FILES:PRINT:PRINT:GOTO 300
320 IF FIND$(na$)="" THEN PRINT"File nicht vorhanden!":na$="":GOTO 310
330 INPUT"Drucker (J/N): ",a$
340 dr=(UPPER$(a$)="J"):PRINT
350 zps=&HF000:zpc=zps:MEMORY zps-1
360 OPEN "i",1,na$
370 '
380 '***** Zeile lesen u. zerlegen
390 '
400 LINE INPUT #1,z$:n=VAL(z$):IF n=0 THEN 2080
410 i=INSTR(z$,";"):IF i THEN km$=MID$(z$,i):z$=LEFT$(z$,i-1) ELSE km$=""
420 k=INSTR(z$,"'"):IF k=0 THEN k=INSTR(z$," "):IF k=0 THEN k=LEN(z$)
430 ul$=" ":la$="":opd$="":lb=0:ds=0:irf=0:df=0:k=k+1
440 WHILE MID$(z$,k,1)=" ":k=k+1:WEND
450 j=INSTR(k,z$," "):IF j THEN a$=UPPER$(MID$(z$,k,j-k)) ELSE a$=UPPER$(MID$(z$,k))
460 k=k+LEN(a$)+1
470 '
480 '***** Test auf gueltigen Befehl
490 '
500 bf$=" "+a$+" ":IF a$="" THEN 2210
510 i=INSTR(t0$,bf$):IF i THEN 980
520 i=INSTR(t1$,bf$):IF i THEN 720
530 i=INSTR(t2$,bf$):IF i THEN 730
540 i=INSTR(t3$,bf$):IF i THEN 770
550 '
560 '***** Verarbeitung als Label
570 '
580 GOSUB 2610:IF i OR la$<>"" THEN 2100
590 la$=a$:IF du THEN 440
600 GOSUB 3250:IF i THEN 2090
610 lt$(ltp)=a$:wlt(ltp)=zpc:ltp=ltp+1
620 FOR i=0 TO flp-1
630 IF la$<>ult$(i) THEN 670 ELSE w=uld(i,0)
640 IF uld(i,1)<0 THEN sa=w-1:za=zpc:GOSUB 2660:POKE w,of ELSE POKE w,zpc AND 255:POKE w+1,INT(zpc/256)AND 255
650 FOR j=i TO flp-1:ult$(j)=ult$(j+1):uld(j,0)=uld(j+1,0):uld(j,1)=uld(j+1,1):NEXT
660 flp=flp-1:i=i-1
670 NEXT i
680 GOTO 440
690 '
700 '***** Befehle ohne Operand
710 '
720 lb=1:p(1)=c1(INT(i/5)):GOTO 2210
730 lb=2:p(1)=&HED:p(2)=c2(INT(i/5)):GOTO 2210
740 '
750 '***** Pseudobefehle
760 '
770 IF i<25 THEN GOSUB 3090
780 ON INT(i/4) GOTO 830,850,870,890,930,2290
790 REM EQU
800 IF la$="" THEN 2100 ELSE IF du THEN 2210
810 GOSUB 2750:wlt(ltp-1)=w:lb=0:GOTO 2210
820 REM ORG
830 GOSUB 2710:zpc=w:zps=w:MEMORY zps-1:lb=0:GOTO 2210
840 REM DB
850 GOSUB 2870:IF ko THEN GOSUB 3170:GOTO 850 ELSE 2210
860 REM DW
870 GOSUB 2710:IF ko THEN GOSUB 3170:GOTO 870 ELSE 2210
880 REM DM
890 lb=LEN(a$)-1:IF ASC(a$)<>34 THEN 2130
900 FOR j=1 TO lb:p(j)=ASC(MID$(a$,j+1)):NEXT
910 GOTO 2210
920 REM DS
930 GOSUB 2710:ds=w:lb=0:GOTO 2210
940 '
950 '***** Befehle mit Operand:
960 '***** Op. zerlegen u. Verzweigung
970 '
980 lb=1:bp=INT(i/5)+1:GOSUB 3090:op$=UPPER$(opd$)
990 IF ko THEN o1$=a$:GOSUB 3170:o2$=a$:ko=-1
1000 ka=INSTR(op$,"("):IF ka THEN kz=INSTR(ka+2,op$,")"):IF kz THEN ki$=MID$(op$,ka+1,kz-ka-1) ELSE 2100
1010 ON bp GOTO 1060,1260,1290,1350,1360,1380,1450,1450,1520,1520,1580,1630,1630,1710,1770
1020 IF bp<24 THEN 1830 ELSE IF bp<32 THEN 1960 ELSE 2010
1030 '
1040 '***** Ladebefehle LD
1050 '
1060 IF ko=0 THEN 2100
1070 a$=o1$:GOSUB 2920:IF rf THEN 1160 ELSE GOSUB 3000:IF rf THEN 1110
1080 p=0:IF ka THEN 1100
1090 IF o2$="A" AND INSTR("IR",a$) THEN 1180 ELSE 2130
1100 IF o2$="A" THEN 1200 ELSE a$=o2$:GOSUB 3000:IF rf THEN 1140 ELSE 2130
1110 IF ka THEN p=8:GOTO 1140
1120 a$=o2$:IF rg=3 THEN GOSUB 3000:IF rg=2 THEN p(1)=&HF9:GOTO 2190
1130 p(1)=1 OR(rg*16):GOSUB 2710:GOTO 2190
1140 IF rg=2 THEN p(1)=p OR &H22 ELSE p(1)=&HED:p(2)=&H43 OR(rg*16)OR p:lb=2
1150 a$=ki$:GOSUB 2710:GOTO 2190
1160 p(1)=rg*8:a$=o2$:GOSUB 2920:IF rf THEN p(1)=p(1)OR 64 OR rg:GOTO 2190
1170 p=8:IF o1$<>"A" THEN 1220 ELSE IF ka THEN 1200
1180 IF a$="I" THEN p(2)=&H47 ELSE IF a$="R" THEN p(2)=&H4F ELSE 1220
1190 lb=2:p(1)=&HED:p(2)=p(2)OR(p*2):GOTO 2210
1200 a$=ki$:IF a$="BC" THEN p(1)=2 ELSE IF a$="DE" THEN p(1)=&H12 ELSE p(1)=&H32:GOSUB 2710
1210 p(1)=p(1)OR p:GOTO 2210
1220 p(1)=p(1)OR 6:a$=o2$:GOSUB 2870:GOTO 2190
1230 '
1240 '***** Relative Spruenge JR/DJNZ
1250 '
1260 IF ko=0 THEN p(1)=&H18:a$=op$:GOTO 1300
1270 a$=o1$:GOSUB 3050:IF rf=0 OR rg>3 THEN 2130
1280 p(1)=(rg OR 4)*8:a$=o2$:GOTO 1300
1290 p(1)=&H10:a$=op$
1300 GOSUB 2710:IF w=0 THEN w=zpc+2
1310 lb=2:sa=zpc:za=w:GOSUB 2660:p(2)=of:GOTO 2210
1320 '
1330 '***** Spruenge CALL/RET/JP
1340 '
1350 IF ko THEN p=&HC4:GOTO 1410 ELSE p(1)=&HCD:GOTO 1400
1360 IF op$="" THEN p(1)=&HC9:GOTO 2210
1370 a$=op$:GOSUB 3050:IF rf THEN p(1)=&HC0 OR(rg*8):GOTO 2210 ELSE 2130
1380 IF ka THEN a$=ki$:GOSUB 3000:IF rg=2 THEN p(1)=&HE9:GOTO 2190
1390 IF ko THEN p=&HC2:GOTO 1410 ELSE p(1)=&HC3
1400 a$=op$:GOSUB 2710:GOTO 2210
1410 a$=o1$:GOSUB 3050:IF rf THEN p(1)=p OR(rg*8):a$=o2$:GOSUB 2710:GOTO 2210 ELSE 2130
1420 '
1430 '***** Zaehlbefehle INC/DEC
1440 '
1450 p=bp-7:a$=op$:GOSUB 2920:IF rf THEN 1480
1460 GOSUB 3000:IF rf=0 THEN 2130
1470 p(1)=(p*8)OR(rg*16)OR 3:GOTO 2190
1480 p(1)=p OR(rg*8)OR 4:GOTO 2190
1490 '
1500 '***** Stackbefehle POP/PUSH
1510 '
1520 a$=op$:IF a$="AF" THEN a$="SP"
1530 GOSUB 3000:IF rf=0 THEN 2130
1540 p(1)=((bp-9)*4)OR(rg*16)OR &HC1:GOTO 2190
1550 '
1560 '***** Restartbefehle RST
1570 '
1580 a$=op$:GOSUB 2870:IF w AND &HFFC7 THEN 2130
1590 lb=1:p(1)=&HC7 OR w:GOTO 2210
1600 '
1610 '***** Ein/Ausgabebefehle IN/OUT
1620 '
1630 IF ko*ka=0 THEN 2100
1640 IF bp=12 THEN p=0:a$=o1$ ELSE p=1:a$=o2$
1650 GOSUB 2920:IF rf=0 OR irf THEN 2130
1660 IF ki$="C" THEN lb=2:p(1)=&HED:p(2)=64 OR(rg*8)OR p:GOTO 2190
1670 IF rg=7 THEN a$=ki$:GOSUB 2870:p(1)=&HDB XOR(p*8):GOTO 2190 ELSE 2130
1680 '
1690 '***** Interruptmodi IM
1700 '
1710 lb=2:p(1)=&HED:IF op$="0" THEN p(2)=&H46:GOTO 2210
1720 IF op$="1" THEN p(2)=&H56:GOTO 2210
1730 IF op$="2" THEN p(2)=&H5E:GOTO 2210 ELSE 2130
1740 '
1750 '***** Austauschbefehle EX
1760 '
1770 IF o1$="(SP)" THEN a$=o2$:GOSUB 3000:IF rg=2 THEN p(1)=&HE3:GOTO 2190
1780 IF op$="DE,HL" THEN p(1)=&HEB:GOTO 2210
1790 IF op$="AF,AF'" THEN p(1)=8:GOTO 2210 ELSE 2130
1800 '
1810 '***** Arithmetisch-logische Befehle
1820 '
1830 IF bp=18 OR bp>19 THEN a$=op$:GOTO 1850
1840 IF ko=0 THEN 2100 ELSE IF o1$<>"A" THEN 1870 ELSE a$=o2$
1850 p=(bp-16)*8:GOSUB 2920:IF rf THEN p(1)=128 OR p OR rg:GOTO 2190
1860 p(1)=p OR &HC6:GOSUB 2870:GOTO 2210
1870 a$=o1$:GOSUB 3000:IF rg<>2 THEN 2130
1880 a$=o2$:GOSUB 3000:IF rf=0 THEN 2130
1890 IF bp=16 THEN IF rg=2 AND o1$<>o2$ THEN 2130 ELSE p=9:GOTO 1920
1900 p(1)=&HED:lb=2:IF irf THEN 2130
1910 IF bp=17 THEN p=&H4A ELSE p=&H42
1920 p(lb)=p OR(rg*16):GOTO 2190
1930 '
1940 '***** Rotations/Schiebebefehle
1950 '
1960 lb=2:p(1)=&HCB:a$=op$:GOSUB 2920:IF rf=0 THEN 2130
1970 p(2)=((bp-24)*8)OR rg:GOTO 2190
1980 '
1990 '***** Bitbefehle BIT/SET/RES
2000 '
2010 IF ko=0 THEN 2100
2020 lb=2:p(1)=&HCB:a$=o2$:p=ASC(op$)-48:GOSUB 2920
2030 IF p<0 OR p>7 OR LEN(o1$)<>1 OR rf=0 THEN 2130
2040 p(2)=(64*(bp-31))OR(p*8)OR rg:GOTO 2190
2050 '
2060 '***** Fehlermeldungen
2070 '
2080 f$="Zeilennummer fehlt":GOTO 2140
2090 f$="Label bereits definiert":GOTO 2140
2100 f$="Syntax-Fehler":GOTO 2140
2110 f$="Offset zu gross":GOTO 2140
2120 f$="Operand fehlt":GOTO 2140
2130 f$="Ungueltiges Argument"
2140 f$=f$+" in "+z$+CHR$(7):fz=fz+1
2150 IF dr THEN LPRINT f$:GOTO 2250 ELSE PRINT f$:GOTO 2250
2160 '
2170 '***** M-Code poken u. Ausgabe
2180 '
2190 IF irf THEN lb=lb+1:FOR i=lb TO 1 STEP -1:p(i)=p(i-1):NEXT
2200 IF df THEN p(4)=p(3):p(3)=dis:lb=lb+1
2210 cd$=HEX$(zpc,4)+ul$
2220 FOR i=1 TO lb:cd$=cd$+HEX$(p(i),2)+" ":POKE zpc+i-1,p(i):NEXT
2230 IF dr THEN LPRINT cd$;TAB(18);DEC$(n,"#####");TAB(24);la$;TAB(30);bf$;TAB(36);opd$;TAB(50);km$ ELSE PRINT cd$;TAB(18);DEC$(n,"#####");TAB(24);la$;TAB(30);bf$;TAB(36);opd$;TAB(50);km$
2240 zpc=zpc+lb+ds
2250 IF NOT EOF(1) THEN 400
2260 '
2270 '***** Programmende
2280 '
2290 IF dr THEN LPRINT ELSE PRINT
2300 FOR i=0 TO flp-1
2310 f$="Undefiniertes Label "+ult$(i)+" in"+STR$(ABS(uld(i,1)))+CHR$(7):fz=fz+1
2320 IF dr THEN LPRINT f$ ELSE PRINT f$
2330 NEXT
2340 a$="Programm: "+na$+"   Start: &H"+HEX$(zps,4)+"   Ende: &H"+HEX$(zpc-1,4)+"   Laenge: &H"+HEX$(zpc-zps,4)+"   Fehler:"+STR$(fz)
2350 IF dr THEN LPRINT a$ ELSE PRINT a$
2360 PRINT:PRINT"Labeltabelle:"
2370 FOR i=0 TO ltp-1:PRINT HEX$(wlt(i),4);"=";lt$(i),:NEXT
2380 CLOSE 1
2390 WHILE INKEY$<>"":WEND
2400 PRINT:PRINT
2410 INPUT"2. Durchlauf (J/N): ",a$:IF UPPER$(a$)="J" THEN du=-1:fz=0:GOTO 330
2420 '
2430 '***** Aufzeichnung
2440 '
2450 INPUT"Speichern als Datazeilen (J/N): ",a$:IF UPPER$(a$)<>"J" THEN END
2460 INPUT"Erste Zeile :",n!:IF n!=0 THEN n!=10
2470 INPUT"Zeilenabstand :",za:IF za=0 THEN za=10
2480 i=INSTR(na$,"."):IF i THEN na$=LEFT$(na$,i-1)
2490 OPEN "o",2,na$+".bld"
2500 z$=MID$(STR$(n!),2)+" MEMORY &H"+HEX$(zps-1,4):PRINT #2,z$:PRINT z$:n!=n!+za
2510 z$=MID$(STR$(n!),2)+" FOR adr=&H"+HEX$(zps,4)+" TO &H"+HEX$(zpc-1,4)+":READ a$:POKE adr,VAL("+CHR$(34)+"&H"+CHR$(34)+"+a$):NEXT"
2520 sa=zps:PRINT #2,z$:PRINT z$;
2530 n!=n!+za:z$=MID$(STR$(n!),2)+" DATA "
2540 FOR i=1 TO 8:IF sa=zpc THEN 2560
2550 z$=z$+HEX$(PEEK(sa),2)+",":sa=sa+1:NEXT
2560 z$=LEFT$(z$,LEN(z$)-1):PRINT #2,z$:PRINT:PRINT z$;:IF sa<>zpc THEN 2530
2570 PRINT:CLOSE 2:END
2580 '
2590 '***** SUB Labeltest
2600 '
2610 i=ASC(a$):i=i<65 OR i>90:IF i THEN RETURN
2620 a$=LEFT$(a$,6):RETURN
2630 '
2640 '***** SUB Offset berechnen
2650 '
2660 of=za-sa-2:IF of>129 OR of<-126 THEN 2110
2670 IF of>=0 THEN RETURN ELSE of=of+256:RETURN
2680 '
2690 '***** SUB 2-Byte-Wert holen
2700 '
2710 GOSUB 2610:IF i THEN 2750
2720 GOSUB 3250:IF i THEN w=wlt(j):GOTO 2830
2730 GOSUB 2920:IF rf THEN 2130 ELSE GOSUB 3000:IF rf THEN 2130
2740 ult$(flp)=a$:uld(flp,0)=zpc+lb-irf:uld(flp,1)=n*((bp=2 OR bp=3)*2+1):flp=flp+1:w=0:ul$="*":GOTO 2830
2750 i=INSTR("%#&+-0123456789",LEFT$(a$,1)):IF i=0 THEN 2130
2760 IF i>2 THEN w=UNT(VAL(a$)):GOTO 2830
2770 IF i=2 THEN w=VAL("&H"+MID$(a$,2)):GOTO 2830
2780 IF LEN(a$)>17 THEN 2130 ELSE w=0
2790 FOR i=2 TO LEN(a$)
2800 j=ASC(MID$(a$,i)):IF j<48 OR j>49 THEN 2130
2810 w=UNT(w*2+j-48)
2820 NEXT i
2830 lb=lb+2:p(lb)=INT(w/256)AND &HFF:p(lb-1)=w AND &HFF:RETURN
2840 '
2850 '***** SUB 1-Byte-Wert holen
2860 '
2870 IF ASC(a$)=34 THEN lb=lb+1:p(lb)=ASC(MID$(a$,2)):RETURN
2880 GOSUB 2750:IF p(lb)MOD 255 THEN 2130 ELSE lb=lb-1:RETURN
2890 '
2900 '***** SUB Test auf Register
2910 '
2920 rf=INSTR(rg$,LEFT$(a$+"  ",3)):rg=INT(rf/3):IF rg<8 THEN RETURN
2930 IF INSTR("+-",MID$(ki$,3,1))=0 OR INSTR(op$,"(HL)") OR irf THEN 2130
2940 dis=VAL(MID$(ki$,3)):IF dis>127 OR dis<-128 THEN 2110
2950 IF dis<0 THEN dis=dis+256
2960 p(0)=&HDD OR(rg-8)*32:irf=-1:df=-1:rg=6:RETURN
2970 '
2980 '***** SUB Test auf Registerpaar
2990 '
3000 rf=INSTR(dr$,LEFT$(a$+"  ",3)):rg=INT(rf/3):IF rg<4 THEN RETURN
3010 p(0)=&HDD OR(rg-4)*32:irf=-1:rg=2:RETURN
3020 '
3030 '***** SUB Test auf Bedingung
3040 '
3050 rf=INSTR(co$,LEFT$(a$+"  ",3)):rg=INT(rf/3):RETURN
3060 '
3070 '***** SUB Operand holen/zerlegen
3080 '
3090 WHILE MID$(z$,k,1)=" ":k=k+1:WEND
3100 j=LEN(z$)
3110 WHILE MID$(z$,j,1)=" ":j=j-1:WEND
3120 IF j<k THEN IF a$="RET" THEN ko=0:RETURN ELSE 2120
3130 opd$=MID$(z$,k,j-k+1):k=1
3140 '
3150 '***** SUB Operand zerlegen
3160 '
3170 IF MID$(opd$,k,1)=CHR$(34) THEN 3200
3180 ko=INSTR(k,opd$,","):IF ko THEN a$=UPPER$(MID$(opd$,k,ko-k)):k=ko+1 ELSE a$=UPPER$(MID$(opd$,k))
3190 IF a$="" THEN 2120 ELSE RETURN
3200 j=INSTR(k+2,opd$,CHR$(34)):IF j=0 THEN 2130
3210 a$=MID$(opd$,k,j-k):ko=INSTR(j,opd$,","):k=ko+1:RETURN
3220 '
3230 '***** SUB Label suchen
3240 '
3250 i=0:j=0
3260 WHILE j<ltp AND NOT i
3270 IF a$=lt$(j) THEN i=-1 ELSE j=j+1
3280 WEND
3290 RETURN