home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pmos2002.zip / UTIL / SRC / PP.MOD next >
Text File  |  1996-09-17  |  34KB  |  845 lines
  1. MODULE PP;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*              Version extraction program              *)
  6.         (*                                                      *)
  7.         (*      Originally derived from a program given to      *)
  8.         (*      me by Deane Blackman of Monash University,      *)
  9.         (*      using a source syntax similar to that used      *)
  10.         (*      by a utility in Rowley Modula-2.                *)
  11.         (*                                                      *)
  12.         (*  Compilers currently supported:                      *)
  13.         (*      FST, Rowley, TopSpeed 1.17, TopSpeed 3.10, XDS  *)
  14.         (*      The Rowley version is untested and may have     *)
  15.         (*      errors.                                         *)
  16.         (*      Now working on an XDS version.                  *)
  17.         (*                                                      *)
  18.         (*  Programmer:         P. Moylan                       *)
  19.         (*  Last edited:        17 September 1996               *)
  20.         (*  Status:             Working                         *)
  21.         (*                                                      *)
  22.         (*  Minor shortcoming: with the "S" command-line        *)
  23.         (*      option, we can get blank lines in the output    *)
  24.         (*      file resulting from the fact that we've         *)
  25.         (*      deleted everything except some space and tab    *)
  26.         (*      characters.  Fixing this would require a        *)
  27.         (*      change in strategy - we'd need to avoid         *)
  28.         (*      writing a partial line, saving it instead       *)
  29.         (*      so that we can look at the whole line before    *)
  30.         (*      deciding whether it consists entirely of        *)
  31.         (*      white space.  For now I don't consider this     *)
  32.         (*      important enough to justify the effort of       *)
  33.         (*      redesigning for that case.                      *)
  34.         (*                                                      *)
  35.         (*  Remark: in case you're wondering why all the File   *)
  36.         (*      parameters in procedures are VAR parameters:    *)
  37.         (*      we have to do it this way because some          *)
  38.         (*      compilers (e.g. FST) implement a File variable  *)
  39.         (*      as a record, rather than as some sort of        *)
  40.         (*      handle which points to the file descriptor.     *)
  41.         (*      If we used value parameters then we'd have      *)
  42.         (*      multiple copies of file descriptors in various  *)
  43.         (*      procedures, and they wouldn't be consistent     *)
  44.         (*      with one another in terms of things like the    *)
  45.         (*      end-of-file flag.                               *)
  46.         (*                                                      *)
  47.         (********************************************************)
  48.  
  49. (************************************************************************)
  50. (*                                                                      *)
  51. (* Selection by (*<xxx where  xxx  is a selecting string.  The          *)
  52. (* terminator for this region is >*).  The text between the (*< and     *)
  53. (* >*) will be activated iff the  xxx  evaluates to TRUE using the      *)
  54. (* assignments in the PP.CFG file.                                      *)
  55. (*                                                                      *)
  56. (* If the S (for suppress) option is specified, all inactive text and   *)
  57. (* all selection delimiters are deleted.  If the S option is absent     *)
  58. (* then all original text is retained but the part that is supposed to  *)
  59. (* be inactive is commented out.                                        *)
  60. (*                                                                      *)
  61. (************************************************************************)
  62.  
  63. FROM PPExpr IMPORT
  64.     (* proc *)  DefineSymbol, Id, Expr, StringExpr, DumpSymbolTable;
  65.  
  66. FROM PPMisc IMPORT
  67.     (* type *)  File,
  68.     (* proc *)  Length, CopyString, Pos,
  69.                 OpenFile, CloseFile, WriteToFile, TerminateLine,
  70.                 ReadLine, EndOfFile, DeleteFile, RenameFile,
  71.                 Message, EndOfMessage, CommandLine;
  72.  
  73. (************************************************************************)
  74. (*                         GLOBAL VARIABLES                             *)
  75. (************************************************************************)
  76.  
  77. TYPE
  78.     BufferSubscript = [0..255];
  79.     FileNumber = [1..255];
  80.     SpecialSymbol = (EofSymbol, StartVersion, EndVersion, CommentedEndVersion);
  81.     CharSet = SET OF CHAR;
  82.  
  83. CONST
  84.     AlphaNumerics = CharSet {"A".."Z", "a".."z", "0".."9"};
  85.  
  86. VAR
  87.     (* Buffer holds the current source line being processed.  We make   *)
  88.     (* it global since it is accessed by a number of procedures.        *)
  89.     (* LinePlace is the location in Buffer that holds the next          *)
  90.     (* character to be looked at.                                       *)
  91.  
  92.     Buffer: ARRAY BufferSubscript OF CHAR;
  93.     LinePlace: CARDINAL;
  94.  
  95.     (* The following flag is set if we have read an empty line from     *)
  96.     (* the input file.  We use it to distinguish between lines that     *)
  97.     (* were empty originally, and those we have made empty by deletions.*)
  98.     (* This allows us to avoid generating excess blank lines in the     *)
  99.     (* output, while still retaining those blank lines that the author  *)
  100.     (* intended to keep.                                                *)
  101.  
  102.     TerminateEmptyLine: BOOLEAN;
  103.  
  104.     (* The next flag says whether there is anything in Buffer.  This    *)
  105.     (* is a guard against reading rubbish or writing the same line      *)
  106.     (* twice.  (There's probably a better way to achieve this, but so   *)
  107.     (* far I haven't worked out a simpler way to handle the end-of-file *)
  108.     (* condition.)                                                      *)
  109.  
  110.     BufferLoaded: BOOLEAN;
  111.  
  112.     (* SourceLength is either MAX(CARDINAL) or the length of the string *)
  113.     (* in Buffer.  Most of the time we leave it equal to MAX(CARDINAL)  *)
  114.     (* and recompute only as needed.                                    *)
  115.  
  116.     SourceLength: CARDINAL;
  117.  
  118.     (* FileName is a list of files that have to be processed. *)
  119.  
  120.     FileName: ARRAY FileNumber OF ARRAY [0..127] OF CHAR;
  121.  
  122.     (* There are LastFileNumber+1 files in total. *)
  123.  
  124.     LastFileNumber: [0..MAX(FileNumber)];
  125.  
  126. (************************************************************************)
  127. (*              INSERTIONS AND DELETIONS IN THE LINE BUFFER             *)
  128. (************************************************************************)
  129.  
  130. PROCEDURE InsertString (offset: INTEGER;  str: ARRAY OF CHAR);
  131.  
  132.     (* Inserts str at Buffer[LinePlace+offset].  If offset is zero or   *)
  133.     (* negative then LinePlace is adjusted.                             *)
  134.  
  135.     VAR j, amount, base: CARDINAL;
  136.  
  137.     BEGIN
  138.         IF SourceLength > MAX(BufferSubscript) THEN
  139.             SourceLength := Length(Buffer);
  140.         END (*IF*);
  141.         amount := Length(str);
  142.         base := VAL(INTEGER,LinePlace) + offset;
  143.         FOR j := SourceLength+amount-1 TO base+amount BY -1 DO
  144.             Buffer[j] := Buffer[j-amount];
  145.         END (*FOR*);
  146.         FOR j := 0 TO amount-1 DO
  147.             Buffer[base+j] := str[j];
  148.         END (*FOR*);
  149.         IF offset <= 0 THEN
  150.             LinePlace := LinePlace + amount;
  151.         END (*IF*);
  152.         INC (SourceLength, amount);
  153.         IF SourceLength <= MAX(BufferSubscript) THEN
  154.             Buffer[SourceLength] := CHR(0);
  155.         END (*IF*);
  156.     END InsertString;
  157.  
  158. (************************************************************************)
  159.  
  160. PROCEDURE DeleteString (offset: INTEGER;  length: CARDINAL);
  161.  
  162.     (* Deletes the substring of length "length" starting at             *)
  163.     (* Buffer[LinePlace+offset].  If offset is negative then LinePlace  *)
  164.     (* is adjusted.                                                     *)
  165.  
  166.     VAR j, base: CARDINAL;
  167.  
  168.     BEGIN
  169.         IF SourceLength > MAX(BufferSubscript) THEN
  170.             SourceLength := Length(Buffer);
  171.         END (*IF*);
  172.         base := VAL(INTEGER,LinePlace) + offset;
  173.         FOR j := base TO SourceLength-length DO
  174.             Buffer[j] := Buffer[j+length];
  175.         END (*FOR*);
  176.         Buffer[SourceLength-length+1] := CHR(0);
  177.         IF offset < 0 THEN
  178.             IF VAL(INTEGER,length) + offset > 0 THEN LinePlace := base;
  179.             ELSE DEC(LinePlace, length);
  180.             END (*IF*);
  181.         END (*IF*);
  182.         DEC (SourceLength, length);
  183.     END DeleteString;
  184.  
  185. (************************************************************************)
  186.  
  187. PROCEDURE WritePartialLine (VAR (*INOUT*) f: File;  pos: CARDINAL);
  188.  
  189.     (* Writes Buffer[0..pos-1] to file f, and then deletes the written  *)
  190.     (* data from Buffer.                                                *)
  191.  
  192.     VAR ch: CHAR;
  193.  
  194.     BEGIN
  195.         ch := Buffer[pos];  Buffer[pos] := CHR(0);
  196.         WriteToFile (f, Buffer);
  197.         Buffer[pos] := ch;
  198.         DeleteString (-VAL(INTEGER,pos), pos);
  199.  
  200.         (* This next assignment is to ensure that the output line       *)
  201.         (* will be terminated even if the rest of it is deleted.        *)
  202.  
  203.         TerminateEmptyLine := TRUE;
  204.  
  205.     END WritePartialLine;
  206.  
  207. (************************************************************************)
  208. (*                      COPYING "ORDINARY" TEXT                         *)
  209. (************************************************************************)
  210.  
  211. PROCEDURE EndOfLine(): BOOLEAN;
  212.  
  213.     (* Returns TRUE iff we are at the end of the line buffer. *)
  214.  
  215.     BEGIN
  216.         RETURN (LinePlace > MAX(BufferSubscript)) OR (Buffer[LinePlace] = CHR(0))
  217.                           OR (Buffer[LinePlace] = CHR(26));
  218.     END EndOfLine;
  219.  
  220. (************************************************************************)
  221.  
  222. PROCEDURE WriteCurrentLine (VAR (*INOUT*) f: File);
  223.  
  224.     (* Writes out the current buffer contents. *)
  225.  
  226.     BEGIN
  227.         (* Blank line suppression test. *)
  228.         IF Buffer[0] = CHR(0) THEN
  229.             IF TerminateEmptyLine THEN
  230.                 TerminateLine (f);
  231.             END (*IF*);
  232.         ELSE
  233.             WriteToFile (f, Buffer);
  234.             TerminateLine (f);
  235.         END (*IF*);
  236.         BufferLoaded := FALSE;  TerminateEmptyLine := FALSE;
  237.     END WriteCurrentLine;
  238.  
  239. (************************************************************************)
  240.  
  241. PROCEDURE GetNextLine (VAR (*INOUT*) fin, fout: File;  SendToOutput: BOOLEAN);
  242.  
  243.     (* Writes out the current line to fout if SendToOutput is TRUE,     *)
  244.     (* and then re-fills the line buffer from fin.                      *)
  245.  
  246.     BEGIN
  247.         IF SendToOutput AND BufferLoaded THEN
  248.             WriteCurrentLine (fout);
  249.         END (*IF*);
  250.         IF NOT EndOfFile(fin) THEN
  251.             ReadLine (fin, Buffer);  LinePlace := 0;
  252.             TerminateEmptyLine := Buffer[0] = CHR(0);
  253.             SourceLength := MAX(CARDINAL);
  254.  
  255.             (* The next test is to guard against the possibility that  *)
  256.             (* all we have read is the terminating end-of-file char.   *)
  257.  
  258.             BufferLoaded := NOT (TerminateEmptyLine AND EndOfFile(fin));
  259.  
  260.         END (*IF*);
  261.  
  262.     END GetNextLine;
  263.  
  264. (************************************************************************)
  265.  
  266. PROCEDURE EndCommentMarkerPresent(): BOOLEAN;
  267.  
  268.     (* If an "end comment" delimiter is found in the source then we     *)
  269.     (* move past it and return TRUE.  Otherwise the result is FALSE.    *)
  270.  
  271.     BEGIN
  272.         IF (Buffer[LinePlace] = "*") AND (Buffer[LinePlace+1] = ")") THEN
  273.             INC (LinePlace, 2);
  274.             RETURN TRUE;
  275.         END (*IF*);
  276.         RETURN FALSE;
  277.     END EndCommentMarkerPresent;
  278.  
  279. (************************************************************************)
  280.  
  281. PROCEDURE SkipComment (VAR (*INOUT*) fin, fout: File;  SendToOutput: BOOLEAN);
  282.  
  283.     (* On entry we have just passed a "start comment" delimiter in the  *)
  284.     (* source.  We copy this over, taking nested comments into account, *)
  285.     (* and return with Buffer[LinePlace] hold the character just beyond *)
  286.     (* the corresponding "end comment" delimiter.                       *)
  287.  
  288.     BEGIN
  289.         LOOP
  290.             IF EndOfLine() THEN
  291.                 IF (Buffer[LinePlace] = CHR(26)) OR EndOfFile (fin) THEN
  292.                     RETURN;
  293.                 END (*IF*);
  294.                 GetNextLine (fin, fout, SendToOutput);
  295.                 IF NOT BufferLoaded THEN
  296.                     RETURN;
  297.                 END (*IF*);
  298.             ELSIF EndCommentMarkerPresent() THEN
  299.                 RETURN;
  300.             ELSIF (Buffer[LinePlace] = "(") AND (Buffer[LinePlace+1] = "*") THEN
  301.                 INC (LinePlace, 2);
  302.                 SkipComment (fin, fout, SendToOutput);
  303.             ELSE
  304.                 INC (LinePlace);
  305.             END (*IF*);
  306.         END (*LOOP*);
  307.     END SkipComment;
  308.  
  309. (************************************************************************)
  310.  
  311. PROCEDURE CopyOver (VAR (*INOUT*) fin, fout: File;
  312.                                 SendToOutput: BOOLEAN): SpecialSymbol;
  313.  
  314.     (* This procedure simply reads the input file fin, copying it to    *)
  315.     (* fout if SendToOutput is TRUE, and returns on end of file or      *)
  316.     (* when an opening or closing version delimiter is detected.  Note  *)
  317.     (* that version delimiters inside comments, or outside comments but *)
  318.     (* inside string delimiters, are treated as ordinary text.          *)
  319.     (* The function result is the symbol that caused this procedure to  *)
  320.     (* return.  On return we have already read past that symbol.        *)
  321.  
  322.     (* Note: on return there might still be some unprocessed text in    *)
  323.     (* Buffer.  This is indicated by the global variable BufferLoaded.  *)
  324.  
  325.     VAR ch: CHAR;
  326.  
  327.     BEGIN
  328.         LOOP
  329.             WHILE EndOfLine() DO
  330.                 IF (Buffer[LinePlace] = CHR(26)) OR EndOfFile (fin) THEN
  331.                     IF SendToOutput AND BufferLoaded THEN
  332.                         WriteCurrentLine (fout);
  333.                     END (*IF*);
  334.                     RETURN EofSymbol;
  335.                 END (*IF*);
  336.                 GetNextLine (fin, fout, SendToOutput);
  337.             END (*WHILE*);
  338.  
  339.             (* Pick up next source character. *)
  340.  
  341.             ch := Buffer[LinePlace];  INC(LinePlace);
  342.  
  343.             IF (ch = "'") OR (ch = '"') THEN
  344.  
  345.                 (* Special case: character string. *)
  346.  
  347.                 WHILE NOT EndOfLine() AND (Buffer[LinePlace] <> ch) DO
  348.                     INC(LinePlace);
  349.                 END (*WHILE*);
  350.                 IF EndOfLine() THEN
  351.                     EndOfMessage;
  352.                     Message ("Error: Unterminated character string");
  353.                     EndOfMessage;
  354.                     Message (Buffer);
  355.                 ELSE
  356.                     INC(LinePlace);
  357.                 END (*IF*);
  358.  
  359.             ELSIF (ch = "(") AND (Buffer[LinePlace] = "*") THEN
  360.  
  361.                 (* Special case: start of comment.  This could be an    *)
  362.                 (* ordinary comment, a "start version" delimiter, or a  *)
  363.                 (* commented-out "end version" delimiter.               *)
  364.  
  365.                 INC (LinePlace);
  366.                 IF Buffer[LinePlace] = "<" THEN
  367.                     INC (LinePlace);
  368.                     RETURN StartVersion;
  369.                 ELSIF Buffer[LinePlace] = ">" THEN
  370.                     INC (LinePlace);
  371.                     IF EndCommentMarkerPresent() THEN
  372.                         RETURN CommentedEndVersion;
  373.                     END (*IF*);
  374.                 ELSE
  375.                     SkipComment (fin, fout, SendToOutput);
  376.                 END (*IF*);
  377.  
  378.             ELSIF ch = ">" THEN
  379.  
  380.                 (* This could be an "end version" delimiter - look in   *)
  381.                 (* more detail.                                         *)
  382.  
  383.                 IF EndCommentMarkerPresent() THEN
  384.                     RETURN EndVersion;
  385.                 END (*IF*);
  386.  
  387.             END (*IF*);
  388.  
  389.         END (*LOOP*);
  390.  
  391.     END CopyOver;
  392.  
  393. (************************************************************************)
  394. (*                      THE MAIN CONVERSION ROUTINES                    *)
  395. (************************************************************************)
  396.  
  397. PROCEDURE Filter (VAR (*INOUT*) fin, fout: File;
  398.                         KeepText, Active: BOOLEAN;
  399.                         VAR (*INOUT*) ChangeMade: BOOLEAN): SpecialSymbol;
  400.  
  401.     (* Copies from fin to fout, altering the version delimiters as      *)
  402.     (* appropriate to comment and uncomment text.  This procedure       *)
  403.     (* returns after reaching the end of fin, or finding the            *)
  404.     (* first unmatched "close version" delimiter, whichever comes       *)
  405.     (* first.  The reason for defining the return condition in this     *)
  406.     (* way is that we use recursive calls to handle nested conditions.  *)
  407.  
  408.     (* KeepText specifies whether the unselected versions should be     *)
  409.     (* copied over (commented out); if KeepText is false then the       *)
  410.     (* unselected code is omitted from the output file.  The "Active"   *)
  411.     (* parameter specifies whether we are currently in a section that   *)
  412.     (* should be retained without being commented out - it should be    *)
  413.     (* TRUE on the first call, but may be false on recursive calls.     *)
  414.     (* The function result indicates which special symbol terminated    *)
  415.     (* the processing.                                                  *)
  416.  
  417.     VAR code: SpecialSymbol;  include, endcomment: BOOLEAN;
  418.         markerstart, length: CARDINAL;
  419.  
  420.     BEGIN
  421.         LOOP
  422.             code := CopyOver (fin, fout, KeepText OR Active);
  423.             IF NOT KeepText AND NOT Active THEN
  424.                 ChangeMade := TRUE;
  425.             END (*IF*);
  426.  
  427.             (* The result of CopyOver can be one of:                    *)
  428.             (*  EofSymbol:      means processing is complete            *)
  429.             (*  StartVersion:   means that we have to conditionally     *)
  430.             (*                  copy a version                          *)
  431.             (*  EndVersion, CommentedEndVersion: these terminate a      *)
  432.             (*                  recursive call                          *)
  433.  
  434.             IF code <> StartVersion THEN EXIT(*LOOP*) END(*IF*);
  435.  
  436.             (* We have reached a "start version" delimiter; so we have  *)
  437.             (* to decide whether to retain or remove the following      *)
  438.             (* section of source.                                       *)
  439.  
  440.             markerstart := LinePlace - 3;
  441.             include := Expr(Buffer, LinePlace) AND Active;
  442.             endcomment := EndCommentMarkerPresent();
  443.  
  444.             IF include THEN
  445.  
  446.                 (* The code in this section should be included.  If     *)
  447.                 (* KeepText is TRUE we should put an "end comment"      *)
  448.                 (* delimiter after this "start version" marker, unless  *)
  449.                 (* it's already there.  If KeepText is FALSE then we    *)
  450.                 (* should delete the entire version selector, including *)
  451.                 (* the "end comment" delimiter if present.              *)
  452.  
  453.                 IF KeepText THEN
  454.                     IF NOT endcomment THEN
  455.                         InsertString (0, "*)");  ChangeMade := TRUE;
  456.                     END (*IF*);
  457.                 ELSE
  458.                     length := LinePlace - markerstart;
  459.                     DeleteString (-VAL(INTEGER,length), length);
  460.                     ChangeMade := TRUE;
  461.                 END (*IF*);
  462.                 code := Filter (fin, fout, KeepText, TRUE, ChangeMade);
  463.                 IF code = EndVersion THEN
  464.  
  465.                     (* Delete the "end version" delimiter, or comment   *)
  466.                     (* it out, depending on the value of KeepText.      *)
  467.  
  468.                     IF KeepText THEN
  469.                         InsertString (-3, "(*");
  470.                     ELSE
  471.                         DeleteString (-3, 3);
  472.                     END (*IF*);
  473.                     ChangeMade := TRUE;
  474.  
  475.                 ELSIF (code = CommentedEndVersion) AND NOT KeepText THEN
  476.                     (* Delete a commented "end version" delimiter if    *)
  477.                     (* KeepText is FALSE.                               *)
  478.                     DeleteString (-5, 5);
  479.                     ChangeMade := TRUE;
  480.                 END (*IF*);
  481.  
  482.             ELSE
  483.  
  484.                 (* The code in this section should be suppressed.  If   *)
  485.                 (* KeepText is FALSE we may need to write out the part  *)
  486.                 (* of the input line before the suppressed text.  If    *)
  487.                 (* KeepText is TRUE we merely remove any "end comment"  *)
  488.                 (* delimiter after this "start version" marker.         *)
  489.  
  490.                 IF KeepText THEN
  491.                     IF endcomment THEN
  492.                         DeleteString (-2, 2);
  493.                         IF Buffer[LinePlace] IN AlphaNumerics THEN
  494.                             InsertString (0, " ");
  495.                         END (*IF*);
  496.                         ChangeMade := TRUE;
  497.                     END (*IF*);
  498.                 ELSIF Active THEN
  499.                     WritePartialLine (fout, markerstart);
  500.                 END (*IF*);
  501.                 code := Filter (fin, fout, KeepText, FALSE, ChangeMade);
  502.                 IF KeepText THEN
  503.                     IF code = CommentedEndVersion THEN
  504.                         (* Change the CommentedEndVersion to an EndVersion. *)
  505.                         DeleteString (-5, 2);
  506.                         ChangeMade := TRUE;
  507.                     END (*IF*);
  508.                 ELSE
  509.                     (* Delete that part of the line already processed. *)
  510.                     DeleteString (-VAL(INTEGER,LinePlace), LinePlace);
  511.                     ChangeMade := TRUE;
  512.                 END (*IF*);
  513.  
  514.             END (*IF include*);
  515.  
  516.             (* In all cases, the special symbol just read should have   *)
  517.             (* been some variety of "end version" marker.               *)
  518.  
  519.             IF code = EofSymbol THEN
  520.                 EndOfMessage;
  521.                 Message ("Error: section not terminated before end of file.");
  522.                 EXIT (*LOOP*);
  523.             END (*IF*);
  524.  
  525.         END (*LOOP*);
  526.  
  527.         RETURN code;
  528.  
  529.     END Filter;
  530.  
  531. (************************************************************************)
  532.  
  533. PROCEDURE ConvertFile (VAR (*INOUT*) fin, fout: File;
  534.                 KeepText: BOOLEAN;  VAR (*OUT*) changed: BOOLEAN): BOOLEAN;
  535.  
  536.     (* Copies fin to fout, converting as directed by the embedded       *)
  537.     (* version control delimiters.  Returns FALSE if the operation      *)
  538.     (* stopped before end-of-file.                                      *)
  539.  
  540.     BEGIN
  541.         ReadLine (fin, Buffer);  LinePlace := 0;
  542.         changed := FALSE;
  543.         TerminateEmptyLine := Buffer[0] = CHR(0);
  544.         SourceLength := MAX(CARDINAL);
  545.         BufferLoaded := TRUE;
  546.         IF Filter (fin, fout, KeepText, TRUE, changed) <> EofSymbol THEN
  547.             EndOfMessage;
  548.             Message ("Error: unmatched delimiter, entire file not read.");
  549.             EndOfMessage;
  550.             RETURN FALSE;
  551.         END (*IF*);
  552.         RETURN TRUE;
  553.     END ConvertFile;
  554.  
  555. (************************************************************************)
  556.  
  557. PROCEDURE ConvertAllFiles (KeepText: BOOLEAN);
  558.  
  559.     (* Converts all files named in array FileName.  The original copies *)
  560.     (* are renamed with a .BAK extension.                               *)
  561.  
  562.     VAR j: FileNumber;  success, changed: BOOLEAN;
  563.         tmpname, BAKname: ARRAY [0..127] OF CHAR;
  564.         dotplace: CARDINAL;
  565.         fin, fout: File;
  566.  
  567.     BEGIN
  568.         IF LastFileNumber = 0 THEN RETURN END(*IF*);
  569.  
  570.         FOR j := 1 TO LastFileNumber DO
  571.  
  572.             Message (FileName[j]);
  573.             Message (": ");
  574.  
  575.             (* From the file name, obtain two derived names. *)
  576.  
  577.             CopyString (FileName[j], BAKname);
  578.             dotplace := Pos (".", BAKname);
  579.             IF dotplace > Length(BAKname) THEN
  580.                 dotplace := Length(BAKname);
  581.                 BAKname[dotplace] := ".";
  582.             END (*IF*);
  583.             BAKname[dotplace+1] := "B";
  584.             BAKname[dotplace+2] := "A";
  585.             BAKname[dotplace+3] := "K";
  586.             BAKname[dotplace+4] := CHR(0);
  587.             CopyString (BAKname, tmpname);
  588.             tmpname[dotplace+1] := "$";
  589.             tmpname[dotplace+2] := "$";
  590.             tmpname[dotplace+3] := "$";
  591.  
  592.             (* Open the source file, and open a temporary file for      *)
  593.             (* output.                                                  *)
  594.  
  595.             (*
  596.             Message ("BAKname is ");  Message (BAKname);  EndOfMessage;
  597.             Message ("tmpname is ");  Message (tmpname);  EndOfMessage;
  598.             *)
  599.             success := TRUE;
  600.             IF OpenFile (fin, FileName[j], FALSE) THEN
  601.                 IF NOT OpenFile (fout, tmpname, TRUE) THEN
  602.                     Message ("can't create output file.");
  603.                     CloseFile (fin);
  604.                     success := FALSE;
  605.                 END (*IF*);
  606.             ELSE
  607.                 Message ("missing input file ");
  608.                 Message (FileName[j]);
  609.                 success := FALSE;
  610.             END (*IF*);
  611.  
  612.             IF success THEN
  613.  
  614.                 (* Perform the conversion. *)
  615.  
  616.                 success := ConvertFile (fin, fout, KeepText, changed);
  617.                 CloseFile (fin);  CloseFile (fout);
  618.  
  619.                 IF success THEN
  620.  
  621.                     IF changed THEN
  622.  
  623.                         (* Delete any existing .BAK file, and rename    *)
  624.                         (* the input and output files.                  *)
  625.  
  626.                         DeleteFile (BAKname);
  627.                         RenameFile (FileName[j], BAKname);
  628.                         RenameFile (tmpname, FileName[j]);
  629.                         Message ("done");
  630.  
  631.                     ELSE
  632.  
  633.                         (* File has not changed, so throw away the      *)
  634.                         (* output file.                                 *)
  635.  
  636.                         DeleteFile (tmpname);
  637.                         Message ("unchanged");
  638.  
  639.                     END (*IF*);
  640.  
  641.                 END (*IF*);
  642.  
  643.             END (*IF*);
  644.             EndOfMessage;
  645.  
  646.         END (*FOR*);
  647.  
  648.     END ConvertAllFiles;
  649.  
  650. (************************************************************************)
  651. (*                      LOADING THE SYMBOL TABLE                        *)
  652. (************************************************************************)
  653.  
  654. PROCEDURE SkipBlanks;
  655.  
  656.     (* Moves LinePlace past any space or tab characters in Buffer. *)
  657.  
  658.     CONST space = " ";  tab = CHR(9);
  659.  
  660.     BEGIN
  661.         WHILE (LinePlace < MAX(BufferSubscript)) AND
  662.                 ((Buffer[LinePlace] = space) OR (Buffer[LinePlace] = tab)) DO
  663.             INC (LinePlace);
  664.         END (*WHILE*);
  665.     END SkipBlanks;
  666.  
  667. (************************************************************************)
  668.  
  669. PROCEDURE ProcessAssignment;
  670.  
  671.     (* Handles an assignment in the line buffer.  The assignment can be *)
  672.     (* a single symbol (in which it is given the value "TRUE"), or it   *)
  673.     (* can be of the form    <symbol> := <expression>                   *)
  674.  
  675.     VAR symbol, result: ARRAY [0..31] OF CHAR;
  676.  
  677.     BEGIN
  678.         Id (Buffer, LinePlace, symbol);
  679.         SkipBlanks;
  680.         IF (Buffer[LinePlace] = ":") AND (Buffer[LinePlace+1] = "=") THEN
  681.             INC (LinePlace, 2);
  682.             SkipBlanks;
  683.             StringExpr (Buffer, LinePlace, result);
  684.         ELSE
  685.             CopyString ("TRUE", result);
  686.         END (*IF*);
  687.         DefineSymbol (symbol, result);
  688.     END ProcessAssignment;
  689.  
  690. (************************************************************************)
  691.  
  692. PROCEDURE ProcessConfigurationFile(): BOOLEAN;
  693.  
  694.     (* Processes the assignments in the configuration file PP.CFG, and  *)
  695.     (* loads the results into the symbol table.  Returns TRUE to        *)
  696.     (* indicate success.                                                *)
  697.  
  698.     VAR f: File;
  699.  
  700.     BEGIN
  701.         IF NOT OpenFile (f, "PP.CFG", FALSE) THEN
  702.             Message ("Error: Can't find file PP.CFG");
  703.             EndOfMessage;
  704.             RETURN FALSE;
  705.         END (*IF*);
  706.  
  707.         (* We process one line of input on each pass through this loop. *)
  708.  
  709.         LOOP
  710.             IF EndOfFile (f) THEN
  711.                 CloseFile (f);  RETURN TRUE;
  712.             END (*IF*);
  713.             ReadLine (f, Buffer);  LinePlace := 0;
  714.  
  715.             (* Leading white space is legal. *)
  716.  
  717.             SkipBlanks;
  718.  
  719.             (* A legal assignment should start with an alphanumeric. *)
  720.  
  721.             IF Buffer[LinePlace] IN AlphaNumerics THEN
  722.                 ProcessAssignment;
  723.             END (*IF*);
  724.  
  725.             (* Trailing white space is also legal. *)
  726.  
  727.             SkipBlanks;
  728.  
  729.             (* The only other thing that should be on the line is an    *)
  730.             (* optional comment.  Comments start with "--".             *)
  731.  
  732.             IF NOT EndOfLine() AND ((Buffer[LinePlace] <> "-")
  733.                                         OR (Buffer[LinePlace+1] <> "-")) THEN
  734.                 Message ("Error: illegal expression in PP.CFG");
  735.                 EndOfMessage;
  736.                 Message (Buffer);
  737.                 EndOfMessage;
  738.                 CloseFile (f);
  739.                 RETURN FALSE;
  740.             END (*IF*);
  741.  
  742.         END (*LOOP*);
  743.  
  744.     END ProcessConfigurationFile;
  745.  
  746. (************************************************************************)
  747. (*                   LOADING THE LIST OF FILE NAMES                     *)
  748. (************************************************************************)
  749.  
  750. PROCEDURE GetFileNames(): BOOLEAN;
  751.  
  752.     (* Reads a list of file names from the file PP.FIL.  Returns FALSE  *)
  753.     (* if the operation failed.                                         *)
  754.  
  755.     VAR f: File;
  756.  
  757.     BEGIN
  758.         IF NOT OpenFile (f, "PP.FIL", FALSE) THEN
  759.             Message ("Error: Can't find file PP.FIL");
  760.             EndOfMessage;
  761.             RETURN FALSE;
  762.         END (*IF*);
  763.         LastFileNumber := 0;
  764.  
  765.         (* We process one line of input on each pass through this loop. *)
  766.  
  767.         LOOP
  768.             IF EndOfFile (f) THEN
  769.                 CloseFile (f);
  770.                 IF LastFileNumber = 0 THEN
  771.                     Message ("Warning: no files to process.");
  772.                     EndOfMessage;
  773.                     RETURN FALSE;
  774.                 ELSE
  775.                     RETURN TRUE;
  776.                 END (*IF*);
  777.             END (*IF*);
  778.  
  779.             INC (LastFileNumber);
  780.             ReadLine (f, FileName[LastFileNumber]);
  781.  
  782.             (* Watch out for blank lines and comment lines, also for CTRL/Z lines       *)
  783.             (* which some editors insert just before end-of-file.                       *)
  784.  
  785.             IF (FileName[LastFileNumber][0] = CHR(0))
  786.                     OR (FileName[LastFileNumber][0] = CHR(26))
  787.                         OR ((FileName[LastFileNumber][0] = "-")
  788.                             AND (FileName[LastFileNumber][1] = "-")) THEN
  789.                 DEC (LastFileNumber);
  790.             END (*IF*);
  791.  
  792.         END (*LOOP*);
  793.  
  794.     END GetFileNames;
  795.  
  796. (************************************************************************)
  797. (*                      PARSING THE COMMAND LINE                        *)
  798. (************************************************************************)
  799.  
  800. PROCEDURE ParseCommandLine (VAR (*OUT*) KeepText: BOOLEAN): BOOLEAN;
  801.  
  802.     (* Reads the command line and checks for the "suppress unused       *)
  803.     (* versions" flag.  Returns FALSE if there is something wrong with  *)
  804.     (* the command line.                                                *)
  805.  
  806.     VAR str: ARRAY [0..31] OF CHAR;
  807.         arglen: CARDINAL;
  808.  
  809.     BEGIN
  810.         CommandLine (1, str, arglen);
  811.         IF arglen = 0 THEN
  812.             KeepText := TRUE;  RETURN TRUE;
  813.         END (*IF*);
  814.  
  815.         (* An argument was present.  Only "S" or "s" are legal. *)
  816.  
  817.         KeepText := (arglen <> 1) OR (CAP(str[0]) <> "S");
  818.  
  819.         (* Check for two or more arguments. *)
  820.  
  821.         CommandLine (2, str, arglen);
  822.         IF (arglen > 0) OR KeepText THEN
  823.             Message ("Usage: PP [S]");
  824.             EndOfMessage;
  825.             RETURN FALSE;
  826.         END (*IF*);
  827.         RETURN TRUE;
  828.  
  829.     END ParseCommandLine;
  830.  
  831. (************************************************************************)
  832. (*                          MAIN PROGRAM                                *)
  833. (************************************************************************)
  834.  
  835. VAR KeepText: BOOLEAN;
  836.  
  837. BEGIN
  838.     IF ParseCommandLine (KeepText) AND GetFileNames()
  839.                 AND ProcessConfigurationFile() THEN
  840.         DumpSymbolTable;
  841.         ConvertAllFiles (KeepText);
  842.     END (*IF*);
  843. END PP.
  844.  
  845.