(*
   This Program was taken from PASCAL NEWS (PUG) and adapted for 
   VAX PASCAL by:

Francis J. Monaco
Major, US ARMY
Systems Manager, Computer Graphics Laboratory
Department of Geography and Computer Science
The United States Military Academy
West Point, New York 10996
914-938-2063
*)

PROGRAM PRETTYPRINT(OUTPUT,FIN,FOUT);

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.        *)
      MAXKEYLENGTHY  =  10; (* THE MAXIMUM lengthy (IN CHARACTERS) OF A *)
(* PASCAL RESERVED KEYWORD.                *)
      MAXLINESIZE   =  131; (* THE MAXIMUM SIZE (IN CHARACTERS) OF A   *)
(* LINE OUTPUT BY THE PRETTYPRINTER.       *)
      SLOFAIL1      =  125; (* UP TO THIS COLUMN POSITION, EACH TIME   *)
(* "INDENTBYTAB" IS INVOKED, THE MARGIN    *)
(* WILL BE INDENTED BY "INDENT1".          *)
      SLOFAIL2      =  130; (* UP TO THIS COLUMN POSITION, EACH TIME   *)
(* "INDENTBYTAB" IS INVOKED, THE MARGIN    *)
(* WILL BE INDENTED BY "INDENT2".  BEYOND  *)
(* THIS, NO INDENTATION OCCURS.            *)
      INDENt1       =   4;
      INDENT2       =   1;
      SPACE = ' ';

TYPE 
     KEYSYMBOL = ( PROGSYM,    FUNCSYM,     PROCSYM,
                  LABELSYM,   CONSTSYM,    TYPESYM,   VARSYM,
                  BEGINSYM,   REPEATSYM,   RECORDSYM,
                  CASESYM,    CASEVARSYM,  OFSYM,
                  FORSYM,     WHILESYM,    WITHSYM,   DOSYM,
                  IFSYM,      THENSYM,     ELSESYM,
                  ENDSYM,     UNTILSYM,
                  BECOMES,    OPENCOMMENT, CLOSECOMMENT,
                  SEMICOLON,  COLON,       EQUALS,
                  OPENPAREN,  CLOSEPAREN,  PERIOD,
                  ENDOFFILE,
                  OTHERSYM );
     OPTION = ( CRSUPPRESS,
               CRBEFORE,
               BLANKLINEBEFORE,
               DINDENTONKEYS,
               DINDENT,
               SPACEBEFORE,
               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..MAXKEYLENGTHY ] OF CHAR;
     KEYWORDTABLE = ARRAY [ PROGSYM..UNTILSYM ] OF KEY;
     SPECIALCHAR = PACKED ARRAY [ 1..2 ] OF CHAR;
     DBLCHRSET = SET OF BECOMES..OPENCOMMENT;
     DBLCHARTABLE = ARRAY [ BECOMES..OPENCOMMENT ] OF SPECIALCHAR;
     SGLCHARTABLE = ARRAY [ SEMICOLON..PERIOD ] OF CHAR;
     STRINGY = ARRAY [ 1..MAXSYMBOLSIZE ] OF CHAR;
     SYMBOL = RECORD
               NAME        : KEYSYMBOL;
               VALUES       : STRINGY;
               LENGTHY      : INTEGER;
               SPACESBEFORE: INTEGER;
               CRSBEFORE   : INTEGER
              END;
     SYMBOLINFO = ^SYMBOL;
     CHARNAME = ( LETTER,    DIGIT,    BLANK,    QUOTE,
                 ENDOFLINE, FILEMARK, OTHERCHAR       );
     CHARINFO = RECORD
                 NAME : CHARNAME;
                 VALUES: CHAR
                END;
     STACKENTRY = RECORD
                   INDENTSYMBOL: KEYSYMBOL;
                   PREVMARGIN  : INTEGER
                  END;
     SYMBOLSTACK = ARRAY [ 1..MAXSTACKSIZE ] OF STACKENTRY;

VAR 
    FIN : FILE OF CHAR;
    FOUT : FILE OF CHAR;
    FINNAME,FINEXT,FOUTNAME,FOUTEXT : STRINGY;
    SAWCOMOPEN, SAWCOMCLOSE, SAWQUOTEDSTRING, INACOMMENT    : BOOLEAN;
    RECORDSEEN: BOOLEAN;
    CURRCHAR,
    NEXTCHAR: CHARINFO;
    CURRSYM,
    NEXTSYM: SYMBOLINFO;
    CRPENDING: BOOLEAN;
    PPOPTION: OPTIONTABLE;
    KEYWORD: KEYWORDTABLE;
    DBLCHARS: DBLCHRSET;
    DBLCHAR: DBLCHARTABLE;
    SGLCHAR: SGLCHARTABLE;
    STACK: SYMBOLSTACK;
    TOP  : INTEGER;
    STARTPOS,           (* STARTING POSITION OF LAST SYMBOL WRITTEN *)
    CURRLINEPOS,
    CURRMARGIN :  INTEGER;
    I : INTEGER;

PROCEDURE GETCHAR(
(* UPDATING *)    VAR NEXTCHAR  : CHARINFO;
(* RETURNING *)   VAR CURRCHAR  : CHARINFO );
BEGIN (* GETCHAR *)
 CURRCHAR := NEXTCHAR;
 WITH NEXTCHAR DO
  BEGIN
   IF EOF(FIN)
    THEN
     NAME  := FILEMARK
    ELSE
     IF EOLN(FIN)
      THEN
       NAME  := ENDOFLINE
      ELSE
       IF ( ( (ORD(FIN^)) >= (ORD('a'))) AND
          ( (ORD(FIN^)) <= (ORD('z'))) AND
          ( NOT SAWQUOTEDSTRING )  AND
          ( NOT INACOMMENT) )
        THEN
         BEGIN
          FIN^ := CHR ( ORD ( FIN^ ) - 32 );
          NAME := LETTER
         END
        ELSE
         IF SAWCOMOPEN
          THEN
           BEGIN
            SAWCOMOPEN := FALSE;
            FIN^ := '*';
            NAME := OTHERCHAR
           END
          ELSE
           IF SAWCOMCLOSE
            THEN
             BEGIN
              SAWCOMCLOSE := FALSE;
              FIN^ := ')';
              NAME := OTHERCHAR
             END
            ELSE
             IF  ( (FIN^ = '{' ) AND (NOT SAWQUOTEDSTRING) )
              THEN
               BEGIN
                SAWCOMOPEN := TRUE;
                INACOMMENT := TRUE;
                FIN^ := '(';
                NAME := OTHERCHAR
               END
              ELSE
               IF  ( (FIN^ = '}')  AND (NOT SAWQUOTEDSTRING) )
                THEN
                 BEGIN
                  SAWCOMCLOSE := TRUE;
                  INACOMMENT := FALSE;
                  FIN^ := '*';
                  NAME := OTHERCHAR
                 END
                ELSE
                 IF FIN^ IN ['A' .. 'Z', '_']
                  THEN
                   NAME  := LETTER
                  ELSE
                   IF FIN^ IN ['0'..'9']
                    THEN
                     NAME  := DIGIT
                    ELSE
                     IF ( FIN^ = '''') AND ( NOT INACOMMENT )
                      THEN
                       IF SAWQUOTEDSTRING
                        THEN
                         BEGIN
                          NAME := QUOTE;
                          SAWQUOTEDSTRING := FALSE
                         END
                        ELSE
                         BEGIN
                          NAME := QUOTE;
                          SAWQUOTEDSTRING := TRUE
                         END
                      ELSE
                       IF FIN^ = SPACE
                        THEN
                         NAME  := BLANK
                        ELSE
                         NAME := OTHERCHAR;
   IF NAME IN [ FILEMARK, ENDOFLINE ]
    THEN
     VALUES := SPACE
    ELSE
     VALUES := FIN^;
   IF (NAME <> FILEMARK) AND (NOT SAWCOMOPEN) AND (NOT SAWCOMCLOSE)
    THEN
     GET(FIN)
  END (* WITH *)
END; (* GETCHAR *)

PROCEDURE STORENEXTCHAR(
(* UPDATING *)          VAR LENGTHY    : INTEGER;
                        VAR CURRCHAR,
                        NEXTCHAR  : CHARINFO;
(* PLACING IN *)        VAR VALUES     : STRINGY   );
BEGIN (* STORENEXTCHAR *)
 GETCHAR(
(* UPDATING *)  NEXTCHAR,
(* RETURNING *) CURRCHAR  );
 IF LENGTHY < MAXSYMBOLSIZE
  THEN
   BEGIN
    LENGTHY := LENGTHY + 1;
    VALUES [LENGTHY] := CURRCHAR.VALUES
   END
END; (* STORENEXTCHAR *)

PROCEDURE SKIPSPACES(
(* UPDATING *)       VAR CURRCHAR,
                     NEXTCHAR     : CHARINFO;
(* RETURNING *)      VAR SPACESBEFORE,
                     CRSBEFORE    : INTEGER  );
BEGIN (* SKIPSPACES *)
 SPACESBEFORE := 0;
 CRSBEFORE    := 0;
 WHILE NEXTCHAR.NAME IN [ BLANK, ENDOFLINE ] DO
  BEGIN
   GETCHAR(
(* 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(
(* UPDATING *)       VAR CURRCHAR,
                     NEXTCHAR  : CHARINFO;
                     VAR NAME      : KEYSYMBOL;
                     VAR VALUES     : STRINGY;
                     VAR LENGTHY    : INTEGER   );
BEGIN (* GETCOMMENT *)
 INACOMMENT := TRUE;
 NAME := OPENCOMMENT;
 WHILE NOT(    ((CURRCHAR.VALUES = '*') AND (NEXTCHAR.VALUES = ')'))
       OR (NEXTCHAR.NAME = ENDOFLINE)
       OR (NEXTCHAR.NAME = FILEMARK)) DO
  STORENEXTCHAR(
(* UPDATING *)  LENGTHY,
                CURRCHAR,
                NEXTCHAR,
(* IN *)        VALUES     );
 IF (CURRCHAR.VALUES = '*') AND (NEXTCHAR.VALUES = ')')
  THEN
   BEGIN
    STORENEXTCHAR(
(* UPDATING *)    LENGTHY,
                  CURRCHAR,
                  NEXTCHAR,
(* IN *)          VALUES     );
    NAME := CLOSECOMMENT;
    INACOMMENT := FALSE
   END
END; (* GETCOMMENT *)

FUNCTION IDTYPE( (* OF *)        VALUES  : STRINGY;
(* USING *)     LENGTHY : INTEGER )
(* RETURNING *)                   : KEYSYMBOL;

VAR 
    I: INTEGER;
    KEYVALUES: KEY;
    HIT: BOOLEAN;
    THISKEY: KEYSYMBOL;
BEGIN (* IDTYPE *)
 IDTYPE := OTHERSYM;
 IF LENGTHY <= MAXKEYLENGTHY
  THEN
   BEGIN
    FOR I := 1 TO LENGTHY DO
     KEYVALUES [I] := VALUES [I];
    FOR I := LENGTHY+1 TO MAXKEYLENGTHY DO
     KEYVALUES [I] := SPACE;
    THISKEY := PROGSYM;
    HIT     := FALSE;
    WHILE NOT(HIT OR (THISKEY = SUCC(UNTILSYM))) DO
     IF KEYVALUES = KEYWORD [THISKEY]
      THEN
       HIT := TRUE
      ELSE
       THISKEY := SUCC(THISKEY);
    IF HIT
     THEN
      IDTYPE := THISKEY
   END;
END; (* IDTYPE *)

PROCEDURE GETIDENTIFIER(
(* UPDATING *)          VAR CURRCHAR,
                        NEXTCHAR  : CHARINFO;
(* RETURNING *)         VAR NAME      : KEYSYMBOL;
                        VAR VALUES     : STRINGY;
                        VAR LENGTHY    : INTEGER   );
BEGIN (* GETIDENTIFIER *)
 WHILE NEXTCHAR.NAME IN [ LETTER, DIGIT ] DO
  STORENEXTCHAR(
(* UPDATING *)  LENGTHY,
                CURRCHAR,
                NEXTCHAR,
(* IN *)        VALUES     );
 NAME := IDTYPE( (* OF *)    VALUES,
(* USING *) LENGTHY );
 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(
(* UPDATING *)      VAR CURRCHAR,
                    NEXTCHAR  : CHARINFO;
(* RETURNING *)     VAR NAME      : KEYSYMBOL;
                    VAR VALUES     : STRINGY;
                    VAR LENGTHY    : INTEGER   );
BEGIN (* GETNUMBER *)
 WHILE NEXTCHAR.NAME = DIGIT DO
  STORENEXTCHAR(
(* UPDATING *)  LENGTHY,
                CURRCHAR,
                NEXTCHAR,
(* IN *)        VALUES     );
 NAME := OTHERSYM
END; (* GETNUMBER *)

PROCEDURE GETCHARLITERAL(
(* UPDATING *)           VAR CURRCHAR,
                         NEXTCHAR  : CHARINFO;
(* RETURNING *)          VAR NAME      : KEYSYMBOL;
                         VAR VALUES     : STRINGY;
                         VAR LENGTHY    : INTEGER   );
BEGIN (* GETCHARLITERAL *)
 WHILE NEXTCHAR.NAME = QUOTE DO
  BEGIN
   STORENEXTCHAR(
(* UPDATING *)   LENGTHY,
                 CURRCHAR,
                 NEXTCHAR,
(* IN *)         VALUES     );
   WHILE NOT(NEXTCHAR.NAME IN [ QUOTE, ENDOFLINE, FILEMARK ]) DO
    STORENEXTCHAR(
(* UPDATING *)    LENGTHY,
                  CURRCHAR,
                  NEXTCHAR,
(* IN *)          VALUES     );
   IF NEXTCHAR.NAME = QUOTE
    THEN
     STORENEXTCHAR(
(* UPDATING *)     LENGTHY,
                   CURRCHAR,
                   NEXTCHAR,
(* IN *)           VALUES     )
  END;
 NAME := OTHERSYM
END; (* GETCHARLITERAL *)

FUNCTION CHARTYPE( (* OF *)        CURRCHAR,
                  NEXTCHAR : CHARINFO )
(* RETURNING *)                      : KEYSYMBOL;

VAR 
    NEXTTWOCHARS: SPECIALCHAR;
    HIT: BOOLEAN;
    THISCHAR: KEYSYMBOL;
BEGIN (* CHARTYPE *)
 NEXTTWOCHARS[1] := CURRCHAR.VALUES;
 NEXTTWOCHARS[2] := NEXTCHAR.VALUES;
 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 := SEMICOLON;
    WHILE NOT(HIT OR (PRED(THISCHAR) = PERIOD)) DO
     IF CURRCHAR.VALUES = SGLCHAR [THISCHAR]
      THEN
       HIT := TRUE
      ELSE
       THISCHAR := SUCC(THISCHAR)
   END;
 IF HIT
  THEN
   CHARTYPE := THISCHAR
  ELSE
   CHARTYPE := OTHERSYM
END; (* CHARTYPE *)

PROCEDURE GETSPECIALCHAR(
(* UPDATING *)           VAR CURRCHAR,
                         NEXTCHAR  : CHARINFO;
(* RETURNING *)          VAR NAME      : KEYSYMBOL;
                         VAR VALUES     : STRINGY;
                         VAR LENGTHY    : INTEGER   );
BEGIN (* GETSPECIALCHAR *)
 STORENEXTCHAR(
(* UPDATING *) LENGTHY,
               CURRCHAR,
               NEXTCHAR,
(* IN *)       VALUES     );
 NAME := CHARTYPE( (* OF *) CURRCHAR,
         NEXTCHAR );
 IF NAME IN DBLCHARS
  THEN
   STORENEXTCHAR(
(* UPDATING *)   LENGTHY,
                 CURRCHAR,
                 NEXTCHAR,
(* IN *)         VALUES     )
END; (* GETSPECIALCHAR *)

PROCEDURE GETNEXTSYMBOL(
(* UPDATING *)          VAR CURRCHAR,
                        NEXTCHAR  : CHARINFO;
(* RETURNING *)         VAR NAME      : KEYSYMBOL;
                        VAR VALUES     : STRINGY;
                        VAR LENGTHY    : INTEGER   );
BEGIN (* GETNEXTSYMBOL *)
 CASE NEXTCHAR.NAME OF
  LETTER      : GETIDENTIFIER(
(* UPDATING *)                CURRCHAR,
                              NEXTCHAR,
(* RETURNING *)               NAME,
                              VALUES,
                              LENGTHY    );
  DIGIT       : GETNUMBER(
(* UPDATING *)            CURRCHAR,
                          NEXTCHAR,
(* RETURNING *)           NAME,
                          VALUES,
                          LENGTHY    );
  QUOTE       : GETCHARLITERAL(
(* UPDATING *)                 CURRCHAR,
                               NEXTCHAR,
(* RETURNING *)                NAME,
                               VALUES,
                               LENGTHY    );
  OTHERCHAR   : BEGIN
                 GETSPECIALCHAR(
(* UPDATING *)                  CURRCHAR,
                                NEXTCHAR,
(* RETURNING *)                 NAME,
                                VALUES,
                                LENGTHY    );
                 IF NAME = OPENCOMMENT
                  THEN
                   GETCOMMENT(
(* UPDATING *)                CURRCHAR,
                              NEXTCHAR,
                              NAME,
                              VALUES,
                              LENGTHY    )
                END;
  FILEMARK    : NAME := ENDOFFILE
 END (* CASE *)
END; (* GETNEXTSYMBOL *)

PROCEDURE GETSYMBOL(
(* UPDATING *)      VAR NEXTSYM   : SYMBOLINFO;
(* RETURNING *)     VAR CURRSYM   : SYMBOLINFO );

VAR 
    DUMMY: SYMBOLINFO;
BEGIN (* GETSYMBOL *)
 DUMMY   := CURRSYM;
 CURRSYM := NEXTSYM;
 NEXTSYM := DUMMY  ;
 WITH NEXTSYM^ DO
  BEGIN
   SKIPSPACES(
(* UPDATING *)  CURRCHAR,
              NEXTCHAR,
(* RETURNING *) SPACESBEFORE,
              CRSBEFORE     );
   LENGTHY := 0;
   IF CURRSYM^.NAME = OPENCOMMENT
    THEN
     GETCOMMENT(
(* UPDATING *)  CURRCHAR,
                NEXTCHAR,
(* RETURNING *) NAME,
                VALUES,
                LENGTHY    )
    ELSE
     GETNEXTSYMBOL(
(* UPDATING *)     CURRCHAR,
                   NEXTCHAR,
(* RETURNING *)    NAME,
                   VALUES,
                   LENGTHY    )
  END (* WITH *)
END; (* GETSYMBOL *)

PROCEDURE INT2 ( VAR TOPOFSTACK : INTEGER;
                VAR CURRLINEPOS,
                CURRMARGIN : INTEGER;
                VAR KEYWORD    : KEYWORDTABLE;
                VAR DBLCHARS   : DBLCHRSET;
                VAR DBLCHAR    : DBLCHARTABLE;
                VAR SGLCHAR    : SGLCHARTABLE;
                VAR RECORDSEEN : BOOLEAN;
                VAR CURRCHAR,
                NEXTCHAR   : CHARINFO;
                VAR CURRSYM,
                NEXTSYM    : SYMBOLINFO;
                VAR PPOPTION   : OPTIONTABLE );
BEGIN
 WITH PPOPTION [ OFSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ CRSUPPRESS,
                        SPACEBEFORE ];
   DINDENTSYMBOLS    := [];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ FORSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ SPACEAFTER,
                        INDENTBYTAB,
                        GOBBLESYMBOLS,
                        CRAFTER ];
   DINDENTSYMBOLS    := [];
   GOBBLETERMINATORS := [ DOSYM ]
  END;
 WITH PPOPTION [ WHILESYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ SPACEAFTER,
                        INDENTBYTAB,
                        GOBBLESYMBOLS,
                        CRAFTER ];
   DINDENTSYMBOLS    := [];
   GOBBLETERMINATORS := [ DOSYM ]
  END;
 WITH PPOPTION [ WITHSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ SPACEAFTER,
                        INDENTBYTAB,
                        GOBBLESYMBOLS,
                        CRAFTER ];
   DINDENTSYMBOLS    := [];
   GOBBLETERMINATORS := [ DOSYM ]
  END;
 WITH PPOPTION [ DOSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ CRSUPPRESS,
                        SPACEBEFORE ];
   DINDENTSYMBOLS    := [];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ IFSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ SPACEAFTER,
                        INDENTBYTAB,
                        GOBBLESYMBols,
                        CRAFTER ];
   DINDENTSYMBOLS    := [];
   GOBBLETERMINATORS := [ THENSYM ]
  END;
 WITH PPOPTION [ THENSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ indenTBYtab,
                        CRAFTER ];
   DINDENTSYMBOLS    := [];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ ELSESYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ CRBEFORE,
                        DINDENTONKEYS,
                        DINDENT,
                        INDENTBYTAB,
                        CRAFTER ];
   DINDENTSYMBOLS    := [ IFSYM,
                        ELSESYM ];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ ENDSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ CRBEFORE,
                        DINDENTONKEYS,
                        DINDENT,
                        CRAFTER ];
   DINDENTSYMBOLS    := [ IFSYM,
                        THENSYM,
                        ELSESYM,
                        FORSYM,
                        WHILESYM,
                        WITHSYM,
                        CASEVARSYM,
                        COLON,
                        EQUALS ];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ UNTILSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ CRBEFORE,
                        DINDENTONKEYS,
                        DINDENT,
                        SPACEAFTER,
                        GOBBLESYMBOLS,
                        CRAFTER ];
   DINDENTSYMBOLS    := [ IFSYM,
                        THENSYM,
                        ELSESYM,
                        FORSYM,
                        WHILESYM,
                        WITHSYM,
                        COLON,
                        EQUALS ];
   GOBBLETERMINATORS := [ ENDSYM,
                        UNTILSYM,
                        ELSESYM,
                        SEMICOLON ];
  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,
                        CRAFTER ];
   DINDENTSYMBOLS    := [ IFSYM,
                        THENSYM,
                        ELSESYM,
                        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; (* INITIALIZE2 *)

PROCEDURE INITIALIZE( (* RETURNING *)
                     VAR TOPOFSTACK  : INTEGER;
                     VAR CURRLINEPOS,
                     CURRMARGIN  : INTEGER;
                     VAR KEYWORD     : KEYWORDTABLE;
                     VAR DBLCHARS    : DBLCHRSET;
                     VAR DBLCHAR     : DBLCHARTABLE;
                     VAR SGLCHAR     : SGLCHARTABLE;
                     VAR RECORDSEEN  : BOOLEAN;
                     VAR CURRCHAR,
                     NEXTCHAR    : CHARINFO;
                     VAR CURRSYM,
                     NEXTSYM     : SYMBOLINFO;
                     VAR PPOPTION    : OPTIONTABLE   );
BEGIN (* INITIALIZE *)
 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 [ IFSYM      ] := 'IF        ' ;
 KEYWORD [ THENSYM    ] := 'THEN      ' ;
 KEYWORD [ ELSESYM    ] := 'ELSE      ' ;
 KEYWORD [ ENDSYM     ] := 'END       ' ;
 KEYWORD [ UNTILSYM   ] := 'UNTIL     ' ;
 DBLCHARS := [ BECOMES, OPENCOMMENT ];
 DBLCHAR [ BECOMES     ]  := ':=' ;
 DBLCHAR [ OPENCOMMENT ]  := '(*' ;
 SGLCHAR [ SEMICOLON  ]   := ';' ;
 SGLCHAR [ COLON      ]   := ':' ;
 SGLCHAR [ EQUALS     ]   := '=' ;
 SGLCHAR [ OPENPAREN  ]   := '(' ;
 SGLCHAR [ CLOSEPAREN ]   := ')' ;
 SGLCHAR [ PERIOD     ]   := '.' ;
 RECORDSEEN := FALSE;
 SAWCOMOPEN := FALSE;
 SAWCOMCLOSE := FALSE;
 INACOMMENT := FALSE;
 SAWQUOTEDSTRING := FALSE;
 GETCHAR(
(* UPDATING *)  NEXTCHAR,
(* RETURNING *) CURRCHAR  );
 NEW(CURRSYM);
 NEW(NEXTSYM);
 GETSYMBOL(
(* UPDATING *)  NEXTSYM,
(* RETURNING *) CURRSYM  );
 WITH PPOPTION [ PROGSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ BLANKLINEBEFORE,
                        SPACEAFTER ];
   DINDENTSYMBOLS    := [];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ FUNCSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ BLANKLINEBEFORE,
                        DINDENTONKEYS,
                        SPACEAFTER ];
   DINDENTSYMBOLS    := [ LABELSYM,
                        CONSTSYM,
                        TYPESYM,
                        VARSYM ];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ PROCSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ BLANKLINEBEFORE,
                        DINDENTONKEYS,
                        SPACEAFTER ];
   DINDENTSYMBOLS    := [ LABELSYM,
                        CONSTSYM,
                        TYPESYM,
                        VARSYM ];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ LABELSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ BLANKLINEBEFORE,
                        SPACEAFTER,
                        INDENTTOCLP,
                        CRAFTER ];
   DINDENTSYMBOLS    := [];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ CONSTSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ BLANKLINEBEFORE,
                        DINDENTONKEYS,
                        SPACEAFTER,
                        INDENTTOCLP,
                        CRAFTER ];
   DINDENTSYMBOLS    := [ LABELSYM ];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ TYPESYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ BLANKLINEBEFORE,
                        DINDENTONKEYS,
                        SPACEAFTER,
                        INDENTTOCLP,
                        CRAFTER ];
   DINDENTSYMBOLS    := [ LABELSYM,
                        CONSTSYM ];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ VARSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ BLANKLINEBEFORE,
                        DINDENTONKEYS,
                        SPACEAFTER,
                        INDENTTOCLP,
                        CRAFTER  ];
   DINDENTSYMBOLS    := [ LABELSYM,
                        CONSTSYM,
                        TYPESYM ];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ BEGINSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ DINDENTONKEYS,
                        INDENTBYTAB,
                        CRAFTER ];
   DINDENTSYMBOLS    := [ LABELSYM,
                        CONSTSYM,
                        TYPESYM,
                        VARSYM ];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ REPEATSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ INDENTBYTAB,
                        CRAFTER ];
   DINDENTSYMBOLS    := [];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ RECORDSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ INDENTBYTAB,
                        CRAFTER ];
   DINDENTSYMBOLS    := [];
   GOBBLETERMINATORS := []
  END;
 WITH PPOPTION [ CASESYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ SPACEAFTER,
                        INDENTBYTAB,
                        GOBBLESYMBOLS,
                        CRAFTER ];
   DINDENTSYMBOLS    := [];
   GOBBLETERMINATORS := [ OFSYM ]
  END;
 WITH PPOPTION [ CASEVARSYM ] DO
  BEGIN
   OPTIONSSELECTED   := [ SPACEAFTER,
                        INDENTBYTAB,
                        GOBBLESYMBOLS,
                        CRAFTER ];
   DINDENTSYMBOLS    := [];
   GOBBLETERMINATORS := [ OFSYM ]
  END;
 INT2 ( TOPOFSTACK, CURRLINEPOS, CURRMARGIN, KEYWORD, DBLCHARS, DBLCHAR,
       SGLCHAR, RECORDSEEN, CURRCHAR, NEXTCHAR, CURRSYM, NEXTSYM, PPOPTION );
END;

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 );

VAR 
    I: INTEGER;
BEGIN (* WRITECRS *)
 IF NUMBEROFCRS > 0
  THEN
   BEGIN
    FOR I := 1 TO NUMBEROFCRS DO
     BEGIN
      WRITELN(FOUT)
     END;
    CURRLINEPOS := 0
   END
END; (* WRITECRS *)

PROCEDURE INSERTCR( (* UPDATING *)   VAR CURRSYM    : SYMBOLINFO );

CONST 
      ONCE = 1;
BEGIN (* INSERTCR *)
 IF CURRSYM^.CRSBEFORE = 0
  THEN
   BEGIN
    WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS );
    CURRSYM^.SPACESBEFORE := 0
   END
END; (* INSERTCR *)

PROCEDURE INSERTBLANKLINE( (* UPDATING *)   VAR CURRSYM : SYMBOLINFO );

CONST 
      ONCE  = 1;
      TWICE = 2;
BEGIN (* INSERTBLANKLINE *)
 IF CURRSYM^.CRSBEFORE = 0
  THEN
   BEGIN
    IF CURRLINEPOS = 0
     THEN
      WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS )
     ELSE
      WRITECRS( TWICE, (* UPDATING *)   CURRLINEPOS );
    CURRSYM^.SPACESBEFORE := 0
   END
  ELSE
   IF CURRSYM^.CRSBEFORE = 1
    THEN
     IF CURRLINEPOS > 0
      THEN
       WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS )
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 );
BEGIN (* INSERTSPACE *)
 IF CURRLINEPOS < MAXLINESIZE
  THEN
   BEGIN
    WRITE(FOUT, 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 );

VAR 
    I: INTEGER;
BEGIN (* MOVELINEPOS *)
 FOR I := CURRLINEPOS+1 TO NEWLINEPOS DO
  BEGIN
   WRITE(FOUT, SPACE)
  END;
 CURRLINEPOS := NEWLINEPOS
END; (* MOVELINEPOS *)

PROCEDURE PRINTSYMBOL( (* IN *)             CURRSYM     : SYMBOLINFO;
(* UPDATING *)        VAR CURRLINEPOS : INTEGER     );

VAR 
    I : INTEGER;
BEGIN (* PRINTSYMBOL *)
 WITH CURRSYM^ DO
  BEGIN
   FOR I := 1 TO LENGTHY DO
    BEGIN
     WRITE(FOUT, VALUES[I])
    END;
   STARTPOS := CURRLINEPOS (* SAVE START POSITION FOR TABBING *);
   CURRLINEPOS := CURRLINEPOS + LENGTHY
  END (* WITH *)
END; (* PRINTSYMBOL *)

PROCEDURE PPSYMBOL( (* IN *) CURRSYM : SYMBOLINFO );

CONST 
      ONCE  = 1;

VAR 
    NEWLINEPOS: INTEGER;
BEGIN (* PPSYMBOL *)
 WITH CURRSYM^ DO
  BEGIN
   WRITECRS( (* USING *)      CRSBEFORE,
(* UPDATING *)   CURRLINEPOS );
   IF (CURRLINEPOS + SPACESBEFORE > CURRMARGIN)
      OR (NAME IN [ OPENCOMMENT, CLOSECOMMENT ])
    THEN
     NEWLINEPOS := CURRLINEPOS + SPACESBEFORE
    ELSE
     NEWLINEPOS := CURRMARGIN;
   IF NEWLINEPOS + LENGTHY > MAXLINESIZE
    THEN
     BEGIN
      WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS );
      IF CURRMARGIN + LENGTHY <= MAXLINESIZE
       THEN
        NEWLINEPOS := CURRMARGIN
       ELSE
        IF LENGTHY < MAXLINESIZE
         THEN
          NEWLINEPOS := MAXLINESIZE - LENGTHY
         ELSE
          NEWLINEPOS := 0
     END;
   MOVELINEPOS( (* TO *)    NEWLINEPOS,
(* FROM *)     CURRLINEPOS );
   PRINTSYMBOL( (* IN *)         CURRSYM,
(* UPDATING *)   CURRLINEPOS )
  END (* WITH *)
END; (* PPSYMBOL *)

PROCEDURE RSHIFTTOCLP( (* USING *) CURRSYM : KEYSYMBOL );
FORWARD;

PROCEDURE GOBBLE(
(* UP TO *)            TERMINATORS : KEYSYMSET;
(* UPDATING *)     VAR CURRSYM,
                 NEXTSYM     : SYMBOLINFO );
BEGIN (* GOBBLE *)
 RSHIFTTOCLP( (* USING *) CURRSYM^.NAME );
 WHILE NOT(NEXTSYM^.NAME IN (TERMINATORS + [ENDOFFILE])) DO
  BEGIN
   GETSYMBOL(
(* UPDATING *)  NEXTSYM,
(* RETURNING *) CURRSYM   );
   PPSYMBOL( (* IN *)         CURRSYM )
  END; (* WHILE *)
 LSHIFT
END; (* GOBBLE *)

PROCEDURE RSHIFT( (* USING *) CURRSYM : KEYSYMBOL );
BEGIN (* RSHIFT *)
 IF NOT STACKFULL
  THEN
   PUSHSTACK( (* USING *) CURRSYM,
             CURRMARGIN);
 IF STARTPOS > CURRMARGIN
  THEN
   CURRMARGIN := STARTPOS;
 IF CURRMARGIN < SLOFAIL1
  THEN
   CURRMARGIN := CURRMARGIN + INDENT1
  ELSE
   IF CURRMARGIN < SLOFAIL2
    THEN
     CURRMARGIN := CURRMARGIN + INDENT2
END; (* RSHIFT *)

PROCEDURE RSHIFTTOCLP;
BEGIN (* RSHIFTTOCLP *)
 IF NOT STACKFULL
  THEN
   PUSHSTACK( (* USING *) CURRSYM,
             CURRMARGIN);
 CURRMARGIN := CURRLINEPOS
END; (* RSHIFTTOCLP *)
BEGIN (* PRETTYPRINT *)
 WRITELN (' Welcome to the PASCAL User''s Group PASCAL Prettyprinter... ');
 WRITELN;
 RESET(FIN);
 REWRITE(FOUT);
 LINELIMIT(FOUT,MAXINT);
 INITIALIZE( TOP,        CURRLINEPOS,
            CURRMARGIN, KEYWORD,    DBLCHARS,    DBLCHAR,
            SGLCHAR,    RECORDSEEN, CURRCHAR,    NEXTCHAR,
            CURRSYM,    NEXTSYM,    PPOPTION );
 CRPENDING := FALSE;
 WHILE (NEXTSYM^.NAME <> ENDOFFILE) DO
  BEGIN
   GETSYMBOL(
(* 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);
        CRPENDING := FALSE
       END;
     IF BLANKLINEBEFORE IN OPTIONSSELECTED
      THEN
       BEGIN
        INSERTBLANKLINE( (* USING *) CURRSYM);
        CRPENDING := FALSE
       END;
     IF DINDENTONKEYS IN OPTIONSSELECTED
      THEN
       LSHIFTON(DINDENTSYMBOLS);
     IF DINDENT IN OPTIONSSELECTED
      THEN
       LSHIFT;
     IF SPACEBEFORE IN OPTIONSSELECTED
      THEN
       INSERTSPACE( (* USING *) CURRSYM );
     PPSYMBOL( (* IN *) CURRSYM );
     IF SPACEAFTER IN OPTIONSSELECTED
      THEN
       INSERTSPACE( (* USING *) NEXTSYM );
     IF INDENTBYTAB IN OPTIONSSELECTED
      THEN
       RSHIFT( (* USING *) CURRSYM^.NAME );
     IF INDENTTOCLP IN OPTIONSSELECTED
      THEN
       RSHIFTTOCLP( (* USING *) CURRSYM^.NAME );
     IF GOBBLESYMBOLS IN OPTIONSSELECTED
      THEN
       GOBBLE(
(* UP TO *)        GOBBLETERMINATORS,
(* UPDATING *)     CURRSYM,
              NEXTSYM            );
     IF CRAFTER IN OPTIONSSELECTED
      THEN
       CRPENDING := TRUE
    END (* WITH *)
  END; (* WHILE *)
 IF CRPENDING
  THEN
   WRITELN(FOUT);
 CLOSE (FOUT);
END.