135 lines
3.9 KiB
ObjectPascal
135 lines
3.9 KiB
ObjectPascal
program Disassembler;
|
|
|
|
uses Sysutils;
|
|
|
|
var
|
|
Op, Regs: 0 .. $f; //Opcode, and register arguments in a single variable
|
|
X, Y: 0 .. 3; //Register arguments in separate variables
|
|
Addr, BP, EP: word; //Address argument and byte and end pointers
|
|
Opcodes: array [0 .. $f] of string; //Opcodes in human readable form
|
|
Bin: array [0 .. $ffef] of byte; //Program in binary form
|
|
Prog: file of byte; //Program file
|
|
|
|
begin
|
|
|
|
//Populate the opcode array
|
|
Opcodes [0] := 'HALT ';
|
|
Opcodes [1] := 'RET ';
|
|
Opcodes [2] := 'SHL ';
|
|
Opcodes [3] := 'SHR ';
|
|
Opcodes [4] := 'ROL ';
|
|
Opcodes [5] := 'ROR ';
|
|
Opcodes [6] := 'NAND ';
|
|
Opcodes [7] := 'AND ';
|
|
Opcodes [8] := 'OR ';
|
|
Opcodes [9] := 'XOR ';
|
|
Opcodes [$a] := 'LOAD ';
|
|
Opcodes [$b] := 'STORE ';
|
|
Opcodes [$c] := 'BREQ ';
|
|
Opcodes [$d] := 'BRNEQ ';
|
|
Opcodes [$e] := 'CLEQ ';
|
|
Opcodes [$f] := 'CLNEQ ';
|
|
|
|
//Initialise the byte pointer
|
|
BP := 0;
|
|
|
|
//Read a program file and check for errors
|
|
if ParamCount <> 1 then begin
|
|
writeln ('Usage: disassembler program (> output)');
|
|
halt (1);
|
|
end;
|
|
{$i-}
|
|
assign (Prog, ParamStr (1));
|
|
reset (Prog);
|
|
{$i+}
|
|
if IOResult <> 0 then begin
|
|
writeln ('Error: program file cannot be read from');
|
|
halt (1);
|
|
end;
|
|
repeat
|
|
read (Prog, Bin [BP]);
|
|
BP := BP + 1;
|
|
until (eof (Prog)) or (BP = $fff0);
|
|
if BP = $fff0 then begin
|
|
writeln ('Error: memory overflow');
|
|
halt (1);
|
|
end;
|
|
//Save the end point and reinitialise the byte pointer
|
|
EP := BP;
|
|
BP := 0;
|
|
|
|
//Begin the main loop
|
|
repeat
|
|
|
|
//Print the memory location
|
|
if BP < $1000 then write (' ');
|
|
if BP < $100 then write (' ');
|
|
if BP < $10 then write (' ');
|
|
write (IntToHex (BP, 1), ' ');
|
|
|
|
//Fetch the instruction and increment the byte pointer
|
|
//Opcode
|
|
Op := Bin [BP] and $f0 shr 4;
|
|
//Register arguments
|
|
Regs := Bin [BP] and $f;
|
|
X := Bin [BP] and $c shr 2;
|
|
Y := Bin [BP] and 3;
|
|
BP := BP + 1;
|
|
//Immediate or address argument
|
|
if Op >= $a then begin
|
|
//Immediate or high byte of address
|
|
Addr := Bin [BP];
|
|
Addr := Addr shl 8;
|
|
BP := BP + 1;
|
|
//Low byte of address
|
|
if Op = $a then begin
|
|
if Y = 0 then begin
|
|
Addr := Addr + Bin [BP];
|
|
BP := BP - 1;
|
|
end
|
|
else BP := BP - 1;
|
|
end
|
|
else begin
|
|
Addr := Addr + Bin [BP];
|
|
BP := BP - 1;
|
|
end;
|
|
end;
|
|
|
|
//Print the data
|
|
write (IntToHex (Op, 1), IntToHex (Regs, 1));
|
|
if Op >= $a then begin
|
|
if Op = $a then begin
|
|
if Y = 0 then write (IntToHex (Addr, 4))
|
|
else write (IntToHex (Addr shr 8, 2), ' ');
|
|
end
|
|
else write (IntToHex (Addr, 4));
|
|
end
|
|
else write (' ');
|
|
write (' ');
|
|
|
|
//Print the instruction
|
|
write (Opcodes [Op]);
|
|
if Op = $b then writeln (IntToHex (Addr, 1), ', R', X)
|
|
else begin
|
|
if Op >= 2 then begin
|
|
write ('R', X);
|
|
if Op <= 5 then begin
|
|
if Y = 0 then write (', 4')
|
|
else write (', ', Y);
|
|
end;
|
|
end;
|
|
if Op >= 6 then if Op <= 9 then write (', R', Y);
|
|
if OP >= $c then write (', R', Y);
|
|
if Op >= $a then begin
|
|
if Op = $a then begin
|
|
if Y = 0 then write (', ', IntToHex (Addr, 1))
|
|
else write (', #', IntToHex (Addr shr 8, 1))
|
|
end
|
|
else write (', ', IntToHex (Addr, 1));
|
|
end;
|
|
writeln ();
|
|
end;
|
|
|
|
until BP >= EP;
|
|
|
|
end.
|