Snippets

T McDonnell A Simple Computer

Created by T McDonnell

File ASC.pas Added

  • Ignore whitespace
  • Hide word diff
+Program ASC (Input,Output); {A Simple Computer}
+
+uses CRT, DOS;
+
+{----------------(ASC Simulation)---------------}
+{CPU Registers}
+var
+  ACC : Longint; {ACCumulator}
+  MBR : Longint; {Memory Buffer Register}
+  MAR : Word;    {Memory Address Register}
+  IR : Word;     {Instruction Register}
+  PC : Word;     {Program Counter}
+  IR1 : Word;    {Index Register 1}
+  IR2 : Word;    {Index Register 2}
+  IR3 : Word;    {Index Register 3}
+
+{Random Access Memory}
+  RAM : Array[1..1000] of Longint; {1Kb RAM}
+{IR decoder variables}
+  memoryAddr : Integer;   {IR bits 7-15} {0-511}
+  idx : Integer;          {IR bits 0-1}  {0-3}
+  indirect : Integer;     {IT bit 2}     {0-1}
+  opcode : Integer;       {IR bits 3-6}  {0-15}
+{-----------------------------------------------}
+
+
+{-----------------------------------------------}
+var key : Char;  {Stores users menu choice}
+{-----------------------------------------------}
+
+
+{-----------------------------------------------}
+procedure PrintHex( X : Word);
+  const s : array[0..15] of char = '0123456789ABCDEF';
+  var i : integer;
+
+  begin
+    for i:=3 downto 0 do
+      Write( s[$000F and (X shr(i*4))]);
+  end;
+  {taken from PASCAL Programers Phasebook}
+  {by Ian A. Clari, Sigma Press, 1992}
+{-----------------------------------------------}
+
+
+procedure RegWin;
+  begin
+    Window(1,1,80,8);
+    TextBackground(blue);
+    TextColor(white);
+    ClrScr;
+    WriteLn('+============================================================================+');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    Write('+============================================================================+');
+    TextColor(yellow);
+    GotoXY(9,3); Write('ACCumalator:');             GotoXY(44,3); Write('Instruction Register:');
+    GotoXY(9,4); Write('Program Counter:');         GotoXY(44,4); Write('Index Register 1:');
+    GotoXY(9,5); Write('Memory Buffer Register:');  GotoXY(44,5); Write('Index Register 2:');
+    GotoXY(9,6); Write('Memory Address Register:'); GotoXY(44,6); Write('Index Register 3:');
+    TextColor(white);
+    GotoXY(34,3); PrintHex(ACC); GotoXY(66,3); PrintHex(IR);
+    GotoXY(34,4); PrintHex(PC);  GotoXY(66,4); PrintHex(IR1);
+    GotoXY(34,5); PrintHex(MBR); GotoXY(66,5); PrintHex(IR2);
+    GotoXY(34,6); PrintHex(MAR); GotoXY(66,6); PrintHex(IR3);
+  end;
+
+
+procedure MainWin;
+  begin
+    Window(1,9,80,25);
+    TextBackground(blue);
+    TextColor(white);
+    ClrScr;
+    WriteLn('+============================================================================+');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    Write('+============================================================================+');
+    TextColor(lightred);
+    GotoXY(11,16);
+    Write('A Simple Computer simulator - T.McDonnell, SYS-1C22,UEA,1999');
+    TextColor(yellow);
+    GotoXY(17,3); Write('1.....Load progam to ASC RAM');
+    GotoXY(17,4); Write('2.....Start ASC simulation using program in ASC RAM');
+    GotoXY(17,5); Write('3.....Step through a running ASC Simulation');
+    GotoXY(17,6); Write('4.....Show map of ASC RAM');
+    GotoXY(17,7); Write('5.....Edit contents of a ASC CPU register');
+    GotoXY(17,8); Write('6.....Edit contents of a ASC RAM address');
+    GotoXY(17,9); Write('7.....Set program break points');
+    GotoXY(17,11); Write('C.....Clear registers');
+    GotoXY(17,13); Write('X.....Exit ASC simulator');
+  end;
+
+
+procedure Dialog;
+  begin
+    Window(21,12,60,18);
+    TextBackground(cyan);
+    TextColor(white);
+    WriteLn('+======================================+');
+    WriteLn('|                                      |');
+    WriteLn('|                                      |');
+    WriteLn('|                                      |');
+    WriteLn('|                                      |');
+    WriteLn('|                                      |');
+    Write('+======================================+');
+    TextColor(black);
+  end;
+
+
+procedure Greeting;
+  begin
+    GotoXY(10,2); Write('A Simple Computer');
+    GotoXY(9,6); Write('T. McDonnell, 1999');
+    TextColor(lightred+blink);
+    GotoXY(10,4); Write('S I M U L A T O R');
+    repeat until KeyPressed;
+  end;
+
+
+function Addr : Word;
+  var address : Word;
+
+  begin
+    CursorOn;
+    Dialog; GotoXY(6,4); Write('Address: ');
+    GotoXY(6,2); Write('Enter in either Hex or Dec');
+    GotoXY(6,6); Write('Use $ for Hex values');
+    GotoXY(15,4); TextBackground(lightgray); Write('          ');
+    GotoXY(15,4); TextColor(white); ReadLn(address);
+    CursorOff;
+    MainWin;
+    Addr := address;
+  end;
+
+
+function Val : Word;
+  var value : Word;
+
+  begin
+    CursorOn;
+    Dialog; GotoXY(6,4); Write('Value: ');
+    GotoXY(6,2); Write('Enter in either Hex or Dec');
+    GotoXY(6,6); Write('Use $ for Hex values');
+    GotoXY(15,4); TextBackground(lightgray); Write('          ');
+    GotoXY(15,4); TextColor(white); ReadLn(value);
+    CursorOff;
+    MainWin;
+    Val := value;
+  end;
+
+
+function UserIn : Word;
+  var data : Word;
+
+  begin
+    Window(21,1,60,7);
+    TextBackground(cyan);
+    TextColor(white);
+    WriteLn('+---------------------------------------------------------+');
+    WriteLn('|                                                         |');
+    WriteLn('|                                                         |');
+    WriteLn('|                                                         |');
+    WriteLn('|                                                         |');
+    WriteLn('|                                                         |');
+    Write('+---------------------------------------------------------+');
+    TextColor(black);
+    Window(22,2,69,6);
+    GotoXY(3,3); Write('Enter Data: ');
+    TextBackground(lightgray); TextColor(white);
+    Write('               '); GotoXY(15,3);
+    ReadLn(data);
+    UserIn := data;
+  end;
+
+
+procedure UserOut(data:Word);
+  begin
+    Window(21,1,60,7);
+    TextBackground(cyan);
+    TextColor(white);
+    WriteLn('+---------------------------------------------------------+');
+    WriteLn('|                                                         |');
+    WriteLn('|                                                         |');
+    WriteLn('|                                                         |');
+    WriteLn('|                                                         |');
+    WriteLn('|                                                         |');
+    Write('+---------------------------------------------------------+');
+    TextColor(black);
+    Window(22,2,69,6);
+    WriteLn(data);
+  end;
+
+
+procedure Fetch;
+  begin
+    memoryAddr := 0; idx := 0; indirect := 0; opcode := 0;
+    MAR := PC;
+    MBR := RAM[MAR];
+    PC := PC + 1;
+    IR := MBR;
+  end;
+
+
+procedure Decode;
+  begin
+    memoryAddr := IR;
+
+    {--------------------------------------}
+    {calculate which index register, if any, is used}
+    if memoryAddr >= $0000 then
+    begin
+      idx := 3;
+      memoryAddr := memoryAddr - $0000;
+    end
+    else if memoryAddr >=$8000 then
+    begin
+      idx := 2;
+      memoryAddr := memoryAddr - $8000;
+    end
+    else if memoryAddr >=$4000 then
+    begin
+      idx := 1;
+      memoryAddr := memoryAddr - $8000;
+    end;
+
+    {--------------------------------------}
+    {check for indirect addressing mode}
+    if memoryAddr >= $2000 then
+    begin
+      indirect := 1;
+      memoryAddr := memoryAddr - $2000;
+    end;
+
+    {--------------------------------------}
+    {remove opcode}
+    if memoryAddr >= $1E00 then
+    begin
+      opcode := $F;           {TDX I,x}
+      memoryAddr := memoryAddr - $1E00;
+    end
+    else if memoryAddr >= $1C00 then
+    begin
+      opcode := $E;           {TIX I,x}
+      memoryAddr := memoryAddr - $1C00;
+    end
+    else if memoryAddr >= $1A00 then
+    begin
+      opcode := $D;           {STX I,x}
+      memoryAddr := memoryAddr - $1A00;
+    end
+    else if memoryAddr >= $1800 then
+    begin
+      opcode := $C;           {LDX, I,x}
+      memoryAddr := memoryAddr - $1800;
+    end
+    else if memoryAddr >= $1600 then
+    begin
+      opcode := $B;           {SHR}
+      memoryAddr := memoryAddr - $1600;
+    end
+    else if memoryAddr >= $1400 then
+    begin
+      opcode := $A;           {SHL}
+      memoryAddr := memoryAddr - $1400;
+    end
+    else if memoryAddr >= $1200 then
+    begin
+      opcode := $9;           {WWD}
+      memoryAddr := memoryAddr - $1200;
+    end
+    else if memoryAddr >= $1000 then
+    begin
+      opcode := $8;           {RWD}
+      memoryAddr := memoryAddr - $1000;
+    end
+    else if memoryAddr >= $0E00 then
+    begin
+      opcode := $7;           {BIN x}
+      memoryAddr := memoryAddr - $0E00;
+    end
+    else if memoryAddr >= $0C00 then
+    begin
+      opcode := $6;           {BIP x}
+      memoryAddr := memoryAddr - $0C00;
+    end
+    else if memoryAddr >= $0A00 then
+    begin
+      opcode := $5;           {BRU x}
+      memoryAddr := memoryAddr - $0A00;
+    end
+    else if memoryAddr >= $0800 then
+    begin
+      opcode := $4;           {HLT}
+      memoryAddr := memoryAddr - $0800;
+    end
+    else if memoryAddr >= $0600 then
+    begin
+      opcode := $3;           {TCA}
+      memoryAddr := memoryAddr - $0600;
+    end
+    else if memoryAddr >= $0400 then
+    begin
+      opcode := $2;           {ADD x}
+      memoryAddr := memoryAddr - $0400;
+    end
+    else if memoryAddr >= $0200 then
+    begin
+      opcode := $1;           {STA x}
+      memoryAddr := memoryAddr - $0200;
+    end
+    else if memoryAddr >= $0000 then
+    begin
+      opcode := $0;           {LDA x}
+      memoryAddr := memoryAddr - $0000;
+    end;
+    {------------------------------}
+    {update registers}
+    MAR := memoryAddr;
+
+    if idx = 0 then
+      begin
+        if indirect = 0 then
+          begin
+            MBR := RAM[MAR];
+          end
+          else
+          begin
+            MBR := RAM[MAR];
+            MAR := MBR;
+            MBR := RAM[MAR];
+          end;
+      end
+      else
+      begin
+        if indirect = 0 then
+        begin
+          if idx = 1 then MBR := RAM[MAR + IR1];
+          if idx = 2 then MBR := RAM[MAR + IR2];
+          if idx = 3 then MBR := RAM[MAR + IR3];
+        end
+        else
+        begin
+          if idx = 1 then MBR := RAM[MAR + IR1];
+          if idx = 2 then MBR := RAM[MAR + IR2];
+          if idx = 3 then MBR := RAM[MAR + IR3];
+          MAR := MBR;
+          MBR := RAM[MAR];
+        end;
+      end;
+
+    if opcode = $C then
+      begin
+        MAR := memoryAddr;
+        MBR := RAM[MAR];
+      end;
+
+    if opcode = $D then MAR := memoryAddr;
+    if opcode = $E then MAR := memoryAddr;
+    if opcode = $F then MAR := memoryAddr;
+  end;
+
+
+procedure Execute;
+  begin
+    if opcode = $0 then ACC := MBR;
+    if opcode = $1 then
+      begin
+        MBR := ACC;
+        RAM[MAR] := MBR;
+      end;
+    if opcode = $2 then ACC := ACC + MBR;
+    if opcode = $3 then ACC := 0 - ACC;
+    if opcode = $5 then PC := MAR;
+    if opcode = $6 then if ACC > 0 then PC := MAR;
+    if opcode = $7 then if ACC < 0 then PC := MAR;
+    if opcode = $8 then ACC := UserIn;
+    if opcode = $9 then UserOut(ACC);
+    if opcode = $A then ACC := ACC * 2;
+    if opcode = $B then ACC := ACC DIV 2;
+    if opcode = $C then
+      begin
+        if idx = 1 then IR1 := MBR;
+        if idx = 2 then IR2 := MBR;
+        if idx = 3 then IR3 := MBR;
+      end;
+    if opcode = $D then
+      begin
+        if idx = 1 then MBR := IR1;
+        if idx = 2 then MBR := IR2;
+        if idx = 3 then MBR := IR3;
+      end;
+    if opcode = $E then
+      begin
+        if idx = 1 then
+          begin
+            IR1 := IR1 + 1;
+            if IR1 = 0 then PC := MAR;
+          end;
+        if idx = 2 then
+          begin
+            IR2 := IR2 + 1;
+            if IR2 = 0 then PC := MAR;
+          end;
+        if idx = 3 then
+          begin
+            IR3 := IR3 + 1;
+            if IR3 = 0 then PC := MAR;
+          end;
+      end;
+    if opcode = $F then
+      begin
+        if idx = 1 then
+          begin
+            IR1 := IR1 - 1;
+            if not(IR1 = 0) then PC := MAR;
+          end;
+        if idx = 2 then
+          begin
+            IR2 := IR2 - 1;
+            if not(IR2 = 0) then PC := MAR;
+          end;
+        if idx = 3 then
+          begin
+            IR3 := IR3 - 1;
+            if not(IR3 = 0) then PC := MAR;
+          end;
+      end;
+  end;
+
+  {---------------------------------------}
+procedure Load;
+  var F : Text;
+      userfile : String;
+      address : integer;
+      temp : Word;
+      SRec : SearchRec;
+
+  begin
+    {--------------------}
+    Dialog;
+    GotoXY(3,2); Write('Load ASC machine code from...');
+    GotoXY(3,5); Write('Do not enter DOS extension (.asc)');
+    GotoXY(5,4); Write('File: ');
+    Textbackground(lightgray); TextColor(white); Write('          ');
+    CursorOn;
+    repeat
+      GotoXY(11,4); ReadLn(userfile);
+    until not(userfile='');
+    userfile := userfile + '.asc';
+    CursorOff; Dialog;
+    TextColor(lightred+blink); GotoXY(11,4); Write('Processing ',userfile);
+    {--------------------}
+    FindFirst(userfile, AnyFile, SRec);
+    if DosError = 2 then
+      begin
+        Dialog; GotoXY(6,4); TextColor(lightred);
+        Write('ERROR - File does not exist');
+        repeat until KeyPressed;
+      end
+      else
+      begin
+        {---------------------}
+        address := Addr;
+        Dialog;
+        TextColor(lightred+blink);
+        GotoXY(11,4); Write('Processing ',userfile);
+        {---------------------}
+        Assign(f,userfile); Reset(f);
+        repeat
+          if address > 1000 then
+            begin
+              Read(F, temp);
+              Dialog; GotoXY(6,4); TextColor(lightred);
+              Write('FATAL ERROR - ASC out of RAM');
+              repeat until KeyPressed;
+            end
+            else
+            begin
+              Read(F, RAM[address]);
+              address := address + 1;
+            end;
+        until Eof(F);
+        close(F);
+      end;
+    MainWin;
+  end;
+
+
+procedure FetchExecute;
+  begin
+    PC := Addr;
+    Dialog; TextColor(lightred+blink);
+    GotoXY(11,4); Write('Processing...');
+    repeat
+      Fetch;
+      Decode;
+      Execute;
+      RegWin;
+    until opcode = $4;
+    MainWin;
+  end;
+
+
+procedure Trace;
+  var
+    step : char;
+    charcheck : Integer;
+
+  begin
+    PC := Addr;
+    Dialog;
+    GotoXY(6,3); Write('[S] - Step');
+    GotoXY(6,5); Write('[X] - Exit');
+    repeat
+      charcheck := 0;
+      Fetch;
+      Decode;
+      Execute;
+      RegWin;
+      repeat
+        repeat until KeyPressed;
+        step := ReadKey;
+        if step = 'x' then
+        begin
+          step := 'X';
+          charcheck := 1;
+        end;
+        if step = 'X' then charcheck := 1;
+        if step = 's' then charcheck := 1;
+        if step = 'S' then charcheck := 1;
+      until charcheck = 1;
+      if opcode = $4 then step := 'X';
+    until step = 'X';
+    MainWin;
+  end;
+
+
+procedure Map;
+  var
+    startAddr : Word;
+    endAddr : Word;
+    address : Word;
+
+  begin
+    Dialog; GotoXY(6,3); Write('Start Addr: ');
+    GotoXY(6,5); Write('End Addr: ');
+    GotoXY(6,2); Write('Enter in either Hex or Dec');
+    GotoXY(6,6); Write('Use $ for Hex values');
+    TextBackground(lightgray);
+    GotoXY(18,3); Write('          ');
+    GotoXY(18,5); Write('          ');
+    CursorOn; TextColor(white);
+    GotoXY(18,3); ReadLn(startAddr);
+    GotoXY(18,5); ReadLn(endAddr);
+    CursorOff;
+    MainWin;
+    {---------------------------}
+    Window(38,1,79,24);
+    WriteLn('+----------------------------------------------------------------------------+');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    WriteLn('|                                                                            |');
+    Write('+----------------------------------------------------------------------------+');
+    TextColor(black);
+    GotoXY(4,2); Write('Address      Contents');
+    GotoXY(19,3); Write('Hex      Decimal');
+    {-------------------------------}
+    Window(43,5,74,22);
+    for address := startAddr to endAddr do
+      begin
+        TextColor(yellow); PrintHex(address);
+        TextColor(white); Write('      '); PrintHex(RAM[address]);
+        WriteLn('      ',RAM[address]);
+      end;
+    repeat until KeyPressed;
+    RegWin; MainWin;
+  end;
+
+
+procedure RegEdit;
+  var
+    reg : String;
+
+  begin
+    Dialog;
+    GotoXY(3,2); Write('Enter Register code');
+    GotoXY(3,6); Write('Capital letters in register window');
+    GotoXY(6,4); Write('Register: ');
+    TextBackground(lightgray); TextColor(white);
+    GotoXY(16,4); Write('          ');
+    GotoXY(16,4); ReadLn(reg);
+    if reg='ACC' then ACC := Val;
+    if reg='acc' then ACC := Val;
+    if reg='PC' then PC := Val;
+    if reg='pc' then PC := Val;
+    if reg='MBR' then MBR := Val;
+    if reg='mbr' then MBR := Val;
+    if reg='MAR' then MAR := Val;
+    if reg='mar' then MAR := Val;
+    if reg='IR' then IR := Val;
+    if reg='ir' then IR := Val;
+    if reg='IR1' then IR1 := Val;
+    if reg='ir1' then IR1 := Val;
+    if reg='IR2' then IR2 := Val;
+    if reg='ir2' then IR2 := Val;
+    if reg='IR3' then IR3 := Val;
+    if reg='ir3' then IR3 := Val;
+    RegWin;
+    MainWin;
+  end;
+
+
+procedure AddrEdit;
+  var
+    address : Word;
+
+  begin
+    address := Addr;
+    RAM[address] := Val;
+  end;
+
+
+procedure BreakPts;
+  begin
+  end;
+
+
+procedure Clear;
+  begin
+    ACC := 0;  IR := 0;
+    PC := 0;   IR1 := 0;
+    MAR := 0;  IR2 := 0;
+    MBR := 0;  IR3 := 0;
+    RegWin;
+  end;
+
+{-------------------------------------------------}
+
+{Main Subroutine}
+begin
+  {startup}
+  CursorOff;
+  RegWin;
+  MainWin;
+  Dialog;
+  Greeting;
+  MainWin;
+
+  {main loop}
+  repeat
+    key := ReadKey;
+    case key of
+      '1' : Load;
+      '2' : FetchExecute;
+      '3' : Trace;
+      '4' : Map;
+      '5' : RegEdit;
+      '6' : AddrEdit;
+      '7' : BreakPts;
+      'C' : Clear;
+      'c' : Clear;
+      'x' : key := 'X';
+    end;
+  until key = 'X';
+end
HTTPS SSH

You can clone a snippet to your computer for local editing. Learn more.