391 lines
12 KiB
Plaintext
391 lines
12 KiB
Plaintext
program Emulator;
|
|
|
|
{$MODE OBJFPC}
|
|
|
|
uses SysUtils, Crt;
|
|
|
|
{$ifdef tape}
|
|
type
|
|
//Tape file path and reset state
|
|
Tape = record
|
|
Path: shortstring;
|
|
Reset: boolean;
|
|
Pos: integer;
|
|
end;
|
|
{$endif}
|
|
|
|
const
|
|
IO = $ffff;
|
|
|
|
var
|
|
Hlt, ASCII: boolean; //Halt and ASCII flags
|
|
Op: 0 .. $f; //Opcode
|
|
X, Y: 0 .. 3; //Register arguments
|
|
Addr, IP, RP: word; //Address argument and instruction and return pointers
|
|
R: array [0 .. 3] of byte; //General-purpose registers
|
|
Mem: array [0 .. $ffef] of byte; //Memory
|
|
Prog{$ifdef printer}, Prn{$endif}{$ifdef tape}, TapeIn, TapeOut{$endif}: file of byte; //Program file, line printer, and tape reader and punch tapes
|
|
{$ifdef tape}
|
|
Reader, Punch: Tape; //States of the tape reader and punch
|
|
State: file of Tape; //File storing the states of the tape reader and punch
|
|
{$endif}
|
|
Ch, Scan: ansichar; //Character for input and output and scancode for non-ASCII keys
|
|
|
|
//Terminal output
|
|
procedure Output;
|
|
begin
|
|
//Do not output most of the control codes
|
|
if Ch <= ansichar ($1f) then begin
|
|
if Ch = ansichar (7) then write (Ch) //Bell
|
|
else if Ch = ansichar (8) then write (Ch) //Backspace
|
|
else if Ch = ansichar ($a) then write (Ch) //Line feed
|
|
else if Ch = ansichar ($d) then write (Ch) //Carriage return
|
|
else write (''); //Others
|
|
end
|
|
else if Ch = ansichar ($7f) then write ('') //Delete
|
|
//Output all regular characters
|
|
else write (Ch);
|
|
end;
|
|
|
|
begin
|
|
|
|
//Initialise the halt flag and the pointers
|
|
Hlt := false;
|
|
IP := 0;
|
|
RP := $fff0;
|
|
|
|
//Initialise the tape reader and punch
|
|
{$ifdef tape}
|
|
Reader.Path := '';
|
|
Reader.Reset := true;
|
|
Reader.Pos := 0;
|
|
Punch.Path := '';
|
|
Punch.Reset := true;
|
|
Punch.Pos := 0;
|
|
{$endif}
|
|
|
|
//Read a program file and check for errors
|
|
if ParamCount <> 1 then begin
|
|
writeln ('Usage: emulator program');
|
|
halt;
|
|
end;
|
|
{$i-}
|
|
assign (Prog, ParamStr (1));
|
|
reset (Prog);
|
|
{$i+}
|
|
if IOResult <> 0 then begin
|
|
writeln ('Error: program file cannot be read from');
|
|
halt;
|
|
end;
|
|
repeat
|
|
read (Prog, Mem [IP]);
|
|
IP := IP + 1;
|
|
until (eof (Prog)) or (IP = $fff0);
|
|
if IP = $fff0 then begin
|
|
writeln ('Error: memory overflow');
|
|
halt;
|
|
end;
|
|
|
|
//Reinitialise the instruction pointer
|
|
IP := 0;
|
|
|
|
//Begin the main loop
|
|
while Hlt = false do begin
|
|
|
|
//Fetch the instruction and increment the instruction pointer
|
|
//Opcode
|
|
Op := Mem [IP] and $f0 shr 4;
|
|
//Register arguments
|
|
X := Mem [IP] and $c shr 2;
|
|
Y := Mem [IP] and 3;
|
|
IP := IP + 1;
|
|
if IP > $ffef then begin
|
|
writeln ('Error: illegal instruction pointer value');
|
|
halt;
|
|
end;
|
|
//Address argument
|
|
if Op >= $a then begin
|
|
//High byte
|
|
Addr := Mem [IP];
|
|
Addr := Addr shl 8;
|
|
IP := IP + 1;
|
|
if IP > $ffef then begin
|
|
writeln ('Error: illegal instruction pointer value');
|
|
halt;
|
|
end;
|
|
//Low byte
|
|
Addr := Addr + Mem [IP];
|
|
IP := IP + 1;
|
|
if IP > $ffef then begin
|
|
writeln ('Error: illegal instruction pointer value');
|
|
halt;
|
|
end;
|
|
end;
|
|
|
|
//Decode and execute the instruction
|
|
//Halt
|
|
if Op = 0 then Hlt := true
|
|
//Ret
|
|
else if Op = 1 then begin
|
|
//High byte of the return address
|
|
IP := Mem [RP];
|
|
IP := IP shl 8;
|
|
RP := RP + 1;
|
|
if RP > $fff0 then begin
|
|
writeln ('Error: illegal return pointer value');
|
|
halt;
|
|
end;
|
|
//Low byte of the return address
|
|
IP := IP + Mem [RP];
|
|
RP := RP + 1;
|
|
if RP > $fff0 then begin
|
|
writeln ('Error: illegal return pointer value');
|
|
halt;
|
|
end;
|
|
end
|
|
//Shl
|
|
else if Op = 2 then R [X] := R [X] shl 1
|
|
//Shr
|
|
else if Op = 3 then R [X] := R [X] shr 1
|
|
//Rol
|
|
else if Op = 4 then R [X] := RolByte (R [X])
|
|
//Ror
|
|
else if Op = 5 then R [X] := RorByte (R [X])
|
|
//Nand
|
|
else if Op = 6 then R [X] := not (R [X] and R [Y])
|
|
//And
|
|
else if Op = 7 then R [X] := R [X] and R [Y]
|
|
//Or
|
|
else if Op = 8 then R [X] := R [X] or R [Y]
|
|
//Xor
|
|
else if Op = 9 then R [X] := R [X] xor R [Y]
|
|
//Load
|
|
else if Op = $a then begin
|
|
//Terminal input
|
|
if Addr = IO then begin
|
|
//Read a keypress
|
|
repeat
|
|
Ch := ReadKey;
|
|
//Check for non-ASCII keys
|
|
if Ch = ansichar (0) then begin
|
|
//Non-ASCII
|
|
if keypressed then begin
|
|
Scan := ReadKey;
|
|
//The delete key inserts the delete character
|
|
if Scan = ansichar ($53) then begin
|
|
Ch := ansichar ($7f);
|
|
ASCII := true;
|
|
end
|
|
//Unused function keys insert a null
|
|
else ASCII := true;
|
|
end
|
|
//Null
|
|
else ASCII := true;
|
|
end
|
|
//Other ASCII
|
|
else ASCII := true;
|
|
until ASCII = true;
|
|
//Bodge for the home and end keys
|
|
if Ch = ansichar ($37) then begin
|
|
if keypressed then begin
|
|
Scan := ReadKey;
|
|
Scan := ReadKey;
|
|
Scan := ReadKey;
|
|
Ch := ansichar (0);
|
|
end;
|
|
end
|
|
else if Ch = ansichar ($38) then begin
|
|
if keypressed then begin
|
|
Scan := ReadKey;
|
|
Scan := ReadKey;
|
|
Scan := ReadKey;
|
|
Ch := ansichar (0);
|
|
end;
|
|
end;
|
|
//Process the keypress
|
|
Output; //Local echo
|
|
R [X] := byte (Ch);
|
|
end
|
|
//Tape reader
|
|
{$ifdef tape}
|
|
else if Addr = $fffd then begin
|
|
assign (State, ExpandFileName ('~/.tapes.thingamajig'));
|
|
//Check the reader state
|
|
if FileExists (ExpandFileName ('~/.tapes.thingamajig')) then begin
|
|
try
|
|
reset (State);
|
|
read (State, Reader);
|
|
read (State, Punch);
|
|
close (State);
|
|
except
|
|
end;
|
|
end;
|
|
//Read
|
|
assign (TapeIn, Reader.Path);
|
|
try
|
|
reset (TapeIn);
|
|
seek (TapeIn, Reader.Pos);
|
|
read (TapeIn, R [X]);
|
|
close (TapeIn);
|
|
Reader.Pos := Reader.Pos + 1;
|
|
except
|
|
R [X] := $ff;
|
|
end;
|
|
//Save the reader state
|
|
if FileExists (ExpandFileName ('~/.tapes.thingamajig')) then begin
|
|
try
|
|
rewrite (State);
|
|
write (State, Reader);
|
|
write (State, Punch);
|
|
close (State);
|
|
except
|
|
end;
|
|
end;
|
|
end
|
|
{$endif}
|
|
//Regular load
|
|
else R [X] := Mem [Addr];
|
|
end
|
|
//Store
|
|
else if Op = $b then begin
|
|
//Terminal output
|
|
if Addr = IO then begin
|
|
Ch := ansichar (R [X]);
|
|
Output;
|
|
end
|
|
//Printer
|
|
{$ifdef printer}
|
|
else if Addr = $fffe then begin
|
|
assign (Prn, '/dev/usb/lp0');
|
|
try
|
|
rewrite (Prn);
|
|
write (Prn, R [X]);
|
|
close (Prn);
|
|
except
|
|
end;
|
|
end
|
|
{$endif}
|
|
//Tape punch
|
|
{$ifdef tape}
|
|
else if Addr = $fffd then begin
|
|
assign (State, ExpandFileName ('~/.tapes.thingamajig'));
|
|
//Check the punch state
|
|
if FileExists (ExpandFileName ('~/.tapes.thingamajig')) then begin
|
|
try
|
|
reset (State);
|
|
read (State, Reader);
|
|
read (State, Punch);
|
|
close (State);
|
|
except
|
|
end;
|
|
end;
|
|
//Punch
|
|
if Punch.Path <> '' then begin
|
|
assign (TapeOut, Punch.Path);
|
|
if FileExists (Punch.Path) = false then begin
|
|
try
|
|
rewrite (TapeOut);
|
|
write (TapeOut, R [X]);
|
|
close (TapeOut);
|
|
Punch.Reset := false;
|
|
except
|
|
end;
|
|
end
|
|
else if Punch.Reset then begin
|
|
try
|
|
rewrite (TapeOut);
|
|
write (TapeOut, R [X]);
|
|
close (TapeOut);
|
|
Punch.Reset := false;
|
|
except
|
|
end;
|
|
end
|
|
else begin
|
|
try
|
|
reset (TapeOut);
|
|
seek (TapeOut, FileSize (TapeOut));
|
|
write (TapeOut, R [X]);
|
|
close (TapeOut);
|
|
except
|
|
end;
|
|
end;
|
|
end;
|
|
//Save the punch state
|
|
if FileExists (ExpandFileName ('~/.tapes.thingamajig')) then begin
|
|
try
|
|
rewrite (State);
|
|
write (State, Reader);
|
|
write (State, Punch);
|
|
close (State);
|
|
except
|
|
end;
|
|
end;
|
|
end
|
|
{$endif}
|
|
|
|
//Regular store
|
|
else Mem [Addr] := R [X];
|
|
end
|
|
//Breq
|
|
else if Op = $c then begin
|
|
if R [X] = R [Y] then IP := Addr;
|
|
end
|
|
//Brneq
|
|
else if Op = $d then begin
|
|
if R [X] <> R [Y] then IP := Addr;
|
|
end
|
|
//Cleq
|
|
else if Op = $e then begin
|
|
if R [X] = R [Y] then begin
|
|
//Low byte of the return address
|
|
RP := RP - 1;
|
|
if RP > $fff0 then begin
|
|
writeln ('Error: illegal return pointer value');
|
|
halt;
|
|
end;
|
|
Mem [RP] := IP and $ff;
|
|
//High byte of the return address
|
|
RP := RP - 1;
|
|
if RP > $fff0 then begin
|
|
writeln ('Error: illegal return pointer value');
|
|
halt;
|
|
end;
|
|
Mem [RP] := IP shr 8;
|
|
//Call
|
|
IP := Addr;
|
|
if IP > $ffef then begin
|
|
writeln ('Error: illegal instruction pointer value');
|
|
halt;
|
|
end;
|
|
end;
|
|
end
|
|
//Clneq
|
|
else if Op = $f then begin
|
|
if R [X] <> R [Y] then begin
|
|
//Low byte of the return address
|
|
RP := RP - 1;
|
|
if RP > $fff0 then begin
|
|
writeln ('Error: illegal return pointer value');
|
|
halt;
|
|
end;
|
|
Mem [RP] := IP and $ff;
|
|
//High byte of the return address
|
|
RP := RP - 1;
|
|
if RP > $fff0 then begin
|
|
writeln ('Error: illegal return pointer value');
|
|
halt;
|
|
end;
|
|
Mem [RP] := IP shr 8;
|
|
//Call
|
|
IP := Addr;
|
|
if IP > $ffef then begin
|
|
writeln ('Error: illegal instruction pointer value');
|
|
halt;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
end.
|