1062 lines
34 KiB
Plaintext
1062 lines
34 KiB
Plaintext
program Emulator;
|
|
|
|
{$MODE OBJFPC}
|
|
|
|
{$ifdef full}
|
|
{$define RAM64}
|
|
{$define printer}
|
|
{$define tape}
|
|
{$define floppy}
|
|
{$define modem}
|
|
{$define status}
|
|
{$endif}
|
|
|
|
uses SysUtils, Crt{$ifdef modem}, BaseUnix, Sockets{$endif}{$ifdef status}{$ifndef modem}, BaseUnix{$endif}{$endif};
|
|
|
|
{$ifdef tape}
|
|
//Tape file path and reset state
|
|
type
|
|
Tape = record
|
|
Path: shortstring;
|
|
Reset: boolean;
|
|
Pos: integer;
|
|
end;
|
|
{$endif}
|
|
{$ifdef modem}
|
|
//Modem connection state
|
|
type
|
|
Connection = record
|
|
Originate: boolean;
|
|
Answer: boolean;
|
|
Dial: boolean;
|
|
Addr: longword;
|
|
Port: word;
|
|
Hang: boolean;
|
|
end;
|
|
{$endif}
|
|
|
|
const
|
|
//The last address of RAM
|
|
{$if defined(RAM4)}
|
|
LastRAM = $fff; //4 KiB
|
|
{$elseif defined(RAM8)}
|
|
LastRAM = $1fff; //8 KiB
|
|
{$elseif defined(RAM16)}
|
|
LastRAM = $3fff; //16 KiB
|
|
{$elseif defined(RAM32)}
|
|
LastRAM = $7fff; //32 KiB
|
|
{$elseif defined(RAM64)}
|
|
LastRAM = $ffef; //64 KiB
|
|
{$else}
|
|
LastRAM = $7ff; //2 KiB (default)
|
|
{$endif}
|
|
|
|
var
|
|
Hlt, Echo{$ifdef floppy}, DiscRead, DiscWrite, DiscTrackSet, DiscSectSet{$endif}{$ifdef modem}, Listening, Connected{$endif}: boolean; //Halt and echo flags, disc system flags, and modem connection flags
|
|
Op, Regs: 0 .. $f; //Opcode
|
|
X, Y: 0 .. 3; //Register arguments
|
|
Addr, IP, RP: word; //Immediate or address argument and instruction and return pointers
|
|
R: array [0 .. 3] of byte; //General-purpose registers
|
|
Mem: array [0 .. LastRAM] of byte; //Random access memory
|
|
{$ifdef floppy}
|
|
DiscSB: array [0 .. $88] of byte; //Sector buffer for the disc system
|
|
DiscSBP: 0 .. $88; //Sector buffer pointer
|
|
{$endif}
|
|
Prog{$ifdef printer}, Prn{$endif}{$ifdef tape}, TapeIn, TapeOut{$endif}{$ifdef floppy}, Disc{$endif}: file of byte; //Program file, line printer, tape reader and punch tapes, and current disc
|
|
{$ifdef tape}
|
|
Reader, Punch: Tape; //States of the tape reader and punch
|
|
Tapes: file of Tape; //File storing the states of the tape reader and punch
|
|
{$endif}
|
|
{$ifdef floppy}
|
|
Disc0Path, Disc1Path, DiscPath: shortstring; //Paths of the discs in the drives and the current disc
|
|
Discs: file of shortstring; //File storing the state of the disc system
|
|
{$endif}
|
|
Ch, Scan: ansichar; //Character for input and output and scancode for non-ASCII keys
|
|
Verbose, IC, LFX: integer; //Verbose flag, instruction counter for CPU speed, and line feed position marker
|
|
Fetched{$ifdef floppy}, Disc0Track, Disc1Track, Disc0Sect, Disc1Sect{$endif}: byte; //Fetched byte and disc drive locations
|
|
{$ifdef floppy}
|
|
DiscDrive: 0 .. 1; //Current disc drive number
|
|
{$endif}
|
|
{$ifdef modem}
|
|
ConnVar: Connection; //State of the modem
|
|
ConnFile: file of Connection; //File storing the state of the modem
|
|
Mode: (Originate, Answer); //Modem mode
|
|
ServerSocket, ListenSocket, ClientSocket, ClientAddrSize: longint; //Server socket
|
|
ServerAddr, ClientAddr: TInetSockAddr; //Server address
|
|
SigPipeHandler: pSigActionRec; //SIGPIPE handler
|
|
{$endif}
|
|
{$ifdef status}
|
|
FileDescs: TFDset; //File descriptor set
|
|
{$endif}
|
|
|
|
//Ignore signal
|
|
{$ifdef modem}
|
|
procedure DoSig (Sig: cint); cdecl;
|
|
begin
|
|
end;
|
|
{$endif}
|
|
|
|
//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 begin //Bodge for line feed
|
|
LFX := WhereX;
|
|
write (Ch);
|
|
GotoXY (LFX, WhereY);
|
|
end
|
|
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;
|
|
|
|
{$ifndef fast}
|
|
//Wait to emulate CPU speed of roughly 500 KIPS
|
|
procedure wait (I: integer);
|
|
begin
|
|
if IC div 500 < I then sleep (I)
|
|
else begin
|
|
sleep (IC div 500);
|
|
if IC mod 500 >= 250 then sleep (1);
|
|
end;
|
|
IC := 0;
|
|
end;
|
|
{$endif}
|
|
|
|
{$ifdef modem}
|
|
//Check the modem state
|
|
procedure CheckModem;
|
|
begin
|
|
assign (ConnFile, ExpandFileName ('~/.thingamajig/connection'));
|
|
//Check the modem state
|
|
if FileExists (ExpandFileName ('~/.thingamajig/connection')) then begin
|
|
try
|
|
reset (ConnFile);
|
|
read (ConnFile, ConnVar);
|
|
close (ConnFile);
|
|
except
|
|
end;
|
|
end;
|
|
//Auto-set things when dialing
|
|
if ConnVar.Dial then begin
|
|
//Auto-change to originate mode if dialing in answer mode
|
|
if Mode = Answer then ConnVar.Originate := true;
|
|
//Auto-hang if dialing
|
|
if Mode = Originate then if Connected then ConnVar.Hang := true;
|
|
end;
|
|
//Mode change
|
|
//Originate
|
|
if ConnVar.Originate then begin
|
|
//Change the mode
|
|
if Mode = Originate then begin
|
|
if Connected then begin
|
|
CloseSocket (ServerSocket);
|
|
Connected := false;
|
|
end;
|
|
end
|
|
else if Mode = Answer then begin
|
|
if Connected then begin
|
|
CloseSocket (ClientSocket);
|
|
Connected := false;
|
|
end;
|
|
CloseSocket (ListenSocket);
|
|
Listening := false;
|
|
Mode := Originate;
|
|
end;
|
|
ConnVar.Originate := false;
|
|
end
|
|
//Answer
|
|
else if ConnVar.Answer then begin
|
|
//Change the mode
|
|
if Mode = Originate then begin
|
|
if Connected then begin
|
|
CloseSocket (ServerSocket);
|
|
Connected := false;
|
|
end;
|
|
Mode := Answer;
|
|
end
|
|
else if Mode = Answer then begin
|
|
if Connected then begin
|
|
CloseSocket (ClientSocket);
|
|
Connected := false;
|
|
end;
|
|
CloseSocket (ListenSocket);
|
|
Listening := false;
|
|
end;
|
|
//Create a listening socket
|
|
ListenSocket := fpSocket (AF_INET, SOCK_STREAM, 0);
|
|
if ListenSocket <> -1 then begin
|
|
ServerAddr.sin_family := AF_INET;
|
|
ServerAddr.sin_addr.s_addr := htonl (ConnVar.Addr);
|
|
ServerAddr.sin_port := htons (ConnVar.Port);
|
|
if fpBind (ListenSocket, @ServerAddr, Sizeof (ServerAddr)) <> -1 then begin
|
|
if fpListen (ListenSocket, 1) <> -1 then begin
|
|
ConnVar.Answer := false;
|
|
Listening := true;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
//Hang
|
|
if ConnVar.Hang then begin
|
|
if Mode = Originate then begin
|
|
if Connected then begin
|
|
CloseSocket (ServerSocket);
|
|
Connected := false;
|
|
end;
|
|
end
|
|
else if Mode = Answer then begin
|
|
if Connected then begin
|
|
CloseSocket (ClientSocket);
|
|
Connected := false;
|
|
end;
|
|
end;
|
|
ConnVar.Hang := false;
|
|
end;
|
|
//Dial
|
|
if ConnVar.Dial then if Connected = false then begin
|
|
//Create a server socket
|
|
ServerSocket := fpSocket (AF_INET, SOCK_STREAM, 0);
|
|
if ServerSocket <> -1 then begin
|
|
//Connect
|
|
ServerAddr.sin_family := AF_INET;
|
|
ServerAddr.sin_addr.s_addr := htonl (ConnVar.Addr);
|
|
ServerAddr.sin_port := htons (ConnVar.Port);
|
|
if fpConnect (ServerSocket, @ServerAddr, Sizeof (ServerAddr)) <> -1 then begin
|
|
ConnVar.Dial := false;
|
|
Connected := true;
|
|
end;
|
|
end;
|
|
end;
|
|
//Save the modem state
|
|
if FileExists (ExpandFileName ('~/.thingamajig/connection')) then begin
|
|
try
|
|
rewrite (ConnFile);
|
|
write (ConnFile, ConnVar);
|
|
close (ConnFile);
|
|
except
|
|
end;
|
|
end;
|
|
end;
|
|
{$endif}
|
|
|
|
//Load a byte from memory
|
|
function LoadByte (W: word): byte;
|
|
var
|
|
B: byte;
|
|
begin
|
|
//Terminal input
|
|
if W = $ffff then begin
|
|
{$ifndef fast}
|
|
wait (1);
|
|
{$endif}
|
|
//Read a keypress
|
|
Ch := ReadKey;
|
|
//Handle non-character keys
|
|
if Ch = ansichar (0) then begin
|
|
if keypressed then begin
|
|
Scan := ReadKey;
|
|
//The delete key inserts the delete character
|
|
if Scan = ansichar ($53) then Ch := ansichar ($7f);
|
|
end;
|
|
end
|
|
//Bodge for the CRT unit not working perfectly in Linux
|
|
else if Ch <= ansichar ($7f) then begin
|
|
if keypressed then begin
|
|
Ch := ansichar (0);
|
|
repeat
|
|
scan := ReadKey;
|
|
until keypressed = false;
|
|
end;
|
|
end;
|
|
//Process the keypress
|
|
if Echo then Output; //Local echo
|
|
B := byte (Ch);
|
|
end
|
|
{$ifdef tape}
|
|
//Tape reader
|
|
else if W = $fffd then begin
|
|
{$ifndef fast}
|
|
wait (2);
|
|
{$endif}
|
|
assign (Tapes, ExpandFileName ('~/.thingamajig/tapes'));
|
|
//Check the reader state
|
|
if FileExists (ExpandFileName ('~/.thingamajig/tapes')) then begin
|
|
try
|
|
reset (Tapes);
|
|
read (Tapes, Reader);
|
|
read (Tapes, Punch);
|
|
close (Tapes);
|
|
except
|
|
end;
|
|
end;
|
|
//Read
|
|
assign (TapeIn, Reader.Path);
|
|
try
|
|
reset (TapeIn);
|
|
seek (TapeIn, Reader.Pos);
|
|
read (TapeIn, B);
|
|
close (TapeIn);
|
|
Reader.Pos := Reader.Pos + 1;
|
|
except
|
|
B := $ff;
|
|
end;
|
|
//Save the reader state
|
|
if FileExists (ExpandFileName ('~/.thingamajig/tapes')) then begin
|
|
try
|
|
rewrite (Tapes);
|
|
write (Tapes, Reader);
|
|
write (Tapes, Punch);
|
|
close (Tapes);
|
|
except
|
|
end;
|
|
end;
|
|
end
|
|
{$endif}
|
|
{$ifdef floppy}
|
|
//Floppy disc drive system
|
|
//Data
|
|
else if W = $fffc then begin
|
|
if DiscRead then begin
|
|
B := DiscSB [DiscSBP];
|
|
if DiscSBP < $88 then DiscSBP := DiscSBP + 1
|
|
else begin
|
|
DiscSBP := 0;
|
|
DiscRead := false;
|
|
end;
|
|
end
|
|
else B := 0;
|
|
end
|
|
{$endif}
|
|
{$ifdef modem}
|
|
//Modem
|
|
//Data
|
|
else if W = $fffa then begin
|
|
{$ifndef fast}
|
|
wait (33);
|
|
{$endif}
|
|
//Check the modem state
|
|
CheckModem;
|
|
//Recieve
|
|
if Mode = Originate then begin
|
|
if Connected then begin
|
|
if fpRecv (ServerSocket, @B, 1, 0) <> 1 then begin
|
|
CloseSocket (ServerSocket);
|
|
Connected := false;
|
|
B := 0;
|
|
end;
|
|
end
|
|
else B := 0;
|
|
end
|
|
else if Mode = Answer then begin
|
|
if Connected then begin
|
|
if fpRecv (ClientSocket, @B, 1, 0) <> 1 then begin
|
|
CloseSocket (ClientSocket);
|
|
Connected := false;
|
|
B := 0;
|
|
end;
|
|
end
|
|
else B := 0;
|
|
end
|
|
else B := 0;
|
|
end
|
|
//Status
|
|
else if W = $fff9 then begin
|
|
//Check the modem state
|
|
CheckModem;
|
|
//Load the status
|
|
if Connected then B := 1
|
|
else B := 0;
|
|
end
|
|
{$endif}
|
|
{$ifdef status}
|
|
//Input status register
|
|
else if W = $fff8 then begin
|
|
{$ifndef fast}
|
|
wait (1);
|
|
{$endif}
|
|
//Initialise the register
|
|
B := 0;
|
|
//FFFF: Terminal
|
|
fpfd_zero (FileDescs);
|
|
fpfd_set (0, FileDescs);
|
|
if fpSelect (1, @FileDescs, nil, nil, 1) > 0 then B := B or 1;
|
|
//FFFE: No input
|
|
B := B or 2;
|
|
//FFFD: Tape reader or no input
|
|
B := B or 4;
|
|
//FFFC: Disc system data or no input
|
|
B := B or 8;
|
|
//FFFB: No input
|
|
B := B or $10;
|
|
//FFFA: Modem or no input
|
|
{$ifdef modem}
|
|
//Check the modem state
|
|
CheckModem;
|
|
//Check connection status
|
|
if Mode = Originate then begin
|
|
if Connected then begin
|
|
fpfd_zero (FileDescs);
|
|
fpfd_set (ServerSocket, FileDescs);
|
|
if fpSelect (ServerSocket + 1, @FileDescs, nil, nil, 0) > 0 then B := B or $20;
|
|
end
|
|
else B := B or $20;
|
|
end
|
|
else if Mode = Answer then begin
|
|
if Connected then begin
|
|
fpfd_zero (FileDescs);
|
|
fpfd_set (ClientSocket, FileDescs);
|
|
if fpSelect (ClientSocket + 1, @FileDescs, nil, nil, 0) > 0 then B := B or $20;
|
|
end
|
|
else B := B or $20;
|
|
end;
|
|
{$endif}
|
|
{$ifndef modem}
|
|
B := B or $20;
|
|
{$endif}
|
|
//FFF9: No input
|
|
B := B or $40;
|
|
//FFF8: Input status register
|
|
B := B or $80;
|
|
end
|
|
{$endif}
|
|
//Unused addresses
|
|
else if W > LastRAM then B := 0
|
|
//Regular load
|
|
else B := Mem [W];
|
|
//Result
|
|
LoadByte := B;
|
|
end;
|
|
|
|
procedure StoreByte (W: word; B: byte);
|
|
begin
|
|
//Terminal output
|
|
if W = $ffff then begin
|
|
{$ifndef fast}
|
|
wait (1);
|
|
{$endif}
|
|
Ch := ansichar (B);
|
|
Output;
|
|
if Ch = ansichar ($12) then Echo := true;
|
|
if Ch = ansichar ($14) then Echo := false;
|
|
end
|
|
{$ifdef printer}
|
|
//Printer
|
|
else if W = $fffe then begin
|
|
{$ifndef fast}
|
|
wait (1);
|
|
{$endif}
|
|
assign (Prn, '/dev/usb/lp0');
|
|
try
|
|
rewrite (Prn);
|
|
write (Prn, B);
|
|
close (Prn);
|
|
except
|
|
end;
|
|
end
|
|
{$endif}
|
|
{$ifdef tape}
|
|
//Tape punch
|
|
else if W = $fffd then begin
|
|
{$ifndef fast}
|
|
wait (20);
|
|
{$endif}
|
|
assign (Tapes, ExpandFileName ('~/.thingamajig/tapes'));
|
|
//Check the punch state
|
|
if FileExists (ExpandFileName ('~/.thingamajig/tapes')) then begin
|
|
try
|
|
reset (Tapes);
|
|
read (Tapes, Reader);
|
|
read (Tapes, Punch);
|
|
close (Tapes);
|
|
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, B);
|
|
close (TapeOut);
|
|
Punch.Reset := false;
|
|
except
|
|
end;
|
|
end
|
|
else if Punch.Reset then begin
|
|
try
|
|
rewrite (TapeOut);
|
|
write (TapeOut, B);
|
|
close (TapeOut);
|
|
Punch.Reset := false;
|
|
except
|
|
end;
|
|
end
|
|
else begin
|
|
try
|
|
reset (TapeOut);
|
|
seek (TapeOut, FileSize (TapeOut));
|
|
write (TapeOut, B);
|
|
close (TapeOut);
|
|
except
|
|
end;
|
|
end;
|
|
end;
|
|
//Save the punch state
|
|
if FileExists (ExpandFileName ('~/.thingamajig/tapes')) then begin
|
|
try
|
|
rewrite (Tapes);
|
|
write (Tapes, Reader);
|
|
write (Tapes, Punch);
|
|
close (Tapes);
|
|
except
|
|
end;
|
|
end;
|
|
end
|
|
{$endif}
|
|
{$ifdef floppy}
|
|
//Floppy disc drive system
|
|
//Data
|
|
else if W = $fffc then begin
|
|
if DiscWrite then begin
|
|
DiscSB [DiscSBP] := B;
|
|
if DiscSBP < $88 then DiscSBP := DiscSBP + 1
|
|
else begin
|
|
DiscSBP := 0;
|
|
DiscWrite := false;
|
|
end;
|
|
end
|
|
else if DiscTrackSet then begin
|
|
if B <= $4c then begin
|
|
if DiscDrive = 0 then begin
|
|
{$ifndef fast}
|
|
if Disc0Track > B then wait (((Disc0Track - B) * 10) + 45)
|
|
else if B > Disc0Track then wait (((B - Disc0Track) * 10) + 45);
|
|
{$endif}
|
|
Disc0Track := B;
|
|
end
|
|
else begin
|
|
{$ifndef fast}
|
|
if Disc1Track > B then wait (((Disc1Track - B) * 10) + 45)
|
|
else if B > Disc1Track then wait (((B - Disc1Track) * 10) + 45);
|
|
{$endif}
|
|
Disc1Track := B;
|
|
end;
|
|
end;
|
|
DiscTrackSet := false;
|
|
end
|
|
else if DiscSectSet then begin
|
|
if B <= $1f then begin
|
|
if DiscDrive = 0 then Disc0Sect := B
|
|
else Disc1Sect := B;
|
|
end;
|
|
DiscSectSet := false;
|
|
end;
|
|
end
|
|
//Command
|
|
else if W = $fffb then begin
|
|
B := B and $f;
|
|
//Reset the system
|
|
if B and $e = 0 then begin
|
|
{$ifndef fast}
|
|
if ((Disc0Track * 10) + 45 ) > ((Disc1Track * 10) + 45 ) then wait ((Disc0Track * 10) + 45)
|
|
else wait ((Disc1Track * 10) + 45);
|
|
{$endif}
|
|
Disc0Track := 0;
|
|
Disc1Track := 0;
|
|
Disc0Sect := 0;
|
|
Disc1Sect := 0;
|
|
DiscRead := false;
|
|
DiscWrite := false;
|
|
DiscTrackSet := false;
|
|
DiscSectSet := false;
|
|
for DiscSBP := 0 to $88 do DiscSB [DiscSBP] := 0;
|
|
DiscSBP := 0;
|
|
end
|
|
//Format the disc
|
|
else if B and $e = 2 then begin
|
|
if DiscRead = false then if DiscWrite = false then if DiscTrackSet = false then if DiscSectSet = false then begin
|
|
{$ifndef fast}
|
|
wait (30000);
|
|
{$endif}
|
|
assign (Discs, ExpandFileName ('~/.thingamajig/discs'));
|
|
//Check the system state
|
|
if FileExists (ExpandFileName ('~/.thingamajig/discs')) then begin
|
|
try
|
|
reset (Discs);
|
|
read (Discs, Disc0Path);
|
|
read (Discs, Disc1Path);
|
|
close (Discs);
|
|
except
|
|
end;
|
|
end;
|
|
//Set the drive
|
|
if B and 1 = 0 then DiscPath := Disc0Path
|
|
else DiscPath := Disc1Path;
|
|
if DiscPath <> '' then begin
|
|
assign (Disc, DiscPath);
|
|
//Write
|
|
try
|
|
reset (Disc);
|
|
if FileSize (Disc) = $526a0 then begin
|
|
if B and 1 = 0 then begin
|
|
for Disc0Track := 0 to $4c do begin
|
|
for Disc0Sect := 0 to $1f do begin
|
|
for DiscSBP := 0 to $88 do begin
|
|
seek (Disc, (Disc0Track * $1120) + (Disc0Sect * $89) + DiscSBP);
|
|
if DiscSBP = 0 then write (Disc, $80)
|
|
else write (Disc, 0);
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
else begin
|
|
for Disc1Track := 0 to $4c do begin
|
|
for Disc1Sect := 0 to $1f do begin
|
|
for DiscSBP := 0 to $88 do begin
|
|
seek (Disc, (Disc1Track * $1120) + (Disc1Sect * $89) + DiscSBP);
|
|
if DiscSBP = 0 then write (Disc, $80)
|
|
else write (Disc, 0);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
close (Disc);
|
|
Disc0Track := 0;
|
|
Disc1Track := 0;
|
|
Disc0Sect := 0;
|
|
Disc1Sect := 0;
|
|
DiscRead := false;
|
|
DiscWrite := false;
|
|
DiscTrackSet := false;
|
|
DiscSectSet := false;
|
|
for DiscSBP := 0 to $88 do DiscSB [DiscSBP] := 0;
|
|
DiscSBP := 0;
|
|
end
|
|
else close (Disc);
|
|
except
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
//Read a sector from the buffer to the computer
|
|
else if B and $e = 4 then begin
|
|
if DiscWrite = false then if DiscTrackSet = false then if DiscSectSet = false then begin
|
|
DiscRead := true;
|
|
DiscSBP := 0;
|
|
end;
|
|
end
|
|
//Write a sector from the computer to the buffer
|
|
else if B and $e = 6 then begin
|
|
if DiscRead = false then if DiscTrackSet = false then if DiscSectSet = false then begin
|
|
DiscWrite := true;
|
|
for DiscSBP := 0 to $88 do DiscSB [DiscSBP] := 0;
|
|
DiscSBP := 0;
|
|
end;
|
|
end
|
|
//Set the track to be accessed
|
|
else if B and $e = 8 then begin
|
|
if DiscRead = false then if DiscWrite = false then if DiscSectSet = false then begin
|
|
DiscDrive := B and 1;
|
|
DiscTrackSet := true;
|
|
end;
|
|
end
|
|
//Set the sector to be accessed
|
|
else if B and $e = $a then begin
|
|
if DiscRead = false then if DiscWrite = false then if DiscTrackSet = false then begin
|
|
DiscDrive := B and 1;
|
|
DiscSectSet := true;
|
|
end;
|
|
end
|
|
//Read a sector from the disc to the buffer
|
|
else if B and $e = $c then begin
|
|
if DiscRead = false then if DiscWrite = false then if DiscTrackSet = false then if DiscSectSet = false then begin
|
|
{$ifndef fast}
|
|
wait (5);
|
|
{$endif}
|
|
assign (Discs, ExpandFileName ('~/.thingamajig/discs'));
|
|
//Check the system state
|
|
if FileExists (ExpandFileName ('~/.thingamajig/discs')) then begin
|
|
try
|
|
reset (Discs);
|
|
read (Discs, Disc0Path);
|
|
read (Discs, Disc1Path);
|
|
close (Discs);
|
|
except
|
|
end;
|
|
end;
|
|
//Set the drive
|
|
if B and 1 = 0 then DiscPath := Disc0Path
|
|
else DiscPath := Disc1Path;
|
|
assign (Disc, DiscPath);
|
|
//Read
|
|
try
|
|
reset (Disc);
|
|
if FileSize (Disc) = $526a0 then begin
|
|
if B and 1 = 0 then seek (Disc, (Disc0Track * $1120) + (Disc0Sect * $89))
|
|
else seek (Disc, (Disc1Track * $1120) + (Disc1Sect * $89));
|
|
read (Disc, DiscSB [0]);
|
|
if DiscSB [0] and $80 = $80 then begin
|
|
for DiscSBP := 1 to $88 do begin
|
|
if B and 1 = 0 then seek (Disc, (Disc0Track * $1120) + (Disc0Sect * $89) + DiscSBP)
|
|
else seek (Disc, (Disc1Track * $1120) + (Disc1Sect * $89) + DiscSBP);
|
|
read (Disc, DiscSB [DiscSBP]);
|
|
end;
|
|
end
|
|
else for DiscSBP := 0 to $88 do DiscSB [DiscSBP] := 0;
|
|
close (Disc)
|
|
end
|
|
else begin
|
|
close (Disc);
|
|
for DiscSBP := 0 to $88 do DiscSB [DiscSBP] := 0;
|
|
end;
|
|
except
|
|
for DiscSBP := 0 to $88 do DiscSB [DiscSBP] := 0;
|
|
end;
|
|
end;
|
|
end
|
|
//Write a sector from the buffer to the disc
|
|
else if B and $e = $e then begin
|
|
if DiscRead = false then if DiscWrite = false then if DiscTrackSet = false then if DiscSectSet = false then begin
|
|
{$ifndef fast}
|
|
wait (5);
|
|
{$endif}
|
|
assign (Discs, ExpandFileName ('~/.thingamajig/discs'));
|
|
//Check the system state
|
|
if FileExists (ExpandFileName ('~/.thingamajig/discs')) then begin
|
|
try
|
|
reset (Discs);
|
|
read (Discs, Disc0Path);
|
|
read (Discs, Disc1Path);
|
|
close (Discs);
|
|
except
|
|
end;
|
|
end;
|
|
//Set the drive
|
|
if B and 1 = 0 then DiscPath := Disc0Path
|
|
else DiscPath := Disc1Path;
|
|
if DiscPath <> '' then begin
|
|
assign (Disc, DiscPath);
|
|
//Write
|
|
try
|
|
reset (Disc);
|
|
if FileSize (Disc) = $526a0 then begin
|
|
for DiscSBP := 0 to $88 do begin
|
|
if B and 1 = 0 then seek (Disc, (Disc0Track * $1120) + (Disc0Sect * $89) + DiscSBP)
|
|
else seek (Disc, (Disc1Track * $1120) + (Disc1Sect * $89) + DiscSBP);
|
|
write (Disc, DiscSB [DiscSBP]);
|
|
end;
|
|
close (Disc);
|
|
end
|
|
else close (Disc);
|
|
except
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
{$endif}
|
|
{$ifdef modem}
|
|
//Modem
|
|
//Data
|
|
else if W = $fffa then begin
|
|
{$ifndef fast}
|
|
wait (33);
|
|
{$endif}
|
|
//Check the modem state
|
|
CheckModem;
|
|
//Send
|
|
if Mode = Originate then begin
|
|
if Connected then begin
|
|
if fpSend (ServerSocket, @B, 1, 0) <> 1 then begin
|
|
CloseSocket (ServerSocket);
|
|
Connected := false;
|
|
end;
|
|
end;
|
|
end
|
|
else if Mode = Answer then begin
|
|
if Connected then begin
|
|
if fpSend (ClientSocket, @B, 1, 0) <> 1 then begin
|
|
CloseSocket (ClientSocket);
|
|
Connected := false;
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
//Status
|
|
else if W = $fff9 then begin
|
|
//Check the modem state
|
|
CheckModem;
|
|
//Change the status
|
|
if Mode = Originate then begin
|
|
if Connected then if (B and 1) = 0 then begin
|
|
CloseSocket (ServerSocket);
|
|
Connected := false;
|
|
end;
|
|
end
|
|
else if Mode = Answer then begin
|
|
if Connected then begin
|
|
CloseSocket (ClientSocket);
|
|
Connected := false;
|
|
end;
|
|
if Listening then if (B and 1) = 1 then begin
|
|
//Connect
|
|
ClientAddrSize := sizeof (ClientAddr);
|
|
ClientSocket := fpAccept (ListenSocket, @ClientAddr, @ClientAddrSize) ;
|
|
if ClientSocket <> -1 then begin
|
|
Connected := true;
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
{$endif}
|
|
//Regular store
|
|
else if W <= LastRAM then Mem [W] := B;
|
|
end;
|
|
|
|
procedure Call;
|
|
begin
|
|
//Low byte of the return address
|
|
RP := RP - 1;
|
|
StoreByte (RP, IP and $ff);
|
|
//High byte of the return address
|
|
RP := RP - 1;
|
|
StoreByte (RP, IP shr 8);
|
|
//Call
|
|
IP := Addr;
|
|
end;
|
|
|
|
begin
|
|
|
|
//Initialise the halt and echo flags, the pointers, and the instruction counter
|
|
Hlt := false;
|
|
Echo := true;
|
|
IP := 0;
|
|
RP := LastRAM + 1;
|
|
IC := 0;
|
|
|
|
{$ifdef tape}
|
|
//Initialise the tape reader and punch
|
|
Reader.Path := '';
|
|
Reader.Reset := true;
|
|
Reader.Pos := 0;
|
|
Punch.Path := '';
|
|
Punch.Reset := true;
|
|
Punch.Pos := 0;
|
|
{$endif}
|
|
|
|
{$ifdef floppy}
|
|
//Initialise the disc system
|
|
Disc0Path := '';
|
|
Disc1Path := '';
|
|
DiscRead := false;
|
|
DiscWrite := false;
|
|
DiscTrackSet := false;
|
|
DiscSectSet := false;
|
|
DiscSBP := 0;
|
|
Disc0Track := 0;
|
|
Disc1Track := 0;
|
|
Disc0Sect := 0;
|
|
Disc1Sect := 0;
|
|
{$endif}
|
|
|
|
{$ifdef modem}
|
|
//Initialise the modem
|
|
Mode := Originate;
|
|
Listening := false;
|
|
Connected := false;
|
|
//Initialise the SIGPIPE handler
|
|
new (SigPipeHandler);
|
|
SigPipeHandler^.sa_Handler := SigActionHandler (@DoSig);
|
|
fillchar (SigPipeHandler^.Sa_Mask, sizeof (SigPipeHandler^.sa_mask), #0);
|
|
SigPipeHandler^.Sa_Flags := 0;
|
|
SigPipeHandler^.Sa_Restorer := nil;
|
|
try
|
|
fpSigAction (SigPipe, SigPipeHandler, nil);
|
|
except
|
|
end;
|
|
{$endif}
|
|
|
|
//Check the arguments
|
|
if ParamCount = 0 then begin
|
|
writeln ('Usage: emulator (-v) program (2> verbose_output)');
|
|
halt (1);
|
|
end;
|
|
if ParamStr (1) = '-v' then begin
|
|
Verbose := 1;
|
|
if ParamCount <> 2 then begin
|
|
writeln ('Usage: emulator (-v) program (2> verbose_output)');
|
|
halt (1);
|
|
end;
|
|
end
|
|
else if ParamStr (2) = '-v' then begin
|
|
Verbose := 2;
|
|
if ParamCount <> 2 then begin
|
|
writeln ('Usage: emulator (-v) program (2> verbose_output)');
|
|
halt (1);
|
|
end;
|
|
end
|
|
else begin
|
|
Verbose := 0;
|
|
if ParamCount <> 1 then begin
|
|
writeln ('Usage: emulator (-v) program (2> verbose_output)');
|
|
halt (1);
|
|
end;
|
|
end;
|
|
|
|
//Read a program file and check for errors
|
|
{$i-}
|
|
if Verbose = 1 then assign (Prog, ParamStr (2))
|
|
else assign (Prog, ParamStr (1));
|
|
reset (Prog);
|
|
if FileSize (Prog) > LastRAM + 1 then begin
|
|
writeln ('Error: program size cannot exceed ', LastRam + 1, ' bytes');
|
|
halt (1);
|
|
end;
|
|
{$i+}
|
|
if IOResult <> 0 then begin
|
|
writeln ('Error: program file cannot be read from');
|
|
halt (1);
|
|
end;
|
|
repeat
|
|
read (Prog, Mem [IP]);
|
|
IP := IP + 1;
|
|
IC := IC + 1;
|
|
until (eof (Prog));
|
|
|
|
//Reinitialise the instruction pointer
|
|
IP := 0;
|
|
|
|
//Begin the main loop
|
|
while Hlt = false do begin
|
|
|
|
//Print the CPU state to StdErr
|
|
if Verbose <> 0 then writeln (StdErr, 'IR: ', IntToHex (Op, 1), IntToHex (Regs, 1), IntToHex (Addr, 4), '; IP: ', IntToHex (IP, 4), ', RP: ', IntToHex (RP, 4), '; R0: ', IntToHex (R[0], 2), ', R1: ', IntToHex (R[1], 2), ', R2: ', IntToHex (R[2], 2), ', R3: ', IntToHex (R[3], 2), ansichar ($d));
|
|
|
|
//Fetch the instruction and increment the instruction pointer
|
|
//Fetch the opcode and register arguments
|
|
Fetched := LoadByte (IP);
|
|
//Decode the opcode
|
|
Op := Fetched and $f0 shr 4;
|
|
//Decode the register arguments
|
|
Regs := Fetched and $f;
|
|
X := Fetched and $c shr 2;
|
|
Y := Fetched and 3;
|
|
IP := IP + 1;
|
|
//Immediate or address argument
|
|
if Op >= $a then begin
|
|
//Immediate or high byte of address
|
|
Fetched := LoadByte (IP);
|
|
Addr := Fetched;
|
|
Addr := Addr shl 8;
|
|
IP := IP + 1;
|
|
//Low byte of address
|
|
if Op = $a then begin
|
|
if Y = 0 then begin
|
|
Fetched := LoadByte (IP);
|
|
Addr := Addr + Fetched;
|
|
IP := IP + 1;
|
|
end;
|
|
end
|
|
else begin
|
|
Fetched := LoadByte (IP);
|
|
Addr := Addr + Fetched;
|
|
IP := IP + 1;
|
|
end;
|
|
end
|
|
else Addr := 0;
|
|
|
|
//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 := LoadByte (RP);
|
|
IP := IP shl 8;
|
|
RP := RP + 1;
|
|
//Low byte of the return address
|
|
IP := IP + LoadByte (RP);
|
|
RP := RP + 1;
|
|
end
|
|
//Shl
|
|
else if Op = 2 then begin
|
|
if Y = 0 then R [X] := R [X] shl 4
|
|
else R [X] := R [X] shl Y;
|
|
end
|
|
//Shr
|
|
else if Op = 3 then begin
|
|
if Y = 0 then R [X] := R [X] shr 4
|
|
else R [X] := R [X] shr Y;
|
|
end
|
|
//Rol
|
|
else if Op = 4 then begin
|
|
if Y = 0 then R [X] := RolByte (R [X], 4)
|
|
else R [X] := RolByte (R [X], Y);
|
|
end
|
|
//Ror
|
|
else if Op = 5 then begin
|
|
if Y = 0 then R [X] := RorByte (R [X], 4)
|
|
else R [X] := RorByte (R [X], Y);
|
|
end
|
|
//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
|
|
//Immediate
|
|
if Y <> 0 then R [X] := Addr shr 8
|
|
//Address
|
|
else R [X] := LoadByte (Addr);
|
|
end
|
|
//Store
|
|
else if Op = $b then StoreByte (Addr, R [Y])
|
|
//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 Call;
|
|
end
|
|
//Clneq
|
|
else if Op = $f then begin
|
|
if R [X] <> R [Y] then Call;
|
|
end;
|
|
|
|
//Increment the instruction counter
|
|
IC := IC + 1;
|
|
|
|
end;
|
|
|
|
{$ifdef modem}
|
|
//Disconnect the modem
|
|
if Mode = Originate then if Connected then CloseSocket (ServerSocket);
|
|
if Mode = Answer then if Connected then begin
|
|
CloseSocket (ClientSocket);
|
|
CloseSocket (ListenSocket);
|
|
end;
|
|
{$endif}
|
|
|
|
{$ifndef fast}
|
|
wait (1);
|
|
{$endif}
|
|
|
|
end.
|