Program Mon8088;



uses

  CommSoft,

  Crt;



const

  Forever: boolean = false;

  comma:  char = ',';



var

  DumInt: integer;

  PointMem:  longint;

  MemData: array[$0000..$00ff] of byte;



Procedure OpeningScreen;

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

begin

  clrscr;

  write('MON8088 -- an 8088 Monitor program for use with the Prolog');

  writeln(' system.');

  writeln('Copyright 1990 U.S. Air Force.');

  writeln('Written by C1C David Croft, class of 1990.');

  writeln('It requires the ".TPU" files CommSoft, LctSupp, & LctKrnl.');

  writeln;

  writeln('Programmers'' notes:');

  writeln('Use of OutTextXY will allow printing of linefeed and CR.');

  writeln('But current filter must be deleted.');

  writeln;

  write('Hit ENTER to continue...');

  readln;

end;



Function Hex(Deci: longint): string;

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

var

  H: array[1..4] of integer;

  HH: array[1..4] of string[1];

  alpha: integer;

begin

  if Deci > (16*16*16*16) then

    begin

      writeln('Overflow in Function Hex!');

      halt;

    end;

  H[4] := (Deci Mod (16*16*16*16)) div (16*16*16);

  H[3] := (Deci Mod (16*16*16)) div (16*16);

  H[2] := (Deci Mod (16*16)) div 16;

  H[1] := Deci Mod 16;

  for alpha := 1 to 4 do

    case H[alpha] of

      10:  HH[alpha] := 'A';

      11:  HH[alpha] := 'B';

      12:  HH[alpha] := 'C';

      13:  HH[alpha] := 'D';

      14:  HH[alpha] := 'E';

      15:  HH[alpha] := 'F';

      else

        str(H[alpha],HH[alpha]);

    end; {case}

  Hex := HH[4] + HH[3] + HH[2] + HH[1];

end;



Procedure PushKey;

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

var

  key: string;

  MessageIn:  string;

begin

  repeat

  write('Key to send:  ');

  readln(key);

  OutComm(key+#13);

    InComm(MessageIn);

    write(MessageIn);

  until Forever;

  writeln;

end;



Function Deci(Hex: string): longint;

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

var

  NewHex: array[1..255] of char;

  HexStr: string;

  TempDeci: longint;

  alpha, bravo: integer;

  Place: longint;

  dumint: integer;

  added:  longint;

  TempAdded: longint;

begin

  HexStr := '';

  for alpha := 1 to length(Hex) do

    begin

      if not (Hex[alpha] in ['0'..'9','A'..'F','a'..'f']) then

        NewHex[alpha] := #0

      else

        NewHex[alpha] := Hex[alpha];

      if NewHex[alpha] <> #0 then

        HexStr := HexStr + NewHex[alpha];

    end;

  TempDeci := 0;

  for alpha := length(HexStr) downto 1 do

    begin

      Place := 1;

      for bravo := (length(HexStr) - alpha +1) downto 2 do

        Place := Place * $10;

      case HexStr[alpha] of

        'A','a':  TempDeci := TempDeci + 10*Place;

        'B','b':  TempDeci := TempDeci + 11*Place;

        'C','c':  TempDeci := TempDeci + 12*Place;

        'D','d':  TempDeci := TempDeci + 13*Place;

        'E','e':  TempDeci := TempDeci + 14*Place;

        'F','f':  TempDeci := TempDeci + 15*Place;

        else

          begin

            val(HexStr[alpha], Added, DumInt);

            TempAdded := Added*Place;

            TempDeci := TempDeci + TempAdded;

          end;

      end; {case}

    end;

  Deci := TempDeci;

end;



Procedure LoadFromProlog;

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

var

  alpha:  integer;

  InStr:  string;

  DataByteStr:  string[2];

begin

  writeln('0.  Flush buffer.');

  writeln('1.  Sending #0 (examine byte).');

  writeln('1.4.  Delay.');

  writeln('1.5.  Reading 9 bytes ("EXA BYTE" + $ff).');

  writeln('1.6.  [If not above, recover.]');

  writeln('1.7.  Sending 5 bytes (4 - address, comma).');

  writeln('2.   Delay.');

  writeln('2.4  Reading 9 bytes (4 address, 2 spaces, 2 data, $ff).');

  writeln('2.5  Load array with data byte.');

  writeln('3.  Sending comma.');

  writeln('4.  Repeating steps 2 to 3 $ff more times');

  writeln('5.  Send period to end.');

  write('Hit ENTER to proceed...');

  readln;

  InComm(InStr);  {*** flushes buffer ***}

  OutComm(#0);

  Delay(25);

  InComm(InStr);  {*** expecting "EXA BYTE" + $ff ***}

  {*** check and recover here ***}

  OutComm(Hex(PointMem) + comma);

  for alpha := 0 to $ff do

    begin

      writeln(alpha);   {*** remove ***}

      Delay(25);

      InComm(InStr);

      DataByteStr := InStr[7] + InStr[8];

      MemData[alpha] := Deci(DataByteStr);

      OutComm(comma);

    end;

  OutComm('.');

end;



Procedure DisplayMem;

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

var

  alpha, bravo: integer;

  Hex2: string[2];

  KharNum: byte;

begin

  LoadFromProlog;

  alpha := $0000;

  repeat

    write(Hex(alpha + PointMem),'  ');

    for bravo := alpha to (alpha + $000F) do

      begin

        Hex2 := Copy(Hex(MemData[bravo]),3,2);

        write(Hex2,' ');

      end;

    write('  ');

    for bravo := alpha to (alpha + $000F) do

      begin

        KharNum := ord(MemData[bravo]);

{!!! Filter !!!}

        if KharNum in [$7,$8,$A,$D] then

          KharNum := $0;

        write(char(KharNum));

      end;

    alpha := alpha + $0010;

    writeln;

  until alpha = $0100;

end;



Procedure HelpScreen;

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

begin

  clrscr;

  writeln('CMD:      Explanation              Syntax');

  writeln('----      -----------              ------');

  writeln('?:        Help screen              ?');

  writeln('D:        Display memory           D [<start address>]');

  writeln('E:        Examine memory           E [<address>]');

  writeln('F:        Fill memory              F <range>, <string>');

  writeln('G:        Execute (Go)             G [<address>][,<breakpoint>]');

  writeln('M:        Move memory block        M <range>, <dest>');

  writeln('R:        Examine registers        R [<register>]');

  writeln('S:        Search memory            S <range>, <string>');

  writeln('T:        Trace program            T [<count>]');

  writeln('U:        Unassemble program       U [<range>]');

  writeln;

  write('Hit ENTER to continue...');

  readln;

  clrscr;

end;





Procedure GetCommand;

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

var

  command: string;

begin

  repeat

    writeln;

    write('Command (? for Help):  ');

    readln(command);

    command[1] := upcase(command[1]);

    case command[1] of

      '?':  begin

              HelpScreen;

              DisplayMem;

            end;

      'D':  begin

              PointMem := Deci(copy(command, 2, length(command) -1));

              DisplayMem;

            end;

      else

        writeln('That command is not available at this time.');

    end; {case}

  until Forever;

end;



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

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

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

begin

  OpeningScreen;

  IntroComm;

  clrscr;

  PointMem := $0000;

  DisplayMem;

  GetCommand;

end.