Complete Bookshop/CompleteWorkshop.iso/compute/cardiac/hrt.pas

Pascal/Delphi Source File | 1987-06-27 | 26.4 KB | 858 lines

Program Cardiac;
   {[A+,T=3] Instructions to PasMat}

   {$C-}

{
             Cardiac compiler version 2.5 by Cyrus Patel

   This is a complete revision of the Cardiac compiler.  It
   includes  a full 'Pascal' type error documentor, where it
   'points' to the error, as well as displaying the line.
   It checks to see if the files exist, and if it is an output
   file, and it also exists, it will ask the user if they want
   to delete that file.  It also checks to make sure that the
   file is not the same, as the input file.  To make it easier
   on the user (since they are beginners, I've made it such that
   the input filenames default extension (the part after, and
   including the '.') is .HRT, also the default extension on the
   output file is .OUT.  I've also taken out all unnessary variables,
   and changed some of their name, to make it more self documenting.

}

   Const
      Limit = 500;                      {Max. statements to be executed.}
      MaxLines = 60;                    {Max. number of lines on the printer.}
      Version = '2.5';

   Type
      String18 = String [18];
      String79 = String [79];
      StringInt = Array [0..99] of Integer;

   Var
      Outf: Text;
      Infile, Outfile: String18;
      Help, Box, Data: StringInt;
      LineNumber, NumberOfStatements, Command, L, Location, MaxData, Step,
        Accumulator: Integer;


   Procedure Printer;

      Begin
         LineNumber := Succ(LineNumber);
         If LineNumber >= MaxLines then
            Begin
            Write(Outf, ^L);
            LineNumber := 1
            End
      End;


   Procedure PrintBlock;

      Begin
         If LineNumber > MaxLines - 6 then
            Begin
            Write(Outf, ^L);
            LineNumber := 1
            End
      End;


   Procedure Blank(Number: Byte);

      Var
         Index: Byte;

      Begin
         For Index := 1 to Number do
            Begin
            WriteLn(Outf);
            Printer;
            WriteLn
            End
      End;


   Procedure Space(Number: Byte);

      Var
         Index: Byte;

      Begin
         For Index := 1 to Number do
            Begin
            Write(Outf, ' ');
            Write(' ')
            End
      End;


   Procedure WriteLine(Line: String79);

      Begin
         WriteLn(Outf, Line);
         WriteLn(Line);
         Printer
      End;


   Procedure WriteLine2(Line: String79;
                        Number: Integer);

      Begin
         WriteLn(Outf, Line, Number: 1);
         WriteLn(Line, Number: 1);
         Printer
      End;


   Procedure Exit(Line: String79);

      Begin
         WriteLn(Line);
         WriteLn(Outf, Line);
         Close(Outf);
         Halt
      End;


   Function Exists(FileName: String18): Boolean;

      Var
         CheckFile: File;

      Begin
         Assign(CheckFile, FileName);
         {$I-}
         Reset(CheckFile);
         {$I+}
         Exists := IOResult = 0
      End;


   Function Yes: Boolean;

      Var
         Ch: Char;

      Begin
         Write('? ');
         Repeat
            Read(Kbd, Ch);
            Ch := UpCase(Ch)
         Until Ch In ['Y', 'N'];
         Yes := Ch = 'Y';
         If Ch = 'Y' then
            WriteLn('Yes')
         else
            WriteLn('No')
      End;


   Function FixLine(Line: String79): String79;

      Begin
         While Length(Line) < 9 do
            Line := Line + ' ';
         FixLine := Line
      End;


   Function FixFileName(FileName: String18;
                        Extension: String18): String18;

      Var
         Index: Byte;

      Begin
         For Index := 1 to Length(FileName) do
            FileName[Index] := UpCase(FileName[Index]);
         While (FileName[Length(FileName)] = ' ') and
               (Length(FileName) > 1) do
            Begin
            FileName := Copy(FileName, 1, Pred(Length(FileName)));
            End;
         If Length(FileName) = 1 then
            If FileName[1] = ' ' then
               FileName := '';
         If Pos('.', FileName) = 0 then
            FileName := FileName + Extension;
         FixFileName := FileName
      End;


   Procedure GettingTheFileNames(Var Infile, Outfile: String18);

      Begin
         If (ParamCount < 1) or (ParamStr(1) = '?') then
            Begin
            WriteLn(^J, ^J, '': 5,
                    'The Master Silicone  CARDIAC simulator -- Ver ', Version,
                    '  June-87');
            WriteLn(^J);
            WriteLn('HRT is a Cardiac language simulator.');
            WriteLn;
            WriteLn('Usage: HRT Filename1 [Filename2]');
            WriteLn;
            WriteLn(
         'Where Filename1 is the input file name (default extension .HRT) and'
                    );
            WriteLn(
                 'Filename2 is the output file name (default extension .OUT).'
                    );
            WriteLn;
            WriteLn(
        'If Filename2 is not specified then the program will place the output'
                    );
            WriteLn('in a file called filename1.OUT');
            WriteLn;
            Halt
            End;
         Infile := ParamStr(1);
         If ParamCount > 1 then
            Outfile := ParamStr(2)
         else
            Begin
            If Pos('.', Infile) = 0 then
               Outfile := Infile
            else
               Outfile := Copy(Infile, 1, Pred(Pos('.', Infile)))
            End;
         Infile := FixFileName(Infile, '.HRT');
         If Not Exists(Infile) then
            Begin
            WriteLn(Infile, ', does not exist.');
            Halt
            End;
         Outfile := FixFileName(Outfile, '.OUT');
         If Infile = Outfile then
            Begin
            WriteLn('File names can''t be the same.');
            Halt;
            End
         else If Exists(Outfile) then
            Begin
            Write(Outfile, ', already exists, do you want to delete it');
            If Not Yes then
               Halt
            End
      End;


   Procedure CopyingTheProgram(Infile: String18);

      Var
         Inf: Text;
         Line: String79;

      Begin
         Assign(Inf, Infile);
         Reset(Inf);
         Blank(2);
         Space(14);
         WriteLine('The Master Silicone  CARDIAC simulator -- Ver ' +
                   Version + '  June-87');
         Blank(3);
         Repeat
            ReadLn(Inf, Line);
            Line := FixLine(Line)
         Until (Line[1] = '6') or (Eof(Inf));
         If Eof(Inf) then
            Exit('  Incomplete program -- Sixes not found.');
         Repeat
            ReadLn(Inf, Line);
            Line := FixLine(Line);
            If Line[1] <> '7' then
               WriteLine(Line)
         Until (Line[1] = '7') or (Eof(Inf));
         If Eof(Inf) then
            Exit('  Incomplete program -- Sevens not found.');
         Repeat
            ReadLn(Inf, Line);
            Line := FixLine(Line)
         Until (Line[1] = '8') or (Eof(Inf));
         If Eof(Inf) then
            Exit('  Incomplete program -- Eights not found.');
         Repeat
            ReadLn(Inf, Line);
            Line := FixLine(Line)
         Until (Line[1] = '9') or (Eof(Inf));
         Close(Inf);
         If Line[1] <> '9' then
            Exit('  Incomplete program -- Nines not found.');
         Blank(1)
      End;


   Procedure ZeroingTheStorage(Var Help, Box, Data: StringInt);

      Var
         Index: Byte;

      Begin
         For Index := 0 to 99 do
            Begin
            Help[Index] := 0;
            Box[Index] := 969;
            Data[Index] := 9999
            End
      End;


   Procedure LoadingTheStorageLocations(Var Box: StringInt;
                                        Infile: String18);

      Var
         Inf: Text;
         Line: String79;
         Index, Index2, Index3, Command, Statement: Integer;

      Begin
         Assign(Inf, Infile);
         Reset(Inf);
         Index := 0;
         Repeat
            ReadLn(Inf, Line);
            Index := Succ(Index);
            Line := FixLine(Line)
         Until Line[1] = '6';
         Repeat
            ReadLn(Inf, Line);
            Index := Succ(Index);
            Line := FixLine(Line);
            If Line[1] = ' ' then
               Begin
               If (Line[2] In ['0'..'9']) and (Line[3] In ['0'..'9']) and
                  (Line[7] In ['0'..'9']) and (Line[8] In ['0'..'9']) and
                  (Line[9] In ['0'..'9']) then
                  Begin
                  Statement := ((Ord(Line[2]) - 48) * 10) + ((Ord(Line[3]) -
                               48));
                  Command := ((Ord(Line[7]) - 48) * 100) + ((Ord(Line[8]) -
                             48) * 10) + ((Ord(Line[9]) - 48))
                  End
               else
                  Begin
                  PrintBlock;
                  WriteLine(Line);
                  For Index2 := 1 to 9 do
                     If (Index2 In [2, 3, 7..9]) and
                        (Not (Line[Index2] In ['0'..'9'])) then
                        Begin
                        For Index3 := 1 to 9 do
                           If (Line[Index3] = ' ') and
                              (Index3 In [2, 3, 7..9]) then
                              Begin
                              WriteLn(' Line number, ', Index: 1,
                                ', is blank, and blank lines are not allowed.'
                                      );
                              WriteLn(Outf, ' Line number, ', Index: 1,
                                ', is blank, and blank lines are not allowed.'
                                      );
                              Close(Outf);
                              Close(Inf);
                              Halt
                              End;
                        Space(Pred(Index2));
                        WriteLine('^');
                        LineNumber := 0;
                        WriteLine2(' Syntax error found on line number: ',
                                   Index);
                        Close(Outf);
                        Close(Inf);
                        Halt
                        End
                  End;
               If Line[6] = '-' then
                  Command := Command * ( - 1);
               Box[Statement] := Command
               End
            else If Line[1] <> '7' then
               Begin
               PrintBlock;
               WriteLine(Line);
               WriteLine('^');
               WriteLine2(' Syntax error found on line number: ', Index);
               Close(Outf);
               Close(Inf);
               Halt
               End
         Until Line[1] = '7';
         Close(Inf)
      End;


   Procedure LoadingData(Var Data: StringInt;
                         Var MaxData: Integer;
                         Infile: String18);

      Var
         Inf: Text;
         Temp: Real;
         Line: String79;
         Index: Integer;

      Begin
         Assign(Inf, Infile);
         Reset(Inf);
         Repeat
            ReadLn(Inf, Line);
            Line := FixLine(Line)
         Until Line[1] = '7';
         MaxData := 0;
         Blank(1);
         Repeat
            ReadLn(Inf, Line);
            Line := FixLine(Line);
            If Line[1] <> '8' then
               Begin
               MaxData := Succ(MaxData);
               For Index := 1 to 9 do
                  If ((Index IN [1, 2, 7..9]) and (Line[Index] <> ' ')) or
                     ((Index in [4..6]) and
                     (Not (Line[Index] In ['0'..'9']))) or ((Index = 3) and
                     (Not (Line[Index] In [' ', '-', '+']))) then
                     Begin
                     PrintBlock;
                     WriteLine(Line);
                     Space(Pred(Index));
                     WriteLine('^');
                     Close(Inf);
                     Exit(' Syntax error found in data.')
                     End;
               Temp := 100 * (Ord(Line[4]) - 48);
               Temp := (10 * (Ord(Line[5]) - 48)) + Temp;
               Temp := (Ord(Line[6]) - 48) + Temp;
               If Line[3] = '-' then
                  Temp := Temp * ( - 1);
               Data[MaxData] := Trunc(Temp)
               End
         Until Line[1] = '8';
         Close(Inf)
      End;


   Procedure GettingTheCommand(Var Command, Location: Integer;
                               NumberOfStatements, Step: Integer;
                               Var Help: StringInt;
                               Box: StringInt);

      Begin
         Command := Box[Step] Div 100;
         Location := Box[Step] Mod 100;
         If (Command < 0) or (Location < 0) then
            Begin
            PrintBlock;
            WriteLine2('Illegal statement in statement ', Step);
            WriteLine('Program terminated!');
            WriteLine2('Number of statements executed = ',
                       NumberOfStatements);
            Command := 12
            End
         else
            Help[Step] := Succ(Help[Step])
      End;


   Procedure WritingOutSummary(NumberOfStatements, Step: Integer);

      Begin
         PrintBlock;
         WriteLine2('Halt encountered at statement ', Step);
         WriteLine2('Number of statements executed = ', NumberOfStatements);
         Blank(1)
      End;


   Procedure ReadData(Var NumberOfStatements, Command, L: Integer;
                      MaxData, Location: Integer;
                      Data: StringInt;
                      Var Box: StringInt);

      Begin
         If L > MaxData then
            Begin
            PrintBlock;
            WriteLine2('End of data at statement ', Step);
            WriteLine('Execution terminated!');
            WriteLine2('Number of statements executed = ',
                       NumberOfStatements);
            Command := 12
            End
         else
            Begin
            Box[Location] := Data[L];
            L := Succ(L);
            NumberOfStatements := Succ(NumberOfStatements);
            Command := 10
            End
      End;


   Procedure Shift(Var Accumulator, Command: Integer;
                   Location: Integer);

      Var
         Left, Right: Integer;

      Begin
         Left := Location Div 10;
         Right := Location Mod 10;
         If Left in [0..3] then
            Case Left of
               0:
                  Accumulator := Accumulator;
               1:
                  Begin
                  If Accumulator > 1000 then
                     Accumulator := Accumulator - (Accumulator Div 1000 *
                                    1000);
                  Accumulator := Accumulator * 10
                  End;
               2:
                  Begin
                  If Accumulator > 100 then
                     Accumulator := Accumulator - (Accumulator Div 100 * 100);
                  Accumulator := Accumulator * 100
                  End;
               3:
                  Begin
                  If Accumulator > 10 then
                     Accumulator := Accumulator - (Accumulator Div 10 * 10);
                  Accumulator := Accumulator * 1000
                  End
               End
         else
            Accumulator := 0;
         If Accumulator <> 0 then
            If Right In [0..3] then
               Case Right of
                  0:
                     Accumulator := Accumulator;
                  1:
                     Accumulator := Accumulator Div 10;
                  0:
                     Accumulator := Accumulator Div 100;
                  0:
                     Accumulator := Accumulator Div 1000
                  End
            else
               Accumulator := 0;
         Command := 15
      End;


   Procedure Print(Location: Integer;
                   Box: StringInt);

      Begin
         WriteLn(Box[Location]: 6);
         WriteLn(Outf, Box[Location]: 6);
         Printer
      End;


   Procedure Store(Accumulator, Location: Integer;
                   Var Box: StringInt);

      Var
         Number: Integer;

      Begin
         Number := Accumulator;
         If Accumulator > 999 then
            Begin
            Number := Accumulator - (1000 * (Accumulator Div 1000));
            PrintBlock;
            WriteLine2('Positive storage overflow at statement ', Step);
            WriteLn(Outf, 'Contents of accumulator (', Accumulator: 1,
                    ') too large for storage!');
            Printer;
            WriteLn('Contents of accumulator (', Accumulator: 1,
                    ') too large for storage!');
            WriteLine('High order digits truncated!');
            WriteLn(Outf, 'Resulting value for location ', Location: 1, ' = ',
                    Number: 1);
            Printer;
            WriteLn('Resulting value for location ', Location: 1, ' = ',
                    Number: 1)
            End
         else If Accumulator < - 999 then
            Begin
            Number := Accumulator - (1000 * (Accumulator Div 1000));
            PrintBlock;
            WriteLine2('Negative storage overflow at statement ', Step);
            WriteLn(Outf, 'Contents of accumulator (', Accumulator: 1,
                    ') too small for storage!');
            Printer;
            WriteLn('Contents of accumulator (', Accumulator: 1,
                    ') too small for storage!');
            WriteLine('High order digits truncated!');
            WriteLn(Outf, 'Resulting value for location ', Location: 1, ' = ',
                    Number: 1);
            Printer;
            WriteLn('Resulting value for location ', Location: 1, ' = ',
                    Number: 1)
            End;
         Box[Location] := Number
      End;


   Procedure OverflowCheck(Var Accumulator: Integer;
                           Command: Integer);

      Var
         Number: Integer;

      Begin
         If Accumulator > 9999 then
            Begin
            Number := Accumulator - (10000 * (Accumulator Div 10000));
            If Command <> 15 then
               Begin
               PrintBlock;
               WriteLine2('Positive storage overflow at statement ', Step);
               WriteLn(Outf, 'Contents of accumulator (', Accumulator: 1,
                       ') too large for storage!');
               Printer;
               WriteLn('Contents of accumulator (', Accumulator: 1,
                       ') too large for storage!');
               WriteLine('High order digits truncated!');
               WriteLn(Outf, 'Resulting value for location ', Location: 1,
                       ' = ', Number: 1);
               Printer;
               WriteLn('Resulting value for location ', Location: 1, ' = ',
                       Number: 1)
               End;
            Accumulator := Number
            End
         else If Accumulator < - 9999 then
            Begin
            Number := Accumulator - (10000 * (Accumulator Div 10000));
            If Command <> 15 then
               Begin
               PrintBlock;
               WriteLine2('Negative storage overflow at statement ', Step);
               WriteLn(Outf, 'Contents of accumulator (', Accumulator: 1,
                       ') too small for storage!');
               Printer;
               WriteLn('Contents of accumulator (', Accumulator: 1,
                       ') too small for storage!');
               WriteLine('High order digits truncated!');
               WriteLn(Outf, 'Resulting value for location ', Location: 1,
                       ' = ', Number: 1);
               Printer;
               WriteLn('Resulting value for location ', Location: 1, ' = ',
                       Number: 1)
               End;
            Accumulator := Number
            End
      End;


   Procedure Subtract(Var Accumulator: Integer;
                      Location: Integer;
                      Box: StringInt);

      Begin
         Accumulator := Accumulator - Box[Location];
         Command := 10
      End;


   Procedure Jump(Var NumberOfStatements, Step: Integer;
                  Location: Integer;
                  Var Box: StringInt);

      Begin
         NumberOfStatements := Succ(NumberOfStatements);
         Box[99] := Step + 801;
         Step := Pred(Location)
      End;


   Procedure CoreDump(Accumulator: Integer;
                      Box, Data, Help: StringInt);

      Var
         CR: Boolean;
         K, J, Index, Index2: Integer;

      Begin
         Write(Outf, ^L);
         For Index := 1 to 3 do
            WriteLn(Outf);
         LineNumber := 4;
         Blank(2);
         Space(34);
         WriteLine('C O R E   D U M P');
         Space(34);
         WriteLine('-----------------');
         Blank(1);
         Space(20);
         WriteLine('0    1    2    3    4    5    6    7    8    9');
         Blank(1);
         For Index := 0 to 9 do
            Begin
            K := Index * 10;
            Write(Index: 14, '  ');
            Write(Outf, Index: 14, '  ');
            For J := 0 to 9 do
               If Box[K + J] = 969 then
                  Begin
                  Write(Outf, '***': 5);
                  Write('***': 5)
                  End
               else
                  Begin
                  Write(Outf, Box[K + J]: 5);
                  Write(Box[K + J]: 5)
                  End;
            Blank(1)
            End;
         Blank(1);
         Space(14);
         WriteLine2('The value of the accumulator at termination was ',
                    Accumulator);
         Blank(3);
         PrintBlock;
         Space(30);
         WriteLine('Profile of executions');
         Space(30);
         WriteLine('---------------------');
         Blank(1);
         WriteLn(Outf, 'Statment': 20, 'Executions': 15, 'Statement': 19,
                 'Executions': 15);
         Printer;
         WriteLn(Outf, '--------': 20, '----------': 15, '---------': 19,
                 '----------': 15);
         Printer;
         WriteLn('Statment': 20, 'Executions': 15, 'Statement': 19,
                 'Executions': 15);
         WriteLn('--------': 20, '----------': 15, '---------': 19,
                 '----------': 15);
         Blank(1);
         CR := False;
         For Index := 1 to 99 do
            If Box[Index] <> 969 then
               Begin
               If Not CR then
                  Begin
                  Write(Outf, Index: 15, Help[Index]: 15);
                  Write(Index: 15, Help[Index]: 15)
                  End
               else
                  Begin
                  WriteLn(Outf, Index: 20, Help[Index]: 15);
                  WriteLn(Index: 20, Help[Index]: 15);
                  Printer
                  End;
               CR := Not CR
               End;
         Blank(2);
         If Data[1] <> 9999 then
            Begin
            PrintBlock;
            Space(28);
            WriteLine('D A T A   L I S T');
            Space(28);
            WriteLine('-----------------');
            Blank(1);
            Index2 := 0;
            For Index := 1 to 99 do
               If Data[Index] <> 9999 then
                  Begin
                  Write(Outf, '': 20, Data[Index]: 5);
                  Write('': 20, Data[Index]: 5);
                  Index2 := Succ(Index2);
                  If Index2 Div 2 = Index2 / 2 then
                     Blank(1)
                  End;
            Blank(1)
            End
      End;

   Begin
      ZeroingTheStorage(Help, Box, Data);
      LineNumber := 1;
      NumberOfStatements := 0;
      Accumulator := 0;
      L := 1;
      GettingTheFileNames(Infile, Outfile);
      Assign(Outf, Outfile);
      Rewrite(Outf);
      CopyingTheProgram(Infile);
      LoadingTheStorageLocations(Box, Infile);
      LoadingData(Data, MaxData, Infile);
      Step := 1;
      WriteLine('     Compilation complete.');
      Blank(1);
      PrintBlock;
      Repeat
         GettingTheCommand(Command, Location, NumberOfStatements, Step, Help,
                           Box);
         Box[0] := 1;
         If NumberOfStatements >= Limit then
            Command := 11;
         If Command IN [1, 2, 4..7, 9] then
            NumberOfStatements := Succ(NumberOfStatements);
         If Command in [0..9, 11, 12] then
            Case Command of
               0:
                  ReadData(NumberOfStatements, Command, L, MaxData, Location,
                           Data, Box);
               1:
                  Accumulator := Box[Location];
               2:
                  Accumulator := Accumulator + Box[Location];
               3:
                  If Accumulator < 0 then
                     Jump(NumberOfStatements, Step, Location, Box);
               4:
                  Shift(Accumulator, Command, Location);
               5:
                  Print(Location, Box);
               6:
                  Store(Accumulator, Location, Box);
               7:
                  Subtract(Accumulator, Location, Box);
               8:
                  Jump(NumberOfStatements, Step, Location, Box);
               9:
                  WritingOutSummary(NumberOfStatements, Step);
               11, 12:
                  Blank(1)
               End
         else
            Begin
            PrintBlock;
            WriteLn(Outf, 'Illegal command in statement ', Step: 1, '!');
            Printer;
            WriteLn('Illegal command in statement ', Step: 1, '!');
            WriteLine('Execution terminated.');
            WriteLine2('Number of statements executed: ', NumberOfStatements);
            Command := 12
            End;
         OverflowCheck(Accumulator, Command);
         Step := Succ(Step)
      Until Command IN [9, 11, 12];
      If Command = 11 then
         Begin
         PrintBlock;
         WriteLine2(
           'Cancelled due to statement execution limit exceeded at statement '
                    , Pred(Step));
         WriteLine2('Number of statements executed: ', NumberOfStatements)
         End;
      Write(^J, 'Do you want a PROFILE');
      If Yes then
         CoreDump(Accumulator, Box, Data, Help);
      Close(Outf);
      WriteLn;
      WriteLn('Program output is stored in ', Outfile)
   End.