0                                                                         00000100     
1 (*====================================================================*)00000200     
2 (*                                                                    *)00000300     
3 (*  PROGRAM TITLE: PASCAL PRETTYPRINTING PROGRAM                      *)00000400     
4 (*                                                                    *)00000500     
5 (*  AUTHORS: JON F. HUERAS AND HENRY F. LEDGARD                       *)00000600     
6 (*           COMPUTER AND INFORMATION SCIENCE DEPARTMENT              *)00000700     
7 (*           UNIVERSITY OF MASSACHUSETTS, AMHERST                     *)00000800     
8 (*           (EARLIER VERSIONS AND CONTRIBUTIONS BY RANDY CHOW        *)00000900     
9 (*            AND JOHN GORMAN.)                                       *)00001000     
10 (*                                                                    *)00001100     
11 (*  PROGRAM SUMMARY:                                                  *)00001200     
12 (*                                                                    *)00001300     
13 (*     THIS PROGRAM TAKES AS INPUT A PASCAL PROGRAM AND               *)00001400     
14 (*     REFORMATS THE PROGRAM ACCORDING TO A STANDARD SET OF           *)00001500     
15 (*     PRETTYPRINTING RULES. THE PRETTYPRINTED PROGRAM IS GIVEN       *)00001600     
16 (*     AS OUTPUT.  THE PRETTYPRINTING RULES ARE GIVEN BELOW.          *)00001700     
17 (*                                                                    *)00001800     
18 (*     AN IMPORTANT FEATURE IS THE PROVISION FOR THE USE OF EXTRA     *)00001900     
19 (*     SPACES AND EXTRA BLANK LINES.  THEY MAY BE FREELY INSERTED BY  *)00002000     
20 (*     THE USER IN ADDITION TO THE SPACES AND BLANK LINES INSERTED    *)00002100     
21 (*     BY THE PRETTYPRINTER.                                          *)00002200     
22 (*                                                                    *)00002300     
23 (*     NO ATTEMPT IS MADE TO DETECT OR CORRECT SYNTACTIC ERRORS IN    *)00002400     
24 (*     THE USER'S PROGRAM.  HOWEVER, SYNTACTIC ERRORS MAY RESULT IN   *)00002500     
25 (*     ERRONEOUS PRETTYPRINTING.                                      *)00002600     
26 (*                                                                    *)00002700     
27 (*                                                                    *)00002800     
28 (*  INPUT FILE: INPUTFILE    - A FILE OF CHARACTERS, PRESUMABLY A     *)00002900     
29 (*                             PASCAL PROGRAM OR PROGRAM FRAGMENT.    *)00003000     
30 (*                                                                    *)00003100     
31 (*  OUTPUT FILES: OUTPUTFILE - THE PRETTYPRINTED PROGRAM.             *)00003200     
32 (*                                                                    *)00003300     
33 (*                OUTPUT     - STANDARD PASCAL FILE FOR RUNTIME       *)00003400     
34 (*                             MESSAGES.                              *)00003500     
35 (*                                                                    *)00003600     
36 (*                                                                    *)00003700     
37 (*====================================================================*)00003800     
38                                                                         00003900     
39 (* $Z *)                                                                00004000     
40                                                                         00004100     
41 (*====================================================================*)00004200     
42 (*                                                                    *)00004300     
43 (*                   PASCAL PRETTYPRINTING RULES                      *)00004400     
44 (*                                                                    *)00004500     
45 (*                                                                    *)00004600     
46 (*  [ GENERAL PRETTYPRINTING RULES ]                                  *)00004700     
47 (*                                                                    *)00004800     
48 (*   1.   ANY SPACES OR BLANK LINES BEYOND THOSE GENERATED BY THE     *)00004900     
49 (*     PRETTYPRINTER ARE LEFT ALONE.  THE USER IS ENCOURAGED, FOR THE *)00005000     
50 (*     SAKE OF READABILITY, TO MAKE USE OF THIS FACILITY.             *)00005100     
51 (*        IN ADDITION, COMMENTS ARE LEFT WHERE THEY ARE FOUND, UNLESS *)00005200     
52 (*     THEY ARE SHIFTED RIGHT BY PRECEEDING TEXT ON A LINE.           *)00005300     
53 (*                                                                    *)00005400     
54 (*   2.   ALL STATEMENTS AND DECLARATIONS BEGIN ON SEPARATE LINES.    *)00005500     
55 (*                                                                    *)00005600     
56 (*   3.   NO LINE MAY BE GREATER THAN 72 CHARACTERS LONG.  ANY LINE   *)00005700     
57 (*     LONGER THAN THIS IS CONTINUED ON A SEPARATE LINE.              *)00005800     
58 (*                                                                    *)00005900     
59 (*   4.   THE KEYWORDS "BEGIN", "END", "REPEAT", AND "RECORD" ARE     *)00006000     
60 (*     FORCED TO STAND ON LINES BY THEMSELVES (OR POSSIBLY FOLLWED BY *)00006100     
61 (*     SUPPORTING COMMENTS).                                          *)00006200     
62 (*        IN  ADDITION, THE "UNTIL" CLAUSE OF A "REPEAT-UNTIL" STATE- *)00006300     
63 (*     MENT IS FORCED TO START ON A NEW LINE.                         *)00006400     
64 (*                                                                    *)00006500     
65 (*   5.   A BLANK LINE IS FORCED BEFORE THE KEYWORDS "PROGRAM",       *)00006600     
66 (*     "PROCEDURE", "FUNCTION", "LABEL", "CONST", "TYPE", AND "VAR".  *)00006700     
67 (*                                                                    *)00006800     
68 (*   6.   A SPACE IS FORCED BEFORE AND AFTER THE SYMBOLS ":=" AND     *)00006900     
69 (*     "=".  ADDITIONALLY, A SPACE IS FORCED AFTER THE SYMBOL ":".    *)00007000     
70 (*                                                                    *)00007100     
71 (*                                                                    *)00007200     
72 (*  [ INDENTATION RULES ]                                             *)00007300     
73 (*                                                                    *)00007400     
74 (*   1.   THE BODIES OF "LABEL", "CONST", "TYPE", AND "VAR" DECLARA-  *)00007500     
75 (*     TIONS ARE INDENTED FROM THEIR CORRESPONDING DECLARATION HEADER *)00007600     
76 (*     KEYWORDS.                                                      *)00007700     
77 (*                                                                    *)00007800     
78 (*   2.   THE BODIES OF "BEGIN-END", "REPEAT-UNTIL", "FOR", "WHILE",  *)00007900     
79 (*     "WITH", AND "CASE" STATEMENTS, AS WELL AS "RECORD-END" STRUC-  *)00008000     
80 (*     TURES AND "CASE" VARIANTS (TO ONE LEVEL) ARE INDENTED FROM     *)00008100     
81 (*     THEIR HEADER KEYWORDS.                                         *)00008200     
82 (*                                                                    *)00008300     
83 (*   3.   AN "IF-THEN-ELSE" STATEMENT IS INDENTED AS FOLLOWS:         *)00008400     
84 (*                                                                    *)00008500     
85 (*             IF <EXPRESSION>                                        *)00008600     
86 (*                THEN                                                *)00008700     
87 (*                   <STATEMENT>                                      *)00008800     
88 (*                ELSE                                                *)00008900     
89 (*                   <STATEMENT>                                      *)00009000     
90 (*                                                                    *)00009100     
91 (*                                                                    *)00009200     
92 (*====================================================================*)00009300     
93                                                                         00009400     
94 (* $Z *)                                                                00009500     
95                                                                         00009600     
96 (*====================================================================*)00009700     
97 (*                                                                    *)00009800     
98 (*                      GENERAL ALGORITHM                             *)00009900     
99 (*                                                                    *)00010000     
100 (*                                                                    *)00010100     
101 (*      THE STRATEGY OF THE PRETTYPRINTER IS TO SCAN SYMBOLS FROM     *)00010200     
102 (*   THE INPUT PROGRAM AND MAP EACH SYMBOL INTO A PRETTYPRINTING      *)00010300     
103 (*   ACTION, INDEPENDENTLY OF THE CONTEXT IN WHICH THE SYMBOL         *)00010400     
104 (*   APPEARS.  THIS IS ACCOMPLISHED BY A TABLE OF PRETTYPRINTING      *)00010500     
105 (*   OPTIONS.                                                         *)00010600     
106 (*                                                                    *)00010700     
107 (*      FOR EACH DISTINGUISHED SYMBOL IN THE TABLE, THERE IS AN       *)00010800     
108 (*   ASSOCIATED SET OF OPTIONS.  IF THE OPTION HAS BEEN SELECTED FOR  *)00010900     
109 (*   THE SYMBOL BEING SCANNED, THEN THE ACTION CORRESPONDING WITH     *)00011000     
110 (*   EACH OPTION IS PERFORMED.                                        *)00011100     
111 (*                                                                    *)00011200     
112 (*      THE BASIC ACTIONS INVOLVED IN PRETTYPRINTING ARE THE INDENT-  *)00011300     
113 (*   ATION AND DE-INDENTATION OF THE MARGIN.  EACH TIME THE MARGIN IS *)00011400     
114 (*   INDENTED, THE PREVIOUS VALUE OF THE MARGIN IS PUSHED ONTO A      *)00011500     
115 (*   STACK, ALONG WITH THE NAME OF THE SYMBOL THAT CAUSED IT TO BE    *)00011600     
116 (*   INDENTED.  EACH TIME THE MARGIN IS DE-INDENTED, THE STACK IS     *)00011700     
117 (*   POPPED OFF TO OBTAIN THE PREVIOUS VALUE OF THE MARGIN.           *)00011800     
118 (*                                                                    *)00011900     
119 (*      THE PRETTYPRINTING OPTIONS ARE PROCESSED IN THE FOLLOWING     *)00012000     
120 (*   ORDER, AND INVOKE THE FOLLOWING ACTIONS:                         *)00012100     
121 (*                                                                    *)00012200     
122 (*                                                                    *)00012300     
123 (*     CRSUPPRESS      - IF A CARRIAGE RETURN HAS BEEN INSERTED       *)00012400     
124 (*                       FOLLOWING THE PREVIOUS SYMBOL, THEN IT IS    *)00012500     
125 (*                       INHIBITED UNTIL THE NEXT SYMBOL IS PRINTED.  *)00012600     
126 (*                                                                    *)00012700     
127 (*     CRBEFORE        - A CARRIAGE RETURN IS INSERTED BEFORE THE     *)00012800     
128 (*                       CURRENT SYMBOL (UNLESS ONE IS ALREADY THERE) *)00012900     
129 (*                                                                    *)00013000     
130 (*     BLANKLINEBEFORE - A BLANK LINE IS INSERTED BEFORE THE CURRENT  *)00013100     
131 (*                       SYMBOL (UNLESS ALREADY THERE).               *)00013200     
132 (*                                                                    *)00013300     
133 (*     DINDENTONKEYS   - IF ANY OF THE SPECIFIED KEYS ARE ON TOP OF   *)00013400     
134 (*                       OF THE STACK, THE STACK IS POPPED, DE-INDEN- *)00013500     
135 (*                       TING THE MARGIN.  THE PROCESS IS REPEATED    *)00013600     
136 (*                       UNTIL THE TOP OF THE STACK IS NOT ONE OF THE *)00013700     
137 (*                       SPECIFIED KEYS.                              *)00013800     
138 (*                                                                    *)00013900     
139 (*     DINDENT         - THE STACK IS UNCONDITIONALLY POPPED AND THE  *)00014000     
140 (*                       MARGIN IS DE-INDENTED.                       *)00014100     
141 (*                                                                    *)00014200     
142 (*     SPACEBEFORE     - A SPACE IS INSERTED BEFORE THE SYMBOL BEING  *)00014300     
143 (*                       SCANNED (UNLESS ALREADY THERE).              *)00014400     
144 (*                                                                    *)00014500     
145 (*     [ THE SYMBOL IS PRINTED AT THIS POINT ]                        *)00014600     
146 (*                                                                    *)00014700     
147 (*     SPACEAFTER      - A SPACE IS INSERTED AFTER THE SYMBOL BEING   *)00014800     
148 (*                       SCANNED (UNLESS ALREADY THERE).              *)00014900     
149 (*                                                                    *)00015000     
150 (*     GOBBLESYMBOLS   - SYMBOLS ARE CONTINUOUSLY SCANNED AND PRINTED *)00015100     
151 (*                       WITHOUT ANY PROCESSING UNTIL ONE OF THE      *)00015200     
152 (*                       SPECIFIED SYMBOLS IS SEEN (BUT NOT GOBBLED). *)00015300     
153 (*                                                                    *)00015400     
154 (*     INDENTBYTAB     - THE MARGIN IS INDENTED BY A STANDARD AMOUNT  *)00015500     
155 (*                       FROM THE PREVIOUS MARGIN.                    *)00015600     
156 (*                                                                    *)00015700     
157 (*     INDENTTOCLP     - THE MARGIN IS INDENTED TO THE CURRENT LINE   *)00015800     
158 (*                       POSITION.                                    *)00015900     
159 (*                                                                    *)00016000     
160 (*     CRAFTER         - A CARRIAGE RETURN IS INSERTED FOLLOWING THE  *)00016100     
161 (*                       SYMBOL SCANNED.                              *)00016200     
162 (*                                                                    *)00016300     
163 (*                                                                    *)00016400     
164 (*                                                                    *)00016500     
165 (*====================================================================*)00016600     
166                                                                         00016700     
167 (* $Z *)                                                                00016800     
168                                                                         00016900     
169 PROGRAM PRETTYPRINT( (* FROM *)  INPUTFILE,                             00017000     
170                      (* TO *)    OUTPUTFILE,                            00017100     
171                      (* USING *) OUTPUT     );                          00017200     
172                                                                         00017300     
173                                                                         00017400     
174 CONST                                                                   00017500     
175                                                                         00017600     
176       MAXSYMBOLSIZE = 200; (* THE MAXIMUM SIZE (IN CHARACTERS) OF A   *)00017700     
177                            (* SYMBOL SCANNED BY THE LEXICAL SCANNER.  *)00017800     
178                                                                         00017900     
179       MAXSTACKSIZE  = 100; (* THE MAXIMUM NUMBER OF SYMBOLS CAUSING   *)00018000     
180                            (* INDENTATION THAT MAY BE STACKED.        *)00018100     
181                                                                         00018200     
182       MAXKEYLENGTH  =  10; (* THE MAXIMUM LENGTH (IN CHARACTERS) OF A *)00018300     
183                            (* PASCAL RESERVED KEYWORD.                *)00018400     
184       MAXLINESIZE   =  72; (* THE MAXIMUM SIZE (IN CHARACTERS) OF A   *)00018500     
185                            (* LINE OUTPUT BY THE PRETTYPRINTER.       *)00018600     
186                                                                         00018700     
187       SLOWFAIL1     =  30; (* UP TO THIS COLUMN POSITION, EACH TIME   *)00018800     
188                            (* "INDENTBYTAB" IS INVOKED, THE MARGIN    *)00018900     
189                            (* WILL BE INDENTED BY "INDENT1".          *)00019000     
190                                                                         00019100     
191       SLOWFAIL2     =  48; (* UP TO THIS COLUMN POSITION, EACH TIME   *)00019200     
192                            (* "INDENTBYTAB" IS INVOKED, THE MARGIN    *)00019300     
193                            (* WILL BE INDENTED BY "INDENT2".  BEYOND  *)00019400     
194                            (* THIS, NO INDENTATION OCCURS.            *)00019500     
195                                                                         00019600     
196       INDENT1       =   3;                                              00019700     
197                                                                         00019800     
198       INDENT2       =   1;                                              00019900     
199                                                                         00020000     
200                                                                         00020100     
201       SPACE = ' ';                                                      00020200     
202                                                                         00020300     
203 (* $Z *)                                                                00020400     
204                                                                         00020500     
205 TYPE                                                                    00020600     
206                                                                         00020700     
207      KEYSYMBOL = ( PROGSYM,    FUNCSYM,     PROCSYM,                    00020800     
208                    LABELSYM,   CONSTSYM,    TYPESYM,   VARSYM,          00020900     
209                    BEGINSYM,   REPEATSYM,   RECORDSYM,                  00021000     
210                    CASESYM,    CASEVARSYM,  OFSYM,                      00021100     
211                    FORSYM,     WHILESYM,    WITHSYM,   DOSYM,           00021200     
212                    IFSYM,      THENSYM,     ELSESYM,                    00021300     
213                    ENDSYM,     UNTILSYM,                                00021400     
214                    BECOMES,    OPENCOMMENT, CLOSECOMMENT,               00021500     
215                    SEMICOLON,  COLON,       EQUALS,                     00021600     
216                    OPENPAREN,  CLOSEPAREN,  PERIOD,                     00021700     
217                    ENDOFFILE,                                           00021800     
218                    OTHERSYM );                                          00021900     
219                                                                         00022000     
220      OPTION = ( CRSUPPRESS,                                             00022100     
221                 CRBEFORE,                                               00022200     
222                 BLANKLINEBEFORE,                                        00022300     
223                 DINDENTONKEYS,                                          00022400     
224                 DINDENT,                                                00022500     
225                 SPACEBEFORE,                                            00022600     
226                 SPACEAFTER,                                             00022700     
227                 GOBBLESYMBOLS,                                          00022800     
228                 INDENTBYTAB,                                            00022900     
229                 INDENTTOCLP,                                            00023000     
230                 CRAFTER );                                              00023100     
231                                                                         00023200     
232      OPTIONSET = SET OF OPTION;                                         00023300     
233                                                                         00023400     
234      KEYSYMSET = SET OF KEYSYMBOL;                                      00023500     
235                                                                         00023600     
236      TABLEENTRY = RECORD                                                00023700     
237                      OPTIONSSELECTED  : OPTIONSET;                      00023800     
238                      DINDENTSYMBOLS   : KEYSYMSET;                      00023900     
239                      GOBBLETERMINATORS: KEYSYMSET                       00024000     
240                   END;                                                  00024100     
241                                                                         00024200     
242      OPTIONTABLE = ARRAY [ KEYSYMBOL ] OF TABLEENTRY;                   00024300     
243                                                                         00024400     
244 (* $Z *)                                                                00024500     
245                                                                         00024600     
246      KEY = PACKED ARRAY [ 1..MAXKEYLENGTH ] OF CHAR;                    00024700     
247                                                                         00024800     
248                                                                         00024900     
249      KEYWORDTABLE = ARRAY [ PROGSYM..UNTILSYM ] OF KEY;                 00025000     
250                                                                         00025100     
251                                                                         00025200     
252      SPECIALCHAR = PACKED ARRAY [ 1..2 ] OF CHAR;                       00025300     
253                                                                         00025400     
254      DBLCHRSET = SET OF BECOMES..OPENCOMMENT;                           00025500     
255                                                                         00025600     
256      DBLCHARTABLE = ARRAY [ BECOMES..OPENCOMMENT ] OF SPECIALCHAR;      00025700     
257                                                                         00025800     
258      SGLCHARTABLE = PACKED ARRAY [ SEMICOLON..PERIOD ] OF CHAR;         00025900     
259                                                                         00026000     
260                                                                         00026100     
261      STRING = PACKED ARRAY [ 1..MAXSYMBOLSIZE ] OF CHAR;                00026200     
262                                                                         00026300     
263      SYMBOL = RECORD                                                    00026400     
264                  NAME        : KEYSYMBOL;                               00026500     
265                  VALUE       : STRING;                                  00026600     
266                  LENGTH      : INTEGER;                                 00026700     
267                  SPACESBEFORE: INTEGER;                                 00026800     
268                  CRSBEFORE   : INTEGER                                  00026900     
269               END;                                                      00027000     
270                                                                         00027100     
271      SYMBOLINFO = @SYMBOL;                                              00027200     
272                                                                         00027300     
273                                                                         00027400     
274      CHARNAME = ( LETTER,    DIGIT,    BLANK,    QUOTE,                 00027500     
275                   ENDOFLINE, FILEMARK, OTHERCHAR       );               00027600     
276                                                                         00027700     
277      CHARINFO = PACKED RECORD                                           00027800     
278                    NAME : CHARNAME;                                     00027900     
279                    VALUE: CHAR                                          00028000     
280                 END;                                                    00028100     
281                                                                         00028200     
282                                                                         00028300     
283      STACKENTRY = RECORD                                                00028400     
284                      INDENTSYMBOL: KEYSYMBOL;                           00028500     
285                      PREVMARGIN  : INTEGER                              00028600     
286                   END;                                                  00028700     
287                                                                         00028800     
288      SYMBOLSTACK = ARRAY [ 1..MAXSTACKSIZE ] OF STACKENTRY;             00028900     
289                                                                         00029000     
290      TEXT = FILE(KIND=PRINTER) OF PACKED ARRAY[1:132] OF CHAR;          00029010     
291 (* $Z *)                                                                00029100     
292                                                                         00029200     
293 VAR                                                                     00029300     
294                                                                         00029400     
295     INPUTFILE:FILE(KIND=DISK,FILETYPE=7)                                00029500     
296       OF PACKED ARRAY[1:132] OF CHAR;                                   00029510     
297     OUTPUTFILE: FILE(KIND=DISK,MAXRECSIZE=132,UNITS=CHARACTERS)         00029600     
298       OF PACKED ARRAY[1:132] OF CHAR;                                   00029605     
299                                                                         00029700     
300     RECORDSEEN: BOOLEAN;                                                00029800     
301                                                                         00029900     
302     CURRCHAR,                                                           00030000     
303     NEXTCHAR: CHARINFO;                                                 00030100     
304                                                                         00030200     
305     CURRSYM,                                                            00030300     
306     NEXTSYM: SYMBOLINFO;                                                00030400     
307                                                                         00030500     
308     CRPENDING: BOOLEAN;                                                 00030600     
309                                                                         00030700     
310     PPOPTION: OPTIONTABLE;                                              00030800     
311                                                                         00030900     
312     KEYWORD: KEYWORDTABLE;                                              00031000     
313                                                                         00031100     
314     DBLCHARS: DBLCHRSET;                                                00031200     
315                                                                         00031300     
316     DBLCHAR: DBLCHARTABLE;                                              00031400     
317     SGLCHAR: SGLCHARTABLE;                                              00031500     
318                                                                         00031600     
319     STACK: SYMBOLSTACK;                                                 00031700     
320     TOP  : INTEGER;                                                     00031800     
321                                                                         00031900     
322     CURRLINEPOS,                                                        00032000     
323     CURRMARGIN :  INTEGER;                                              00032100     
324                                                                         00032200     
325 (* $Z *)                                                                00032300     
326                                                                         00032400     
327 PROCEDURE GETCHAR( (* FROM *)      VAR INPUTFILE : TEXT;                00032500     
328                    (* UPDATING *)  VAR NEXTCHAR  : CHARINFO;            00032600     
329                    (* RETURNING *) VAR CURRCHAR  : CHARINFO );          00032700     
330                                                                         00032800     
331 BEGIN (* GETCHAR *)                                                     00032900     
332                                                                         00033000     
333    CURRCHAR := NEXTCHAR;                                                00033100     
334                                                                         00033200     
335    WITH NEXTCHAR DO                                                     00033300     
336       BEGIN                                                             00033400     
337                                                                         00033500     
338       READ(INPUTFILE,VALUE);                                            00033510     
339          IF EOF(INPUTFILE)                                              00033600     
340             THEN                                                        00033700     
341                NAME  := FILEMARK                                        00033800     
342                                                                         00033900     
343     ELSE IF EOLN(INPUTFILE)                                             00034000     
344             THEN                                                        00034100     
345                NAME  := ENDOFLINE                                       00034200     
346                                                                         00034300     
347    ELSE                                                                 00034310     
348          IF (VALUE >= 'A') AND (VALUE <= 'Z')                           00034400     
349             THEN                                                        00034500     
350                NAME  := LETTER                                          00034600     
351                                                                         00034700     
352     ELSE IF (VALUE >='0') AND (VALUE <= '9')                            00034800     
353             THEN                                                        00034900     
354                NAME  := DIGIT                                           00035000     
355                                                                         00035100     
356     ELSE IF VALUE = "'"                                                 00035200     
357             THEN                                                        00035300     
358                NAME  := QUOTE                                           00035400     
359                                                                         00035500     
360     ELSE IF VALUE = SPACE                                               00035600     
361             THEN                                                        00035700     
362                NAME  := BLANK                                           00035800     
363                                                                         00035900     
364     ELSE NAME := OTHERCHAR;                                             00036000     
365                                                                         00036100     
366                                                                         00036200     
367          IF NAME IN [ FILEMARK, ENDOFLINE ]                             00036300     
368             THEN                                                        00036400     
369                VALUE := SPACE;                                          00036500     
370                                                                         00036800     
371                                                                         00037200     
372       END (* WITH *)                                                    00037300     
373                                                                         00037400     
374 END; (* GETCHAR *)                                                      00037500     
375                                                                         00037600     
376 (* $Z *)                                                                00037700     
377                                                                         00037800     
378 PROCEDURE STORENEXTCHAR( (* FROM *)        VAR INPUTFILE : TEXT;        00037900     
379                          (* UPDATING *)    VAR LENGTH    : INTEGER;     00038000     
380                                            VAR CURRCHAR,                00038100     
381                                                NEXTCHAR  : CHARINFO;    00038200     
382                          (* PLACING IN *)  VAR VALUE     : STRING   );  00038300     
383                                                                         00038400     
384 BEGIN (* STORENEXTCHAR *)                                               00038500     
385                                                                         00038600     
386    GETCHAR( (* FROM *)      INPUTFILE,                                  00038700     
387             (* UPDATING *)  NEXTCHAR,                                   00038800     
388             (* RETURNING *) CURRCHAR  );                                00038900     
389                                                                         00039000     
390    IF LENGTH < MAXSYMBOLSIZE                                            00039100     
391       THEN                                                              00039200     
392          BEGIN                                                          00039300     
393                                                                         00039400     
394             LENGTH := LENGTH + 1;                                       00039500     
395                                                                         00039600     
396             VALUE [LENGTH] := CURRCHAR.VALUE                            00039700     
397                                                                         00039800     
398          END                                                            00039900     
399                                                                         00040000     
400 END; (* STORENEXTCHAR *)                                                00040100     
401                                                                         00040200     
402 (* $Z *)                                                                00040300     
403                                                                         00040400     
404 PROCEDURE SKIPSPACES( (* IN *)        VAR INPUTFILE    : TEXT;          00040500     
405                       (* UPDATING *)  VAR CURRCHAR,                     00040600     
406                                           NEXTCHAR     : CHARINFO;      00040700     
407                       (* RETURNING *) VAR SPACESBEFORE,                 00040800     
408                                           CRSBEFORE    : INTEGER  );    00040900     
409                                                                         00041000     
410 BEGIN (* SKIPSPACES *)                                                  00041100     
411                                                                         00041200     
412    SPACESBEFORE := 0;                                                   00041210     
413    CRSBEFORE    := 0;                                                   00041300     
414                                                                         00041400     
415    WHILE NEXTCHAR.NAME IN [ BLANK, ENDOFLINE ] DO                       00041500     
416       BEGIN                                                             00041600     
417                                                                         00041700     
418          GETCHAR( (* FROM *)      INPUTFILE,                            00041800     
419                   (* UPDATING *)  NEXTCHAR,                             00041900     
420                   (* RETURNING *) CURRCHAR  );                          00042000     
421                                                                         00042100     
422          CASE CURRCHAR.NAME OF                                          00042200     
423                                                                         00042300     
424             BLANK     : SPACESBEFORE := SPACESBEFORE + 1;               00042400     
425                                                                         00042500     
426             ENDOFLINE : BEGIN                                           00042600     
427                            CRSBEFORE    := CRSBEFORE + 1;               00042700     
428                            SPACESBEFORE := 0                            00042800     
429                         END                                             00042900     
430                                                                         00043000     
431          END (* CASE *)                                                 00043100     
432                                                                         00043200     
433       END (* WHILE *)                                                   00043300     
434                                                                         00043400     
435 END; (* SKIPSPACES *)                                                   00043500     
436                                                                         00043600     
437 (* $Z *)                                                                00043700     
438                                                                         00043800     
439 PROCEDURE GETCOMMENT( (* FROM *)     VAR INPUTFILE : TEXT;              00043900     
440                       (* UPDATING *) VAR CURRCHAR,                      00044000     
441                                          NEXTCHAR  : CHARINFO;          00044100     
442                                      VAR NAME      : KEYSYMBOL;         00044200     
443                                      VAR VALUE     : STRING;            00044300     
444                                      VAR LENGTH    : INTEGER   );       00044400     
445                                                                         00044500     
446 BEGIN (* GETCOMMENT *)                                                  00044600     
447                                                                         00044700     
448    NAME := OPENCOMMENT;                                                 00044800     
449                                                                         00044900     
450    WHILE NOT(    ((CURRCHAR.VALUE = '*') AND (NEXTCHAR.VALUE = ')'))    00045000     
451               OR (NEXTCHAR.NAME = ENDOFLINE)                            00045100     
452               OR (NEXTCHAR.NAME = FILEMARK)) DO                         00045200     
453                                                                         00045300     
454       STORENEXTCHAR( (* FROM *)     INPUTFILE,                          00045400     
455                      (* UPDATING *) LENGTH,                             00045500     
456                                     CURRCHAR,                           00045600     
457                                     NEXTCHAR,                           00045700     
458                      (* IN *)       VALUE     );                        00045800     
459                                                                         00045900     
460                                                                         00046000     
461    IF (CURRCHAR.VALUE = '*') AND (NEXTCHAR.VALUE = ')')                 00046100     
462       THEN                                                              00046200     
463          BEGIN                                                          00046300     
464                                                                         00046400     
465             STORENEXTCHAR( (* FROM *)     INPUTFILE,                    00046500     
466                            (* UPDATING *) LENGTH,                       00046600     
467                                           CURRCHAR,                     00046700     
468                                           NEXTCHAR,                     00046800     
469                            (* IN *)       VALUE     );                  00046900     
470                                                                         00047000     
471             NAME := CLOSECOMMENT                                        00047100     
472                                                                         00047200     
473          END                                                            00047300     
474                                                                         00047400     
475 END; (* GETCOMMENT *)                                                   00047500     
476                                                                         00047600     
477 (* $Z *)                                                                00047700     
478                                                                         00047800     
479 FUNCTION IDTYPE( (* OF *)        VALUE  : STRING;                       00047900     
480                  (* USING *)     LENGTH : INTEGER )                     00048000     
481                  (* RETURNING *)                   : KEYSYMBOL;         00048100     
482                                                                         00048200     
483 VAR                                                                     00048300     
484     I: INTEGER;                                                         00048400     
485                                                                         00048500     
486     KEYVALUE: KEY;                                                      00048600     
487                                                                         00048700     
488     HIT: BOOLEAN;                                                       00048800     
489                                                                         00048900     
490     THISKEY: KEYSYMBOL;                                                 00049000     
491                                                                         00049100     
492                                                                         00049200     
493 BEGIN (* IDTYPE *)                                                      00049300     
494                                                                         00049400     
495    IDTYPE := OTHERSYM;                                                  00049500     
496                                                                         00049600     
497    IF LENGTH <= MAXKEYLENGTH                                            00049700     
498       THEN                                                              00049800     
499          BEGIN                                                          00049900     
500                                                                         00050000     
501             FOR I := 1 TO LENGTH DO                                     00050100     
502                KEYVALUE [I] := VALUE [I];                               00050200     
503                                                                         00050300     
504             FOR I := LENGTH+1 TO MAXKEYLENGTH DO                        00050400     
505                KEYVALUE [I] := SPACE;                                   00050500     
506                                                                         00050600     
507             THISKEY := PROGSYM;                                         00050700     
508             HIT     := FALSE;                                           00050800     
509                                                                         00050900     
510             WHILE NOT(HIT OR (THISKEY = BECOMES)) DO                    00051000     
511                IF KEYVALUE = KEYWORD [THISKEY]                          00051100     
512                   THEN                                                  00051200     
513                      HIT := TRUE                                        00051300     
514                   ELSE                                                  00051400     
515                      THISKEY := SUCC(THISKEY);                          00051500     
516                                                                         00051600     
517             IF HIT                                                      00051700     
518                THEN                                                     00051800     
519                   IDTYPE := THISKEY                                     00051900     
520                                                                         00052000     
521          END;                                                           00052100     
522                                                                         00052200     
523 END; (* IDTYPE *)                                                       00052300     
524                                                                         00052400     
525 (* $Z *)                                                                00052500     
526                                                                         00052600     
527 PROCEDURE GETIDENTIFIER( (* FROM *)      VAR INPUTFILE : TEXT;          00052700     
528                          (* UPDATING *)  VAR CURRCHAR,                  00052800     
529                                              NEXTCHAR  : CHARINFO;      00052900     
530                          (* RETURNING *) VAR NAME      : KEYSYMBOL;     00053000     
531                                          VAR VALUE     : STRING;        00053100     
532                                          VAR LENGTH    : INTEGER   );   00053200     
533                                                                         00053300     
534 BEGIN (* GETIDENTIFIER *)                                               00053400     
535                                                                         00053500     
536    WHILE NEXTCHAR.NAME IN [ LETTER, DIGIT ] DO                          00053600     
537                                                                         00053700     
538       STORENEXTCHAR( (* FROM *)     INPUTFILE,                          00053800     
539                      (* UPDATING *) LENGTH,                             00053900     
540                                     CURRCHAR,                           00054000     
541                                     NEXTCHAR,                           00054100     
542                      (* IN *)       VALUE     );                        00054200     
543                                                                         00054300     
544                                                                         00054400     
545    NAME := IDTYPE( (* OF *)    VALUE,                                   00054500     
546                    (* USING *) LENGTH );                                00054600     
547                                                                         00054700     
548    IF NAME IN [ RECORDSYM, CASESYM, ENDSYM ]                            00054800     
549       THEN                                                              00054900     
550          CASE NAME OF                                                   00055000     
551                                                                         00055100     
552             RECORDSYM : RECORDSEEN := TRUE;                             00055200     
553                                                                         00055300     
554             CASESYM   : IF RECORDSEEN                                   00055400     
555                            THEN                                         00055500     
556                               NAME := CASEVARSYM;                       00055600     
557                                                                         00055700     
558             ENDSYM    : RECORDSEEN := FALSE                             00055800     
559                                                                         00055900     
560          END (* CASE *)                                                 00056000     
561                                                                         00056100     
562 END; (* GETIDENTIFIER *)                                                00056200     
563                                                                         00056300     
564 (* $Z *)                                                                00056400     
565                                                                         00056500     
566 PROCEDURE GETNUMBER( (* FROM *)      VAR INPUTFILE : TEXT;              00056600     
567                      (* UPDATING *)  VAR CURRCHAR,                      00056700     
568                                          NEXTCHAR  : CHARINFO;          00056800     
569                      (* RETURNING *) VAR NAME      : KEYSYMBOL;         00056900     
570                                      VAR VALUE     : STRING;            00057000     
571                                      VAR LENGTH    : INTEGER   );       00057100     
572                                                                         00057200     
573 BEGIN (* GETNUMBER *)                                                   00057300     
574                                                                         00057400     
575    WHILE NEXTCHAR.NAME = DIGIT DO                                       00057500     
576                                                                         00057600     
577       STORENEXTCHAR( (* FROM *)     INPUTFILE,                          00057700     
578                      (* UPDATING *) LENGTH,                             00057800     
579                                     CURRCHAR,                           00057900     
580                                     NEXTCHAR,                           00058000     
581                      (* IN *)       VALUE     );                        00058100     
582                                                                         00058200     
583                                                                         00058300     
584    NAME := OTHERSYM                                                     00058400     
585                                                                         00058500     
586 END; (* GETNUMBER *)                                                    00058600     
587                                                                         00058700     
588 (* $Z *)                                                                00058800     
589                                                                         00058900     
590 PROCEDURE GETCHARLITERAL( (* FROM *)      VAR INPUTFILE : TEXT;         00059000     
591                           (* UPDATING *)  VAR CURRCHAR,                 00059100     
592                                               NEXTCHAR  : CHARINFO;     00059200     
593                           (* RETURNING *) VAR NAME      : KEYSYMBOL;    00059300     
594                                           VAR VALUE     : STRING;       00059400     
595                                           VAR LENGTH    : INTEGER   );  00059500     
596                                                                         00059600     
597 BEGIN (* GETCHARLITERAL *)                                              00059700     
598                                                                         00059800     
599    WHILE NEXTCHAR.NAME = QUOTE DO                                       00059900     
600       BEGIN                                                             00060000     
601                                                                         00060100     
602          STORENEXTCHAR( (* FROM *)     INPUTFILE,                       00060200     
603                         (* UPDATING *) LENGTH,                          00060300     
604                                        CURRCHAR,                        00060400     
605                                        NEXTCHAR,                        00060500     
606                         (* IN *)       VALUE     );                     00060600     
607                                                                         00060700     
608          WHILE NOT(NEXTCHAR.NAME IN [ QUOTE, ENDOFLINE, FILEMARK ]) DO  00060800     
609                                                                         00060900     
610             STORENEXTCHAR( (* FROM *)     INPUTFILE,                    00061000     
611                            (* UPDATING *) LENGTH,                       00061100     
612                                           CURRCHAR,                     00061200     
613                                           NEXTCHAR,                     00061300     
614                            (* IN *)       VALUE     );                  00061400     
615                                                                         00061500     
616                                                                         00061600     
617          IF NEXTCHAR.NAME = QUOTE                                       00061700     
618             THEN                                                        00061800     
619                STORENEXTCHAR( (* FROM *)     INPUTFILE,                 00061900     
620                               (* UPDATING *) LENGTH,                    00062000     
621                                              CURRCHAR,                  00062100     
622                                              NEXTCHAR,                  00062200     
623                               (* IN *)       VALUE     )                00062300     
624                                                                         00062400     
625       END;                                                              00062500     
626                                                                         00062600     
627                                                                         00062700     
628    NAME := OTHERSYM                                                     00062800     
629                                                                         00062900     
630 END; (* GETCHARLITERAL *)                                               00063000     
631                                                                         00063100     
632 (* $Z *)                                                                00063200     
633                                                                         00063300     
634 FUNCTION CHARTYPE( (* OF *)        CURRCHAR,                            00063400     
635                                    NEXTCHAR : CHARINFO )                00063500     
636                    (* RETURNING *)                      : KEYSYMBOL;    00063600     
637                                                                         00063700     
638 VAR                                                                     00063800     
639     NEXTTWOCHARS: SPECIALCHAR;                                          00063900     
640                                                                         00064000     
641     HIT: BOOLEAN;                                                       00064100     
642                                                                         00064200     
643     THISCHAR: KEYSYMBOL;                                                00064300     
644                                                                         00064400     
645                                                                         00064500     
646 BEGIN (* CHARTYPE *)                                                    00064600     
647                                                                         00064700     
648    NEXTTWOCHARS[1] := CURRCHAR.VALUE;                                   00064800     
649    NEXTTWOCHARS[2] := NEXTCHAR.VALUE;                                   00064900     
650                                                                         00065000     
651    THISCHAR := BECOMES;                                                 00065100     
652    HIT      := FALSE;                                                   00065200     
653                                                                         00065300     
654    WHILE NOT(HIT OR (THISCHAR = CLOSECOMMENT)) DO                       00065400     
655       IF NEXTTWOCHARS = DBLCHAR [THISCHAR]                              00065500     
656          THEN                                                           00065600     
657             HIT := TRUE                                                 00065700     
658          ELSE                                                           00065800     
659             THISCHAR := SUCC(THISCHAR);                                 00065900     
660                                                                         00066000     
661    IF NOT HIT                                                           00066100     
662       THEN                                                              00066200     
663          BEGIN                                                          00066300     
664                                                                         00066400     
665             THISCHAR := SEMICOLON;                                      00066500     
666                                                                         00066600     
667             WHILE NOT(HIT OR (PRED(THISCHAR) = PERIOD)) DO              00066700     
668                IF CURRCHAR.VALUE = SGLCHAR [THISCHAR]                   00066800     
669                   THEN                                                  00066900     
670                      HIT := TRUE                                        00067000     
671                   ELSE                                                  00067100     
672                      THISCHAR := SUCC(THISCHAR)                         00067200     
673                                                                         00067300     
674          END;                                                           00067400     
675                                                                         00067500     
676    IF HIT                                                               00067600     
677       THEN                                                              00067700     
678          CHARTYPE := THISCHAR                                           00067800     
679       ELSE                                                              00067900     
680          CHARTYPE := OTHERSYM                                           00068000     
681                                                                         00068100     
682 END; (* CHARTYPE *)                                                     00068200     
683                                                                         00068300     
684 (* $Z *)                                                                00068400     
685                                                                         00068500     
686 PROCEDURE GETSPECIALCHAR( (* FROM *)      VAR INPUTFILE : TEXT;         00068600     
687                           (* UPDATING *)  VAR CURRCHAR,                 00068700     
688                                               NEXTCHAR  : CHARINFO;     00068800     
689                           (* RETURNING *) VAR NAME      : KEYSYMBOL;    00068900     
690                                           VAR VALUE     : STRING;       00069000     
691                                           VAR LENGTH    : INTEGER   );  00069100     
692                                                                         00069200     
693 BEGIN (* GETSPECIALCHAR *)                                              00069300     
694                                                                         00069400     
695    STORENEXTCHAR( (* FROM *)     INPUTFILE,                             00069500     
696                   (* UPDATING *) LENGTH,                                00069600     
697                                  CURRCHAR,                              00069700     
698                                  NEXTCHAR,                              00069800     
699                   (* IN *)       VALUE     );                           00069900     
700                                                                         00070000     
701    NAME := CHARTYPE( (* OF *) CURRCHAR,                                 00070100     
702                               NEXTCHAR );                               00070200     
703                                                                         00070300     
704    IF NAME IN DBLCHARS                                                  00070400     
705       THEN                                                              00070500     
706                                                                         00070600     
707          STORENEXTCHAR( (* FROM *)     INPUTFILE,                       00070700     
708                         (* UPDATING *) LENGTH,                          00070800     
709                                        CURRCHAR,                        00070900     
710                                        NEXTCHAR,                        00071000     
711                         (* IN *)       VALUE     )                      00071100     
712                                                                         00071200     
713 END; (* GETSPECIALCHAR *)                                               00071300     
714                                                                         00071400     
715 (* $Z *)                                                                00071500     
716                                                                         00071600     
717 PROCEDURE GETNEXTSYMBOL( (* FROM *)      VAR INPUTFILE : TEXT;          00071700     
718                          (* UPDATING *)  VAR CURRCHAR,                  00071800     
719                                              NEXTCHAR  : CHARINFO;      00071900     
720                          (* RETURNING *) VAR NAME      : KEYSYMBOL;     00072000     
721                                          VAR VALUE     : STRING;        00072100     
722                                          VAR LENGTH    : INTEGER   );   00072200     
723                                                                         00072300     
724 BEGIN (* GETNEXTSYMBOL *)                                               00072400     
725                                                                         00072500     
726    CASE NEXTCHAR.NAME OF                                                00072600     
727                                                                         00072700     
728       LETTER      : GETIDENTIFIER( (* FROM *)      INPUTFILE,           00072800     
729                                    (* UPDATING *)  CURRCHAR,            00072900     
730                                                    NEXTCHAR,            00073000     
731                                    (* RETURNING *) NAME,                00073100     
732                                                    VALUE,               00073200     
733                                                    LENGTH    );         00073300     
734                                                                         00073400     
735       DIGIT       : GETNUMBER( (* FROM *)      INPUTFILE,               00073500     
736                                (* UPDATING *)  CURRCHAR,                00073600     
737                                                NEXTCHAR,                00073700     
738                                (* RETURNING *) NAME,                    00073800     
739                                                VALUE,                   00073900     
740                                                LENGTH    );             00074000     
741                                                                         00074100     
742       QUOTE       : GETCHARLITERAL( (* FROM *)      INPUTFILE,          00074200     
743                                     (* UPDATING *)  CURRCHAR,           00074300     
744                                                     NEXTCHAR,           00074400     
745                                     (* RETURNING *) NAME,               00074500     
746                                                     VALUE,              00074600     
747                                                     LENGTH    );        00074700     
748                                                                         00074800     
749       OTHERCHAR   : BEGIN                                               00074900     
750                                                                         00075000     
751                        GETSPECIALCHAR( (* FROM *)      INPUTFILE,       00075100     
752                                        (* UPDATING *)  CURRCHAR,        00075200     
753                                                        NEXTCHAR,        00075300     
754                                        (* RETURNING *) NAME,            00075400     
755                                                        VALUE,           00075500     
756                                                        LENGTH    );     00075600     
757                                                                         00075700     
758                        IF NAME = OPENCOMMENT                            00075800     
759                           THEN                                          00075900     
760                              GETCOMMENT( (* FROM *)     INPUTFILE,      00076000     
761                                          (* UPDATING *) CURRCHAR,       00076100     
762                                                         NEXTCHAR,       00076200     
763                                                         NAME,           00076300     
764                                                         VALUE,          00076400     
765                                                         LENGTH    )     00076500     
766                                                                         00076600     
767                     END;                                                00076700     
768                                                                         00076800     
769       FILEMARK    : NAME := ENDOFFILE                                   00076900     
770                                                                         00077000     
771    END (* CASE *)                                                       00077100     
772                                                                         00077200     
773 END; (* GETNEXTSYMBOL *)                                                00077300     
774                                                                         00077400     
775 (* $Z *)                                                                00077500     
776                                                                         00077600     
777 PROCEDURE GETSYMBOL( (* FROM *)      VAR INPUTFILE : TEXT;              00077700     
778                      (* UPDATING *)  VAR NEXTSYM   : SYMBOLINFO;        00077800     
779                      (* RETURNING *) VAR CURRSYM   : SYMBOLINFO );      00077900     
780                                                                         00078000     
781 VAR                                                                     00078100     
782     DUMMY: SYMBOLINFO;                                                  00078200     
783                                                                         00078300     
784                                                                         00078400     
785 BEGIN (* GETSYMBOL *)                                                   00078500     
786                                                                         00078600     
787    DUMMY   := CURRSYM;                                                  00078700     
788    CURRSYM := NEXTSYM;                                                  00078800     
789    NEXTSYM := DUMMY  ;                                                  00078900     
790                                                                         00079000     
791    WITH NEXTSYM@ DO                                                     00079100     
792       BEGIN                                                             00079200     
793                                                                         00079300     
794          SKIPSPACES( (* IN *)        INPUTFILE,                         00079400     
795                      (* UPDATING *)  CURRCHAR,                          00079500     
796                                      NEXTCHAR,                          00079600     
797                      (* RETURNING *) SPACESBEFORE,                      00079700     
798                                      CRSBEFORE     );                   00079800     
799          LENGTH := 0;                                                   00079900     
800                                                                         00080000     
801          IF CURRSYM@.NAME = OPENCOMMENT                                 00080100     
802             THEN                                                        00080200     
803                GETCOMMENT( (* FROM *)      INPUTFILE,                   00080300     
804                            (* UPDATING *)  CURRCHAR,                    00080400     
805                                            NEXTCHAR,                    00080500     
806                            (* RETURNING *) NAME,                        00080600     
807                                            VALUE,                       00080700     
808                                            LENGTH    )                  00080800     
809             ELSE                                                        00080900     
810                GETNEXTSYMBOL( (* FROM *)      INPUTFILE,                00081000     
811                               (* UPDATING *)  CURRCHAR,                 00081100     
812                                               NEXTCHAR,                 00081200     
813                               (* RETURNING *) NAME,                     00081300     
814                                               VALUE,                    00081400     
815                                               LENGTH    )               00081500     
816                                                                         00081600     
817       END (* WITH *)                                                    00081700     
818                                                                         00081800     
819 END; (* GETSYMBOL *)                                                    00081900     
820                                                                         00082000     
821 (* $Z *)                                                                00082100     
822                                                                         00082200     
823 PROCEDURE INITIALIZE( (* RETURNING *)                                   00082300     
824                                                                         00082400     
825                           VAR INPUTFILE,                                00082500     
826                               OUTPUTFILE  : TEXT;                       00082600     
827                                                                         00082700     
828                           VAR TOPOFSTACK  : INTEGER;                    00082800     
829                                                                         00082900     
830                           VAR CURRLINEPOS,                              00083000     
831                               CURRMARGIN  : INTEGER;                    00083100     
832                                                                         00083200     
833                           VAR KEYWORD     : KEYWORDTABLE;               00083300     
834                                                                         00083400     
835                           VAR DBLCHARS    : DBLCHRSET;                  00083500     
836                                                                         00083600     
837                           VAR DBLCHAR     : DBLCHARTABLE;               00083700     
838                                                                         00083800     
839                           VAR SGLCHAR     : SGLCHARTABLE;               00083900     
840                                                                         00084000     
841                           VAR RECORDSEEN  : BOOLEAN;                    00084100     
842                                                                         00084200     
843                           VAR CURRCHAR,                                 00084300     
844                               NEXTCHAR    : CHARINFO;                   00084400     
845                                                                         00084500     
846                           VAR CURRSYM,                                  00084600     
847                               NEXTSYM     : SYMBOLINFO;                 00084700     
848                                                                         00084800     
849                           VAR PPOPTION    : OPTIONTABLE   );            00084900     
850                                                                         00085000     
851 (* $Z *)                                                                00085100     
852                                                                         00085200     
853 BEGIN (* INITIALIZE *)                                                  00085300     
854                                                                         00085400     
855    RESET(INPUTFILE);                                                    00085500     
856    REWRITE(OUTPUTFILE);                                                 00085600     
857                                                                         00085700     
858    TOPOFSTACK  := 0;                                                    00085800     
859    CURRLINEPOS := 0;                                                    00085900     
860    CURRMARGIN  := 0;                                                    00086000     
861                                                                         00086100     
862                                                                         00086200     
863    KEYWORD [ PROGSYM    ] := 'PROGRAM   ' ;                             00086300     
864    KEYWORD [ FUNCSYM    ] := 'FUNCTION  ' ;                             00086400     
865    KEYWORD [ PROCSYM    ] := 'PROCEDURE ' ;                             00086500     
866    KEYWORD [ LABELSYM   ] := 'LABEL     ' ;                             00086600     
867    KEYWORD [ CONSTSYM   ] := 'CONST     ' ;                             00086700     
868    KEYWORD [ TYPESYM    ] := 'TYPE      ' ;                             00086800     
869    KEYWORD [ VARSYM     ] := 'VAR       ' ;                             00086900     
870    KEYWORD [ BEGINSYM   ] := 'BEGIN     ' ;                             00087000     
871    KEYWORD [ REPEATSYM  ] := 'REPEAT    ' ;                             00087100     
872    KEYWORD [ RECORDSYM  ] := 'RECORD    ' ;                             00087200     
873    KEYWORD [ CASESYM    ] := 'CASE      ' ;                             00087300     
874    KEYWORD [ CASEVARSYM ] := 'CASE      ' ;                             00087400     
875    KEYWORD [ OFSYM      ] := 'OF        ' ;                             00087500     
876    KEYWORD [ FORSYM     ] := 'FOR       ' ;                             00087600     
877    KEYWORD [ WHILESYM   ] := 'WHILE     ' ;                             00087700     
878    KEYWORD [ WITHSYM    ] := 'WITH      ' ;                             00087800     
879    KEYWORD [ DOSYM      ] := 'DO        ' ;                             00087900     
880    KEYWORD [ IFSYM      ] := 'IF        ' ;                             00088000     
881    KEYWORD [ THENSYM    ] := 'THEN      ' ;                             00088100     
882    KEYWORD [ ELSESYM    ] := 'ELSE      ' ;                             00088200     
883    KEYWORD [ ENDSYM     ] := 'END       ' ;                             00088300     
884    KEYWORD [ UNTILSYM   ] := 'UNTIL     ' ;                             00088400     
885                                                                         00088500     
886                                                                         00088600     
887    DBLCHARS := [ BECOMES, OPENCOMMENT ];                                00088700     
888                                                                         00088800     
889    DBLCHAR [ BECOMES     ]  := ':=' ;                                   00088900     
890    DBLCHAR [ OPENCOMMENT ]  := '(*' ;                                   00089000     
891                                                                         00089100     
892    SGLCHAR [ SEMICOLON  ]   := ';' ;                                    00089200     
893    SGLCHAR [ COLON      ]   := ':' ;                                    00089300     
894    SGLCHAR [ EQUALS     ]   := '=' ;                                    00089400     
895    SGLCHAR [ OPENPAREN  ]   := '(' ;                                    00089500     
896    SGLCHAR [ CLOSEPAREN ]   := ')' ;                                    00089600     
897    SGLCHAR [ PERIOD     ]   := '.' ;                                    00089700     
898                                                                         00089800     
899    RECORDSEEN := FALSE;                                                 00089900     
900                                                                         00090000     
901                                                                         00090100     
902    GETCHAR( (* FROM *)      INPUTFILE,                                  00090200     
903             (* UPDATING *)  NEXTCHAR,                                   00090300     
904             (* RETURNING *) CURRCHAR  );                                00090400     
905                                                                         00090500     
906    NEW(CURRSYM);                                                        00090600     
907    NEW(NEXTSYM);                                                        00090700     
908                                                                         00090800     
909    GETSYMBOL( (* FROM *)      INPUTFILE,                                00090900     
910               (* UPDATING *)  NEXTSYM,                                  00091000     
911               (* RETURNING *) CURRSYM  );                               00091100     
912                                                                         00091200     
913 (* $Z *)                                                                00091300     
914                                                                         00091400     
915    WITH PPOPTION [ PROGSYM ] DO                                         00091500     
916       BEGIN                                                             00091600     
917          OPTIONSSELECTED   := [ BLANKLINEBEFORE,                        00091700     
918                                 SPACEAFTER ];                           00091800     
919          DINDENTSYMBOLS    := [];                                       00091900     
920          GOBBLETERMINATORS := []                                        00092000     
921       END;                                                              00092100     
922                                                                         00092200     
923    WITH PPOPTION [ FUNCSYM ] DO                                         00092300     
924       BEGIN                                                             00092400     
925          OPTIONSSELECTED   := [ BLANKLINEBEFORE,                        00092500     
926                                 DINDENTONKEYS,                          00092600     
927                                 SPACEAFTER ];                           00092700     
928          DINDENTSYMBOLS    := [ LABELSYM,                               00092800     
929                                 CONSTSYM,                               00092900     
930                                 TYPESYM,                                00093000     
931                                 VARSYM ];                               00093100     
932          GOBBLETERMINATORS := []                                        00093200     
933       END;                                                              00093300     
934                                                                         00093400     
935    WITH PPOPTION [ PROCSYM ] DO                                         00093500     
936       BEGIN                                                             00093600     
937          OPTIONSSELECTED   := [ BLANKLINEBEFORE,                        00093700     
938                                 DINDENTONKEYS,                          00093800     
939                                 SPACEAFTER ];                           00093900     
940          DINDENTSYMBOLS    := [ LABELSYM,                               00094000     
941                                 CONSTSYM,                               00094100     
942                                 TYPESYM,                                00094200     
943                                 VARSYM ];                               00094300     
944          GOBBLETERMINATORS := []                                        00094400     
945       END;                                                              00094500     
946                                                                         00094600     
947    WITH PPOPTION [ LABELSYM ] DO                                        00094700     
948       BEGIN                                                             00094800     
949           OPTIONSSELECTED   := [ BLANKLINEBEFORE,                       00094900     
950                                 SPACEAFTER,                             00095000     
951                                 INDENTTOCLP ];                          00095100     
952          DINDENTSYMBOLS    := [];                                       00095200     
953          GOBBLETERMINATORS := []                                        00095300     
954       END;                                                              00095400     
955                                                                         00095500     
956    WITH PPOPTION [ CONSTSYM ] DO                                        00095600     
957       BEGIN                                                             00095700     
958           OPTIONSSELECTED   := [ BLANKLINEBEFORE,                       00095800     
959                                 DINDENTONKEYS,                          00095900     
960                                 SPACEAFTER,                             00096000     
961                                 INDENTTOCLP ];                          00096100     
962          DINDENTSYMBOLS    := [ LABELSYM ];                             00096200     
963          GOBBLETERMINATORS := []                                        00096300     
964       END;                                                              00096400     
965                                                                         00096500     
966    WITH PPOPTION [ TYPESYM ] DO                                         00096600     
967       BEGIN                                                             00096700     
968           OPTIONSSELECTED   := [ BLANKLINEBEFORE,                       00096800     
969                                 DINDENTONKEYS,                          00096900     
970                                 SPACEAFTER,                             00097000     
971                                 INDENTTOCLP ];                          00097100     
972          DINDENTSYMBOLS    := [ LABELSYM,                               00097200     
973                                 CONSTSYM ];                             00097300     
974          GOBBLETERMINATORS := []                                        00097400     
975       END;                                                              00097500     
976                                                                         00097600     
977    WITH PPOPTION [ VARSYM ] DO                                          00097700     
978       BEGIN                                                             00097800     
979           OPTIONSSELECTED   := [ BLANKLINEBEFORE,                       00097900     
980                                 DINDENTONKEYS,                          00098000     
981                                 SPACEAFTER,                             00098100     
982                                 INDENTTOCLP ];                          00098200     
983          DINDENTSYMBOLS    := [ LABELSYM,                               00098300     
984                                 CONSTSYM,                               00098400     
985                                 TYPESYM ];                              00098500     
986          GOBBLETERMINATORS := []                                        00098600     
987       END;                                                              00098700     
988                                                                         00098800     
989    WITH PPOPTION [ BEGINSYM ] DO                                        00098900     
990       BEGIN                                                             00099000     
991          OPTIONSSELECTED   := [ DINDENTONKEYS,                          00099100     
992                                 INDENTBYTAB,                            00099200     
993                                 CRAFTER ];                              00099300     
994          DINDENTSYMBOLS    := [ LABELSYM,                               00099400     
995                                 CONSTSYM,                               00099500     
996                                 TYPESYM,                                00099600     
997                                 VARSYM ];                               00099700     
998          GOBBLETERMINATORS := []                                        00099800     
999       END;                                                              00099900     
1000                                                                         00100000     
1001    WITH PPOPTION [ REPEATSYM ] DO                                       00100100     
1002       BEGIN                                                             00100200     
1003          OPTIONSSELECTED   := [ INDENTBYTAB,                            00100300     
1004                                 CRAFTER ];                              00100400     
1005          DINDENTSYMBOLS    := [];                                       00100500     
1006          GOBBLETERMINATORS := []                                        00100600     
1007       END;                                                              00100700     
1008                                                                         00100800     
1009    WITH PPOPTION [ RECORDSYM ] DO                                       00100900     
1010       BEGIN                                                             00101000     
1011          OPTIONSSELECTED   := [ INDENTBYTAB,                            00101100     
1012                                 CRAFTER ];                              00101200     
1013          DINDENTSYMBOLS    := [];                                       00101300     
1014          GOBBLETERMINATORS := []                                        00101400     
1015       END;                                                              00101500     
1016                                                                         00101600     
1017    WITH PPOPTION [ CASESYM ] DO                                         00101700     
1018       BEGIN                                                             00101800     
1019          OPTIONSSELECTED   := [ SPACEAFTER,                             00101900     
1020                                 INDENTBYTAB,                            00102000     
1021                                 GOBBLESYMBOLS,                          00102100     
1022                                 CRAFTER ];                              00102200     
1023          DINDENTSYMBOLS    := [];                                       00102300     
1024          GOBBLETERMINATORS := [ OFSYM ]                                 00102400     
1025       END;                                                              00102500     
1026                                                                         00102600     
1027    WITH PPOPTION [ CASEVARSYM ] DO                                      00102700     
1028       BEGIN                                                             00102800     
1029          OPTIONSSELECTED   := [ SPACEAFTER,                             00102900     
1030                                 INDENTBYTAB,                            00103000     
1031                                 GOBBLESYMBOLS,                          00103100     
1032                                 CRAFTER ];                              00103200     
1033          DINDENTSYMBOLS    := [];                                       00103300     
1034          GOBBLETERMINATORS := [ OFSYM ]                                 00103400     
1035       END;                                                              00103500     
1036                                                                         00103600     
1037    WITH PPOPTION [ OFSYM ] DO                                           00103700     
1038       BEGIN                                                             00103800     
1039          OPTIONSSELECTED   := [ CRSUPPRESS,                             00103900     
1040                                 SPACEBEFORE ];                          00104000     
1041          DINDENTSYMBOLS    := [];                                       00104100     
1042          GOBBLETERMINATORS := []                                        00104200     
1043       END;                                                              00104300     
1044                                                                         00104400     
1045    WITH PPOPTION [ FORSYM ] DO                                          00104500     
1046       BEGIN                                                             00104600     
1047          OPTIONSSELECTED   := [ SPACEAFTER,                             00104700     
1048                                 INDENTBYTAB,                            00104800     
1049                                 GOBBLESYMBOLS,                          00104900     
1050                                 CRAFTER ];                              00105000     
1051          DINDENTSYMBOLS    := [];                                       00105100     
1052          GOBBLETERMINATORS := [ DOSYM ]                                 00105200     
1053       END;                                                              00105300     
1054                                                                         00105400     
1055    WITH PPOPTION [ WHILESYM ] DO                                        00105500     
1056       BEGIN                                                             00105600     
1057          OPTIONSSELECTED   := [ SPACEAFTER,                             00105700     
1058                                 INDENTBYTAB,                            00105800     
1059                                 GOBBLESYMBOLS,                          00105900     
1060                                 CRAFTER ];                              00106000     
1061          DINDENTSYMBOLS    := [];                                       00106100     
1062          GOBBLETERMINATORS := [ DOSYM ]                                 00106200     
1063       END;                                                              00106300     
1064                                                                         00106400     
1065    WITH PPOPTION [ WITHSYM ] DO                                         00106500     
1066       BEGIN                                                             00106600     
1067          OPTIONSSELECTED   := [ SPACEAFTER,                             00106700     
1068                                 INDENTBYTAB,                            00106800     
1069                                 GOBBLESYMBOLS,                          00106900     
1070                                 CRAFTER ];                              00107000     
1071          DINDENTSYMBOLS    := [];                                       00107100     
1072          GOBBLETERMINATORS := [ DOSYM ]                                 00107200     
1073       END;                                                              00107300     
1074                                                                         00107400     
1075    WITH PPOPTION [ DOSYM ] DO                                           00107500     
1076       BEGIN                                                             00107600     
1077          OPTIONSSELECTED   := [ CRSUPPRESS,                             00107700     
1078                                 SPACEBEFORE ];                          00107800     
1079          DINDENTSYMBOLS    := [];                                       00107900     
1080          GOBBLETERMINATORS := []                                        00108000     
1081       END;                                                              00108100     
1082                                                                         00108200     
1083    WITH PPOPTION [ IFSYM ] DO                                           00108300     
1084       BEGIN                                                             00108400     
1085          OPTIONSSELECTED   := [ SPACEAFTER,                             00108500     
1086                                 INDENTBYTAB,                            00108600     
1087                                 GOBBLESYMBOLS,                          00108700     
1088                                 CRAFTER ];                              00108800     
1089          DINDENTSYMBOLS    := [];                                       00108900     
1090          GOBBLETERMINATORS := [ THENSYM ]                               00109000     
1091       END;                                                              00109100     
1092                                                                         00109200     
1093    WITH PPOPTION [ THENSYM ] DO                                         00109300     
1094       BEGIN                                                             00109400     
1095          OPTIONSSELECTED   := [ INDENTBYTAB,                            00109500     
1096                                 CRAFTER ];                              00109600     
1097          DINDENTSYMBOLS    := [];                                       00109700     
1098          GOBBLETERMINATORS := []                                        00109800     
1099       END;                                                              00109900     
1100                                                                         00110000     
1101    WITH PPOPTION [ ELSESYM ] DO                                         00110100     
1102       BEGIN                                                             00110200     
1103          OPTIONSSELECTED   := [ CRBEFORE,                               00110300     
1104                                 DINDENTONKEYS,                          00110400     
1105                                 DINDENT,                                00110500     
1106                                 INDENTBYTAB,                            00110600     
1107                                 CRAFTER ];                              00110700     
1108          DINDENTSYMBOLS    := [ IFSYM,                                  00110800     
1109                                 ELSESYM ];                              00110900     
1110          GOBBLETERMINATORS := []                                        00111000     
1111       END;                                                              00111100     
1112                                                                         00111200     
1113    WITH PPOPTION [ ENDSYM ] DO                                          00111300     
1114       BEGIN                                                             00111400     
1115          OPTIONSSELECTED   := [ CRBEFORE,                               00111500     
1116                                 DINDENTONKEYS,                          00111600     
1117                                 DINDENT,                                00111700     
1118                                 CRAFTER ];                              00111800     
1119          DINDENTSYMBOLS    := [ IFSYM,                                  00111900     
1120                                 THENSYM,                                00112000     
1121                                 ELSESYM,                                00112100     
1122                                 FORSYM,                                 00112200     
1123                                 WHILESYM,                               00112300     
1124                                 WITHSYM,                                00112400     
1125                                 CASEVARSYM,                             00112500     
1126                                 COLON,                                  00112600     
1127                                 EQUALS ];                               00112700     
1128          GOBBLETERMINATORS := []                                        00112800     
1129       END;                                                              00112900     
1130                                                                         00113000     
1131    WITH PPOPTION [ UNTILSYM ] DO                                        00113100     
1132       BEGIN                                                             00113200     
1133          OPTIONSSELECTED   := [ CRBEFORE,                               00113300     
1134                                 DINDENTONKEYS,                          00113400     
1135                                 DINDENT,                                00113500     
1136                                 SPACEAFTER,                             00113600     
1137                                 GOBBLESYMBOLS,                          00113700     
1138                                 CRAFTER ];                              00113800     
1139          DINDENTSYMBOLS    := [ IFSYM,                                  00113900     
1140                                 THENSYM,                                00114000     
1141                                 ELSESYM,                                00114100     
1142                                 FORSYM,                                 00114200     
1143                                 WHILESYM,                               00114300     
1144                                 WITHSYM,                                00114400     
1145                                 COLON,                                  00114500     
1146                                 EQUALS ];                               00114600     
1147          GOBBLETERMINATORS := [ ENDSYM,                                 00114700     
1148                                 UNTILSYM,                               00114800     
1149                                 ELSESYM,                                00114900     
1150                                 SEMICOLON ];                            00115000     
1151       END;                                                              00115100     
1152                                                                         00115200     
1153    WITH PPOPTION [ BECOMES ] DO                                         00115300     
1154       BEGIN                                                             00115400     
1155          OPTIONSSELECTED   := [ SPACEBEFORE,                            00115500     
1156                                 SPACEAFTER,                             00115600     
1157                                 GOBBLESYMBOLS ];                        00115700     
1158          DINDENTSYMBOLS    := [];                                       00115800     
1159          GOBBLETERMINATORS := [ ENDSYM,                                 00115900     
1160                                 UNTILSYM,                               00116000     
1161                                 ELSESYM,                                00116100     
1162                                 SEMICOLON ]                             00116200     
1163       END;                                                              00116300     
1164                                                                         00116400     
1165    WITH PPOPTION [ OPENCOMMENT ] DO                                     00116500     
1166       BEGIN                                                             00116600     
1167          OPTIONSSELECTED   := [ CRSUPPRESS ];                           00116700     
1168          DINDENTSYMBOLS    := [];                                       00116800     
1169          GOBBLETERMINATORS := []                                        00116900     
1170       END;                                                              00117000     
1171                                                                         00117100     
1172    WITH PPOPTION [ CLOSECOMMENT ] DO                                    00117200     
1173       BEGIN                                                             00117300     
1174          OPTIONSSELECTED   := [ CRSUPPRESS ];                           00117400     
1175          DINDENTSYMBOLS    := [];                                       00117500     
1176          GOBBLETERMINATORS := []                                        00117600     
1177       END;                                                              00117700     
1178                                                                         00117800     
1179    WITH PPOPTION [ SEMICOLON ] DO                                       00117900     
1180       BEGIN                                                             00118000     
1181          OPTIONSSELECTED   := [ CRSUPPRESS,                             00118100     
1182                                 DINDENTONKEYS,                          00118200     
1183                                 CRAFTER ];                              00118300     
1184          DINDENTSYMBOLS    := [ IFSYM,                                  00118400     
1185                                 THENSYM,                                00118500     
1186                                 ELSESYM,                                00118600     
1187                                 FORSYM,                                 00118700     
1188                                 WHILESYM,                               00118800     
1189                                 WITHSYM,                                00118900     
1190                                 COLON,                                  00119000     
1191                                 EQUALS ];                               00119100     
1192          GOBBLETERMINATORS := []                                        00119200     
1193       END;                                                              00119300     
1194                                                                         00119400     
1195    WITH PPOPTION [ COLON ] DO                                           00119500     
1196       BEGIN                                                             00119600     
1197          OPTIONSSELECTED   := [ SPACEAFTER,                             00119700     
1198                                 INDENTTOCLP ];                          00119800     
1199          DINDENTSYMBOLS    := [];                                       00119900     
1200          GOBBLETERMINATORS := []                                        00120000     
1201       END;                                                              00120100     
1202                                                                         00120200     
1203    WITH PPOPTION [ EQUALS ] DO                                          00120300     
1204       BEGIN                                                             00120400     
1205          OPTIONSSELECTED   := [ SPACEBEFORE,                            00120500     
1206                                 SPACEAFTER,                             00120600     
1207                                 INDENTTOCLP ];                          00120700     
1208          DINDENTSYMBOLS    := [];                                       00120800     
1209          GOBBLETERMINATORS := []                                        00120900     
1210       END;                                                              00121000     
1211                                                                         00121100     
1212    WITH PPOPTION [ OPENPAREN ] DO                                       00121200     
1213       BEGIN                                                             00121300     
1214          OPTIONSSELECTED   := [ GOBBLESYMBOLS ];                        00121400     
1215          DINDENTSYMBOLS    := [];                                       00121500     
1216          GOBBLETERMINATORS := [ CLOSEPAREN ]                            00121600     
1217       END;                                                              00121700     
1218                                                                         00121800     
1219    WITH PPOPTION [ CLOSEPAREN ] DO                                      00121900     
1220       BEGIN                                                             00122000     
1221          OPTIONSSELECTED   := [];                                       00122100     
1222          DINDENTSYMBOLS    := [];                                       00122200     
1223          GOBBLETERMINATORS := []                                        00122300     
1224       END;                                                              00122400     
1225                                                                         00122500     
1226    WITH PPOPTION [ PERIOD ] DO                                          00122600     
1227       BEGIN                                                             00122700     
1228          OPTIONSSELECTED   := [ CRSUPPRESS ];                           00122800     
1229          DINDENTSYMBOLS    := [];                                       00122900     
1230          GOBBLETERMINATORS := []                                        00123000     
1231       END;                                                              00123100     
1232                                                                         00123200     
1233    WITH PPOPTION [ ENDOFFILE ] DO                                       00123300     
1234       BEGIN                                                             00123400     
1235          OPTIONSSELECTED   := [];                                       00123500     
1236          DINDENTSYMBOLS    := [];                                       00123600     
1237          GOBBLETERMINATORS := []                                        00123700     
1238       END;                                                              00123800     
1239                                                                         00123900     
1240    WITH PPOPTION [ OTHERSYM ] DO                                        00124000     
1241       BEGIN                                                             00124100     
1242          OPTIONSSELECTED   := [];                                       00124200     
1243          DINDENTSYMBOLS    := [];                                       00124300     
1244          GOBBLETERMINATORS := []                                        00124400     
1245       END                                                               00124500     
1246                                                                         00124600     
1247                                                                         00124700     
1248 END; (* INITIALIZE *)                                                   00124800     
1249                                                                         00124900     
1250 (* $Z *)                                                                00125000     
1251                                                                         00125100     
1252 FUNCTION STACKEMPTY (* RETURNING *) : BOOLEAN;                          00125200     
1253                                                                         00125300     
1254 BEGIN (* STACKEMPTY *)                                                  00125400     
1255                                                                         00125500     
1256    IF TOP = 0                                                           00125600     
1257       THEN                                                              00125700     
1258          STACKEMPTY := TRUE                                             00125800     
1259       ELSE                                                              00125900     
1260          STACKEMPTY := FALSE                                            00126000     
1261                                                                         00126100     
1262 END; (* STACKEMPTY *)                                                   00126200     
1263                                                                         00126300     
1264 (* $Z *)                                                                00126400     
1265                                                                         00126500     
1266 FUNCTION STACKFULL (* RETURNING *) : BOOLEAN;                           00126600     
1267                                                                         00126700     
1268 BEGIN (* STACKFULL *)                                                   00126800     
1269                                                                         00126900     
1270    IF TOP = MAXSTACKSIZE                                                00127000     
1271       THEN                                                              00127100     
1272          STACKFULL := TRUE                                              00127200     
1273       ELSE                                                              00127300     
1274          STACKFULL := FALSE                                             00127400     
1275                                                                         00127500     
1276 END; (* STACKFULL *)                                                    00127600     
1277                                                                         00127700     
1278 (* $Z *)                                                                00127800     
1279                                                                         00127900     
1280 PROCEDURE POPSTACK( (* RETURNING *) VAR INDENTSYMBOL : KEYSYMBOL;       00128000     
1281                                     VAR PREVMARGIN   : INTEGER   );     00128100     
1282                                                                         00128200     
1283 BEGIN (* POPSTACK *)                                                    00128300     
1284                                                                         00128400     
1285    IF NOT STACKEMPTY                                                    00128500     
1286       THEN                                                              00128600     
1287          BEGIN                                                          00128700     
1288                                                                         00128800     
1289             INDENTSYMBOL := STACK[TOP].INDENTSYMBOL;                    00128900     
1290             PREVMARGIN   := STACK[TOP].PREVMARGIN;                      00129000     
1291                                                                         00129100     
1292             TOP := TOP - 1                                              00129200     
1293                                                                         00129300     
1294          END                                                            00129400     
1295                                                                         00129500     
1296       ELSE                                                              00129600     
1297          BEGIN                                                          00129700     
1298             INDENTSYMBOL := OTHERSYM;                                   00129800     
1299             PREVMARGIN   := 0                                           00129900     
1300          END                                                            00130000     
1301                                                                         00130100     
1302 END; (* POPSTACK *)                                                     00130200     
1303                                                                         00130300     
1304 (* $Z *)                                                                00130400     
1305                                                                         00130500     
1306 PROCEDURE PUSHSTACK( (* USING *) INDENTSYMBOL : KEYSYMBOL;              00130600     
1307                                  PREVMARGIN   : INTEGER   );            00130700     
1308                                                                         00130800     
1309 BEGIN (* PUSHSTACK *)                                                   00130900     
1310                                                                         00131000     
1311    TOP := TOP + 1;                                                      00131100     
1312                                                                         00131200     
1313    STACK[TOP].INDENTSYMBOL := INDENTSYMBOL;                             00131300     
1314    STACK[TOP].PREVMARGIN   := PREVMARGIN                                00131400     
1315                                                                         00131500     
1316 END; (* PUSHSTACK *)                                                    00131600     
1317                                                                         00131700     
1318 (* $Z *)                                                                00131800     
1319                                                                         00131900     
1320 PROCEDURE WRITECRS( (* USING *)          NUMBEROFCRS : INTEGER;         00132000     
1321                     (* UPDATING *)   VAR CURRLINEPOS : INTEGER;         00132100     
1322                     (* WRITING TO *) VAR OUTPUTFILE  : TEXT    );       00132200     
1323                                                                         00132300     
1324 VAR                                                                     00132400     
1325     I: INTEGER;                                                         00132500     
1326                                                                         00132600     
1327                                                                         00132700     
1328 BEGIN (* WRITECRS *)                                                    00132800     
1329                                                                         00132900     
1330    IF NUMBEROFCRS > 0                                                   00133000     
1331       THEN                                                              00133100     
1332          BEGIN                                                          00133200     
1333                                                                         00133300     
1334             FOR I := 1 TO NUMBEROFCRS DO                                00133400     
1335                WRITELN(OUTPUTFILE);                                     00133500     
1336                                                                         00133600     
1337             CURRLINEPOS := 0                                            00133700     
1338                                                                         00133800     
1339          END                                                            00133900     
1340                                                                         00134000     
1341 END; (* WRITECRS *)                                                     00134100     
1342                                                                         00134200     
1343 (* $Z *)                                                                00134300     
1344                                                                         00134400     
1345 PROCEDURE INSERTCR( (* UPDATING *)   VAR CURRSYM    : SYMBOLINFO;       00134500     
1346                     (* WRITING TO *) VAR OUTPUTFILE : TEXT       );     00134600     
1347                                                                         00134700     
1348 CONST                                                                   00134800     
1349       ONCE = 1;                                                         00134900     
1350                                                                         00135000     
1351                                                                         00135100     
1352 BEGIN (* INSERTCR *)                                                    00135200     
1353                                                                         00135300     
1354    IF CURRSYM@.CRSBEFORE = 0                                            00135400     
1355       THEN                                                              00135500     
1356          BEGIN                                                          00135600     
1357                                                                         00135700     
1358             WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS,               00135800     
1359                             (* WRITING TO *) OUTPUTFILE  );             00135900     
1360                                                                         00136000     
1361             CURRSYM@.SPACESBEFORE := 0                                  00136100     
1362                                                                         00136200     
1363          END                                                            00136300     
1364                                                                         00136400     
1365 END; (* INSERTCR *)                                                     00136500     
1366                                                                         00136600     
1367 (* $Z *)                                                                00136700     
1368                                                                         00136800     
1369 PROCEDURE INSERTBLANKLINE( (* UPDATING *)   VAR CURRSYM : SYMBOLINFO;   00136900     
1370                            (* WRITING TO *) VAR OUTPUTFILE : TEXT  );   00137000     
1371                                                                         00137100     
1372 CONST                                                                   00137200     
1373       ONCE  = 1;                                                        00137300     
1374       TWICE = 2;                                                        00137400     
1375                                                                         00137500     
1376                                                                         00137600     
1377 BEGIN (* INSERTBLANKLINE *)                                             00137700     
1378                                                                         00137800     
1379    IF CURRSYM@.CRSBEFORE = 0                                            00137900     
1380       THEN                                                              00138000     
1381          BEGIN                                                          00138100     
1382                                                                         00138200     
1383             IF CURRLINEPOS = 0                                          00138300     
1384                THEN                                                     00138400     
1385                   WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS,         00138500     
1386                                   (* WRITING TO *) OUTPUTFILE  )        00138600     
1387                ELSE                                                     00138700     
1388                   WRITECRS( TWICE, (* UPDATING *)   CURRLINEPOS,        00138800     
1389                                    (* WRITING TO *) OUTPUTFILE  );      00138900     
1390                                                                         00139000     
1391             CURRSYM@.SPACESBEFORE := 0                                  00139100     
1392                                                                         00139200     
1393          END                                                            00139300     
1394                                                                         00139400     
1395       ELSE                                                              00139500     
1396          IF CURRSYM@.CRSBEFORE = 1                                      00139600     
1397             THEN                                                        00139700     
1398                IF CURRLINEPOS > 0                                       00139800     
1399                   THEN                                                  00139900     
1400                      WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS,      00140000     
1401                                      (* WRITING TO *) OUTPUTFILE  )     00140100     
1402                                                                         00140200     
1403                                                                         00140300     
1404 END; (* INSERTBLANKLINE *)                                              00140350     
1405 (* $Z *)                                                                00140400     
1406                                                                         00140500     
1407 PROCEDURE LSHIFTON( (* USING *) DINDENTSYMBOLS : KEYSYMSET );           00140600     
1408                                                                         00140700     
1409 VAR                                                                     00140800     
1410     INDENTSYMBOL: KEYSYMBOL;                                            00140900     
1411     PREVMARGIN  : INTEGER;                                              00141000     
1412                                                                         00141100     
1413                                                                         00141200     
1414 BEGIN (* LSHIFTON *)                                                    00141300     
1415                                                                         00141400     
1416    IF NOT STACKEMPTY                                                    00141500     
1417       THEN                                                              00141600     
1418          BEGIN                                                          00141700     
1419                                                                         00141800     
1420             REPEAT                                                      00141900     
1421                                                                         00142000     
1422                POPSTACK( (* RETURNING *) INDENTSYMBOL,                  00142100     
1423                                          PREVMARGIN   );                00142200     
1424                                                                         00142300     
1425                IF INDENTSYMBOL IN DINDENTSYMBOLS                        00142400     
1426                   THEN                                                  00142500     
1427                      CURRMARGIN := PREVMARGIN                           00142600     
1428                                                                         00142700     
1429             UNTIL NOT(INDENTSYMBOL IN DINDENTSYMBOLS)                   00142800     
1430                    OR (STACKEMPTY);                                     00142900     
1431                                                                         00143000     
1432             IF NOT(INDENTSYMBOL IN DINDENTSYMBOLS)                      00143100     
1433                THEN                                                     00143200     
1434                   PUSHSTACK( (* USING *) INDENTSYMBOL,                  00143300     
1435                                          PREVMARGIN   )                 00143400     
1436                                                                         00143500     
1437          END                                                            00143600     
1438                                                                         00143700     
1439 END; (* LSHIFTON *)                                                     00143800     
1440                                                                         00143900     
1441 (* $Z *)                                                                00144000     
1442                                                                         00144100     
1443 PROCEDURE LSHIFT;                                                       00144200     
1444                                                                         00144300     
1445 VAR                                                                     00144400     
1446     INDENTSYMBOL: KEYSYMBOL;                                            00144500     
1447     PREVMARGIN  : INTEGER;                                              00144600     
1448                                                                         00144700     
1449                                                                         00144800     
1450 BEGIN (* LSHIFT *)                                                      00144900     
1451                                                                         00145000     
1452    IF NOT STACKEMPTY                                                    00145100     
1453       THEN                                                              00145200     
1454          BEGIN                                                          00145300     
1455             POPSTACK( (* RETURNING *) INDENTSYMBOL,                     00145400     
1456                                       PREVMARGIN   );                   00145500     
1457             CURRMARGIN := PREVMARGIN                                    00145600     
1458          END                                                            00145700     
1459                                                                         00145800     
1460 END; (* LSHIFT *)                                                       00145900     
1461                                                                         00146000     
1462 (* $Z *)                                                                00146100     
1463                                                                         00146200     
1464 PROCEDURE INSERTSPACE( (* USING *)      VAR SYMBOL     : SYMBOLINFO;    00146300     
1465                        (* WRITING TO *) VAR OUTPUTFILE : TEXT       );  00146400     
1466                                                                         00146500     
1467 BEGIN (* INSERTSPACE *)                                                 00146600     
1468                                                                         00146700     
1469    IF CURRLINEPOS < MAXLINESIZE                                         00146800     
1470       THEN                                                              00146900     
1471          BEGIN                                                          00147000     
1472                                                                         00147100     
1473             WRITE(OUTPUTFILE, SPACE);                                   00147200     
1474                                                                         00147300     
1475             CURRLINEPOS := CURRLINEPOS + 1;                             00147400     
1476                                                                         00147500     
1477             WITH SYMBOL@ DO                                             00147600     
1478                IF (CRSBEFORE = 0) AND (SPACESBEFORE > 0)                00147700     
1479                   THEN                                                  00147800     
1480                      SPACESBEFORE := SPACESBEFORE - 1                   00147900     
1481                                                                         00148000     
1482          END                                                            00148100     
1483                                                                         00148200     
1484 END; (* INSERTSPACE *)                                                  00148300     
1485                                                                         00148400     
1486 (* $Z *)                                                                00148500     
1487                                                                         00148600     
1488 PROCEDURE MOVELINEPOS( (* TO *)       NEWLINEPOS  : INTEGER;            00148700     
1489                        (* FROM *) VAR CURRLINEPOS : INTEGER;            00148800     
1490                        (* IN *)   VAR OUTPUTFILE  : TEXT    );          00148900     
1491                                                                         00149000     
1492 VAR                                                                     00149100     
1493    I: INTEGER;                                                          00149200     
1494                                                                         00149300     
1495                                                                         00149400     
1496 BEGIN (* MOVELINEPOS *)                                                 00149500     
1497                                                                         00149600     
1498    FOR I := CURRLINEPOS+1 TO NEWLINEPOS DO                              00149700     
1499       WRITE(OUTPUTFILE, SPACE);                                         00149800     
1500                                                                         00149900     
1501    CURRLINEPOS := NEWLINEPOS                                            00150000     
1502                                                                         00150100     
1503 END; (* MOVELINEPOS *)                                                  00150200     
1504                                                                         00150300     
1505 (* $Z *)                                                                00150400     
1506                                                                         00150500     
1507 PROCEDURE PRINTSYMBOL( (* IN *)             CURRSYM     : SYMBOLINFO;   00150600     
1508                        (* UPDATING *)   VAR CURRLINEPOS : INTEGER;      00150700     
1509                        (* WRITING TO *) VAR OUTPUTFILE  : TEXT       ); 00150800     
1510                                                                         00150900     
1511 VAR                                                                     00151000     
1512    I: INTEGER;                                                          00151100     
1513                                                                         00151200     
1514                                                                         00151300     
1515 BEGIN (* PRINTSYMBOL *)                                                 00151400     
1516                                                                         00151500     
1517    WITH CURRSYM@ DO                                                     00151600     
1518       BEGIN                                                             00151700     
1519                                                                         00151800     
1520          FOR I := 1 TO LENGTH DO                                        00151900     
1521             WRITE(OUTPUTFILE, VALUE[I]);                                00152000     
1522                                                                         00152100     
1523          CURRLINEPOS := CURRLINEPOS + LENGTH                            00152200     
1524                                                                         00152300     
1525       END (* WITH *)                                                    00152400     
1526                                                                         00152500     
1527 END; (* PRINTSYMBOL *)                                                  00152600     
1528                                                                         00152700     
1529 (* $Z *)                                                                00152800     
1530                                                                         00152900     
1531 PROCEDURE PPSYMBOL( (* IN *)             CURRSYM    : SYMBOLINFO;       00153000     
1532                     (* WRITING TO *) VAR OUTPUTFILE : TEXT       );     00153100     
1533                                                                         00153200     
1534 CONST                                                                   00153300     
1535       ONCE  = 1;                                                        00153400     
1536                                                                         00153500     
1537 VAR                                                                     00153600     
1538     NEWLINEPOS: INTEGER;                                                00153700     
1539                                                                         00153800     
1540                                                                         00153900     
1541 BEGIN (* PPSYMBOL *)                                                    00154000     
1542                                                                         00154100     
1543    WITH CURRSYM@ DO                                                     00154200     
1544       BEGIN                                                             00154300     
1545                                                                         00154400     
1546          WRITECRS( (* USING *)      CRSBEFORE,                          00154500     
1547                    (* UPDATING *)   CURRLINEPOS,                        00154600     
1548                    (* WRITING TO *) OUTPUTFILE  );                      00154700     
1549                                                                         00154800     
1550          IF (CURRLINEPOS + SPACESBEFORE > CURRMARGIN)                   00154900     
1551             OR (NAME IN [ OPENCOMMENT, CLOSECOMMENT ])                  00155000     
1552             THEN                                                        00155100     
1553                NEWLINEPOS := CURRLINEPOS + SPACESBEFORE                 00155200     
1554             ELSE                                                        00155300     
1555                NEWLINEPOS := CURRMARGIN;                                00155400     
1556                                                                         00155500     
1557          IF NEWLINEPOS + LENGTH > MAXLINESIZE                           00155600     
1558             THEN                                                        00155700     
1559                BEGIN                                                    00155800     
1560                                                                         00155900     
1561                   WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS,         00156000     
1562                                   (* WRITING TO *) OUTPUTFILE  );       00156100     
1563                                                                         00156200     
1564                   IF CURRMARGIN + LENGTH <= MAXLINESIZE                 00156300     
1565                      THEN                                               00156400     
1566                         NEWLINEPOS := CURRMARGIN                        00156500     
1567                      ELSE                                               00156600     
1568                         IF LENGTH < MAXLINESIZE                         00156700     
1569                            THEN                                         00156800     
1570                               NEWLINEPOS := MAXLINESIZE - LENGTH        00156900     
1571                            ELSE                                         00157000     
1572                               NEWLINEPOS := 0                           00157100     
1573                                                                         00157200     
1574                END;                                                     00157300     
1575                                                                         00157400     
1576          MOVELINEPOS( (* TO *)    NEWLINEPOS,                           00157500     
1577                       (* FROM *)  CURRLINEPOS,                          00157600     
1578                       (* IN *)    OUTPUTFILE  );                        00157700     
1579                                                                         00157800     
1580          PRINTSYMBOL( (* IN *)         CURRSYM,                         00157900     
1581                       (* UPDATING *)   CURRLINEPOS,                     00158000     
1582                       (* WRITING TO *) OUTPUTFILE  )                    00158100     
1583                                                                         00158200     
1584       END (* WITH *)                                                    00158300     
1585                                                                         00158400     
1586 END; (* PPSYMBOL *)                                                     00158500     
1587                                                                         00158600     
1588 (* $Z *)                                                                00158700     
1589                                                                         00158800     
1590 PROCEDURE RSHIFTTOCLP( (* USING *) CURRSYM : KEYSYMBOL );               00158900     
1591    FORWARD;                                                             00159000     
1592                                                                         00159100     
1593 PROCEDURE GOBBLE( (* SYMBOLS FROM *) VAR INPUTFILE   : TEXT;            00159200     
1594                   (* UP TO *)            TERMINATORS : KEYSYMSET;       00159300     
1595                   (* UPDATING *)     VAR CURRSYM,                       00159400     
1596                                          NEXTSYM     : SYMBOLINFO;      00159500     
1597                   (* WRITING TO *)   VAR OUTPUTFILE  : TEXT       );    00159600     
1598                                                                         00159700     
1599 BEGIN (* GOBBLE *)                                                      00159800     
1600                                                                         00159900     
1601    RSHIFTTOCLP( (* USING *) CURRSYM@.NAME );                            00160000     
1602                                                                         00160100     
1603    WHILE NOT(NEXTSYM@.NAME IN (TERMINATORS + [ENDOFFILE])) DO           00160200     
1604       BEGIN                                                             00160300     
1605                                                                         00160400     
1606          GETSYMBOL( (* FROM *)      INPUTFILE,                          00160500     
1607                     (* UPDATING *)  NEXTSYM,                            00160600     
1608                     (* RETURNING *) CURRSYM   );                        00160700     
1609                                                                         00160800     
1610          PPSYMBOL( (* IN *)         CURRSYM,                            00160900     
1611                    (* WRITING TO *) OUTPUTFILE )                        00161000     
1612                                                                         00161100     
1613       END; (* WHILE *)                                                  00161200     
1614                                                                         00161300     
1615    LSHIFT                                                               00161400     
1616                                                                         00161500     
1617 END; (* GOBBLE *)                                                       00161600     
1618                                                                         00161700     
1619 (* $Z *)                                                                00161800     
1620                                                                         00161900     
1621 PROCEDURE RSHIFT( (* USING *) CURRSYM : KEYSYMBOL );                    00162000     
1622                                                                         00162100     
1623 BEGIN (* RSHIFT *)                                                      00162200     
1624                                                                         00162300     
1625    IF NOT STACKFULL                                                     00162400     
1626       THEN                                                              00162500     
1627          PUSHSTACK( (* USING *) CURRSYM,                                00162600     
1628                                 CURRMARGIN);                            00162700     
1629                                                                         00162800     
1630    IF CURRMARGIN < SLOWFAIL1                                            00162900     
1631       THEN                                                              00163000     
1632          CURRMARGIN := CURRMARGIN + INDENT1                             00163100     
1633       ELSE                                                              00163200     
1634          IF CURRMARGIN < SLOWFAIL2                                      00163300     
1635             THEN                                                        00163400     
1636                CURRMARGIN := CURRMARGIN + INDENT2                       00163500     
1637                                                                         00163600     
1638 END; (* RSHIFT *)                                                       00163700     
1639                                                                         00163800     
1640 (* $Z *)                                                                00163900     
1641                                                                         00164000     
1642 PROCEDURE RSHIFTTOCLP;                                                  00164100     
1643                                                                         00164200     
1644 BEGIN (* RSHIFTTOCLP *)                                                 00164300     
1645                                                                         00164400     
1646    IF NOT STACKFULL                                                     00164500     
1647       THEN                                                              00164600     
1648          PUSHSTACK( (* USING *) CURRSYM,                                00164700     
1649                                 CURRMARGIN);                            00164800     
1650                                                                         00164900     
1651    CURRMARGIN := CURRLINEPOS                                            00165000     
1652                                                                         00165100     
1653 END; (* RSHIFTTOCLP *)                                                  00165200     
1654                                                                         00165300     
1655 (* $Z *)                                                                00165400     
1656                                                                         00165500     
1657 BEGIN (* PRETTYPRINT *)                                                 00165600     
1658                                                                         00165700     
1659    INITIALIZE( INPUTFILE,  OUTPUTFILE, TOP,         CURRLINEPOS,        00165800     
1660                CURRMARGIN, KEYWORD,    DBLCHARS,    DBLCHAR,            00165900     
1661                SGLCHAR,    RECORDSEEN, CURRCHAR,    NEXTCHAR,           00166000     
1662                CURRSYM,    NEXTSYM,    PPOPTION );                      00166100     
1663                                                                         00166200     
1664    CRPENDING := FALSE;                                                  00166300     
1665                                                                         00166400     
1666    WHILE (NEXTSYM@.NAME <> ENDOFFILE) DO                                00166500     
1667       BEGIN                                                             00166600     
1668                                                                         00166700     
1669          GETSYMBOL( (* FROM *)      INPUTFILE,                          00166800     
1670                     (* UPDATING *)  NEXTSYM,                            00166900     
1671                     (* RETURNING *) CURRSYM   );                        00167000     
1672                                                                         00167100     
1673          WITH PPOPTION [CURRSYM@.NAME] DO                               00167200     
1674             BEGIN                                                       00167300     
1675                                                                         00167400     
1676                IF (CRPENDING AND NOT(CRSUPPRESS IN OPTIONSSELECTED))    00167500     
1677                  OR (CRBEFORE IN OPTIONSSELECTED)                       00167600     
1678                   THEN                                                  00167700     
1679                      BEGIN                                              00167800     
1680                         INSERTCR( (* USING *)      CURRSYM,             00167900     
1681                                   (* WRITING TO *) OUTPUTFILE );        00168000     
1682                         CRPENDING := FALSE                              00168100     
1683                      END;                                               00168200     
1684                                                                         00168300     
1685                IF BLANKLINEBEFORE IN OPTIONSSELECTED                    00168400     
1686                   THEN                                                  00168500     
1687                      BEGIN                                              00168600     
1688                         INSERTBLANKLINE( (* USING *)      CURRSYM,      00168700     
1689                                          (* WRITING TO *) OUTPUTFILE ); 00168800     
1690                         CRPENDING := FALSE                              00168900     
1691                      END;                                               00169000     
1692                                                                         00169100     
1693                IF DINDENTONKEYS IN OPTIONSSELECTED                      00169200     
1694                   THEN                                                  00169300     
1695                      LSHIFTON(DINDENTSYMBOLS);                          00169400     
1696                                                                         00169500     
1697                IF DINDENT IN OPTIONSSELECTED                            00169600     
1698                   THEN                                                  00169700     
1699                      LSHIFT;                                            00169800     
1700                                                                         00169900     
1701                IF SPACEBEFORE IN OPTIONSSELECTED                        00170000     
1702                   THEN                                                  00170100     
1703                      INSERTSPACE( (* USING *)      CURRSYM,             00170200     
1704                                   (* WRITING TO *) OUTPUTFILE );        00170300     
1705                                                                         00170400     
1706                PPSYMBOL( (* IN *)         CURRSYM,                      00170500     
1707                          (* WRITING TO *) OUTPUTFILE );                 00170600     
1708                                                                         00170700     
1709                IF SPACEAFTER IN OPTIONSSELECTED                         00170800     
1710                   THEN                                                  00170900     
1711                      INSERTSPACE( (* USING *)      NEXTSYM,             00171000     
1712                                   (* WRITING TO *) OUTPUTFILE );        00171100     
1713                                                                         00171200     
1714                IF INDENTBYTAB IN OPTIONSSELECTED                        00171300     
1715                   THEN                                                  00171400     
1716                      RSHIFT( (* USING *) CURRSYM@.NAME );               00171500     
1717                                                                         00171600     
1718                IF INDENTTOCLP IN OPTIONSSELECTED                        00171700     
1719                   THEN                                                  00171800     
1720                      RSHIFTTOCLP( (* USING *) CURRSYM@.NAME );          00171900     
1721                                                                         00172000     
1722                IF GOBBLESYMBOLS IN OPTIONSSELECTED                      00172100     
1723                   THEN                                                  00172200     
1724                      GOBBLE( (* SYMBOLS FROM *) INPUTFILE,              00172300     
1725                              (* UP TO *)        GOBBLETERMINATORS,      00172400     
1726                              (* UPDATING *)     CURRSYM,                00172500     
1727                                                 NEXTSYM,                00172600     
1728                              (* WRITING TO *)   OUTPUTFILE        );    00172700     
1729                                                                         00172800     
1730                IF CRAFTER IN OPTIONSSELECTED                            00172900     
1731                   THEN                                                  00173000     
1732                      CRPENDING := TRUE                                  00173100     
1733                                                                         00173200     
1734             END (* WITH *)                                              00173300     
1735                                                                         00173400     
1736       END; (* WHILE *)                                                  00173500     
1737                                                                         00173600     
1738    IF CRPENDING                                                         00173700     
1739       THEN                                                              00173800     
1740          WRITELN(OUTPUTFILE)                                            00173900     
1741                                                                         00174000     
1742 END.                                                                    00174100     