{**************************************************************}
{                                                              }
{                Machine Language Simulator                    }
{                       version 2.0P                           }
{                                                              }
{                  by J. Glenn Brookshear                      }
{                     Marquette University                     }
{                                                              }
{     Distributed by The Benjamin/Cummings Publishing Co.      }
{                                                              }
{        Simulates the machine described in Appendix B         }
{        of the text Computer Science: An Overview.            }
{                                                              }
{              Last update:  September 8, 1993                 }
{                                                              }
{**************************************************************}

{**************************************************************}
{                                                              }
{   Except for the file I/O in the procedures ListPrograms,    }
{   Insert, DeleteProg, and RestoreProg, this program should   }
{   be compatible with any Pascal system.  This version of     }
{   the program is written for Borland's Turbo Pascal and      }
{   thus uses the assign statement.  It expects a file         }
{   named SaveFile to be present, even if that file is empty.  }
{   This file contains the programs (memory images) that       }
{   have been saved.                                           }
{                                                              }
{**************************************************************}

program Simulator (input, output, SaveFile);

const StringLength = 20;
      SaveFileName = 'SaveFile';
      TempFileName = 'TempFile';

type MemType =      array[0..15, 0..15] of integer;
     StringType =   packed array [1..StringLength] of char;
     MemoryRecord = record
                      ID: StringType;
                      Contents: MemType
                    end;


var ProgramCounter:  integer;                   { Machine's registers  }
    InstructRegHigh: integer;                   { and main memory      }
    InstructRegLow:  integer;                   { are global           }
    Register:        array[0..15] of integer;   { variables.           }
    Memory:          MemType;
    SaveFile:        file of MemoryRecord;      { Files for saving     }
    TempFile:        file of MemoryRecord;      { memory images.       }
    I, J:            integer;
    Command:         char;                      { Command received     }
                                                { from may display     }
                                                { options.             }
    Done:            Boolean;
    OpCode:          integer;                   { Parts of machine     }
    Operand1:        integer;                   { instruction assigned }
    Operand2:        integer;                   { by procedure Decode. }
    Operand3:        integer;                   {                      }


{*****************************************************}
{                                                     }
{   UpperCase converts letters to uppercase.          }
{                                                     }
{*****************************************************}

function UpperCase(C: char): char;
begin
  if C in ['a'..'z']
    then UpperCase := chr(ord(C) - ord('a') + ord('A'))
    else UpperCase := C
end;


{*****************************************************}
{                                                     }
{   Hex converts values 0 through 9 to characters     }
{                                                     }
{*****************************************************}

function Hex(N: integer): char;
begin
  if N in [0..9]
    then Hex := chr(N + ord('0'))
    else Hex := chr(N - 10 + ord('A'))
end;


{*****************************************************}
{                                                     }
{   Int converts characters representing hexadecimal  }
{   digits to their numeric equivalent.               }
{                                                     }
{*****************************************************}

function Int(C: char): integer;
begin
  if C in ['0'..'9'] then Int := ord(C) - ord('0');
  if C in ['A'..'F'] then Int := ord(C) - ord('A')
end;


{*****************************************************}
{                                                     }
{   DisplayMemory displays the simulated machine's    }
{   memory on the monitor screen.                     }
{                                                     }
{   Global variables:  Memory                         }
{                                                     }
{*****************************************************}

procedure DisplayMemory;
var I, J:         integer;
    HexContents:  packed array[1..2] of char;
begin
  writeln;
  writeln('Main Memory':40);
  writeln;
  write ('   ');
  for I := 0 to 15 do
    write('   ', Hex(I));
  writeln;
  for I := 0 to 15 do
    begin
      write(' ', Hex(I), ' ');
      for J := 0 to 15 do
        begin
          HexContents[1] := Hex(Memory[I,J] div 16);
          HexContents[2] := Hex(Memory[I,J] mod 16);
          write(HexContents:4)
        end;
      writeln
    end;
  writeln
end;


{*****************************************************}
{                                                     }
{   Display displays the contents of the simulated    }
{   machine's main memory and registers on the        }
{   monitor's screen as well as the command options.  }
{                                                     }
{   Global variables:  Register                       }
{                      ProgramCounter                 }
{                      InstructionRegHigh             }
{                      InstructionRegLow              }
{                                                     }
{*****************************************************}

procedure Display;
var I, J:         integer;
    HexContents:  packed array[1..2] of char;
begin
  writeln;
  DisplayMemory;
  for I := 0 to 7 do
    begin
      HexContents[1] := Hex(Register[I] div 16);
      HexContents[2] := Hex(Register[I] mod 16);
      write('R', Hex(I), ': ', HexContents, '  ')
    end;
  HexContents[1] := Hex(ProgramCounter div 16);
  HexContents[2] := Hex(ProgramCounter mod 16);
  writeln(' PC: ', HexContents);
  for I := 8 to 15 do
    begin
      HexContents[1] := Hex(Register[I] div 16);
      HexContents[2] := Hex(Register[I] mod 16);
      write('R', Hex(I), ': ', HexContents, '  ')
    end;
  HexContents[1] := Hex(InstructRegHigh div 16);
  HexContents[2] := Hex(InstructRegHigh mod 16);
  write(' IR: ', HexContents);
  HexContents[1] := Hex(InstructRegLow div 16);
  Hexcontents[2] := Hex(InstructRegLow mod 16);
  writeln(HexContents);
  writeln;
  write('Type one of the following (H for Help): ');
  write('M, R, P, S, G, C, F, H, Q: ')
end;


{*****************************************************}
{                                                     }
{   ClearMemory places 0 in all memory cells.         }
{                                                     }
{   Global variables:  Memory                         }
{                                                     }
{*****************************************************}

procedure ClearMemory;
begin
  for I := 0 to 15 do
    for J := 0 to 15 do
      Memory[I,J] := 0
end;


{*****************************************************}
{                                                     }
{   Clear places 0 in all memory cells, all           }
{   registers, or both.                               }
{                                                     }
{   Global variables:  Register                       }
{                                                     }
{*****************************************************}

procedure Clear;
var C: char;
    I: integer;
begin
  writeln;
  write('Clear memory, registers, or both? (M, R, or B): ');
  readln(C);
  writeln;
  C := UpperCase(C);
  if C = 'M' then ClearMemory;
  if C = 'R' then
    for I := 0 to 15 do
      Register[I] := 0;
  if C = 'B' then
    begin
      ClearMemory;
      for I := 0 to 15 do
        Register[I] := 0
    end
end;


{*****************************************************}
{                                                     }
{  GetByte reads two characters from the keyboard,    }
{  interprets them as a hexadecimal representation,   }
{  and returns the equivalent numeric value.  If      }
{  nothing but a <Enter> is typed, GetByte returns    }
{  -2, if invalid input is entered, GetByte returns   }
{  -1.                                                }
{                                                     }
{*****************************************************}

function GetByte: integer;
var HexString:  packed array [1..2] of char;
    valid:      Boolean;
    empty:      Boolean;
    value:      integer;
    I:          integer;
begin
  HexString[1] := ' ';
  HexString[2] := ' ';
  valid := true;
  value := 0;
  empty := true;
  I := 1;
  while (not eoln) and (I < 3) do
    begin
      read(HexString[I]);
      I := I + 1
    end;
  readln;
  if I <> 1 then empty := false;
  for I := 1 to 2 do
    begin
      HexString[I] := UpperCase(HexString[I]);
      if HexString[I] in ['0'..'9','A'..'F'] then
        case HexString[I] of
          '0': value := value * 16 + 0;
          '1': value := value * 16 + 1;
          '2': value := value * 16 + 2;
          '3': value := value * 16 + 3;
          '4': value := value * 16 + 4;
          '5': value := value * 16 + 5;
          '6': value := value * 16 + 6;
          '7': value := value * 16 + 7;
          '8': value := value * 16 + 8;
          '9': value := value * 16 + 9;
          'A': value := value * 16 + 10;
          'B': value := value * 16 + 11;
          'C': value := value * 16 + 12;
          'D': value := value * 16 + 13;
          'E': value := value * 16 + 14;
          'F': value := value * 16 + 15
        end
      else
        valid := false
    end;
  if valid and not empty then GetByte := value;
  if empty then GetByte := -2;
  if (not valid) and (not empty) then GetByte := -1
end;


{*****************************************************}
{                                                     }
{   ChangeMemory allows the user to change the        }
{   contents of specified memory cells.               }
{                                                     }
{   Global variables:  Memory                         }
{                                                     }
{*****************************************************}

procedure ChangeMemory;
var Address:     integer;
    Row:         integer;
    Column:      integer;
    HexContents: array[1..2] of char;
    Value:       integer;
begin
  repeat
    writeln;
    writeln;
    write('Address of the cell to be changed (two hexadecimal digits): ');
    Address := GetByte
  until (0 <= Address) and (Address <= 256);
  Row := Address div 16;
  Column := Address mod 16;
  writeln;
  writeln;
  writeln('      Cell      Current        New');
  writeln('     Address    Contents     Contents');
  repeat
    write('       ', Hex(Row), Hex(Column), '          ');
    HexContents[1] := Hex(Memory[Row, Column] div 16);
    HexContents[2] := Hex(Memory[Row, Column] mod 16);
    write(HexContents[1], HexContents[2], '           ');
    Value := GetByte;
    writeln;
    if Value = -1 then
      writeln('Illegal value.  Type <Enter> to return to main display.');
    if (0 <= Value) and (Value <= 255) then
      begin
        Memory[Row, Column] := Value;
        Address := (Address + 1) mod 256;
        Row := Address div 16;
        Column := Address mod 16
      end
  until (Value = -2)
end;


{*****************************************************}
{                                                     }
{   ChangeReg allows the users to change the          }
{   contents of specified general purpose registers.  }
{                                                     }
{   Global variables:  Register                       }
{                                                     }
{*****************************************************}

procedure ChangeReg;
var Continue:    Boolean;
    Num:         integer;
    Character:   char;
    Value:       integer;
    HexContents: packed array[1..2] of char;
begin
  Continue := true;
  while Continue do
    begin
      writeln;
      write('Register to change: ');
      readln(Character);
      writeln;
      Character := UpperCase(Character);
      if Character in ['0'..'9','A'..'F'] then
        begin
          Num := Int(Character);
          HexContents[1] := Hex(Register[Num] div 16);
          HexContents[2] := Hex(Register[Num] mod 16);
          writeln('Value of register ', Character, ' is: ', HexContents);
          write('New value for register ',Character, ' is: ');
          Value := GetByte;
          writeln;
          if (0 <= Value) and (Value <= 255) then
            begin
              Register[Num] := Value;
              writeln;
              write('Change another register? (Y/N): ');
              readln(Character);
              if not (Character in ['Y','y']) then
                Continue := false
            end
          else
            writeln('Illegal register value.')
        end
      else
        writeln('**Illegal register number**')
  end
end;


{*****************************************************}
{                                                     }
{   ChangePC allows the user to change the contents   }
{   of the program counter.                           }
{                                                     }
{   Global variables:  ProgramCounter                 }
{*****************************************************}

procedure ChangePC;
begin
  writeln;
  repeat
    writeln;
    write('New value of the program counter: ');
    ProgramCounter := GetByte;
    writeln;
    if (ProgramCounter < 0) or (255 < ProgramCounter) then
      writeln('**Illegal value for program counter**');
  until (0 <= ProgramCounter) and (ProgramCounter <= 255);
  writeln
end;


{*****************************************************}
{                                                     }
{   AddFloatingPoint implements the floating-point    }
{   addition machine instruction.                     }
{                                                     }
{   Global variables:  Register                       }
{                      Operand1                       }
{                      Operand2                       }
{                      Operand3                       }
{*****************************************************}

procedure AddFloatingPoint;
var  Mantissa2:  integer;
     Mantissa3:  integer;
     Exponent2:  integer;
     Exponent3:  integer;
     Answer:     integer;
     Exponent:   integer;
begin
  Mantissa2 := (Register[Operand2] mod 16) * 16;
  Mantissa3 := (Register[Operand3] mod 16) * 16;
  Exponent2 := ((Register[Operand2] div 16) mod 8) - 4;
  Exponent3 := ((Register[Operand3] div 16) mod 8) - 4;
  if Exponent2 > 0 then
    while Exponent2 <> 0 do
      begin
        Mantissa2 := Mantissa2 * 2;
        Exponent2 := Exponent2 - 1
      end
  else
    while Exponent2 <> 0 do
      begin
        Mantissa2 := Mantissa2 div 2;
        Exponent2 := Exponent2 + 1
      end;
  if Exponent3 > 0 then
    while Exponent3 <> 0 do
      begin
        Mantissa3 := Mantissa3 * 2;
        Exponent3 := Exponent3 - 1
      end
  else
    while Exponent3 <> 0 do
      begin
        Mantissa3 := Mantissa3 div 2;
        Exponent3 := Exponent3 + 1
      end;
  if (Register[Operand2] div 128) = 1 then
    Mantissa2 := Mantissa2 * -1;
  if (Register[Operand3] div 128) = 1 then
    Mantissa3 := Mantissa3 * -1;
  Answer := Mantissa2 + Mantissa3;
  if Answer < 0 then
    begin
      Register[Operand1] := 128;
      Answer := Answer * -1
    end
  else
    Register[Operand1] := 0;
  if (Answer <> 0) then
    begin
      Exponent := 4;
      while (Answer > 255) or (Answer < 128) do
        if Answer > 255 then
          begin
            Answer := Answer div 2;
            Exponent := Exponent + 1
          end
        else
          begin
            Answer := Answer * 2;
            Exponent := Exponent + 1
          end
    end;
    if (Answer = 0) then Exponent := 0;
    Register[Operand1] := Register[Operand1] + (Exponent * 16);
    Register[Operand1] := Register[Operand1] + (Answer div 16)
end;


{*****************************************************}
{                                                     }
{   OrRegisters implements the machine language Or    }
{   instruction.                                      }
{                                                     }
{   Global variables:  Register                       }
{                      Operand1                       }
{                      Operand2                       }
{                      Operand3                       }
{                                                     }
{*****************************************************}

procedure OrRegisters;
var  Op2:  integer;
     Op3:  integer;
     I:    integer;
     Bit:  integer;
begin
  Op2 := Register[Operand2];
  Op3 := Register[Operand3];
  Register[Operand1] := 0;
  Bit := 1;
  for I := 0 to 7 do
  begin
    if (1 = Op2 mod 2) or (1 = Op3 mod 2) then
      Register[Operand1] := Register[Operand1] + Bit;
    Op2 := Op2 div 2;
    Op3 := Op3 div 2;
    Bit := Bit * 2
  end
end;


{*****************************************************}
{                                                     }
{   AndRegisters implements the machine language And  }
{   instruction.                                      }
{                                                     }
{   Global variables:  Register                       }
{                      Operand1                       }
{                      Operand2                       }
{                      Operand3                       }
{                                                     }

{*****************************************************}

procedure AndRegisters;
var  Op2:  integer;
     Op3:  integer;
     I:    integer;
     Bit:  integer;
begin
  Op2 := Register[Operand2];
  Op3 := Register[Operand3];
  Register[Operand1] := 0;
  Bit := 1;
  for I := 0 to 7 do
  begin
    if (1 = Op2 mod 2) and (1 = Op3 mod 2) then
      Register[Operand1] := Register[Operand1] + Bit;
    Op2 := Op2 div 2;
    Op3 := Op3 div 2;
    Bit := Bit * 2
  end
end;


{*****************************************************}
{                                                     }
{   XOrRegisters implements the machine language XOr  }
{   instruction.                                      }
{                                                     }
{   Global variables:  Register                       }
{                      Operand1                       }
{                      Operand2                       }
{                      Operand3                       }
{                                                     }

{*****************************************************}

procedure XOrRegisters;
var  Op2:  integer;
     Op3:  integer;
     I:    integer;
     Bit:  integer;
begin
  Op2 := Register[Operand2];
  Op3 := Register[Operand3];
  Register[Operand1] := 0;
  Bit := 1;
  for I := 0 to 7 do
  begin
    if ((1 = Op2 mod 2) and (0 = Op3 mod 2)) or
       ((0 = Op2 mod 2) and (1 = Op3 mod 2)) then
      Register[Operand1] := Register[Operand1] + Bit;
    Op2 := Op2 div 2;
    Op3 := Op3 div 2;
    Bit := Bit * 2
  end
end;


{*****************************************************}
{                                                     }
{   Rotate implements the machine language Rotate     }
{   instruction.                                      }
{                                                     }
{   Global variables:  Register                       }
{                      Operand1                       }
{                      Operand3                       }
{                                                     }

{*****************************************************}

procedure Rotate;
var  I:   integer;
     Bit: integer;
begin
  for I := 1 to Operand3 do
    begin
      Bit := Register[Operand1] mod 2;
      Register[Operand1] := (Register[Operand1] div 2) + (Bit * 128)
    end
end;


{*****************************************************}
{                                                     }
{   Fetch implements the fetch phase of the           }
{   simulated machine cycle.                          }
{                                                     }
{   Global variables:  ProgramCounter                 }
{                      InstructionRegHigh             }
{                      InstructionRegLow              }
{                      Memory                         }
{                                                     }
{*****************************************************}

procedure Fetch;
var  Row:    integer;
     Column: integer;
begin
  Row := ProgramCounter div 16;
  Column := ProgramCounter mod 16;
  InstructRegHigh := Memory[Row, Column];
  ProgramCounter := (ProgramCounter + 1) mod 256;
  Row := ProgramCounter div 16;
  Column := ProgramCounter mod 16;
  InstructRegLow := Memory[Row, Column];
  ProgramCounter := (ProgramCounter + 1) mod 256
end;


{*****************************************************}
{                                                     }
{   Decode implements the decode phase of the         }
{   simulated machine cycle.                          }
{                                                     }
{   Global variables:  OpCode                         }
{                      Operand1                       }
{                      Operand2                       }
{                      Operand3                       }
{                      InstructionRegHigh             }
{                      InstructionRegLow              }
{                                                     }
{*****************************************************}

procedure Decode;
begin
  OpCode := InstructRegHigh div 16;
  Operand1 := InstructRegHigh mod 16;
  Operand2 := InstructRegLow div 16;
  Operand3 := InstructRegLow mod 16
end;


{*****************************************************}
{                                                     }
{   Execute implements the execute phase of the       }
{   simulated machine cycle.                          }
{                                                     }
{   Global variables:  OpCode                         }
{                      Register                       }
{                      Memory                         }
{                      Operand1                       }
{                      Operand2                       }
{                      Operand3                       }
{                      ProgramCounter                 }
{                                                     }
{*****************************************************}

procedure Execute(var Halt: Boolean);
begin
  Halt := false;
  case OpCode of
    1: Register[Operand1] := Memory[Operand2, Operand3];
    2: Register[Operand1] := (Operand2 * 16) + Operand3;
    3: Memory[Operand2, Operand3] := Register[Operand1];
    4: Register[Operand3] := Register[Operand2];
    5: Register[Operand1] := (Register[Operand2] + Register[Operand3]) mod 256;
    6: AddFloatingPoint;
    7: OrRegisters;
    8: AndRegisters;
    9: XOrRegisters;
   10: Rotate;
   11: if Register[0] = Register[Operand1] then
          ProgramCounter := (Operand2 * 16) + Operand3;
   12: Halt := true
  end
end;


{*****************************************************}
{                                                     }
{   SingleStep simulates one machine cycle.           }
{                                                     }
{   Global variables:  OpCode                         }
{                                                     }
{*****************************************************}

procedure SingleStep;
var Halt: Boolean;
begin
  Fetch;
  Decode;
  if not (OpCode in [1..12]) then
    begin
      writeln;
      writeln('***Illegal instruction encountered***');
      write('***Type <Enter> to return to the main display. ');
      readln;
      writeln
    end
  else
    Execute(Halt)
end;


{*****************************************************}
{                                                     }
{   Go repeats machine cycles until it encounters     }
{   a halt instruction or until 500 cycles have       }
{   been simulated.  In the latter case, Go asks      }
{   the user if it should continue executing cycles.  }
{                                                     }
{   Global variables:  OpCode                         }
{                                                     }
{*****************************************************}

procedure Go;
var  Count:  integer;
     Stop:   Boolean;
     C:      char;
begin
  Stop := false;
  repeat
    Count := 0;
    while (Count < 500) and (Stop = false) do
      begin
        Fetch;
        Decode;
        if not (OpCode in [1..12]) then
          begin
            Stop := true;
            writeln;
            writeln('***Illegal instruction encountered***');
            write('***Type <Enter> to return to the main display. ');
            readln;
            writeln
          end
        else
          Execute(Stop);
        Count := Count + 1;
        if Count = 500 then
          begin
            writeln;
            writeln('500 machine cycles have been executed.');
            write('Continue executing machine cycles? (Y/N): ');
            readln(C);
            writeln;
            if (C = 'Y') or (C = 'y') then
              Count := 0
            else
              Stop:= true
          end
      end
  until (Stop = true)
end;


{*****************************************************}
{                                                     }
{  ListPrograms presents a listing of all the         }
{  programs currently in the file SaveFile.           }
{                                                     }
{*****************************************************}

procedure ListPrograms;
var CurrRecord: MemoryRecord;
    NoProgs:    Boolean;
begin
  assign(SaveFile, SaveFileName);
  reset(SaveFile);
  writeln;
  writeln('Programs available are as follows: ');
  NoProgs := true;
  while not eof (SaveFile) do
    begin
      read(SaveFile, CurrRecord);
      writeln('     ', CurrRecord.ID);
      NoProgs := false
    end;
  if NoProgs = true then
    writeln('     No programs are available.');
  writeln;
  write('Type <Enter> to return to main display. ');
  readln;
  writeln
end;


{*****************************************************}
{                                                     }
{   Insert places a new program in SaveFile.          }
{   Programs are stored in alphabetical order.  If    }
{   a program already exists with the name of the     }
{   new program, the old program is over-written.     }
{                                                     }
{*****************************************************}

procedure Insert(NewProg: MemoryRecord);
var TempFile:    file of MemoryRecord;
    CurrRecord:  MemoryRecord;
    Inserted:    Boolean;
begin
  assign(SaveFile, SaveFileName);
  assign(TempFile, TempFileName);
  reset(SaveFile);
  rewrite(TempFile);
  Inserted := false;
  while (not eof(SaveFile)) do
    begin
      read(SaveFile, CurrRecord);
      if CurrRecord.ID < NewProg.ID then
        write(TempFile, CurrRecord)
      else if (CurrRecord.ID = NewProg.ID) then
        begin
          write(TempFile, NewProg);
          Inserted := true
        end
      else if (not inserted) then
        begin
          write(TempFile, NewProg);
          write(TempFile, CurrRecord);
          Inserted := true
        end
      else
        write(TempFile, CurrRecord)
    end;
    if not inserted then write(TempFile, NewProg);
    reset(TempFile);
    rewrite(SaveFile);
    while not eof(TempFile) do
      begin
        read(TempFile, CurrRecord);
        write(SaveFile, CurrRecord)
      end;
    close(SaveFile);
    close(TempFile)
end;


{*****************************************************}
{                                                     }
{   SaveProgram uses the procedure Insert to save a   }
{   program in SaveFile.                              }
{                                                     }
{   Global variables:  Memory                         }
{                                                     }
{*****************************************************}

procedure SaveProgram;
var NewProg: MemoryRecord;
begin
  for I := 1 to StringLength do
    NewProg.ID[I] := ' ';
  writeln;
  write('Enter the name of the program to be saved: ');
  I := 1;
  while (not eoln) and (I < StringLength) do
    begin
      read(NewProg.ID[I]);
      I := I + 1
    end;
  readln;
  writeln;
  NewProg.Contents := Memory;
  insert(NewProg)
end;


{*****************************************************}
{                                                     }
{   RestoreProg retrieves a program from SaveFile.    }
{                                                     }
{   Global variables:  Memory                         }
{                                                     }
{*****************************************************}

procedure RestoreProg;
var ProgID:     StringType;
    Found:      Boolean;
    CurrRecord: MemoryRecord;
begin
  for I := 1 to StringLength do
    ProgID[I] := ' ';
  writeln;
  write('Enter the name of the program to be restored: ');
  I := 1;
  while (not eoln) and (I < StringLength) do
    begin
      read(ProgID[I]);
      I := I + 1
    end;
  readln;
  writeln;
  Found := false;
  assign(SaveFile, SaveFileName);
  reset(SaveFile);
  while (not eof(SaveFile)) and (not Found) do
    begin
      read(SaveFile, CurrRecord);
      if (CurrRecord.ID = ProgID) then
        begin
          Found := true;
          Memory := CurrRecord.Contents
        end
    end;
  if (not Found) then
    begin
      writeln;
      writeln('**', ProgID, ' not found.***');
      write('Type <Enter> to return to main Display. ');
      readln;
      writeln
    end;
  close(SaveFile)
end;


{*****************************************************}
{                                                     }
{   DeleteProg removes a program from SaveFile.       }
{                                                     }
{*****************************************************}

procedure DeleteProg;
var ProgID:      StringType;
    TempFile:    file of MemoryRecord;
    CurrRecord:  MemoryRecord;
begin
  for I := 1 to StringLength do
    ProgID[I] := ' ';
  writeln;
  write('Enter the name of the program to be deleted: ');
  I := 1;
  while (not eoln) and (I < StringLength) do
    begin
      read(ProgID[I]);
      I := I + 1
    end;
  readln;
  writeln;
  assign(SaveFile, SaveFileName);
  assign(TempFile, TempFileName);
  reset(SaveFile);
  rewrite(TempFile);
  while (not eof(SaveFile)) do
    begin
      read(SaveFile, CurrRecord);
      if CurrRecord.ID <> ProgID then
        write(TempFile, CurrRecord)
    end;
  reset(TempFile);
  rewrite(SaveFile);
  while not eof(TempFile) do
    begin
      read(TempFile, CurrRecord);
      write(SaveFile, CurrRecord)
    end;
  close(SaveFile);
  close(TempFile)
end;


{*****************************************************}
{                                                     }
{   ProcessFile determines which file activitiy is    }
{   desired and calls the appropriate procedure.      }
{                                                     }
{*****************************************************}

procedure ProcessFile;
var C: char;
begin
  writeln;
  writeln('Retrieve a program, save a program, ');
  writeln('delete a program, or list available programs? ');
  write('(R, S, D, or L): ');
  readln(C);
  writeln;
  C := UpperCase(C);
  if C in ['R', 'S', 'D', 'L'] then
    case C of
      'R': RestoreProg;
      'S': SaveProgram;
      'D': DeleteProg;
      'L': ListPrograms;
    end
end;


{*****************************************************}
{                                                     }
{   Help provides an explanation of the commands      }
{   available on the main display.                    }
{                                                     }
{*****************************************************}

procedure Help;
begin
  writeln;
  writeln;
  writeln;
  writeln('Options are as follows:');
  writeln;
  writeln('    M  Change contents of memory cells.');
  writeln('    R  Change contents of registers.');
  writeln('    P  Change contents of program counter.');
  writeln('    C  Clear memory or registers.  (Options will be given.)');
  writeln('    S  Single step.  (Execute a single machine cycle.)');
  writeln('    G  Go.  (Execute until a halt instruction is executed');
  writeln('             or until 500 machine cycles have been executed.)');
  write('    F  Obtain list of file options ');
  writeln('(to save or retrieve programs).');
  writeln('    H  Display this help screen.');
  writeln('    Q  Terminate this simulation program.');
  writeln;
  writeln;
  writeln(' Press <Enter> to return to the main display.');
  readln;
  writeln
end;


{*****************************************************}
{                                                     }
{   Identify presents a short introduction each       }
{   time the simulator is executed.  The time that    }
{   this introduction is left on the screen is        }
{   machine dependent.                                }
{                                                     }
{*****************************************************}

procedure Identify;
var I, J:  integer;
begin
  for I := 1 to 6 do
    writeln;
  writeln('      ***************************************************');
  writeln('      *                                                 *');
  writeln('      *                 Machine Simulator               *');
  writeln('      *                    version 2.0                  *');
  writeln('      *                                                 *');
  writeln('      *     Distributed by Benjamin/Cummings Pub. Co.   *');
  writeln('      *                                                 *');
  writeln('      *  Simulates the machine described in Appendix B  *');
  writeln('      *  of the text Computer Science: An Overview.     *');
  writeln('      *                                                 *');
  writeln('      ***************************************************');
  for I := 1 to 8 do
    writeln;
  for I := 1 to 512 do
    for J := 1 to 512 do
      I := I
end;


{*****************************************************}
{                                                     }
{   Here is the main routine.  It initializes global  }
{   variables, and then repeatedly displays the main  }
{   display and calls the appropriate procedure       }
{   depending on the command typed by the user.       }
{                                                     }
{*****************************************************}

begin
  ClearMemory;
  ProgramCounter := 0;
  InstructRegHigh := 0;
  InstructRegLow := 0;
  for I := 0 to 15 do
    Register[I] := 0;
  Identify;
  Done := false;
  repeat
    Display;
    readln(Command);
    Command := UpperCase(Command);
    if Command in ['M','R','P','S','G','C','F','H','Q'] then
      case Command of
        'M': ChangeMemory;
        'R': ChangeReg;
        'P': ChangePC;
        'S': SingleStep;
        'G': Go;
        'C': Clear;
        'F': ProcessFile;
        'H': Help;
        'Q': Done := true
      end
    else writeln('Type the letter of the desired option: ')
  until Done
end.