(*======================================================================*)
(*                                                                      *)
(*  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          *)
(*            AND JOHN GORMAN.)                                         *)
(*                                                                      *)
(*  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 FILE:  OUTPUTFILE - THE PRETTYPRINTED PROGRAM.               *)
(*                                                                      *)
(*                OUTPUT     - STANDARD PASCAL FILE FOR RUNTIME         *)
(*                             MESSAGES.                                *)
(*                                                                      *)
(*                                                                      *)
(*======================================================================*)


(*======================================================================*)
(*                                                                      *)
(*                      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 PRECEEDING TEXT ON A LINE.            *)
(*                                                                      *)
(*   2.    ALL STATEMENTS AND DECLARATIONS BEGIN ON SEPARATE LINES.     *)
(*                                                                      *)
(*   3.    NO LINE MAY BE GREATER THAN 120 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 FOLLOWED 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 ":".      *)
(*      NOTE THAT ONLY "="S IN DECLARATIONS ARE FORMATTED. "="S IN      *)
(*      EXPRESSIONS ARE IGNORED.                                        *)
(*                                                                      *)
(*                                                                      *)
(*  [ 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 >                                      *)
(*                                                                      *)
(*                                                                      *)
(*======================================================================*)


(*======================================================================*)
(*                                                                      *)
(*                       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-INDENT- *)
(*                        ING 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).               *)
(*                                                                      *)
(*     [ 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 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 *)  INPUTFILE,
                     (* TO *)    OUTPUTFILE{,}
                     (* USING *) { OUTPUT }); { output file not used [sam] }

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     = 72;
                          (* THE MAXIMUM SIZE (IN CHARACTERS) OF A *)
                          (* LINE OUTPUT BY THE PRETTYPRINTER. *)

   SLOFAIL1        = 30;  (* UP TO THIS COLUMN POSITION, EACH TIME *)
                          (* "INDENTBYTAB" IS INVOKED, THE MARGIN *)
                          (* WILL BE INDENTED BY "INDENT1". *)

   SLOFAIL2        = 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           = ' ';

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..MAXKEYLENGTH ] 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;


   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,
                       ENDOFLINE, FILEMARK, OTHERCHAR       );

   CHARINFO        = RECORD
                        NAME            : CHARNAME;
                        VALUE           : CHAR
                     END;


   STACKENTRY      = RECORD
                        INDENTSYMBOL    : KEYSYMBOL;
                        PREVMARGIN      : INTEGER
                     END;

   SYMBOLSTACK     = ARRAY [ 1..MAXSTACKSIZE ] OF STACKENTRY;


VAR

   INPUTFILE,
   OUTPUTFILE: TEXT;

   RECORDSEEN: BOOLEAN;

   CURRCHAR,
   NEXTCHAR: CHARINFO;

   CURRSYM,
   NEXTSYM: SYMBOLINFO;

   CRPENDING: BOOLEAN;

   PPOPTION: OPTIONTABLE;

   KEYWORD: KEYWORDTABLE;

   DBLCHARS: DBLCHRSET;

   DBLCHAR: DBLCHARTABLE;
   SGLCHAR: SGLCHARTABLE;

   STACK: SYMBOLSTACK;
   TOP: INTEGER;
   
   CURRLINEPOS,
   CURRMARGIN: INTEGER;


PROCEDURE GETCHAR( (* FROM *)      VAR INPUTFILE : TEXT;
                   (* UPDATING *)  VAR NEXTCHAR  : CHARINFO;
                   (* RETURNING *) VAR CURRCHAR  : CHARINFO );

BEGIN (* GETCHAR *)

   CURRCHAR := NEXTCHAR;

   WITH NEXTCHAR DO
      BEGIN

         IF EOF(INPUTFILE)
            THEN
               NAME := FILEMARK

   ELSE IF EOLN(INPUTFILE)
            THEN
               NAME := ENDOFLINE

   ELSE IF INPUTFILE^ IN ['A'..'Z','a'..'z'] { added lower case [sam] }
            THEN
               NAME := LETTER

   ELSE IF INPUTFILE^ IN ['0'..'9']
            THEN
               NAME := DIGIT

   ELSE IF INPUTFILE^ = ''''
            THEN
               NAME := QUOTE

   ELSE IF INPUTFILE^ = SPACE
            THEN
               NAME := BLANK

   ELSE NAME := OTHERCHAR;


        IF NAME IN [ FILEMARK, ENDOFLINE ] 
           THEN
              VALUE := SPACE
        ELSE
           VALUE := INPUTFILE^;

        IF NAME <> FILEMARK THEN
           GET(INPUTFILE)

      END (* WITH *)

END; (* GETCHAR *)


PROCEDURE STORENEXTCHAR( (* FROM *)		  VAR INPUTFILE : TEXT;
                         (* UPDATING   *) VAR LENGTH    : INTEGER;
                                          VAR CURRCHAR,
                                              NEXTCHAR  : CHARINFO;
                         (* PLACING IN *) VAR VALUE     : STRING );

BEGIN

   GETCHAR( (* FROM *)		 INPUTFILE,
            (* UPDATING   *) NEXTCHAR,
            (* RETURNING  *) CURRCHAR );

   IF LENGTH < MAXSYMBOLSIZE THEN BEGIN

      LENGTH := LENGTH + 1;

      VALUE[LENGTH] := CURRCHAR.VALUE

      END

   END;


PROCEDURE SKIPSPACES ( (* IN *)        VAR INPUTFILE    : TEXT;
                       (* UPDATING  *) VAR CURRCHAR,
                                           NEXTCHAR     : CHARINFO;
                       (* RETURNING *) VAR SPACESBEFORE,
                                           CRSBEFORE    : INTEGER  );

BEGIN

   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

      END

   END;


PROCEDURE GETCOMMENT( (* FROM *)	 VAR INPUTFILE : TEXT;
                      (* UPDATING *) VAR CURRCHAR,
                                         NEXTCHAR  : CHARINFO;
                                     VAR NAME      : KEYSYMBOL;
                                     VAR VALUE     : STRING;
                                     VAR LENGTH    : INTEGER   );

BEGIN

   NAME := OPENCOMMENT;

   WHILE NOT (    ((CURRCHAR.VALUE = '*') AND (NEXTCHAR.VALUE= ')'))
               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

   END;


FUNCTION IDTYPE( (* OF        *) VALUE  : STRING;
                 (* USING     *) LENGTH : INTEGER )
                 (* RETURNING *)                   : KEYSYMBOL;

VAR
   I: INTEGER;

   KEYVALUE: KEY;

   HIT: BOOLEAN;

   THISKEY: KEYSYMBOL;


BEGIN

   IDTYPE := OTHERSYM;

   IF LENGTH <= MAXKEYLENGTH THEN BEGIN

      FOR I := 1 TO LENGTH DO
            KEYVALUE [I] := VALUE [I];

      FOR I := LENGTH+1 TO MAXKEYLENGTH DO
         KEYVALUE [I] := SPACE;

      THISKEY := PROGSYM;
      HIT     := FALSE;

      WHILE NOT (HIT OR (PRED(THISKEY) = UNTILSYM)) DO
         IF KEYVALUE = KEYWORD [THISKEY] THEN
            HIT := TRUE
         ELSE
            THISKEY := SUCC(THISKEY);

      IF HIT THEN
         IDTYPE := THISKEY

      END;

   END;


PROCEDURE GETIDENTIFIER( (* FROM *)		  VAR INPUTFILE : TEXT;
                         (* UPDATING *)   VAR CURRCHAR,
                                              NEXTCHAR  : CHARINFO;
                         (* RETURNING  *) VAR NAME      : KEYSYMBOL;
                                          VAR VALUE     : STRING;
                                          VAR LENGTH    : INTEGER   );

BEGIN

   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

   END;


PROCEDURE GETNUMBER( (* FROM *)		 VAR INPUTFILE : TEXT;
                     (* UPDATING *)  VAR CURRCHAR,
                                         NEXTCHAR  : CHARINFO;
                     (* RETURNING *) VAR NAME      : KEYSYMBOL;
                                     VAR VALUE     : STRING;
                                     VAR LENGTH    : INTEGER   );

BEGIN

   WHILE NEXTCHAR.NAME = DIGIT DO

      STORENEXTCHAR( (* FROM *)		INPUTFILE,
                     (* UPDATING *) LENGTH,
                                    CURRCHAR,
                                    NEXTCHAR,
                     (* IN *)       VALUE    );

   NAME := OTHERSYM

END;


PROCEDURE GETCHARLITERAL( (* FROM *)	  VAR INPUTFILE : TEXT;
                          (* UPDATING *)  VAR CURRCHAR,
                                              NEXTCHAR  : CHARINFO;
                          (* RETURNING *) VAR NAME      : KEYSYMBOL;
                                          VAR VALUE     : STRING;
                                          VAR LENGTH    : INTEGER   );

BEGIN

   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;


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

VAR
   NEXTTWOCHARS    : SPECIALCHAR;

   HIT             : BOOLEAN;

   THISCHAR        : KEYSYMBOL;


BEGIN

   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 := SEMICOLON;

      WHILE NOT (HIT OR (PRED(THISCHAR) = PERIOD)) DO
         IF CURRCHAR.VALUE = SGLCHAR [THISCHAR] THEN
            HIT := TRUE
         ELSE
            THISCHAR := SUCC(THISCHAR)

      END;

   IF HIT THEN
      CHARTYPE := THISCHAR
   ELSE
      CHARTYPE := OTHERSYM

   END;


PROCEDURE GETSPECIALCHAR( (* FROM *)      VAR INPUTFILE : TEXT;
                          (* UPDATING *)  VAR CURRCHAR,
                                              NEXTCHAR  : CHARINFO;
                          (* RETURNING *) VAR NAME      : KEYSYMBOL;
                                          VAR VALUE     : STRING;
                                          VAR LENGTH    : INTEGER   );

BEGIN

   STORENEXTCHAR( (* FROM *)	 INPUTFILE,
                  (* UPDATING *) LENGTH,
                                 CURRCHAR,
                                 NEXTCHAR,
                  (* IN *)       VALUE     );

   NAME := CHARTYPE( (* OF *) CURRCHAR,
                              NEXTCHAR );

   IF NAME IN DBLCHARS THEN
      STORENEXTCHAR( (* FROM *)		INPUTFILE,
                     (* UPDATING *) LENGTH,
                                    CURRCHAR,
                                    NEXTCHAR,
                     (* IN *)       VALUE    );

END;


PROCEDURE GETNEXTSYMBOL( (* FROM *)		 VAR INPUTFILE : TEXT;
                         (* UPDATING *)  VAR CURRCHAR,
                                             NEXTCHAR  : CHARINFO;
                         (* RETURNING *) VAR NAME      : KEYSYMBOL;
                                         VAR VALUE     : STRING;
                                         VAR LENGTH    : INTEGER   );

BEGIN

   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

   END

END;


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

VAR
   DUMMY: SYMBOLINFO;

BEGIN

   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;

END;


PROCEDURE INITIALISE( (* RETURNING *)
                      VAR INPUTFILE, 
					      OUTPUTFILE   : TEXT;

                      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

   RESET(INPUTFILE);
   REWRITE(OUTPUTFILE);

   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;


   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,
                             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 ];
      DINDENTSYMBOLS    := [];
      GOBBLETERMINATORS := []
      END;

   WITH PPOPTION [ CONSTSYM ] DO BEGIN
      OPTIONSSELECTED   := [ BLANKLINEBEFORE,
                             DINDENTONKEYS,
                             SPACEAFTER,
                             INDENTTOCLP ];
      DINDENTSYMBOLS    := [ LABELSYM ];
      GOBBLETERMINATORS := []
      END;

   WITH PPOPTION [ TYPESYM ] DO BEGIN
      OPTIONSSELECTED   := [ BLANKLINEBEFORE,
                             DINDENTONKEYS,
                             SPACEAFTER,
                             INDENTTOCLP ];
      DINDENTSYMBOLS    := [ LABELSYM,
                             CONSTSYM ];
      GOBBLETERMINATORS := []
      END;

   WITH PPOPTION [ VARSYM ] DO BEGIN
      OPTIONSSELECTED   := [ BLANKLINEBEFORE,
                             DINDENTONKEYS,
                             SPACEAFTER,
                             INDENTTOCLP ];
      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;

   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;



FUNCTION STACKEMPTY (* RETURNING *) : BOOLEAN;

BEGIN

   IF TOP = 0 THEN
      STACKEMPTY := TRUE
   ELSE
      STACKEMPTY := FALSE

END;


FUNCTION STACKFULL (* RETURNING *) : BOOLEAN;

BEGIN

   IF TOP = MAXSTACKSIZE THEN
      STACKFULL := TRUE
   ELSE
      STACKFULL := FALSE

END;


PROCEDURE POPSTACK( (* RETURNING *) VAR INDENTSYMBOL : KEYSYMBOL;
                                    VAR PREVMARGIN   : INTEGER);

BEGIN

   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;


PROCEDURE PUSHSTACK( (* USING *) INDENTSYMBOL   : KEYSYMBOL;
                                 PREVMARGIN     : INTEGER   );

BEGIN

   TOP := TOP + 1;

   STACK[TOP].INDENTSYMBOL := INDENTSYMBOL;
   STACK[TOP].PREVMARGIN   := PREVMARGIN;

END;


PROCEDURE WRITECRS( (* USING *)          NUMBEROFCRS : INTEGER;
                    (* UPDATING *)   VAR CURRLINEPOS : INTEGER;
                    (* WRITING TO *) VAR OUTPUTFILE  : TEXT    );

VAR
   I: INTEGER;

BEGIN

   IF NUMBEROFCRS > 0 THEN BEGIN

      FOR I := 1 TO NUMBEROFCRS DO
         WRITELN(OUTPUTFILE);

      CURRLINEPOS := 0

      END

   END;


PROCEDURE INSERTCR( (* UPDATING *)   VAR CURRSYM    : SYMBOLINFO;
                    (* WRITING TO *) VAR OUTPUTFILE : TEXT       );

CONST
   ONCE            = 1;

BEGIN

   IF CURRSYM^.CRSBEFORE  = 0 THEN BEGIN

      WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS,
                      (* WRITING TO *) OUTPUTFILE  );

      CURRSYM^.SPACESBEFORE := 0

      END

END;


PROCEDURE INSERTBLANKLINE( (* UPDATING *)   VAR CURRSYM    : SYMBOLINFO;
                           (* WRITING TO *) VAR OUTPUTFILE : TEXT       );

CONST
   ONCE            = 1;
   TWICE           = 2;

BEGIN

   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;


PROCEDURE LSHIFTON( (* USING *) DINDENTSYMBOLS : KEYSYMSET );

VAR
   INDENTSYMBOL    : KEYSYMBOL;
   PREVMARGIN      : INTEGER;

BEGIN

   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;


PROCEDURE LSHIFT;

VAR
   INDENTSYMBOL    : KEYSYMBOL;
   PREVMARGIN      : INTEGER;

BEGIN

   IF NOT STACKEMPTY THEN BEGIN
      POPSTACK( (* RETURNING *) INDENTSYMBOL,
                                PREVMARGIN   );
      CURRMARGIN := PREVMARGIN
   END

END;


PROCEDURE INSERTSPACE( (* USING *)      VAR SYMBOL     : SYMBOLINFO;
                       (* WRITING TO *) VAR OUTPUTFILE : TEXT       );

BEGIN

   IF CURRLINEPOS < MAXLINESIZE THEN BEGIN

      WRITE(OUTPUTFILE,SPACE);

      CURRLINEPOS := CURRLINEPOS + 1;

      WITH SYMBOL^ DO
         IF (CRSBEFORE = 0) AND (SPACESBEFORE > 0) THEN
            SPACESBEFORE := SPACESBEFORE - 1

      END

END;


PROCEDURE MOVELINEPOS( (* TO *)             NEWLINEPOS  : INTEGER;
                       (* FROM *)       VAR CURRLINEPOS : INTEGER;
                       (* WRITING TO *) VAR OUTPUTFILE : TEXT     );

VAR
   I: INTEGER;

BEGIN

   FOR I := CURRLINEPOS+1 TO NEWLINEPOS DO
      WRITE(OUTPUTFILE, SPACE);

   CURRLINEPOS := NEWLINEPOS

END;


PROCEDURE PRINTSYMBOL( (* IN *)         CURRSYM         : SYMBOLINFO;
                       (* UPDATING *)   VAR CURRLINEPOS : INTEGER;
                       (* WRITING TO *) VAR OUTPUTFILE  : TEXT       );

VAR
   I: INTEGER;

BEGIN

   WITH CURRSYM^ DO BEGIN

      FOR I := 1 TO LENGTH DO
         WRITE(OUTPUTFILE, VALUE[I]);

      CURRLINEPOS := CURRLINEPOS + LENGTH

   END

END;


PROCEDURE PPSYMBOL( (* IN *)             CURRSYM : SYMBOLINFO;
                    (* WRITING TO *) VAR OUTPUTFILE : TEXT    );

CONST
   ONCE            = 1;

VAR
   NEWLINEPOS      : INTEGER;

BEGIN

   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

END;


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

BEGIN

   RSHIFTTOCLP( (* USING *) CURRSYM^.NAME );

   WHILE NOT (NEXTSYM^.NAME IN (TERMINATORS + [ ENDOFFILE ] )) DO BEGIN

      GETSYMBOL( (* FROM *)	     INPUTFILE,
                 (* UPDATING *)  NEXTSYM,
                 (* RETURNING *) CURRSYM );

      PPSYMBOL ( (* IN *)         CURRSYM,
                 (* WRITING TO *) OUTPUTFILE )

      END;

   LSHIFT

END;


PROCEDURE RSHIFT( (* USING *) CURRSYM : KEYSYMBOL );

BEGIN

   IF NOT STACKFULL THEN
      PUSHSTACK( (* USING *) CURRSYM,
                             CURRMARGIN );

   IF CURRMARGIN < SLOFAIL1 THEN
      CURRMARGIN := CURRMARGIN + INDENT1
   ELSE
      IF CURRMARGIN < SLOFAIL2 THEN
         CURRMARGIN := CURRMARGIN + INDENT2

END;


PROCEDURE RSHIFTTOCLP;

BEGIN

   IF NOT STACKFULL THEN
      PUSHSTACK( (* USING *) CURRSYM,
                             CURRMARGIN);

   CURRMARGIN := CURRLINEPOS;

END;

BEGIN

   INITIALISE( INPUTFILE,  OUTPUTFILE,  TOP,        CURRLINEPOS,
               CURRMARGIN, KEYWORD    , DBLCHARS,   DBLCHAR,
               SGLCHAR   , RECORDSEEN , CURRCHAR,   NEXTCHAR,
               CURRSYM   , NEXTSYM    , PPOPTION  );

   CRPENDING := FALSE;

   WHILE (NEXTSYM^.NAME <> ENDOFFILE) DO BEGIN

      GETSYMBOL( (* FROM *)	     INPUTFILE,
                 (* 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 );

            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 *) INPUTFILE,
                       (* UP TO *)        GOBBLETERMINATORS,
                       (* UPDATING *)     CURRSYM,
                                          NEXTSYM,
                       (* WRITING TO *)   OUTPUTFILE );

            IF CRAFTER IN OPTIONSSELECTED THEN
                  CRPENDING := TRUE;

         END;

   END;

   IF CRPENDING THEN
      WRITELN(OUTPUTFILE);

END.