home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d0xx / d079 / m2error.lha / M2Error / m2error.mod < prev    next >
Encoding:
Text File  |  1987-06-04  |  6.4 KB  |  211 lines
  1. (*
  2.  
  3.         This program was written to display compile errors
  4.         in TDI/Modula-2 programs. You can use this program
  5.         instead of the TDI's Editor.
  6.  
  7.         Loosely based on a program by Bob Hawkins.
  8.         
  9.         Use with TDI/Modula-2 V3.00
  10.  
  11.         Created: 3/29/87 by Richie Bielak
  12.         
  13.         Modified:
  14.  
  15.         Copyright (c) 1987 by Richie Bielak.
  16.         
  17.         This program may be freely copied, but please leave
  18.         my name in.....Thanks....Richie
  19. *)
  20. MODULE M2Error;
  21.  
  22. FROM GetFileNames IMPORT ProcessCommandLine;
  23. FROM FastTextIO   IMPORT OpenFF, CloseFF, FastFile, ReadLine, EofFF,
  24.                          SkipLines;
  25. FROM InOut        IMPORT WriteString, WriteLn, Write, OpenOutputFile,
  26.                          WriteCard, CloseOutput, Done, Read, EOL;
  27. FROM GetError     IMPORT GetErrString;
  28.  
  29. VAR
  30.   GotFiles : BOOLEAN;
  31.   inFileName, outFileName, errorFileName : ARRAY [0..80] OF CHAR;
  32.   inFile, errorFile : FastFile;
  33.   PromptAfterError  : BOOLEAN;
  34.   
  35. (* +++++++++++++++++++++++++++++++++++++++++ *)
  36. PROCEDURE GiveDirections ();
  37.   BEGIN
  38.     WriteString ("Usage: M2ERROR <infile> {<outfile>}"); WriteLn;
  39.     WriteString ("       <outfile> optional"); WriteLn;
  40.     WriteString ("       Use with V3.00 of TDI"); WriteLn;
  41.     WriteString ("    -- by Richie Bielak, April 1987 --"); WriteLn;
  42.   END GiveDirections;
  43.   
  44. (* ++++++++++++++++++++++++++++++++++++++++++ *)
  45. (* This procedure opens all files and returns *)
  46. (* if all files were opened successfully.     *)
  47. PROCEDURE OpenFiles (in, out, error : ARRAY OF CHAR) : BOOLEAN;
  48.   VAR
  49.     succ : BOOLEAN;
  50.   BEGIN
  51.     OpenFF (inFile, in, succ);
  52.     IF NOT succ THEN
  53.       WriteString ("Can't open input file-->"); WriteString (in); WriteLn;
  54.       RETURN FALSE (* Get out of here *)
  55.     END;
  56.     OpenFF (errorFile, error, succ);
  57.     IF NOT succ THEN
  58.       CloseFF (inFile); (* Close the file already opened *)
  59.       WriteString ("Can't open error file-->"); WriteString (error); WriteLn;
  60.       RETURN FALSE(* Get out of here *)
  61.     END;
  62.     IF out[0] <> 0C THEN 
  63.       OpenOutputFile (out);
  64.       IF NOT Done THEN
  65.         CloseFF (inFile); (* Close the files already opened *)
  66.         CloseFF (errorFile);
  67.         WriteString ("Can't open output file"); WriteLn;
  68.         RETURN FALSE
  69.       END;    
  70.     END;
  71.     RETURN TRUE
  72.   END OpenFiles;
  73.  
  74. (* +++++++++++++++++++++++++++++++++++++++ *)
  75. PROCEDURE CloseFiles ();
  76.   BEGIN
  77.     CloseOutput ();
  78.     CloseFF (inFile);
  79.     CloseFF (errorFile);
  80.   END CloseFiles;
  81.  
  82. (* +++++++++++++++++++++++++++++++++++++++ *)
  83. (* The format of the error line is this:   *)
  84. (* <line no> <column> <error code>         *)
  85. PROCEDURE GetErrorNumber (ErrorLine : ARRAY OF CHAR;
  86.                           VAR line, col, err : CARDINAL);
  87.   VAR
  88.     i : CARDINAL;
  89.  
  90.   PROCEDURE MakeNumber (VAR pos, number : CARDINAL);
  91.     TYPE CharSet = SET OF CHAR;
  92.     BEGIN
  93.       number := 0;
  94.       WHILE ErrorLine [pos] IN CharSet {"0".."9"} DO
  95.         number := number * 10 + ORD (ErrorLine[pos]) - ORD ("0");
  96.         INC (pos);
  97.       END
  98.     END MakeNumber;
  99.  
  100.   BEGIN
  101.     i := 0;
  102.     MakeNumber (i, line);  INC (i);  (* Skip past the space *)
  103.     MakeNumber (i, col);   INC (i);
  104.     MakeNumber (i, err)    
  105.   END GetErrorNumber;
  106.  
  107. (* +++++++++++++++++++++++++++++++++++++++ *)
  108. PROCEDURE GetSourceLine (lineNo, CurLine : CARDINAL;
  109.                          VAR outline : ARRAY OF CHAR);
  110.   BEGIN
  111.     (* Skip some lines *)
  112.     SkipLines (inFile, lineNo - CurLine - 1);
  113.     (* Now read the source line *)
  114.     IF NOT EofFF (inFile) THEN
  115.        ReadLine (inFile, outline);
  116.     END
  117.   END GetSourceLine;
  118.  
  119. (* +++++++++++++++++++++++++++++++++++++++ *)
  120. PROCEDURE DisplayError (col, err : CARDINAL);
  121.   VAR
  122.     i : CARDINAL;
  123.     errstr : ARRAY [0..100] OF CHAR;
  124.   BEGIN
  125.     (* First set up a string of blanks *)
  126.     (* Bump the "col" by the length of the "Line   34: " string *)
  127.     col := col + 11;
  128.     FOR i := 0 TO col-1 DO errstr[i] := " " END;
  129.     errstr[col-1] := "|"; errstr[col] := 0C;
  130.     WriteString (errstr); WriteLn;
  131.     (* Get the error string and print it *)
  132.     GetErrString (err, errstr);
  133.     WriteString ("  "); WriteString (errstr); WriteLn;
  134.   END DisplayError;
  135.  
  136. (* +++++++++++++++++++++++++++++++++++++++ *)
  137. PROCEDURE PromptUser (VAR quit : BOOLEAN);
  138.   VAR ch : CHAR;
  139.   BEGIN
  140.     quit := FALSE;
  141.     WriteLn;
  142.     WriteString ("Type RETURN to continue, or Q to quit: ");
  143.     REPEAT
  144.       Read (ch);
  145.       IF CAP(ch) = "Q" THEN quit := TRUE END;
  146.     UNTIL ch = EOL;
  147.   END PromptUser;
  148.  
  149. (* +++++++++++++++++++++++++++++++++++++++ *)
  150. PROCEDURE PrintErrors ();
  151.   TYPE
  152.     line = ARRAY [0..100] OF CHAR;
  153.   VAR
  154.     SourceLine, ErrorLine : line;    
  155.     OldLineNo, Column, ErrorCode, LineNo : CARDINAL;
  156.     Quit : BOOLEAN;
  157.   BEGIN
  158.     (* First print some heading *)
  159.     WriteString ("-- Module           -->");
  160.     WriteString (inFileName); WriteLn;
  161.     ReadLine (errorFile, ErrorLine);
  162.     WriteString ("-- Number of errors --> ");
  163.     WriteString (ErrorLine); WriteLn; WriteLn;
  164.     (* Now read the input file and print the *)
  165.     (* offending lines.                      *)
  166.  
  167.     OldLineNo := 0; 
  168.     LOOP
  169.       ReadLine (errorFile, ErrorLine);
  170.       (* If no more errors, then exit *)
  171.       IF EofFF (errorFile) THEN EXIT END;
  172.       GetErrorNumber (ErrorLine, LineNo, Column, ErrorCode);
  173.       (* If this is a new line number, skip through the source *)
  174.       IF LineNo <> OldLineNo THEN
  175.         (* All errors for this line displayed, prompt the user *)
  176.         (* But don't do it the first time through.             *)
  177.         IF PromptAfterError AND (OldLineNo <> 0) THEN
  178.           PromptUser (Quit);
  179.           IF Quit THEN EXIT END;
  180.         END;
  181.         GetSourceLine (LineNo, OldLineNo, SourceLine);
  182.         IF EofFF (inFile) THEN EXIT END;
  183.         WriteLn; WriteString ("Line "); WriteCard (LineNo,4);
  184.         WriteString(": "); WriteString (SourceLine); WriteLn;
  185.         OldLineNo := LineNo;
  186.       END;      
  187.       DisplayError (Column, ErrorCode);
  188.     END; (* LOOP *)
  189.   END PrintErrors;
  190.  
  191. BEGIN
  192.   (* First process the command line *)
  193.   ProcessCommandLine (inFileName, outFileName, errorFileName, GotFiles);
  194.  
  195.   IF GotFiles THEN
  196.     (* Open files *)
  197.     IF OpenFiles (inFileName, outFileName, errorFileName) THEN
  198.       (* If no output file was specified, errors are  *)
  199.       (* displayed on the screen, and we prompt after *)
  200.       (* erroneus line.                               *)
  201.       PromptAfterError := (outFileName[0] = 0C);
  202.       (* Print errors *)
  203.       PrintErrors ();
  204.       (* Close files *)  
  205.       CloseFiles ();
  206.     END
  207.   ELSE
  208.     GiveDirections ();
  209.   END;
  210. END M2Error.
  211.