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.