From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 11 Feb 2019 11:49:19 +0100 Subject: Add source files from Michael --- system/eumel0-z80/src/DISEUMEL.ELA | 607 +++++++++++++++++++++++++++++++++++++ 1 file changed, 607 insertions(+) create mode 100644 system/eumel0-z80/src/DISEUMEL.ELA (limited to 'system/eumel0-z80/src/DISEUMEL.ELA') diff --git a/system/eumel0-z80/src/DISEUMEL.ELA b/system/eumel0-z80/src/DISEUMEL.ELA new file mode 100644 index 0000000..b1039dc --- /dev/null +++ b/system/eumel0-z80/src/DISEUMEL.ELA @@ -0,0 +1,607 @@ +PROC arith 16 : + + EXTERNAL 92 + +ENDPROC arith 16 ; + +BOOL OP ULSEQ (INT CONST left, right) : + + (left MINUS right) <= 0 + +ENDOP ULSEQ ; + +LET max words minus 1 = 32767 ; (* = max : 64K *) + +TEXT VAR source name , instr, parameter , t ; +INT VAR addr , start addr, end addr , file nr , laenge, i , offset ; +FILE VAR source file ; + +BOUND STRUCT (ALIGN align, ROW max words minus 1 INT word) VAR space ; + +TEXT VAR a, b, c; +BOOL VAR screen mode := yes ("Bildschirmausgabe zusaetzlich") ; +put ("Startaddr:") ; +getline (a) ; +put ("Endaddr :") ; +getline (b) ; +put ("Offset :") ; +getline (c) ; +resource ("eumel0", "eumel0.prt", a, b, c) ; +edit ("eumel0.prt") ; + + +PROC resource (TEXT CONST code space name, source file name, + TEXT CONST from, to, offs) : + + space := old (code space name) ; + start addr := integer (from) ; + end addr := integer (to) ; + offset := integer (offs) ; + source name := source file name ; + file nr := 1 ; + forget (source name, quiet) ; + source file := sequential file (output, source name) ; + + source putline ("ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT") ; + put tabs (source file, 40 * ""2"" + "^") ; + addr := start addr ; + line ; + WHILE addr ULSEQ end addr REP + IF online THEN out (hex16 (addr)) ; + out (""13"") ; + FI ; + source put (hex16 (addr)) ; + disass ; + FOR i FROM 1 UPTO laenge REP + source put (hex8 (zugriff (addr PLUS (i-1)))) + PER ; + FOR i FROM laenge UPTO 3 REP + source put (" ") + PER ; + t := "" ; + FOR i FROM 1 UPTO laenge REP + t CAT ascii (zugriff (addr PLUS (i-1))) + PER ; + source put (t, 5) ; + source put (instr, 5) ; + source put (parameter, 10) ; + source line ; + addr := addr PLUS laenge ; + PER ; +ENDPROC resource ; + +INT OP PLUS (INT CONST left, right) : + arith16 ; + left + right +ENDOP PLUS ; + +INT OP MINUS (INT CONST left, right) : + arith16 ; + left - right +ENDOP MINUS ; + +PROC source line : + check file overflow ; + line (source file) ; + IF screen mode AND online THEN line FI +ENDPROC source line ; + +PROC source put (TEXT CONST text) : + put (source file, text) ; + IF screen mode AND online THEN put (text) FI +ENDPROC source put ; + +PROC source out (TEXT CONST text) : + write (source file, text) ; + IF screen mode AND online THEN write (text) FI +ENDPROC source out ; + +PROC source putline (TEXT CONST text) : + check file overflow ; + putline (source file, text) ; + IF screen mode AND online THEN putline (text) FI +ENDPROC source putline ; + +PROC source put (TEXT CONST text, INT CONST laenge) : + source put (text + (laenge - length (text)) * " ") ; +ENDPROC source put ; + +PROC check file overflow : + TEXT VAR new name ; + IF lines (source file) > 4000 THEN + file nr INCR 1 ; + new name := source name + "." + text (file nr) ; + line (source file) ; + putline (source file," - Fortsetzung in Datei """ + new name + """ -"); + IF screen mode AND online THEN putline ("New FILE:" + new name) FI ; + modify (source file) ; + to first record (source file) ; + forget (new name, quiet) ; + source file := sequentialfile (output, new name) ; + source putline ("ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT") ; + put tabs (source file, 40 * ""2"" + "^") + FI +ENDPROC check file overflow ; + +TEXT PROC hex16 (INT CONST nr) : + INT VAR i, var := nr ; + TEXT VAR result := "" ; + FOR i FROM 1 UPTO 4 REP + rotate (var, 4) ; + result CAT hex4 (var AND 15) + PER ; + result +ENDPROC hex16 ; + +TEXT PROC hex8 (INT CONST nr) : + hex4 (nr DIV 16) + hex4 (nr AND 15) +ENDPROC hex8 ; + +TEXT PROC hex4 (INT CONST nr) : + "0123456789ABCDEF" SUB (nr+1) +ENDPROC hex4 ; + +TEXT PROC ascii (INT CONST nr) : + IF nr < 32 OR nr > 126 THEN "." + ELSE code (nr) + FI +ENDPROC ascii ; + +INT PROC zugriff (INT CONST adr) : + TEXT VAR t := " " ; + INT VAR index := offset PLUS adr MINUS startaddr ; + rotate (index, -1) ; (* Signed DIV 2 *) + index := index AND maxint ; + BOOL CONST low byte :: ((adr MINUS start addr) AND 1) = 0 ; + replace (t, 1, space.word (index PLUS 1)) ; + IF low byte THEN code (t SUB 1) + ELSE code (t SUB 2) + FI +ENDPROC zugriff ; + +INT PROC integer (TEXT CONST hex addr) : + INT VAR i, summe := 0 ; + FOR i FROM 1 UPTO length (hex addr) REP + rotate (summe, 4) ; + summe INCR digit + PER ; + summe . + +digit : + TEXT CONST char := hex addr SUB i ; + IF char >= "a" THEN code (char) - 87 + ELIF char >= "A" THEN code (char) - 55 + ELSE code (char) - 48 + FI +ENDPROC integer ; + +INT VAR byte, + div 8, + and 7, + and f, + div 10, + int addr ; + +TEXT VAR index, c byte ; + +TEXT PROC arith log : + SELECT div 8 OF + CASE 0 : "ADD" + CASE 1 : "ADC" + CASE 2 : "SUB" + CASE 3 : "SBC" + CASE 4 : "AND" + CASE 5 : "XOR" + CASE 6 : "OR" + CASE 7 : "CP" + OTHERWISE "???" + ENDSELECT + +ENDPROC arith log; + +TEXT PROC reg1 : + SELECT div8 OF + CASE 0 : "B" + CASE 1 : "C" + CASE 2 : "D" + CASE 3 : "E" + CASE 4 : "H" + CASE 5 : "L" + CASE 6 : "(HL)" + CASE 7 : "A" + OTHERWISE "???" + ENDSELECT + +ENDPROC reg1; + +TEXT PROC reg2 : + SELECT and7 OF + CASE 0 : "B" + CASE 1 : "C" + CASE 2 : "D" + CASE 3 : "E" + CASE 4 : "H" + CASE 5 : "L" + CASE 6 : "(HL)" + CASE 7 : "A" + OTHERWISE "???" + ENDSELECT + +ENDPROC reg2; + +TEXT PROC rp: + SELECT div10 AND 3 OF + CASE 0 : "BC" + CASE 1 : "DE" + CASE 2 : "HL" + CASE 3 : IF byte > 127 THEN "AF" + ELSE "SP" FI + OTHERWISE "???" + ENDSELECT + +ENDPROC rp; + + +PROC bitmanipulation : + parameter := text (div8) + "," + reg2 ; + laenge := 2 ; + SELECT byte DIV 64 OF + CASE 1 : instr := "BIT" + CASE 2 : instr := "RES" + CASE 3 : instr := "SET" + OTHERWISE laenge := 1 ; + parameter := "" + ENDSELECT + +ENDPROC bitmanipulation; + + +PROC disass : + laenge := 1 ; + instr := "" ; + parameter := "" ; + int addr := addr ; + byte := zugriff (int addr) ; + c byte := code (byte) ; + and 7 := byte AND 7 ; + and f := byte AND 15 ; + div 10:= byte DIV 16 ; + div 8 := (byte DIV 8) AND 7 ; + IF is special instruction + THEN disass special instruction + ELIF div 10 < 4 + THEN lower case instruction + ELIF byte < 128 + THEN ld instruction + ELIF byte < 192 + THEN arith log instruction + ELSE higher case instruction + FI. + +is special instruction : + pos (special instruction codes, c byte) > 0 . + +special instruction codes : + ""0""2""7""8""10""15""16""18""23""24""26""31""32""34""39""40""42""47""48""50 + ""55""56""58""63""118""195""198""201""203""205""206""211""214""217""219 + ""221""222""227""230""233""235""237""238""243""246""249""251""253""254"". + +arith log instruction : + instr := arith log ; + parameter := reg 2 . + +ld instruction : + instr := "LD" ; + parameter := reg 1 + "," + reg 2 . + +condition code : + SELECT div8 OF + CASE 0 : "NZ" + CASE 1 : "Z" + CASE 2 : "NC" + CASE 3 : "C" + CASE 4 : "PO" + CASE 5 : "PE" + CASE 6 : "P" + CASE 7 : "M" + OTHERWISE "??" + ENDSELECT. + +lower case instruction : + IF and f = 1 THEN instr := "LD" ; + parameter := rp + "," + next word ; + laenge := 3 + ELIF and f = 3 THEN instr := "INC" ; + parameter := rp ; + ELIF and 7 = 4 THEN instr := "INC" ; + parameter := reg1 + ELIF and 7 = 5 THEN instr := "DEC" ; + parameter := reg1 + ELIF and 7 = 6 THEN instr := "LD" ; + parameter := reg1 + "," + next byte ; + laenge := 2 + ELIF and f = 9 THEN instr := "ADD" ; + parameter := "HL," + rp ; + ELIF and f =11 THEN instr := "DEC" ; + parameter := rp + FI. + +higher case instruction : + SELECT and 7 OF + CASE 0 : instr := "RET" ; + parameter := condition code + CASE 1 : instr := "POP" ; + parameter := rp + CASE 2 : instr := "JP" ; + parameter := condition code + "," + next word ; + laenge := 3 + CASE 4 : instr := "CALL" ; + parameter := condition code + "," + next word ; + laenge := 3 + CASE 5 : instr := "PUSH" ; + parameter := rp + CASE 7 : instr := "RST" ; + parameter := hex8 (8 * div 8) + ENDSELECT. + + +branchaddress : + hex16 (addr PLUS displacement) . + +displacement : + IF zugriff (int addr PLUS 1) < 128 + THEN zugriff (int addr PLUS 1) + 2 + ELSE zugriff (int addr PLUS 1) - 254 + FI. + +cb instructions : + byte := zugriff (addr PLUS 1) ; + and 7 := byte AND 7 ; + and f := byte AND 15 ; + div 10:= byte DIV 16 ; + div 8 := (byte DIV 8) AND 7 ; + laenge := 2 ; + parameter := reg 2 ; + IF byte < 64 THEN + SELECT div 8 OF + CASE 0 : instr := "RLC" + CASE 1 : instr := "RRC" + CASE 2 : instr := "RL" + CASE 3 : instr := "RR" + CASE 4 : instr := "SLA" + CASE 5 : instr := "SRA" + CASE 6 : instr := "" ; parameter := "" ; laenge := 1 + CASE 7 : instr := "SLR" + OTHERWISE laenge := 1 ; parameter := "" + ENDSELECT + ELSE + bitmanipulation + FI . + + +disass special instruction : + SELECT byte OF + CASE 0 : instr := "NOP" + CASE 2 : instr := "LD" ; parameter := "(BC),A" + CASE 7 : instr := "RLCA" + CASE 8 : instr := "EX" ; parameter := "AF,AF'" + CASE 10 : instr := "LD" ; parameter := "A,(BC)" + CASE 15 : instr := "RRCA" + CASE 16 : instr := "DJNZ" ; parameter := branchaddress ; laenge:=2 + CASE 18 : instr := "LD" ; parameter := "(DE),A" + CASE 23 : instr := "RLA" + CASE 24 : instr := "JR" ; parameter := branchaddress ; laenge:=2 + CASE 26 : instr := "LD" ; parameter := "A,(DE)" + CASE 31 : instr := "RRA" + CASE 32 : instr := "JR" ; parameter := "NZ," + branchaddress;laenge:=2 + CASE 34 : instr := "LD" ; parameter := "("+nextword+"),HL"; laenge:=3 + CASE 39 : instr := "DAA" + CASE 40 : instr := "JR" ; parameter := "Z," + branchaddress; laenge:=2 + CASE 42 : instr := "LD" ; parameter := "HL,("+nextword+")"; laenge:=3 + CASE 47 : instr := "CPL" + CASE 48 : instr := "JR" ; parameter := "NC," + branchaddress;laenge:=2 + CASE 50 : instr := "LD" ; parameter := "("+nextword+"),A"; laenge:=3 + CASE 55 : instr := "SCF" + CASE 56 : instr := "JR" ; parameter := "C," + branchaddress; laenge:=2 + CASE 58 : instr := "LD" ; parameter := "A,("+nextword+")"; laenge:=3 + CASE 63 : instr := "CCF" + CASE 118: instr := "HALT" + CASE 195: instr := "JP" ; parameter := next word ; laenge:=3 + CASE 198: instr := "ADD" ; parameter := "A,"+next byte; laenge:=2 + CASE 201: instr := "RET" + CASE 203: cb instructions + CASE 205: instr := "CALL" ; parameter := next word; laenge := 3 + CASE 206: instr := "ADC" ; parameter := "A," + next byte ; laenge := 2 + CASE 211: instr := "OUT" ; parameter := "("+next byte+"),A";laenge:=2 + CASE 214: instr := "SUB" ; parameter := "A,"+next byte;laenge := 2 + CASE 217: instr := "EXX" + CASE 219: instr := "IN" ; parameter := "A,(" + next byte+")";laenge := 2 + CASE 221: index := "IX"; dd and fd instructions + CASE 222: instr := "SBC" ; parameter := "A," + next byte ;laenge := 2 + CASE 227: instr := "EX"; parameter := "(SP),HL" + CASE 230: instr := "AND" ; parameter := next byte; laenge := 2 + CASE 233: instr := "JP" ; parameter := "(HL)" + CASE 235: instr := "EX" ; parameter := "DE,HL" + CASE 237: ed instructions + CASE 238: instr := "XOR" ; parameter := next byte ; laenge := 2 + CASE 243: instr := "DI" + CASE 246: instr := "OR" ; parameter := next byte ; laenge := 2 + CASE 249: instr := "LD" ; parameter := "SP,HL" + CASE 251: instr := "EI" + CASE 253: index := "IY"; dd and fd instructions + CASE 254: instr := "CP" ; parameter := next byte ; laenge := 2 + ENDSELECT. + +ENDPROC disass ; + +PROC dd and fd instructions : + laenge := 2 ; + int addr := addr PLUS 1 ; + byte := zugriff (int addr) ; + c byte := code (byte) ; + and 7 := byte AND 7 ; + and f := byte AND 15 ; + div 10:= byte DIV 16 ; + div 8 := (byte DIV 8) AND 7 ; + SELECT byte OF + CASE 33 : instr := "LD" ; parameter := index+","+next word;laenge:=4 + CASE 34 : instr := "LD" ; parameter:="("+next word+"),"+index;laenge:=4 + CASE 35 : instr := "INC" ; parameter := index + CASE 42 : instr := "LD" ; parameter:=index+",("+next word+")";laenge:=4 + CASE 43 : instr := "DEC" ; parameter := index + CASE 52 : instr := "INC";parameter:="("+index+"+"+nextbyte+")";laenge:=3 + CASE 53 : instr := "DEC";parameter:="("+index+"+"+nextbyte+")";laenge:=3; + CASE 54 : instr := "LD" ; parameter :="("+index+"+"+next byte+"),"+ + hex8(zugriff (addr PLUS 3));laenge := 4 + CASE 203: dd and fd cb instructions + CASE 225: instr := "POP" ; parameter := index + CASE 227: instr := "EX" ; parameter := "(SP)," + index + CASE 229: instr := "PUSH" ; parameter := index + CASE 233: instr := "JP" ; parameter := "(" + index + ")" + CASE 249: instr := "LD" ; parameter := "SP," + index + OTHERWISE calculated dd and fd instructions + ENDSELECT. + +calculated dd and fd instructions : + parameter := "(" + index + "+" + next byte + ")" ; + laenge := 3 ; + IF andf = 9 THEN instr := "ADD" ; parameter := index+","+rp;laenge:=2 + ELIF and7 = 6 AND div 10 > 3 AND div 10 < 8 + THEN instr := "LD" ; parameter := reg1 + "," + parameter + ELIF div 10 = 7 AND byte <> 118 + THEN instr := "LD" ; parameter CAT "," + reg2 + ELIF and7 = 6 AND div 10 > 7 AND div 10 < 12 + THEN instr := arith log + ELSE laenge := 1 ; + parameter := "" + FI. + +dd and fd cb instructions : + int addr := addr PLUS 3 ; + byte := zugriff (int addr) ; + c byte := code (byte) ; + and 7 := byte AND 7 ; + and f := byte AND 15 ; + div 10:= byte DIV 16 ; + div 8 := (byte DIV 8) AND 7 ; + IF byte < 64 AND and7 = 6 THEN + laenge := 4 ; + parameter := "("+index + "+" + hex8 (zugriff (addr PLUS 2)) + ")" ; + SELECT div 8 OF + CASE 0 : instr := "RLC" + CASE 1 : instr := "RRC" + CASE 2 : instr := "RL" + CASE 3 : instr := "RR" + CASE 4 : instr := "SLA" + CASE 5 : instr := "SRA" + CASE 7 : instr := "SRL" + OTHERWISE instr := "" ; parameter := "" ;laenge := 1 + ENDSELECT + ELIF and7 = 6 THEN laenge := 4 ; parameter := "(" + index + "+" + + hex8 (zugriff (addr PLUS 2)) + ")" ; + dd and fd bitmanipulation + ELSE laenge := 1 ; + parameter := "" + FI. + +dd and fd bitmanipulation : + parameter := text (div8) + "," + parameter ; + SELECT byte DIV 64 OF + CASE 1 : instr := "BIT" + CASE 2 : instr := "RES" + CASE 3 : instr := "SET" + OTHERWISE laenge := 1 ; + parameter := "" + ENDSELECT. + +ENDPROC dd and fd instructions ; + +PROC ed instructions : + int addr := addr PLUS 1 ; + byte := zugriff (int addr) ; + c byte := code (byte) ; + and 7 := byte AND 7 ; + and f := byte AND 15 ; + div 10:= byte DIV 16 ; + div 8 := (byte DIV 8) AND 7 ; + laenge := 2 ; + SELECT byte OF + CASE 52 : instr := "TST" ; parameter := "(HL)" + CASE 68 : instr := "NEG" + CASE 69 : instr := "RETN" + CASE 70 : instr := "IM" ; parameter := "0" + CASE 71 : instr := "LD" ; parameter := "I,A" + CASE 77 : instr := "RETI" + CASE 79 : instr := "LD" ; parameter := "R,A" + CASE 86 : instr := "IM" ; parameter := "1" + CASE 87 : instr := "LD" ; parameter := "A,I" + CASE 94 : instr := "IM" ; parameter := "2" + CASE 95 : instr := "LD" ; parameter := "A,R" + CASE 100: instr := "TST" ; parameter := next byte ; laenge := 3 + CASE 103: instr := "RRD" + CASE 111: instr := "RLD" + CASE 116: instr := "TSTIO" ; parameter := next byte ; laenge := 3 + CASE 118: instr := "SLP" + CASE 131: instr := "OTIM" + CASE 139: instr := "OTDM" + CASE 147: instr := "OTIMR" + CASE 155: instr := "OTDMR" + CASE 171: instr := "OUTD" + CASE 163: instr := "OUTI" + CASE 179: instr := "OTIR" + CASE 187: instr := "OTDR" + OTHERWISE calculate ed instruction + ENDSELECT. + +calculate ed instruction : + IF is 40 to 7f THEN + IF and7 = 0 THEN instr := "IN" ; parameter := reg1 + ",(C)" + ELIF and7 = 1 THEN instr := "OUT" ; parameter := "(C)," + reg1 + ELIF andf = 2 THEN instr := "SBC" ; parameter := "HL," + rp + ELIF andf = 3 THEN instr := "LD" ; parameter := "("+nextword+"),"+rp; + laenge := 4 + ELIF andf =11 THEN instr := "LD" ; parameter := rp+",("+nextword+")"; + laenge := 4 + ELIF andf =10 THEN instr := "ADC" ; parameter := "HL," + rp + ELIF andf =12 THEN instr := "MLT" ; parameter := rp + ELSE laenge := 1 + FI + ELIF byte < 64 THEN + IF and7 = 0 THEN instr := "IN0" ; parameter := reg1 + ",(" + next + byte + ")" ; laenge := 3 + ELIF and7 = 1 THEN instr := "OUT0" ; parameter := "(" + next word + + ")," + reg1 ; laenge := 3 + ELIF and7 = 4 THEN instr := "TST" ; parameter := reg1 + ELSE laenge := 1 + FI + ELIF div10 = 10 OR div10 = 11 THEN + IF and7 = 0 THEN instr := "LD" + modification + ELIF and7 = 1 THEN instr := "CP" + modification + ELIF and7 = 2 THEN instr := "IN" + modification + ELSE laenge := 1 + FI + ELSE laenge := 1 + FI. + +is 40 to 7f : + div 10 < 8 AND div 10 > 3. + +modification : + SELECT div8 - 4 OF + CASE 0 : "I" + CASE 1 : "D" + CASE 2 : "IR" + CASE 3 : "DR" + OTHERWISE "???" + ENDSELECT. + +ENDPROC ed instructions ; + +TEXT PROC next word : + hex8 (zugriff (int addr PLUS 2)) + hex8 (zugriff (int addr PLUS 1)) +ENDPROC next word ; + +TEXT PROC next byte : + hex8 (zugriff (int addr PLUS 1)) +ENDPROC next byte + -- cgit v1.2.3