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