perm filename PRETTY.PAS[PAS,SYS] blob sn#459961 filedate 1979-07-21 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(*$O-,I-,C-,D-*)
C00102 ENDMK
C⊗;
(*$O-,I-,C-,D-*)

(*====================================================================*)
(*                                                                    *)
(*  Program title: Pascal PrettyPrinting program                      *)
(*                                                                    *)
(*  Authors: Jon F. Hueras and Henry F. Ledgard                       *)
(*           Computer and Information Science Department              *)
(*           University of Massachusetts, Amherst                     *)
(*           (earlier versions and contributions by Randy Chow        *)
(*            John Gorman.)                                           *)
(*  Modified: Paul N. Hilfinger                                       *)
(*            Michael E. Fryd                                         *)
(*                                                                    *)
(*  Program Summary:                                                  *)
(*                                                                    *)
(*     This program takes as input a Pascal program and               *)
(*     reformats the program according to a standard set of           *)
(*     PrettyPrinting rules. The PrettyPrinted program is given       *)
(*     as output.  The PrettyPrinting rules are given below.          *)
(*                                                                    *)
(*     An important feature is the provision for the use of extra     *)
(*     spaces and extra blank lines.  They may be freely inserted by  *)
(*     the user in addition to the spaces and blank lines inserted    *)
(*     by the PrettyPrinter.                                          *)
(*                                                                    *)
(*     No attempt is made to detect or correct syntactic errors in    *)
(*     the user's program.  however, syntactic errors may result in   *)
(*     erroneous PrettyPrinting.                                      *)
(*                                                                    *)
(*                                                                    *)
(*  input file: InputFile    - A file of characters, presumably a     *)
(*                             pascal program or program fragment.    *)
(*                                                                    *)
(*  output files: OutputFile - The PrettyPrinted program.             *)
(*                                                                    *)
(*                TempFile   - Working file for undenting.            *)
(*                                                                    *)
(*                                                                    *)
(*====================================================================*)



(*====================================================================*)
(*                                                                    *)
(*                   Pascal PrettyPrinting Rules                      *)
(*                                                                    *)
(*                                                                    *)
(*  [ general PrettyPrinting rules ]                                  *)
(*                                                                    *)
(*   1.   Any spaces or blank lines beyond those generated by the     *)
(*     PrettyPrinter are left alone.  The user is encouraged, for the *)
(*     sake of readability, to make use of this facility.             *)
(*        In addition, comments are left where they are found, unless *)
(*     they are shifted right by preceding text on a line.            *)
(*                                                                    *)
(*   2.   All declarations and all "FOR", "WHILE", "WITH", and "LOOP" *)
(*     statements begin on separate lines.                            *)
(*                                                                    *)
(*   3.   No line may be greater than 128 characters long.  Any line  *)
(*     longer than this is continued on a separate line.              *)
(*                                                                    *)
(*   4.   The keywords "BEGIN", "END", "REPEAT", and "RECORD" are     *)
(*     forced to stand on lines by themselves (or possibly follwed by *)
(*     supporting comments).                                          *)
(*        In  addition, the "UNTIL" clause of a "REPEAT-UNTIL" state- *)
(*     ment is forced to start on a new line.                         *)
(*                                                                    *)
(*   5.   A blank line is forced before the keywords "PROGRAM",       *)
(*     "PROCEDURE", "FUNCTION", "LABEL", "CONST", "TYPE", and "VAR".  *)
(*                                                                    *)
(*   6.   A space is forced before and after the symbols ":=" and     *)
(*     "="  additionally, a space is forced after the symbol ":".     *)
(*                                                                    *)
(*                                                                    *)
(*  [ indentation rules ]                                             *)
(*                                                                    *)
(*   1.   The bodies of "LABEL", "CONST", "TYPE", and "VAR" declara-  *)
(*     tions are indented from their corresponding declaration header *)
(*     keywords.                                                      *)
(*                                                                    *)
(*   2.   The bodies of "BEGIN-END", "REPEAT-UNTIL", "FOR", "WHILE",  *)
(*     "WITH", and "CASE" statements, as well as "RECORD-END" struc-  *)
(*     tures and "CASE" variants (to one level) are indented from     *)
(*     their header keywords.                                         *)
(*                                                                    *)
(*   3.   An "IF-THEN-ELSE" statement is indented as follows:         *)
(*                                                                    *)
(*             IF <expression>                                        *)
(*                THEN                                                *)
(*                   <statement>                                      *)
(*                ELSE                                                *)
(*                   <statement>                                      *)
(*     however, none of the line breaks illustrated is required.      *)
(*                                                                    *)
(*   4.   A sequence of "IF-THEN-ELSE IF-THEN-ELSE IF..." is indented *)
(*                                                                    *)
(*              IF <expression>                                       *)
(*                 THEN                                               *)
(*                    <statement>                                     *)
(*              ELSE IF <expression>                                  *)
(*                 THEN                                               *)
(*                    . . .                                           *)
(*                 ELSE                                               *)
(*                    <statement>                                     *)
(*                                                                    *)
(*     each "ELSE IF" appears on a new line.  The "ELSE" and the "IF" *)
(*     should appear on the same line in the input source text.       *)
(*                                                                    *)
(*   5.   A sequence of "IF-THEN " is indented                        *)
(*                                                                    *)
(*              IF <expression>                                       *)
(*                 THEN IF <expression> ...                           *)
(*                    THEN                                            *)
(*                       <statement> ....                             *)
(*                                                                    *)
(*     each "THEN IF" appears on a new line.  The "THEN" and the "IF" *)
(*     should appear on the same line in the source text.             *)
(*                                                                    *)
(*====================================================================*)



(*====================================================================*)
(*                                                                    *)
(*                      GENERAL ALGORITHM                             *)
(*                                                                    *)
(*                                                                    *)
(*      The strategy of the PrettyPrinter is to scan symbols from     *)
(*   the input program and map each symbol into a PrettyPrinting      *)
(*   action, independently of the context in which the symbol         *)
(*   appears.  This is accomplished by a table of PrettyPrinting      *)
(*   options.                                                         *)
(*                                                                    *)
(*      For each distinguished symbol in the table, there is an       *)
(*   associated set of options.  If the option has been selected for  *)
(*   the symbol being scanned, then the action corresponding with     *)
(*   each option is performed.                                        *)
(*                                                                    *)
(*      The basic actions involved in PrettyPrinting are the indent-  *)
(*   ation and de-indentation of the margin.  Each time the margin is *)
(*   indented, the previous value of the margin is pushed onto a      *)
(*   stack, along with the name of the symbol that caused it to be    *)
(*   indented.  Each time the margin is de-indented, the stack is     *)
(*   popped off to obtain the previous value of the margin.           *)
(*                                                                    *)
(*      The PrettyPrinting options are processed in the following     *)
(*   order, and invoke the following actions:                         *)
(*                                                                    *)
(*                                                                    *)
(*     CrSuppress      - If a carriage return has been inserted       *)
(*                       following the previous symbol, then it is    *)
(*                       inhibited until the next symbol is printed.  *)
(*                                                                    *)
(*     CrBefore        - A carriage return is inserted before the     *)
(*                       current symbol (unless one is already there).*)
(*                                                                    *)
(*     BlankLineBefore - A blank line is inserted before the current  *)
(*                       symbol (unless already there).               *)
(*                                                                    *)
(*     DIndentOnKeys   - If any of the specified keys are on top of   *)
(*                       of the stack, the stack is popped, de-inden- *)
(*                       ting the margin.  The process is repeated    *)
(*                       until the top of the stack is not one of the *)
(*                       specified keys.                              *)
(*                                                                    *)
(*     DIndent         - The stack is unconditionally popped and the  *)
(*                       margin is de-indented.                       *)
(*                                                                    *)
(*     SpaceBefore     - A space is inserted before the symbol being  *)
(*                       scanned (unless already there).              *)
(*                                                                    *)
(*     Capitalize      - The word is capitalized. This option only    *)
(*                       valid if the user requested it.              *)
(*                                                                    *)
(*                                                                    *)
(*     [ the symbol is printed at this point ]                        *)
(*                                                                    *)
(*     SpaceAfter      - A space is inserted after the symbol being   *)
(*                       scanned (unless already there).              *)
(*                                                                    *)
(*     GobbleSymbols   - Symbols are continuously scanned and printed *)
(*                       without any processing (except for capital-  *)
(*                       zation) until one of the specified symbols   *)
(*                       is seen (but not gobbled).                   *)
(*                                                                    *)
(*     IndentByTab     - The margin is indented by a standard amount  *)
(*                       from the previous margin.                    *)
(*                                                                    *)
(*     IndentToCLP     - The margin is indented to the current line   *)
(*                       position.                                    *)
(*                                                                    *)
(*     CrAfter         - A carriage return is inserted following the  *)
(*                       symbol scanned.                              *)
(*                                                                    *)
(*                                                                    *)
(*                                                                    *)
(*====================================================================*)



PROGRAM PrettyPrint( (* from *)  Input,
		     (* to *)    OutputFile ,
		     (* using *) TempFile );


CONST 

      MaxSymbolSize = 200; (* the maximum size (in characters) of a   *)
			   (* symbol scanned by the lexical scanner.  *)

      MaxStackSize  = 100; (* the maximum number of symbols causing   *)
			   (* indentation that may be stacked.        *)

      MaxKeyLength  =  10; (* the maximum length (in characters) of a *)
			   (* Pascal reserved keyword.                *)
      MaxLineSize   = 128; (* the maximum size (in characters) of a   *)
			   (* line output by the PrettyPrinter.       *)

      SlowFail1     =  30; (* up to this column position, each time   *)
			   (* "IndentByTab" is invoked, the margin    *)
			   (* will be Indented by "Indent1".          *)

      SlowFail2     =  48; (* up to this column position, each time   *)
			   (* "IndentByTab" is invoked, the margin    *)
			   (* will be Indented by "Indent2".  beyond  *)
			   (* this, no Indentation occurs.            *)

      Indent1       =   3;

      Indent2       =   1;


      Space = ' ';
      TabSize = 8;
      InitLineNumber = 00100;

      LastByteIndex = 5;
      CRchr = 15B;
      LFchr = 12B;
      NULLchr = 0B;
      FFchr = 14B;
      TABchr = 11B;
      MaxLine = 99999;



TYPE 

     KeySymbol = ( ProgSym,    FuncSym,     ProcSym,
		  LabelSym,   ConstSym,    TypeSym,   VarSym,
		  BeginSym,   RepeatSym,   RecordSym,
		  CaseSym,    CaseVarSym,  OfSym,
		  ForSym,     WhileSym,    WithSym,   DoSym,
		  LoopSym,    ExitSym,
		  IfSym,      ThenSym,     ElseSym,
		  EndSym,
		  AndSym,         ArraySym,       DivSym,
		  DownToSym,      FileSym,        GotoSym,
		  InSym,          ModSym,         NilSym,
		  FalseSym,       TrueSym,        MaxIntSym,
		  ToSym,          PascalSym,      SetSym,
		  PackedSym,      AlgolSym,       ForwardSym,
		  FortranSym,     ExternSym,      CobolSym,
		  OrSym,          NotSym,         ExitLoopSym,
		  NextLoopSym,    UntilSym,
		  ElIfSym,    ThIfSym,
		  Becomes,    OpenComment, CloseComment,
		  SemiColon,  Colon,       Equals,
		  OpenParen,  CloseParen,  Period,
		  EndofFile,
		  OtherSym );

     Option = ( CrSuppress,
	       CrBefore,
	       BlankLineBefore,
	       DIndentOnKeys,
	       DIndent,
	       SpaceBefore,
	       Capitalize,
	       SpaceAfter,
	       GobbleSymbols,
	       IndentByTab,
	       IndentToCLP,
	       CrAfter );

     OptionSet = SET OF Option;

     KeySymSet = SET OF KeySymbol;

     TableEntry = RECORD
		     OptionsSelected  : OptionSet;
		     DIndentSymbols   : KeySymSet;
		     GobbleTerminators: KeySymSet
		  END;

     OptionTable = ARRAY [ KeySymbol ] OF TableEntry;



     Key = PACKED ARRAY [ 1..MaxKeyLength ] OF Char;


     KeyWordTable = ARRAY [ ProgSym..UntilSym ] OF Key;


     SpecialChar = PACKED ARRAY [ 1..2 ] OF Char;


     DblCharTable = ARRAY [ Becomes..OpenComment ] OF SpecialChar;

     SglCharTable = ARRAY [ OpenComment..Period ] OF Char;

     FoldTable = ARRAY [ Char ] OF Char;


     String = ARRAY [ 1..MaxSymbolSize ] OF Char;

     Symbol = RECORD
		 Name        : KeySymbol;
		 Value       : String;
		 Length      : Integer;
		 SpacesBefore: Integer;
		 CrsBefore   : Integer
	      END;

     SymbolInfo = ↑Symbol;


     CharName = ( Letter,    Digit,    Blank,    Quote,  PageMark,
		 EndOfLIne, Filemark, OtherChar       );

     CharTypeTable = ARRAY [ Char ] OF CharName;

     CharInfo = RECORD
		   Name : CharName;
		   Value: Char
		END;


     StackEntry = RECORD
		     IndentSymbol: KeySymbol;
		     PrevMargin  : Integer
		  END;

     SymbolStack = ARRAY [ 1..MaxStackSize ] OF StackEntry;


     TextBlock = 
		 RECORD  (* Machine Dependent *)
		    CASE boolean OF
		       TRUE: (Text: PACKED ARRAY [1..LastByteIndex] OF char);
		       FALSE: (IntForm: integer)
		 END;
     TextFile = FILE OF TextBlock;
     LineNumber = PACKED ARRAY [1..5] OF char;
     NTextStruct = RECORD
		      Pntr: Integer;
		      Buff: ARRAY [1..LastByteIndex] OF char;
		      AtStart, Numbering: boolean;
		      CurrNumber, Increment: integer
		   END;
     NText = ↑NTextStruct;

VAR 

    Tab, FF: Char;  (* actually constants *)

    TempFile: Text;
    OutputFile: NText;

    RecordSeen: Boolean;

    CurrChar,
    NextChar: CharInfo;

    CurrSym,
    NextSym: SymbolInfo;

    CrPending: Boolean;

    PPOption: OptionTable;

    KeyWord: KeyWordTable;


    FoldedChar: FoldTable;
    CharType: CharTypeTable;
    DblChar: DblCharTable;
    SglChar: SglCharTable;

    Stack: SymbolStack;
    Top  : Integer;

    CurrLinePos,
    CurrMargin :  Integer;

    Resp : Char;

    WeAreCapitalizing : Boolean;

    AreNumbering:  Boolean;

    DeleteTemp: Boolean;

    L : LineNumber;

    Out: TextFile;
    OutP: NText;


FUNCTION eop(VAR InputFile: Text): Boolean;
  (* True iff InputFile at page mark. (But currently works only
    if InputFile is Input.) *)
VAR L: LineNumber;
BEGIN
   GetLineNR(L);
   eop := (L='     ')
END;  (* eop *)

PROCEDURE Error(n: integer);
BEGIN
   Writeln(tty);
   CASE n OF
      1: Writeln(tty,'? Only one NText file may be open at a time.')
   END;
   halt;
END;

PROCEDURE NDREWRITE(VAR OutFile: NText);
BEGIN
   DREWRITE(Out);
   new(OutP);  OutFile := OutP;
   WITH OutFile↑ DO
      BEGIN
	 Pntr := 1;  AtStart := TRUE;  Numbering := FALSE
      END;
END;  (* NDREWRITE *)

PROCEDURE WNumber(Outfile: NText; n: integer);  FORWARD;

PROCEDURE NPage(OutFile: NText);  FORWARD;

PROCEDURE NWrite(OutFile: NText; c: char);

VAR OutRec: TextBlock;
BEGIN
   IF OutFile<>OutP THEN ERROR(1);
   WITH OutFile↑ DO
      BEGIN
	 IF AtStart AND Numbering THEN
	       BEGIN
		  IF CurrNumber>MaxLine THEN NPage(OutFile);
		  WNumber(OutFile,CurrNumber);
		  CurrNumber := CurrNumber+Increment;
	       END;
	 Buff[Pntr] := c;
	 AtStart := FALSE;
	 IF Pntr>=LastByteIndex THEN
	       BEGIN
		  Pntr := 1;
		  OutRec.IntForm := 0;
		  pack(Buff,1,OutRec.Text,5);
		  Out↑ := OutRec;  Put(Out);
	       END
	    ELSE Pntr := Pntr+1
      END
END;  (* NWrite *)

PROCEDURE NWrteln(OutFile: NText);

VAR i: integer;
BEGIN
   NWrite(OutFile,chr(CRchr));  NWrite(OutFile,chr(LFchr));
   WITH OutFile↑ DO
      BEGIN
	 IF (Pntr>1) AND Numbering
	    THEN
	       FOR i := Pntr TO LastByteIndex DO NWrite(OutFile,chr(Nullchr));
	 AtStart := TRUE;
      END
END;  (* NWrteln *)

PROCEDURE WNumber;

VAR OutRec: TextBlock;
    i: integer;
BEGIN
   IF Outp<>OutFile THEN ERROR(1);
   WITH OutFile↑ DO
      BEGIN
	 FOR i := LastByteIndex DOWNTO 1 DO
	    BEGIN
	       Buff[i] := chr(n MOD 10 + ord('0'));  n := n DIV 10
	    END;
	 OutRec.IntForm := 0;
	 pack(Buff,1,OutRec.Text,5);
	 OutRec.IntForm := OutRec.IntForm+1;
	 Out↑ := OutRec;  Put(Out);
	 Pntr := 2;  Buff[1] := chr(TABchr);
      END
END;  (* WNumber  *)

PROCEDURE NPage;

VAR 
    OutRec: TextBlock;
    j: Integer;
BEGIN
   IF OutFile<>Outp THEN ERROR(1);
   WITH Outfile↑ DO
      BEGIN
	 IF NOT AtStart THEN NWrteln(OutFile);
	 OutRec.IntForm := 0;  OutRec.Text := '     ';
	 IF Numbering THEN
	       BEGIN
		  OutRec.IntForm := OutRec.IntForm+1;
		  Out↑ := OutRec;  Put(Out);
	       END;
	 AtStart := FALSE;
	 NWrite(OutFile,chr(CRchr));  NWrite(OutFile,chr(FFchr));
	 IF Numbering THEN
	       FOR j := 1 TO 3 DO NWrite(OutFile,chr(NULLchr));
	 AtStart := TRUE;
	 IF Numbering THEN CurrNumber := Increment;
      END
END;  (* NPage *)

PROCEDURE NSetLine(OutFile: NText; St,Incr: Integer);
BEGIN
   WITH OutFile↑ DO
      BEGIN
	 Numbering := TRUE;  CurrNumber := St;  Increment := Incr
      END
END;  (* NSetLine *)

PROCEDURE NClose(VAR OutFile: NText);
VAR j: Integer;
BEGIN
   WITH OutFile↑ DO
      IF Pntr>1 THEN
	    FOR j := Pntr TO LastByteIndex DO NWrite(OutFile,chr(NULLchr));
   OutFile := NIL;  Close(Out)
END;  (* NClose *)


PROCEDURE GetChar( (* from *)      VAR InputFile : Text;
		   (* updating *)  VAR NextChar  : CharInfo;
		   (* returning *) VAR CurrChar  : CharInfo );

BEGIN (* GetChar *)

   CurrChar := NextChar;

   WITH NextChar DO
      BEGIN

	 Value := Space;
	 IF EOF(InputFile)
	    THEN
	       Name  := FileMark

	 ELSE IF EOLn(InputFile)
	    THEN
	       BEGIN
		  IF eop(InputFile)
		     THEN
			BEGIN
			   Name := PageMark;  Value := FF
			END
		     ELSE Name := EndOfLine;
		  ReadLn(InputFile)
	       END

	    ELSE
	       BEGIN
		  Read(InputFile,Value);  Name := CharType [ Value ];
	       END;

      END (* With *)

END; (* GetChar *)



PROCEDURE StoreNextChar( (* from *)        VAR InputFile : Text;
			 (* updating *)    VAR Length    : Integer;
			 (* and *)         VAR CurrChar,
			NextChar  : CharInfo;
			 (* placing in *)  VAR Value     : String   );

BEGIN (* StoreNextChar *)

   GetChar( (* from *)      InputFile,
	    (* updating *)  NextChar,
	    (* returning *) CurrChar  );

   IF Length < MaxSymbolSize
      THEN
	 BEGIN

	    Length := Length + 1;

	    Value [Length] := CurrChar.Value

	 END

END; (* StoreNextChar *)



PROCEDURE SkipSpaces( (* in *)        VAR InputFile    : Text;
		      (* updating *)  VAR CurrChar,
		      (* and *)           NextChar     : CharInfo;
		      (* returning *) VAR SpacesBefore,
			(* and *)         CrsBefore    : Integer  );

BEGIN (* SkipSpaces *)

   SpacesBefore := 0;
   CrsBefore    := 0;

   WHILE NextChar.Name IN [ Blank, EndOfLine ] DO
      BEGIN

	 GetChar( (* from *)      InputFile,
		  (* updating *)  NextChar,
		  (* returning *) CurrChar  );

	 CASE CurrChar.Name OF

	    Blank     : SpacesBefore := SpacesBefore + 1;

	    EndOfLine : 
			BEGIN
			   CrsBefore    := CrsBefore + 1;
			   SpacesBefore := 0
			END

	 END (* Case *)

      END (* While *)

END; (* SkipSpaces *)



PROCEDURE GetComment( (* from *)     VAR InputFile : Text;
		      (* updating *) VAR CurrChar,
			(* and *)        NextChar  : CharInfo;
		     VAR Name      : KeySymbol;
		     VAR Value     : String;
		     VAR Length    : Integer   );

BEGIN (* GetComment *)

   Name := OpenComment;

   WHILE NOT(    ((CurrChar.Value = '*') AND (NextChar.Value = ')'))
	 OR (CurrChar.Value = '}')
	 OR (CurrChar.Name = PageMark)
	 OR (NextChar.Name = EndOfLine)
	 OR (NextChar.Name = FileMark)) DO

      StoreNextChar( (* from *)     InputFile,
		     (* updating *) Length,
		    CurrChar,
		    NextChar,
		     (* In *)       Value     );


   IF (CurrChar.Value = '*') AND (NextChar.Value = ')')
      THEN
	 BEGIN

	    StoreNextChar( (* from *)     InputFile,
			   (* updating *) Length,
			  CurrChar,
			  NextChar,
			   (* in *)       Value     );

	    Name := CloseComment

	 END

   ELSE IF (CurrChar.Value = '}') OR (CurrChar.Name = PageMark)
      THEN
	 Name := CloseComment

END; (* GetComment *)



FUNCTION IdType( (* of *)        Value  : String;
		 (* using *)     Length : Integer )
		 (* returning *)                   : KeySymbol;

VAR 
    I: Integer;

    KeyValue: Key;

    Hit: Boolean;

    ThisKey: KeySymbol;


BEGIN (* IdType *)

   IdType := OtherSym;

   IF Length <= MaxKeyLength
      THEN
	 BEGIN

	    FOR I := 1 TO Length DO
	       KeyValue [I] := FoldedChar [ Value [I] ];

	    FOR I := Length+1 TO MaxKeyLength DO
	       KeyValue [I] := Space;

	    ThisKey := ProgSym;
	    Hit     := FALSE;

	    REPEAT
	       IF KeyValue = KeyWord [ThisKey]
		  THEN
		     Hit := TRUE
		  ELSE
		     ThisKey := Succ(ThisKey)
	    UNTIL Hit OR (ThisKey = Succ(UntilSym));

	    IF Hit
	       THEN
		  IdType := ThisKey

	 END;

END; (* IdType *)



PROCEDURE GetIdentifier( (* from *)      VAR InputFile : Text;
			 (* updating *)  VAR CurrChar,
			NextChar  : CharInfo;
			 (* returning *) VAR Name      : KeySymbol;
			VAR Value     : String;
			VAR Length    : Integer   );

BEGIN (* GetIdentifier *)

   WHILE NextChar.Name IN [ Letter, Digit ] DO

      StoreNextChar( (* from *)     InputFile,
		     (* updating *) Length,
		    CurrChar,
		    NextChar,
		     (* in *)       Value     );


   Name := IdType( (* of *)    Value,
		   (* using *) Length );

   IF Name IN [ RecordSym, CaseSym, EndSym ]
      THEN
	 CASE Name OF

	    RecordSym : RecordSeen := TRUE;

	    CaseSym   : 
			IF RecordSeen
			   THEN
			      Name := CaseVarSym;

	    EndSym    : RecordSeen := FALSE

	 END (* Case *)

END; (* GetIdentifier *)



PROCEDURE GetNumber( (* from *)      VAR InputFile : Text;
		     (* updating *)  VAR CurrChar,
		    NextChar  : CharInfo;
		     (* returning *) VAR Name      : KeySymbol;
		    VAR Value     : String;
		    VAR Length    : Integer   );

BEGIN (* GetNumber *)

   WHILE NextChar.Name = Digit DO

      StoreNextChar( (* from *)     InputFile,
		     (* updating *) Length,
		    CurrChar,
		    NextChar,
		     (* in *)       Value     );


   Name := OtherSym

END; (* GetNumber *)



PROCEDURE GetCharLiteral( (* from *)      VAR InputFile : Text;
			  (* updating *)  VAR CurrChar,
			 NextChar  : CharInfo;
			  (* returning *) VAR Name      : KeySymbol;
			 VAR Value     : String;
			 VAR Length    : Integer   );

BEGIN (* GetCharLiteral *)

   WHILE NextChar.Name = Quote DO
      BEGIN

	 StoreNextChar( (* from *)     InputFile,
			(* updating *) Length,
		       CurrChar,
		       NextChar,
			(* in *)       Value     );

	 WHILE NOT(NextChar.Name IN [ Quote, EndOfLine, FileMark ]) DO

	    StoreNextChar( (* from *)     InputFile,
			   (* updating *) Length,
			  CurrChar,
			  NextChar,
			   (* in *)       Value     );


	 IF NextChar.Name = Quote
	    THEN
	       StoreNextChar( (* from *)     InputFile,
			      (* updating *) Length,
			     CurrChar,
			     NextChar,
			      (* in *)       Value     )

      END;


   Name := OtherSym

END; (* GetCharLiteral *)



PROCEDURE GetSpecialChar( (* from *)       VAR InputFile : Text;
			  (* updating *)   VAR CurrChar,
			 NextChar  : CharInfo;
			  (* returning *)  VAR Name      : KeySymbol;
			 VAR Value     : String;
			 VAR Length    : Integer    );

VAR 
    NextTwoChars: SpecialChar;

    Hit: Boolean;

    ThisChar: KeySymbol;


BEGIN (* GetSpecialChar *)

   StoreNextChar( (* from *)     InputFile,
		  (* updating *) Length,
		 CurrChar,
		 NextChar,
		  (* in *)       Value   );


   NextTwoChars[1] := CurrChar.Value;
   NextTwoChars[2] := NextChar.Value;

   ThisChar := Becomes;
   Hit      := FALSE;

   WHILE NOT(Hit OR (ThisChar = CloseComment)) DO
      IF NextTwoChars = DblChar [ThisChar]
	 THEN
	    Hit := TRUE
	 ELSE
	    ThisChar := Succ(ThisChar);

   IF NOT Hit
      THEN
	 BEGIN

	    ThisChar := OpenComment;

	    WHILE NOT(Hit OR (Pred(ThisChar) = Period)) DO
	       IF CurrChar.Value = SglChar [ThisChar]
		  THEN
		     Hit := TRUE
		  ELSE
		     ThisChar := Succ(ThisChar)

	 END

      ELSE

	 StoreNextChar( (* from *)     InputFile,
			(* updating *) Length,
		       CurrChar,
		       NextChar,
			(* in *)       Value     );

   IF Hit
      THEN
	 Name := ThisChar
      ELSE
	 Name := OtherSym

END; (* GetSpecialChar *)



PROCEDURE GetNextSymbol( (* from *)      VAR InputFile : Text;
			 (* updating *)  VAR CurrChar,
			NextChar  : CharInfo;
			 (* returning *) VAR Name      : KeySymbol;
			VAR Value     : String;
			VAR Length    : Integer   );

BEGIN (* GetNextSymbol *)

   CASE NextChar.Name OF

      Letter      : GetIdentifier( (* from *)      InputFile,
				   (* updating *)  CurrChar,
				  NextChar,
				   (* returning *) Name,
				  Value,
				  Length    );

      Digit       : GetNumber( (* from *)      InputFile,
			       (* updating *)  CurrChar,
			      NextChar,
			       (* returning *) Name,
			      Value,
			      Length    );

      Quote       : GetCharLiteral( (* from *)      InputFile,
				    (* updating *)  CurrChar,
				   NextChar,
				    (* returning *) Name,
				   Value,
				   Length    );

      OtherChar   : 
		    BEGIN

		       GetSpecialChar( (* from *)      InputFile,
				       (* updating *)  CurrChar,
				      NextChar,
				       (* returning *) Name,
				      Value,
				      Length    );

		       IF Name = OpenComment
			  THEN
			     GetComment( (* from *)     InputFile,
					 (* updating *) CurrChar,
					NextChar,
					Name,
					Value,
					Length    )

		    END;

      FileMark    : Name := EndOfFile;

      PageMark    : 
		    BEGIN
		       Name := CloseComment;
		       StoreNextChar( (* from *)     InputFile,
				      (* updating *) Length, CurrChar, NextChar,
				      (* in *)       Value )
		    END;

   END (* Case *)

END; (* GetNextSymbol *)



PROCEDURE CheckComb( (* updating *) VAR CurrSym : SymbolInfo;
		     (* using *)        NextSym : SymbolInfo );

BEGIN (* CheckComb *)

   IF (CurrSym↑.Name = ElseSym) AND (NextSym↑.Name = IfSym)
      THEN
	 CurrSym↑.Name := ElIfSym
   ELSE IF (CurrSym↑.Name = ThenSym) AND (NextSym↑.Name = IfSym)
      THEN
	 CurrSym↑.Name := ThIfSym

END; (* CheckComb *)



PROCEDURE GetSymbol( (* from *)      VAR InputFile : Text;
		     (* updating *)  VAR NextSym   : SymbolInfo;
		     (* returning *) VAR CurrSym   : SymbolInfo );

VAR 
    Dummy: SymbolInfo;


BEGIN (* GetSymbol *)

   Dummy   := CurrSym;
   CurrSym := NextSym;
   NextSym := Dummy  ;

   WITH NextSym↑ DO
      BEGIN

	 SkipSpaces( (* in *)        InputFile,
		     (* updating *)  CurrChar,
		    NextChar,
		     (* returning *) SpacesBefore,
		    CrsBefore     );
	 Length := 0;

	 IF CurrSym↑.Name = OpenComment
	    THEN
	       GetComment( (* from *)      InputFile,
			   (* updating *)  CurrChar,
			  NextChar,
			   (* returning *) Name,
			  Value,
			  Length    )
	    ELSE
	       GetNextSymbol( (* from *)      InputFile,
			      (* updating *)  CurrChar,
			     NextChar,
			      (* returning *) Name,
			     Value,
			     Length    )

      END; (* With *)

   CheckComb( (* updating *) CurrSym,
	      (* using *)    NextSym );

END; (* GetSymbol *)



PROCEDURE Initialize( (* returning *)

		     VAR InputFile  : Text;
		     VAR OutputFile  : NText;

		     VAR TopOfStack  : Integer;

		     VAR CurrLinePos,
		     CurrMargin  : Integer;

		     VAR KeyWord     : KeyWordTable;

		     VAR FoldedChar  : FoldTable;

		     VAR CharType    : CharTypeTable;


		     VAR DblChar     : DblCharTable;

		     VAR SglChar     : SglCharTable;

		     VAR RecordSeen  : Boolean;

		     VAR CurrChar,
		     NextChar    : CharInfo;

		     VAR CurrSym,
		     NextSym     : SymbolInfo;

		     VAR PPOption    : OptionTable  );

CONST 
      FirstChr = 0;
      LastChr  = 127;

VAR 
    Lc, C : Char;



BEGIN (* Initialize *)

   Tab := Chr(11B);  FF := Chr(14B);    (* actually constants *)

   TopOfStack  := 0;
   CurrLinePos := 0;
   CurrMargin  := 0;


   KeyWord [ ProgSym    ] := 'PROGRAM   ' ;
   KeyWord [ FuncSym    ] := 'FUNCTION  ' ;
   KeyWord [ ProcSym    ] := 'PROCEDURE ' ;
   KeyWord [ LabelSym   ] := 'LABEL     ' ;
   KeyWord [ ConstSym   ] := 'CONST     ' ;
   KeyWord [ TypeSym    ] := 'TYPE      ' ;
   KeyWord [ VarSym     ] := 'VAR       ' ;
   KeyWord [ BeginSym   ] := 'BEGIN     ' ;
   KeyWord [ RepeatSym  ] := 'REPEAT    ' ;
   KeyWord [ RecordSym  ] := 'RECORD    ' ;
   KeyWord [ CaseSym    ] := 'CASE      ' ;
   KeyWord [ CaseVarSym ] := 'CASE      ' ;
   KeyWord [ OfSym      ] := 'OF        ' ;
   KeyWord [ ForSym     ] := 'FOR       ' ;
   KeyWord [ WhileSym   ] := 'WHILE     ' ;
   KeyWord [ WithSym    ] := 'WITH      ' ;
   KeyWord [ DoSym      ] := 'DO        ' ;
   KeyWord [ LoopSym    ] := 'LOOP      ' ;
   KeyWord [ ExitSym    ] := 'EXIT      ' ;
   KeyWord [ IfSym      ] := 'IF        ' ;
   KeyWord [ ThenSym    ] := 'THEN      ' ;
   KeyWord [ ElseSym    ] := 'ELSE      ' ;
   KeyWord [ EndSym     ] := 'END       ' ;
   KeyWord [ AndSym     ] := 'AND       ' ;
   KeyWord [ ArraySym   ] := 'ARRAY     ' ;
   KeyWord [ DivSym     ] := 'DIV       ' ;
   KeyWord [ DownToSym  ] := 'DOWNTO    ' ;
   KeyWord [ FileSym    ] := 'FILE      ' ;
   KeyWord [ GotoSym    ] := 'GOTO      ' ;
   KeyWord [ InSym      ] := 'IN        ' ;
   KeyWord [ ModSym     ] := 'MOD       ' ;
   KeyWord [ NilSym     ] := 'NIL       ' ;
   KeyWord [ FalseSym   ] := 'FALSE     ' ;
   KeyWord [ TrueSym    ] := 'TRUE      ' ;
   KeyWord [ MaxIntSym  ] := 'MAXINT    ' ;
   KeyWord [ ToSym      ] := 'TO        ' ;
   KeyWord [ PascalSym  ] := 'PASCAL    ' ;
   KeyWord [ SetSym     ] := 'SET       ' ;
   KeyWord [ PackedSym  ] := 'PACKED    ' ;
   KeyWord [ AlgolSym   ] := 'ALGOL     ' ;
   KeyWord [ ForwardSym ] := 'FORWARD   ' ;
   KeyWord [ FortranSym ] := 'FORTRAN   ' ;
   KeyWord [ ExternSym  ] := 'EXTERN    ' ;
   KeyWord [ CobolSym   ] := 'COBOL     ' ;
   KeyWord [ OrSym      ] := 'OR        ' ;
   KeyWord [ NotSym     ] := 'NOT       ' ;
   KeyWord [ ExitLoopSym] := 'EXITLOOP  ' ;
   KeyWord [ NextLoopSym] := 'NEXTLOOP  ' ;
   KeyWord [ UntilSym   ] := 'UNTIL     ' ;



   DblChar [ Becomes     ]  := ':=' ;
   DblChar [ OpenComment ]  := '(*' ;

   SglChar [ OpenComment ]   := '{' ;
   SglChar [ CloseComment]   := '}' ;
   SglChar [ SemiColon  ]   := ';' ;
   SglChar [ Colon      ]   := ':' ;
   SglChar [ Equals     ]   := '=' ;
   SglChar [ OpenParen  ]   := '(' ;
   SglChar [ CloseParen ]   := ')' ;
   SglChar [ Period     ]   := '.' ;

   FOR C := Chr(FirstChr) TO Chr(LastChr) DO
      BEGIN
	 FoldedChar [ C ] := C;
	 CharType [C] := OtherChar
      END;

   Lc := 'a';
   FOR C := 'A' TO 'Z' DO
      BEGIN
	 FoldedChar [ Lc ] := C;
	 CharType [ C ] := Letter;
	 CharType [ Lc ] := Letter;
	 Lc := Succ(Lc)
      END;

   FOR C := '0' TO '9' DO
      CharType [ C ] := Digit;

   CharType [ Space ] := Blank;
   CharType [ '''' ] := Quote;


   RecordSeen := FALSE;

   GetChar( (* from *)      InputFile,
	    (* updating *)  NextChar,
	    (* returning *) CurrChar  );

   New(CurrSym);
   New(NextSym);

   GetSymbol( (* from *)      InputFile,
	      (* updating *)  NextSym,
	      (* returning *) CurrSym  );



   WITH PPOption [ ProgSym ] DO
      BEGIN
	 OptionsSelected   := [ BlankLineBefore,
			      Capitalize,
			      SpaceAfter ];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ FuncSym ] DO
      BEGIN
	 OptionsSelected   := [ BlankLineBefore,
			      Capitalize,
			      DIndentOnKeys,
			      SpaceAfter ];
	 DIndentSymbols    := [ LabelSym,
			      ConstSym,
			      TypeSym,
			      VarSym ];
	 GobbleTerminators := []
      END;
   WITH PPOption [ ProcSym ] DO
      BEGIN
	 OptionsSelected   := [ BlankLineBefore,
			      Capitalize,
			      DIndentOnKeys,
			      SpaceAfter ];
	 DIndentSymbols    := [ LabelSym,
			      ConstSym,
			      TypeSym,
			      VarSym ];
	 GobbleTerminators := []
      END;

   WITH PPOption [ LabelSym ] DO
      BEGIN
	 OptionsSelected   := [ BlankLineBefore,
			      Capitalize,
			      SpaceAfter,
			      IndentToCLP ];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ ConstSym ] DO
      BEGIN
	 OptionsSelected   := [ BlankLineBefore,
			      Capitalize,
			      DIndentOnKeys,
			      SpaceAfter,
			      IndentToCLP ];
	 DIndentSymbols    := [ LabelSym ];
	 GobbleTerminators := []
      END;

   WITH PPOption [ TypeSym ] DO
      BEGIN
	 OptionsSelected   := [ BlankLineBefore,
			      Capitalize,
			      DIndentOnKeys,
			      SpaceAfter,
			      IndentToCLP ];
	 DIndentSymbols    := [ LabelSym,
			      ConstSym ];
	 GobbleTerminators := []
      END;

   WITH PPOption [ VarSym ] DO
      BEGIN
	 OptionsSelected   := [
			      Capitalize,
			      DIndentOnKeys,
			      SpaceAfter,
			      IndentToCLP ];
	 DIndentSymbols    := [ LabelSym,
			      ConstSym,
			      TypeSym ];
	 GobbleTerminators := []
      END;

   WITH PPOption [ BeginSym ] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      DIndentOnKeys,
			      IndentByTab,
			      CrAfter ];
	 DIndentSymbols    := [ LabelSym,
			      ConstSym,
			      TypeSym,
			      VarSym ];
	 GobbleTerminators := []
      END;

   WITH PPOption [ RepeatSym ] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      IndentByTab,
			      CrAfter ];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ RecordSym ] DO
      BEGIN
	 OptionsSelected   := [ IndentByTab,
			      Capitalize,
			      CrAfter ];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ CaseSym ] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      SpaceAfter,
			      IndentByTab,
			      GobbleSymbols,
			      CrAfter ];
	 DIndentSymbols    := [];
	 GobbleTerminators := [ OfSym ]
      END;

   WITH PPOption [ CaseVarSym ] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      SpaceAfter,
			      IndentByTab,
			      GobbleSymbols,
			      CrAfter ];
	 DIndentSymbols    := [];
	 GobbleTerminators := [ OfSym ]
      END;

   WITH PPOption [ OfSym ] DO
      BEGIN
	 OptionsSelected   := [ CrSuppress,
			      Capitalize,
			      SpaceBefore ];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ ForSym ] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      SpaceAfter,
			      IndentByTab,
			      GobbleSymbols ];
	 DIndentSymbols    := [];
	 GobbleTerminators := [ DoSym ]
      END;

   WITH PPOption [ WhileSym ] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      SpaceAfter,
			      IndentByTab,
			      GobbleSymbols ];
	 DIndentSymbols    := [];
	 GobbleTerminators := [ DoSym ]
      END;

   WITH PPOption [ WithSym ] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      SpaceAfter,
			      IndentByTab,
			      GobbleSymbols,
			      CrAfter ];
	 DIndentSymbols    := [];
	 GobbleTerminators := [ DoSym ]
      END;

   WITH PPOption [ DoSym ] DO
      BEGIN
	 OptionsSelected   := [ CrSuppress,
			      Capitalize,
			      SpaceBefore ];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;
   WITH PPOption [ LoopSym] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      IndentByTab,
			      CrAfter ];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ ExitSym ] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      DIndent,
			      GobbleSymbols,
			      IndentByTab ];
	 DIndentSymbols    := [];
	 GobbleTerminators := [ EndSym,
			      SemiColon ]
      END;

   WITH PPOption [ IfSym ] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      SpaceAfter,
			      GobbleSymbols,
			      IndentByTab ];
	 DIndentSymbols    := [];
	 GobbleTerminators := [ ThenSym ]
      END;

   WITH PPOption [ ThenSym ] DO
      BEGIN
	 OptionsSelected   := [ IndentByTab,
			      Capitalize];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ ElseSym ] DO
      BEGIN
	 OptionsSelected   := [ DIndentOnKeys,
			      Capitalize,
			      DIndent,
			      IndentByTab ];
	 DIndentSymbols    := [ IfSym,
			      WhileSym,
			      WithSym,
			      ForSym,
			      ElseSym ];
	 GobbleTerminators := []
      END;

   WITH PPOption [ EndSym ] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      DIndentOnKeys,
			      DIndent,
			      CrAfter ];
	 DIndentSymbols    := [ IfSym,
			      ThenSym,
			      ElseSym,
			      ThIfSym,
			      ElIfSym,
			      ForSym,
			      WhileSym,
			      WithSym,
			      CaseVarSym,
			      Colon,
			      Equals ];
	 GobbleTerminators := []
      END;
   WITH PPOption [ AndSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ ArraySym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ DivSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ DownToSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ FileSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ GotoSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ InSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ ModSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ NilSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ FalseSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ TrueSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ MaxIntSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ ToSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ PascalSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ SetSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ PackedSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ AlgolSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ ForwardSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ FortranSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ ExternSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ CobolSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ OrSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ NotSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;


   WITH PPOption [ ExitLoopSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ NextLoopSym ] DO
      BEGIN
	 OptionsSelected := [ Capitalize ];
	 DIndentSymbols  := [];
	 GobbleTerminators := []
      END;


   WITH PPOption [ UntilSym ] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      DIndentOnKeys,
			      DIndent,
			      SpaceAfter,
			      GobbleSymbols,
			      CrAfter ];
	 DIndentSymbols    := [ IfSym,
			      ThenSym,
			      ElseSym,
			      ThIfSym,
			      ElIfSym,
			      ForSym,
			      WhileSym,
			      WithSym,
			      Colon,
			      Equals ];
	 GobbleTerminators := [ EndSym,
			      UntilSym,
			      ElseSym,
			      SemiColon ];
      END;

   WITH PPOption [ ElIfSym ] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      DIndentOnKeys,
			      DIndent,
			      IndentByTab,
			      GobbleSymbols ];
	 DIndentSymbols    := [ ThenSym,
			      ElseSym,
			      WhileSym,
			      WithSym,
			      ForSym ];
	 GobbleTerminators := [ ThenSym ]
      END;

   WITH PPOption [ ThIfSym ] DO
      BEGIN
	 OptionsSelected   := [ CrBefore,
			      Capitalize,
			      IndentByTab,
			      GobbleSymbols,
			      CrAfter ];
	 DIndentSymbols    := [];
	 GobbleTerminators := [ ThenSym ]
      END;

   WITH PPOption [ Becomes ] DO
      BEGIN
	 OptionsSelected   := [ SpaceBefore,
			      SpaceAfter,
			      GobbleSymbols ];
	 DIndentSymbols    := [];
	 GobbleTerminators := [ EndSym,
			      UntilSym,
			      ElseSym,
			      SemiColon ]
      END;

   WITH PPOption [ OpenComment ] DO
      BEGIN
	 OptionsSelected   := [ CrSuppress ];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ CloseComment ] DO
      BEGIN
	 OptionsSelected   := [ CrSuppress ];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ SemiColon ] DO
      BEGIN
	 OptionsSelected   := [ CrSuppress,
			      DIndentOnKeys ];
	 DIndentSymbols    := [ IfSym,
			      ThenSym,
			      ElseSym,
			      ThIfSym,
			      ElIfSym,
			      ForSym,
			      WhileSym,
			      WithSym,
			      Colon,
			      Equals ];
	 GobbleTerminators := []
      END;

   WITH PPOption [ Colon ] DO
      BEGIN
	 OptionsSelected   := [ SpaceAfter,
			      IndentToCLP ];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ Equals ] DO
      BEGIN
	 OptionsSelected   := [ SpaceBefore,
			      SpaceAfter,
			      IndentToCLP ];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ OpenParen ] DO
      BEGIN
	 OptionsSelected   := [ GobbleSymbols ];
	 DIndentSymbols    := [];
	 GobbleTerminators := [ CloseParen ]
      END;

   WITH PPOption [ CloseParen ] DO
      BEGIN
	 OptionsSelected   := [];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ Period ] DO
      BEGIN
	 OptionsSelected   := [ CrSuppress ];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ EndOfFile ] DO
      BEGIN
	 OptionsSelected   := [];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END;

   WITH PPOption [ OtherSym ] DO
      BEGIN
	 OptionsSelected   := [];
	 DIndentSymbols    := [];
	 GobbleTerminators := []
      END


END; (* Initialize *)



FUNCTION StackEmpty (* returning *) : Boolean;

BEGIN (* StackEmpty *)

   IF Top = 0
      THEN
	 StackEmpty := TRUE
      ELSE
	 StackEmpty := FALSE

END; (* StackEmpty *)



FUNCTION Stackfull (* returning *) : Boolean;

BEGIN (* StackFull *)

   IF Top = MaxStackSize
      THEN
	 StackFull := TRUE
      ELSE
	 StackFull := FALSE

END; (* StackFull *)



PROCEDURE PopStack( (* returning *) VAR IndentSymbol : KeySymbol;
		   VAR PrevMargin   : Integer   );

BEGIN (* PopStack *)

   IF NOT StackEmpty
      THEN
	 BEGIN

	    IndentSymbol := Stack[Top].IndentSymbol;
	    PrevMargin   := Stack[Top].PrevMargin;

	    Top := Top - 1

	 END

      ELSE
	 BEGIN
	    IndentSymbol := OtherSym;
	    PrevMargin   := 0
	 END

END; (* PopStack *)



PROCEDURE PushStack( (* using *) IndentSymbol : KeySymbol;
		    PrevMargin   : Integer   );

BEGIN (* PushStack *)

   Top := Top + 1;

   Stack[Top].IndentSymbol := IndentSymbol;
   Stack[Top].PrevMargin   := PrevMargin

END; (* PushStack *)



PROCEDURE WriteCrs( (* using *)          NumberOfCrs : Integer;
		    (* updating *)   VAR CurrLinePos : Integer;
		    (* writing to *) VAR OutputFile  : NText    );

VAR 
    I: Integer;


BEGIN (* WriteCrs *)

   IF NumberOfCrs > 0
      THEN
	 BEGIN

	    FOR I := 1 TO NumberOfCrs DO
	       NWrteln(OutputFile);

	    CurrLinePos := 0

	 END

END; (* WriteCrs *)



PROCEDURE InsertCr( (* updating *)   VAR CurrSym    : SymbolInfo;
		    (* writing to *) VAR OutputFile : NText       );

CONST 
      Once = 1;


BEGIN (* InsertCr *)

   IF CurrSym↑.CrsBefore = 0
      THEN
	 BEGIN

	    WriteCrs( Once, (* updating *)   CurrLinePos,
			    (* writing to *) OutputFile  );

	    CurrSym↑.SpacesBefore := 0

	 END

END; (* InsertCr *)



PROCEDURE InsertBlankLine( (* updating *)   VAR CurrSym : SymbolInfo;
			   (* writing to *) VAR OutputFile : NText  );

CONST 
      Once  = 1;
      Twice = 2;


BEGIN (* InsertBlankLine *)

   IF CurrSym↑.CrsBefore = 0
      THEN
	 BEGIN

	    IF CurrLinePos = 0
	       THEN
		  WriteCrs( Once, (* updating *)   CurrLinePos,
				  (* writing to *) OutputFile  )
	       ELSE
		  WriteCrs( Twice, (* updating *)   CurrLinePos,
				   (* writing to *) OutputFile  );

	    CurrSym↑.SpacesBefore := 0

	 END

   ELSE
       IF CurrSym↑.CrsBefore = 1
      THEN
	  IF CurrLinePos > 0
	 THEN
	    WriteCrs( Once, (* updating *)   CurrLinePos,
				     (* writing to *) OutputFile  )

END; (* InsertBlankLine *)



PROCEDURE LShiftOn( (* using *) DIndentSymbols : KeySymSet );

VAR 
    IndentSymbol: KeySymbol;
    PrevMargin  : Integer;


BEGIN (* LShiftOn *)

   IF NOT StackEmpty
      THEN
	 BEGIN

	    REPEAT

	       PopStack( (* returning *) IndentSymbol,
			PrevMargin   );

	       IF IndentSymbol IN DIndentSymbols
		  THEN
		     CurrMargin := PrevMargin

	    UNTIL NOT(IndentSymbol IN DIndentSymbols)
		  OR (StackEmpty);

	    IF NOT(IndentSymbol IN DIndentSymbols)
	       THEN
		  PushStack( (* using *) IndentSymbol,
			    PrevMargin   )

	 END

END; (* LShiftOn *)



PROCEDURE LShift;

VAR 
    IndentSymbol: KeySymbol;
    PrevMargin  : Integer;


BEGIN (* LShift *)

   IF NOT StackEmpty
      THEN
	 BEGIN
	    PopStack( (* returning *) IndentSymbol,
		     PrevMargin   );
	    CurrMargin := PrevMargin
	 END

END; (* LShift *)



PROCEDURE InsertSpace( (* using *)      VAR Symbol     : SymbolInfo;
		       (* writing to *) VAR OutputFile : NText       );

BEGIN (* InsertSpace *)

   IF CurrLinePos < MaxLineSize
      THEN
	 BEGIN

	    NWrite(OutputFile, Space);

	    CurrLinePos := CurrLinePos + 1;

	    WITH Symbol↑ DO
	       IF (CrsBefore = 0) AND (SpacesBefore > 0)
		  THEN
		     SpacesBefore := SpacesBefore - 1

	 END

END; (* InsertSpace *)



PROCEDURE MoveLinePos( (* to *)       NewLinePos  : Integer;
		       (* from *) VAR CurrLinePos : Integer;
		       (* in *)   VAR OutputFile  : NText    );

VAR 
    R,
    I: Integer;


BEGIN (* MoveLinePos *)

   IF CurrLinePos=0
      THEN
	 BEGIN
	    R := CurrLinePos - (CurrLinePos MOD TabSize)        + TabSize;
	    WHILE R <= NewLinePos DO
	       BEGIN
		  CurrLinePos := R;
		  R := R + TabSize;
		  NWrite(OutputFile,Tab)
	       END;
	 END;

   FOR I := CurrLinePos+1 TO NewLinePos DO
      NWrite(OutputFile, Space);

   CurrLinePos := NewLinePos

END; (* MoveLinePos *)


PROCEDURE MakeCapitals ( (* updating *) CurrSym : SymbolInfo  );

VAR I : Integer;
BEGIN  (* MakeCapitals *)
   WITH CurrSym↑ DO
      FOR I := 1 TO Length DO Value[I] := FoldedChar[Value[I]];
END  (* MakeCapitals *);




PROCEDURE PrintSymbol( (* in *)             CurrSym     : SymbolInfo;
		       (* updating *)   VAR CurrLinePos : Integer;
		       (* writing to *) VAR OutputFile  : NText       );

VAR 
    I: Integer;


BEGIN (* PrintSymbol *)

   WITH CurrSym↑ DO
      BEGIN

	 IF Value[1] = FF
	    THEN NPage(OutputFile)
	    ELSE
	       BEGIN
		  FOR I := 1 TO Length DO
		     NWrite(OutputFile, Value[I]);
		  CurrLinePos := CurrLinePos + Length

	       END
      END (* with *)

END; (* PrintSymbol *)



PROCEDURE PPSymbol( (* in *)             CurrSym    : SymbolInfo;
		    (* writing to *) VAR OutputFile : NText       );

CONST 
      Once  = 1;

VAR 
    NewLinePos: Integer;


BEGIN (* PPSymbol *)

   WITH CurrSym↑ DO
      BEGIN

	 WriteCrs( (* using *)      CrsBefore,
		   (* updating *)   CurrLinePos,
		   (* writing to *) OutputFile  );

	 IF (CurrLinePos + SpacesBefore > CurrMargin)
	    OR (Name IN [ OpenComment, CloseComment ])
	    THEN
	       NewLinePos := CurrLinePos + SpacesBefore
	    ELSE
	       NewLinePos := CurrMargin;

	 IF NewLinePos + Length > MaxLineSize
	    THEN
	       BEGIN

		  WriteCrs( Once, (* updating *)   CurrLinePos,
				  (* writing to *) OutputFile  );

		  IF CurrMargin + Length <= MaxLineSize
		     THEN
			NewLinePos := CurrMargin
		  ELSE
		      IF Length < MaxLineSize
		     THEN
			NewLinePos := MaxLineSize - Length
		     ELSE
			NewLinePos := 0

	       END;

	 MoveLinePos( (* to *)    NewLinePos,
		      (* from *)  CurrLinePos,
		      (* in *)    OutputFile  );

	 PrintSymbol( (* in *)         CurrSym,
		      (* updating *)   CurrLinePos,
		      (* writing to *) OutputFile  )

      END (* with *)

END; (* PPSymbol *)



PROCEDURE RShiftToCLP( (* using *) CurrSym : KeySymbol );
FORWARD;

PROCEDURE Gobble( (* Symbols from *) VAR InputFile   : Text;
		  (* up to *)            Terminators : KeySymSet;
		  (* updating *)     VAR CurrSym,
		 NextSym     : SymbolInfo;
		  (* writing to *)   VAR OutputFile  : NText       );

BEGIN (* Gobble *)

   RShiftToCLP( (* using *) CurrSym↑.Name );

   WHILE NOT(NextSym↑.Name IN (Terminators + [EndOfFile])) DO
      BEGIN

	 GetSymbol( (* from *)      InputFile,
		    (* updating *)  NextSym,
		    (* returning *) CurrSym   );

	 IF ( Capitalize IN PPOption[CurrSym↑.Name].OptionsSelected)
	    AND WeAreCapitalizing
	    THEN MakeCapitals ( (* updating *)  CurrSym );

	 PPSymbol( (* in *)         CurrSym,
		   (* writing to *) OutputFile )

      END; (* while *)

   LShift

END; (* Gobble *)



PROCEDURE RShift( (* using *) CurrSym : KeySymbol );

BEGIN (* RShift *)

   IF NOT StackFull
      THEN
	 PushStack( (* using *) CurrSym,
		   CurrMargin);

   IF CurrMargin < SlowFail1
      THEN
	 CurrMargin := CurrMargin + Indent1
   ELSE
       IF CurrMargin < SlowFail2
      THEN
	 CurrMargin := CurrMargin + Indent2

END; (* RShift *)



PROCEDURE RShiftToCLP;

BEGIN (* RShiftToCLP *)

   IF NOT StackFull
      THEN
	 PushStack( (* using *) CurrSym,
		   CurrMargin);

   CurrMargin := CurrLinePos

END; (* RShiftToCLP *)


PROCEDURE Uglify( (* from *) VAR InFile: Text;
		  (* to *)       VAR OutFile: Text);

VAR 
    C: Char;    (* Current Input *)
    BlCount: Integer;   (* number of leading blanks in current line *)
    AtStart,InComment,InString: Boolean;
		(* state indicators *)

PROCEDURE SpaceOver(N: Integer);

VAR I: Integer;

BEGIN
   FOR I := 1 TO N DO Write(OutFile,' ')
END;


BEGIN   (* Uglify *)

   AtStart := TRUE;  InComment := FALSE;  InString := FALSE;
   WHILE NOT EOF(InFile) DO
      IF EOLn(InFile) THEN
	    BEGIN
	       BlCount := 0;  AtStart := NOT (InString OR InComment);
	       ReadLn(InFile);
	       IF eof(InFile) THEN WriteLn(OutFile)
	       ELSE IF NOT eoln(InFile) THEN WriteLn(OutFile)
	       ELSE IF NOT eop(InFile) THEN WriteLn(OutFile)
		  ELSE
		     BEGIN
			Page(OutFile); ReadLn(InFile)
		     END
	    END
	 ELSE
	    BEGIN
	       Read(InFile,C);
	       IF C=' '
		  THEN IF AtStart
		     THEN BlCount := BlCount + 1 ELSE Write(OutFile,C)
		  ELSE
		     BEGIN
			CASE C OF
			   '{' : 
				 IF NOT InString THEN
				   BEGIN
				    InComment := TRUE;
				    IF AtStart THEN SpaceOver(BlCount)
				   END;
			   '(' : 
				 IF (NOT InString) AND (InFile↑='*') THEN
				   BEGIN
				    InComment := TRUE;
				    IF AtStart THEN SpaceOver(BlCount);
				    Write(OutFile,'(');  Read(InFile,C)
				   END;
			   '*' : 
				 IF InComment AND (InFile↑=')') THEN
				   BEGIN
				    InComment := FALSE;
				    Write(OutFile,'*');  Read(InFile,C)
				   END;
			   '}' : InComment := FALSE;
			   '''' : 
				  IF NOT InComment THEN InString := NOT InString
			END;
			AtStart := FALSE;
			Write(OutFile,c)
		     END
	    END
END;    (* Uglify *)

BEGIN (* PrettyPrint *)

   WriteLn(tty,'Pascal PrettyPrinter.  Version 1/29/79.');
   DReset(Input);
   NDReWrite(OutputFile);
   GetLineNR(L);
   IF L<>'-----' THEN NSetLine(OutputFile,InitLineNumber,InitLineNumber);


   REPEAT
      WriteLn (tty);
      Write(tty,'Do you want to undent first?  [respond Y,N, or ?]: ');
      ReadLn(tty,Resp);
      CASE Resp OF
	 'Y','y': 
		  BEGIN
		     DeleteTemp := TRUE;
		     ReWrite(TempFile,'Output   ');
		     Uglify(Input,TempFile);
		     Close(TempFile);
		     Reset(Input,'Output   ');
		  END;

	 'N','n': DeleteTemp := FALSE;

	 '?': 
	      BEGIN
		 WriteLn(tty,'Undenting first removes all leading ',
			 'blanks on each line, aside from lines ');
		 Write(tty,'beginning with comments.');
		 WriteLn(tty,' The effect is that Pretty places all ',
			 'text as far left');
		 WriteLn(tty,'as the formatting conventions allow.');
	      END
      END
   UNTIL (Resp='Y') OR (Resp='N') OR(Resp='y') OR (Resp='n');


   REPEAT
      WriteLn (tty);
      WriteLn (tty, 'Do you want to force capitalization of ');
      Write (tty,'reserved words ? [respond Y,N, or ?] : ');
      ReadLn (tty, Resp);
      CASE Resp OF
	 'Y','y','N','n': WeAreCapitalizing := (Resp='Y') OR (Resp='y');

	 '?' : 
	       BEGIN
		  WriteLn (tty,'A "Y" will force capitalization of',
			   '  all reserved words');
		  WriteLn (tty,'that are not in comments or quotes.');
		  WriteLn (tty,'An "N" will cause the PrettyPrinter',
			   ' to leave them as they are.');
	       END;
      END;

   UNTIL (Resp='Y') OR (Resp='N') OR(Resp='y') OR (Resp='n');


   Initialize( Input,  OutputFile, Top,         CurrLinePos,
	      CurrMargin, KeyWord,    FoldedChar,  CharType,
	      DblChar,    SglChar,    RecordSeen, CurrChar,
	      NextChar,   CurrSym,    NextSym,    PPoption  );


   CrPending := FALSE;

   WHILE (NextSym↑.Name <> EndOfFile) DO
      BEGIN

	 GetSymbol( (* from *)      Input,
		    (* updating *)  NextSym,
		    (* returning *) CurrSym   );

	 WITH PPOption [CurrSym↑.Name] DO
	    BEGIN

	       IF (CrPending AND NOT(CrSuppress IN OptionsSelected))
		  OR (CrBefore IN OptionsSelected)
		  THEN
		     BEGIN
			InsertCr( (* using *)      CurrSym,
				  (* writing to *) OutputFile );
			CrPending := FALSE
		     END;

	       IF BlankLineBefore IN OptionsSelected
		  THEN
		     BEGIN
			InsertBlankLine( (* using *)      CurrSym,
					 (* writing to *) OutputFile );
			CrPending := FALSE
		     END;

	       IF DIndentOnKeys IN OptionsSelected
		  THEN
		     LShiftOn(DIndentSymbols);

	       IF DIndent IN OptionsSelected
		  THEN
		     LShift;

	       IF SpaceBefore IN OptionsSelected
		  THEN
		     InsertSpace( (* using *)      CurrSym,
				  (* writing to *) OutputFile );

	       IF (Capitalize IN OptionsSelected )
		  AND WeAreCapitalizing
		  THEN  MakeCapitals (  (* updating*)  CurrSym );

	       PPSymbol( (* in *)         CurrSym,
			 (* writing to *) OutputFile );

	       IF SpaceAfter IN OptionsSelected
		  THEN
		     InsertSpace( (* using *)      NextSym,
				  (* writing to *) OutputFile );


	       IF IndentByTab IN OptionsSelected
		  THEN
		     RShift( (* using *) CurrSym↑.Name );

	       IF IndentToCLP IN OptionsSelected
		  THEN
		     RShiftToCLP( (* using *) CurrSym↑.Name );

	       IF GobbleSymbols IN OptionsSelected
		  THEN
		     Gobble( (* Symbols from *) Input,
			     (* up to *)        GobbleTerminators,
			     (* updating *)     CurrSym,
			    NextSym,
			     (* writing to *)   OutputFile        );

	       IF CrAfter IN OptionsSelected
		  THEN
		     CrPending := TRUE

	    END (* With *)

      END; (* While *)

   IF CrPending
      THEN
	 NWrteLn(OutputFile);
   NClose(OutputFile);

   IF DeleteTemp THEN
	 BEGIN
	    Close(Input);
	    ReWrite(Input);
	    Close(Input)
	 END


END.