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.