0                                                                         00000100           
1                                                                         00000200           
2 (*[I=2,B-,A=20,S=2] FORMATTER DIRECTIVES. *)                            00000300           
3 (*                                                                      00000400           
4    ***********************************************************          00000500           
5    *                                                         *          00000600           
6    *      P A S C A L  P R O G R A M  F O R M A T T E R      *          00000700           
7    *      ---------------------------------------------      *          00000800           
8    *                                                         *          00000900           
9    *               AUTHOR: MICHAEL N. CONDICT, 1975,         *          00001000           
10    *                       LEHIGH UNIVERSITY                 *          00001100           
11    *      CURRENT ADDRESS: PAR CORP                          *          00001200           
12    *                       228 LIBERTY PLAZA                 *          00001300           
13    *                       ROME, NY 13440                    *          00001400           
14    *                                                         *          00001500           
15    *              UPDATED: AUGUST 1978                       *          00001600           
16    *                                                         *          00001700           
17    *         MODIFIED FOR                                    *          00001800           
18    *          PASCAL-6000: RICK L. MARCUS                    *          00001900           
19    *                       ANDY MICKEL                       *          00002000           
20    *                       UNIVERSITY OF MINNESOTA           *          00002100           
21    *                       78/11/30                          *          00002200           
22    *                                                         *          00002300           
23    *          B6700/B7700 PASCAL:                            *          00002310           
24    *                       R. A. FREAK                       *          00002320           
25    *                       DEPT. INFORMATION SCIENCE         *          00002330           
26    *                       UNIVERSITY OF TASMANIA            *          00002340           
27    *                       MARCH 1980                        *          00002350           
28    *                                                         *          00002360           
29    ***********************************************************          00002400           
30 *)                                                                      00002500           
31                                                                         00002600           
32 (**       PASCAL-6000 MODIFICATIONS.                                    00002700           
33 *                                                                       00002800           
34 *         0. CHANGE NAME OF FORMAT TO SPRUCE.                           00002900           
35 *         1. USE CHARSET 'A' ..'<'.                                     00002910           
36 *         2. IMPLEMENT CONTROL STATEMENT DIRECTIVE PROCESSING.          00002920           
37 *         3. ISSUE DAYFILE MESSAGES.                                    00002930           
38 *         4. UTILIZE VALUE INITIALIZATION.                              00002940           
39 *         5. PROCESS 'VALUE' AND 'OTHERWISE'.                           00002950           
40 *                                                                       00003000           
41 *         B6700/B7700 PASCAL MODIFICATIONS.                             00003100           
42 *                                                                       00003200           
43 *         1. REMOVE 1,2,3,4 OF ABOVE                                    00003300           
44 *         2. % COMMENTS                                                 00003400           
45 *         3. $ CONTROL CARDS                                            00003500           
46 *         4. LOWER-CASE ALPHABET                                        00003510           
47 *         5. ALLOW _ IN IDENTIFIERS                                     00003520           
48 *                                                                       00003600           
49 *)                                                                      00003700           
50                                                                         00003710           
51 PROGRAM SPRUCE(INPUT, OUTPUT);                                          00003800           
52                                                                         00003900           
53                                                                         00004000           
54 LABEL                                                                   00004100           
55   13;                                                                   00004200           
56                                                                         00004300           
57 CONST                                                                   00004400           
58              ALFALENG = 10 ;                                            00004500           
59 (* !!!!!!!! IMPLEMENTATION DEPENDENCY: !!!!!!!! *)                      00004600           
60 (* MINIMUM AND MAXIMUM CHAR VALUES. *)                                  00004700           
61               MINCHAR = 0;                                              00004800           
62               MAXCHAR = 255;                                            00004900           
63        LASTPASCSYMBOL = 61;                                             00005000           
64 (* THE FOLLOWING CONSTANTS MUST ALL BE CHANGED TOGETHER, SO THAT THEIR  00005100           
65    VALUES AGREE WITH THEIR NAMES:                                       00005200           
66 *)                                                                      00005300           
67            BUFFERSIZE = 160;                                            00005400           
68              BUFFSZP1 = 161;                                            00005500           
69              BUFFSZM1 = 159;                                            00005600           
70           BUFFSZDIV10 = 16;                                             00005700           
71 (*                           *)                                         00005800           
72       MAXREADRIGHTCOL = 999;                                            00005900           
73      MAXWRITERIGHTCOL = 132;                                            00006000           
74                                                                         00006100           
75 TYPE                                                                    00006200           
76                  ALFA = PACKED ARRAY [1 .. ALFALENG] OF CHAR;           00006300           
77 (* !!!!!!!! IMPLEMENTATION DEPENDENCY: !!!!!!!! *)                      00006400           
78 (* SET SIZE MAY NOT ALLOW SET OF CHAR. *)                               00006500           
79               CHARSET = SET OF CHAR;                                    00006600           
80          STATMNTTYPES = (FORWITHWHILESTATEMENT, REPEATSTATEMENT,        00006700           
81                          IFSTATEMENT, CASESTATEMENT, COMPOUNDSTATEMENT, 00006800           
82                          OTHERSTATEMENT);                               00006900           
83               SYMBOLS = (PROGSYMBOL, COMMENT, BEGINSYMBOL, ENDSYMBOL,   00007000           
84                          SEMICOLON, CONSTSYMBOL, TYPESYMBOL,            00007100           
85                          RECORDSYMBOL, COLONSYMBOL, EQUALSYMBOL,        00007200           
86                          PERIODSYMBOL, RANGE, CASESYMBOL, OWISESYMBOL,  00007300           
87                          IFSYMBOL, THENSYMBOL, ELSESYMBOL, DOSYMBOL,    00007400           
88                          OFSYMBOL, FORSYMBOL, WITHSYMBOL, WHILESYMBOL,  00007500           
89                          REPEATSYMBOL, UNTILSYMBOL, IDENTIFIER,         00007600           
90                          VARSYMBOL, VALUESYMBOL, PROCSYMBOL, FUNCSYMBOL,00007700           
91                          LEFTBRACKET, RIGHTBRACKET, COMMASYMBOL,        00007800           
92                          LABELSYMBOL, LEFTPARENTH, RIGHTPARENTH,        00007900           
93                          ALPHAOPERATOR, OTHERSYMBOL);                   00008000           
94                 WIDTH = 0 .. BUFFERSIZE;                                00008100           
95               MARGINS = - 100 .. BUFFERSIZE;                            00008200           
96             SYMBOLSET = SET OF SYMBOLS;                                 00008300           
97            OPTIONSIZE = - 99 .. 99;                                     00008400           
98           COMMENTTEXT = ARRAY [1 .. BUFFSZDIV10] OF ALFA;               00008500           
99          SYMBOLSTRING = ARRAY [WIDTH] OF CHAR;                          00008600           
100                                                                         00008700           
101 VAR                                                                     00008800           
102                CHISEOL,                                                 00008900           
103            NEXTCHISEOL: BOOLEAN;                                        00009000           
104                      I: INTEGER (*USED AS FOR LOOP INDEX*);             00009100           
105              CHARACTER: CHAR;                                           00009200           
106             READCOLUMN,                                                 00009300           
107           READRIGHTCOL: 0 .. 1000;                                      00009400           
108              OUTPUTCOL,                                                 00009500           
109            WRITECOLUMN,                                                 00009600           
110             LEFTMARGIN,                                                 00009700           
111       ACTUALLEFTMARGIN,                                                 00009800           
112            READLEFTCOL,                                                 00009900           
113           WRITELEFTCOL,                                                 00010000           
114          WRITERIGHTCOL: MARGINS;                                        00010100           
115            DISPLAYISON,                                                 00010200           
116        PROCNAMESWANTED,                                                 00010300           
117      ENDCOMMENTSWANTED,                                                 00010400           
118            PACKERISOFF,                                                 00010500           
119             SAVEDBUNCH,                                                 00010600           
120            BUNCHWANTED,                                                 00010700           
121           NOFORMATTING: BOOLEAN;                                        00010800           
122             LINENUMBER,                                                 00010900           
123              INCREMENT: INTEGER;                                        00011000           
124            INDENTINDEX,                                                 00011100           
125         LONGLINEINDENT,                                                 00011200           
126              SYMBOLGAP,                                                 00011300           
127        DECLARALIGNMENT,                                                 00011400           
128       STATMTSEPARATION,                                                 00011500           
129         PROCSEPARATION: OPTIONSIZE;                                     00011600           
130             LASTSYMBOL,                                                 00011700           
131             SYMBOLNAME: SYMBOLS;                                        00011800           
132           ALPHASYMBOLS,                                                 00011900           
133               ENDLABEL,                                                 00012000           
134               ENDCONST,                                                 00012100           
135                ENDTYPE,                                                 00012200           
136                 ENDVAR,                                                 00012300           
137               ENDVALUE: SYMBOLSET;                                      00012400           
138                 SYMBOL: SYMBOLSTRING;                                   00012500           
139                 LENGTH: WIDTH;                                          00012600           
140         SYMBOLISNUMBER,                                                 00012700           
141    LASTPROGPARTWASBODY: BOOLEAN;                                        00012800           
142                 DIGITS,                                                 00012900           
143       LETTERSANDDIGITS: CHARSET;                                        00013000           
144                 OLDEST: WIDTH;                                          00013100           
145              CHARCOUNT: INTEGER (* COUNT OF TOTAL CHARS READ,           00013200           
146                    BUT IS OFF BY BUFFERSIZE AFTER END OF FIRST BODY.    00013300           
147                    IT IS IMPERATIVE THAT CHARCOUNT BE MONOTONICALLY     00013400           
148                    INCREASING DURING PROCESSING OF A BODY, AND THAT IT  00013500           
149                    NEVER RETURN TO A VALUE <= BUFFERSIZE, AFTER PASSING 00013600           
150                    THAT POINT.  THUS "DOBLOCK" MAY RESET IT AS LOW AS   00013700           
151                    POSSIBLE, LIMITING THE LENGTH OF A PROCEDURE TO      00013800           
152                    "MAXINT - BUFFERSIZE" CHARACTERS. *);                00013900           
153                   MAIN: COMMENTTEXT;                                    00014000           
154           MAINNMLENGTH: WIDTH;                                          00014100           
155                 BLANKS,                                                 00014200           
156                 ZEROES: ALFA;                                           00014300           
157              UNWRITTEN: ARRAY [WIDTH] OF RECORD                         00014400           
158                                                         CH: CHAR;       00014500           
159                                                CHISENDLINE: BOOLEAN;    00014600           
160                                             INDENTAFTEREOL: MARGINS     00014700           
161                                          END;                           00014800           
162           PASCALSYMBOL: ARRAY [1 .. LASTPASCSYMBOL] OF ALFA;            00014900           
163         PASCSYMBOLNAME: ARRAY [1 .. LASTPASCSYMBOL] OF SYMBOLS;         00015000           
164                 NAMEOF: ARRAY [CHAR] OF SYMBOLS;                        00015100           
165        STATEMENTTYPEOF: ARRAY [SYMBOLS] OF STATMNTTYPES;                00015200           
166              INCOMMENT: BOOLEAN;                                        00015300           
167                                                                         00015600           
168                                                                         00015700           
169 PROCEDURE INITIALIZE;                                                   00015800           
170 VAR                                                                     00015900           
171   I:INTEGER;                                                            00016000           
172   J:SYMBOLS;                                                            00016010           
173 BEGIN                                                                   00016100           
174                BLANKS := '          ';                                  00016200           
175                ZEROES := '0000000000';                                  00016300           
176             CHARACTER := ' ';                                           00016400           
177     FOR I:=0 TO BUFFERSIZE DO BEGIN                                     00016500           
178       UNWRITTEN[I].CH := 'A';                                           00016600           
179       UNWRITTEN[I].CHISENDLINE := FALSE;                                00016700           
180       UNWRITTEN[I].INDENTAFTEREOL := 0;                                 00016800           
181     END;                                                                00016900           
182      FOR I:=0 TO MAXCHAR DO                                             00017000           
183        NAMEOF[CHR(I)] := OTHERSYMBOL;                                   00017010           
184      NAMEOF['(']:=LEFTPARENTH;                                          00017020           
185      NAMEOF[')']:=RIGHTPARENTH;                                         00017030           
186      NAMEOF['=']:=EQUALSYMBOL;                                          00017040           
187      NAMEOF[';']:=COMMASYMBOL;                                          00017050           
188      NAMEOF['.']:=PERIODSYMBOL;                                         00017060           
189      NAMEOF['[']:=LEFTBRACKET;                                          00017070           
190      NAMEOF[']']:=RIGHTBRACKET;                                         00017080           
191      NAMEOF[':']:=COLONSYMBOL;                                          00017090           
192      NAMEOF['<']:=EQUALSYMBOL;   % <                                    00017100           
193      NAMEOF['>']:=EQUALSYMBOL;   % >                                    00017110           
194      NAMEOF[';']:=SEMICOLON;                                            00017120           
195      PASCALSYMBOL[1]:='PROGRAM   ';    PASCALSYMBOL[31]:='program   ';  00017700           
196      PASCALSYMBOL[2]:='BEGIN     ';    PASCALSYMBOL[32]:='begin     ';  00017800           
197      PASCALSYMBOL[3]:='END       ';    PASCALSYMBOL[33]:='end       ';  00017900           
198      PASCALSYMBOL[4]:='CONST     ';    PASCALSYMBOL[34]:='const     ';  00018000           
199      PASCALSYMBOL[5]:='TYPE      ';    PASCALSYMBOL[35]:='type      ';  00018100           
200      PASCALSYMBOL[6]:='VAR       ';    PASCALSYMBOL[36]:='var       ';  00018200           
201      PASCALSYMBOL[7]:='RECORD    ';    PASCALSYMBOL[37]:='record    ';  00018300           
202      PASCALSYMBOL[8]:='CASE      ';    PASCALSYMBOL[38]:='case      ';  00018400           
203      PASCALSYMBOL[9]:='IF        ';    PASCALSYMBOL[39]:='if        ';  00018500           
204      PASCALSYMBOL[10]:='THEN      ';   PASCALSYMBOL[40]:='then      ';  00018600           
205      PASCALSYMBOL[11]:='ELSE      ';   PASCALSYMBOL[41]:='else      ';  00018700           
206      PASCALSYMBOL[12]:='DO        ';   PASCALSYMBOL[42]:='do        ';  00018800           
207      PASCALSYMBOL[13]:='OF        ';   PASCALSYMBOL[43]:='of        ';  00018900           
208      PASCALSYMBOL[14]:='FOR       ';   PASCALSYMBOL[44]:='for       ';  00019000           
209      PASCALSYMBOL[15]:='WHILE     ';   PASCALSYMBOL[45]:='while     ';  00019100           
210      PASCALSYMBOL[16]:='WITH      ';   PASCALSYMBOL[46]:='with      ';  00019200           
211      PASCALSYMBOL[17]:='REPEAT    ';   PASCALSYMBOL[47]:='repeat    ';  00019300           
212      PASCALSYMBOL[18]:='UNTIL     ';   PASCALSYMBOL[48]:='until     ';  00019400           
213      PASCALSYMBOL[19]:='PROCEDURE ';   PASCALSYMBOL[49]:='procedure ';  00019500           
214      PASCALSYMBOL[20]:='FUNCTION  ';   PASCALSYMBOL[50]:='function  ';  00019600           
215      PASCALSYMBOL[21]:='LABEL     ';   PASCALSYMBOL[51]:='label     ';  00019700           
216      PASCALSYMBOL[22]:='IN        ';   PASCALSYMBOL[52]:='in        ';  00019800           
217      PASCALSYMBOL[23]:='MOD       ';   PASCALSYMBOL[53]:='mod       ';  00019900           
218      PASCALSYMBOL[24]:='DIV       ';   PASCALSYMBOL[54]:='div       ';  00020000           
219      PASCALSYMBOL[25]:='AND       ';   PASCALSYMBOL[55]:='and       ';  00020100           
220      PASCALSYMBOL[26]:='OR        ';   PASCALSYMBOL[56]:='or        ';  00020200           
221      PASCALSYMBOL[27]:='NOT       ';   PASCALSYMBOL[57]:='not       ';  00020300           
222      PASCALSYMBOL[28]:='ARRAY     ';   PASCALSYMBOL[58]:='array     ';  00020400           
223      PASCALSYMBOL[29]:='VALUE     ';   PASCALSYMBOL[59]:='value     ';  00020500           
224      PASCALSYMBOL[30]:='OTHERWISE ';   PASCALSYMBOL[60]:='otherwise ';  00020600           
225      PASCALSYMBOL[61]:='NOSYMBOL  ';                                    00020700           
226    PASCSYMBOLNAME[1]:=PROGSYMBOL;    PASCSYMBOLNAME[31]:=PROGSYMBOL;    00020800           
227    PASCSYMBOLNAME[2]:=BEGINSYMBOL;   PASCSYMBOLNAME[32]:=BEGINSYMBOL;   00020900           
228    PASCSYMBOLNAME[3]:=ENDSYMBOL;     PASCSYMBOLNAME[33]:=ENDSYMBOL;     00021000           
229    PASCSYMBOLNAME[4]:=CONSTSYMBOL;   PASCSYMBOLNAME[34]:=CONSTSYMBOL;   00021100           
230    PASCSYMBOLNAME[5]:=TYPESYMBOL;    PASCSYMBOLNAME[35]:=TYPESYMBOL;    00021200           
231    PASCSYMBOLNAME[6]:=VARSYMBOL;     PASCSYMBOLNAME[36]:=VARSYMBOL;     00021300           
232    PASCSYMBOLNAME[7]:=RECORDSYMBOL;  PASCSYMBOLNAME[37]:=RECORDSYMBOL;  00021400           
233    PASCSYMBOLNAME[8]:=CASESYMBOL;    PASCSYMBOLNAME[38]:=CASESYMBOL;    00021500           
234    PASCSYMBOLNAME[9]:=IFSYMBOL;      PASCSYMBOLNAME[39]:=IFSYMBOL;      00021600           
235    PASCSYMBOLNAME[10]:=THENSYMBOL;   PASCSYMBOLNAME[40]:=THENSYMBOL;    00021700           
236    PASCSYMBOLNAME[11]:=ELSESYMBOL;   PASCSYMBOLNAME[41]:=ELSESYMBOL;    00021800           
237    PASCSYMBOLNAME[12]:=DOSYMBOL;     PASCSYMBOLNAME[42]:=DOSYMBOL;      00021900           
238    PASCSYMBOLNAME[13]:=OFSYMBOL;     PASCSYMBOLNAME[43]:=OFSYMBOL;      00022000           
239    PASCSYMBOLNAME[14]:=FORSYMBOL;    PASCSYMBOLNAME[44]:=FORSYMBOL;     00022100           
240    PASCSYMBOLNAME[15]:=WHILESYMBOL;  PASCSYMBOLNAME[45]:=WHILESYMBOL;   00022200           
241    PASCSYMBOLNAME[16]:=WITHSYMBOL;   PASCSYMBOLNAME[46]:=WITHSYMBOL;    00022300           
242    PASCSYMBOLNAME[17]:=REPEATSYMBOL; PASCSYMBOLNAME[47]:=REPEATSYMBOL;  00022400           
243    PASCSYMBOLNAME[18]:=UNTILSYMBOL;  PASCSYMBOLNAME[48]:=UNTILSYMBOL;   00022500           
244    PASCSYMBOLNAME[19]:=PROCSYMBOL;   PASCSYMBOLNAME[49]:=PROCSYMBOL;    00022600           
245    PASCSYMBOLNAME[20]:=FUNCSYMBOL;   PASCSYMBOLNAME[50]:=FUNCSYMBOL;    00022700           
246    PASCSYMBOLNAME[21]:=LABELSYMBOL;  PASCSYMBOLNAME[51]:=LABELSYMBOL;   00022800           
247    FOR I:= 22 TO 28 DO                                                  00022900           
248      PASCSYMBOLNAME[I]:=ALPHAOPERATOR;                                  00023000           
249    FOR I:= 52 TO 58 DO                                                  00023010           
250      PASCSYMBOLNAME[I]:=ALPHAOPERATOR;                                  00023020           
251    PASCSYMBOLNAME[29]:=VALUESYMBOL;  PASCSYMBOLNAME[59]:=VALUESYMBOL;   00023100           
252    PASCSYMBOLNAME[30]:=OWISESYMBOL;  PASCSYMBOLNAME[60]:=OWISESYMBOL;   00023200           
253      PASCSYMBOLNAME[61]:=IDENTIFIER;                                    00023300           
254      FOR J:=PROGSYMBOL TO OTHERSYMBOL DO                                00023400           
255        STATEMENTTYPEOF[J] := OTHERSTATEMENT;                            00023410           
256      STATEMENTTYPEOF[BEGINSYMBOL]:=COMPOUNDSTATEMENT;                   00023420           
257      STATEMENTTYPEOF[CASESYMBOL]:=CASESTATEMENT;                        00023430           
258      STATEMENTTYPEOF[IFSYMBOL]:=IFSTATEMENT;                            00023440           
259      STATEMENTTYPEOF[FORSYMBOL]:=FORWITHWHILESTATEMENT;                 00023450           
260      STATEMENTTYPEOF[WITHSYMBOL]:=FORWITHWHILESTATEMENT;                00023460           
261      STATEMENTTYPEOF[WHILESYMBOL]:=FORWITHWHILESTATEMENT;               00023470           
262      STATEMENTTYPEOF[REPEATSYMBOL]:=REPEATSTATEMENT;                    00023480           
263                DIGITS := ['0' .. '9'];                                  00023900           
264      LETTERSANDDIGITS := ['A'..'I','J'..'R','S'..'Z', '0' .. '9',       00024000           
265                             '_', 'a'..'i', 'j'..'r', 's'..'z'];         00024010           
266          ALPHASYMBOLS := [PROGSYMBOL, BEGINSYMBOL, ENDSYMBOL,           00024100           
267                          CONSTSYMBOL, TYPESYMBOL, RECORDSYMBOL,         00024200           
268                          CASESYMBOL, OWISESYMBOL, IFSYMBOL, THENSYMBOL, 00024300           
269                          ELSESYMBOL, DOSYMBOL, OFSYMBOL, FORSYMBOL,     00024400           
270                          WITHSYMBOL, WHILESYMBOL, REPEATSYMBOL,         00024500           
271                          UNTILSYMBOL, IDENTIFIER, VARSYMBOL,            00024600           
272                          PROCSYMBOL, FUNCSYMBOL, LABELSYMBOL,           00024700           
273                          VALUESYMBOL, ALPHAOPERATOR];                   00024800           
274              ENDLABEL := [CONSTSYMBOL, TYPESYMBOL, VARSYMBOL,           00024900           
275                          VALUESYMBOL, PROCSYMBOL, FUNCSYMBOL,           00025000           
276                          BEGINSYMBOL];                                  00025100           
277              ENDCONST:= [TYPESYMBOL, VARSYMBOL, VALUESYMBOL, PROCSYMBOL,00025200           
278                          FUNCSYMBOL, BEGINSYMBOL];                      00025300           
279               ENDTYPE:= [VARSYMBOL, VALUESYMBOL, PROCSYMBOL, FUNCSYMBOL,00025400           
280                          BEGINSYMBOL];                                  00025500           
281                ENDVAR := [VALUESYMBOL, PROCSYMBOL, FUNCSYMBOL,          00025600           
282                          BEGINSYMBOL];                                  00025700           
283              ENDVALUE := [PROCSYMBOL, FUNCSYMBOL, BEGINSYMBOL];         00025800           
284 (* INITIALIZE COLUMN DATA:  *)                                          00025900           
285           WRITECOLUMN := 0;                                             00026000           
286            LEFTMARGIN := 0;                                             00026100           
287      ACTUALLEFTMARGIN := 0;                                             00026200           
288             OUTPUTCOL := 1;                                             00026300           
289           READLEFTCOL := 1;                                             00026400           
290          READRIGHTCOL := 999;                                           00026500           
291          WRITELEFTCOL := 1;                                             00026600           
292         WRITERIGHTCOL := 72;                                            00026700           
293                OLDEST := 1;                                             00026800           
294             CHARCOUNT := 1;                                             00026900           
295            LINENUMBER := 0;                                             00027000           
296             INCREMENT := 0;                                             00027100           
297 (* INITIALIZE BOOLEAN PARAMETERS:  *)                                   00027200           
298           PACKERISOFF := TRUE;                                          00027300           
299           BUNCHWANTED := FALSE;                                         00027400           
300           DISPLAYISON := TRUE;                                          00027500           
301       PROCNAMESWANTED := TRUE;                                          00027600           
302     ENDCOMMENTSWANTED := FALSE;                                         00027700           
303             INCOMMENT := FALSE;                                         00027710           
304          NOFORMATTING := FALSE;                                         00027800           
305 (* INITIALIZE NUMERIC PARAMETERS:  *)                                   00027900           
306           INDENTINDEX := 3;                                             00028000           
307        LONGLINEINDENT := 3;                                             00028100           
308        PROCSEPARATION := 2;                                             00028200           
309             SYMBOLGAP := 1;                                             00028300           
310      STATMTSEPARATION := 3;                                             00028400           
311       DECLARALIGNMENT := 0;                                             00028500           
312 (* INITIALIZE INPUT CONTEXT DATA:  *)                                   00028600           
313            READCOLUMN := 1;                                             00028700           
314               CHISEOL := FALSE;                                         00028800           
315           NEXTCHISEOL := FALSE;                                         00028900           
316      FOR I:=0 TO BUFFERSIZE DO                                          00029000           
317         SYMBOL[I]:=' ';                                                 00029010           
318            LASTSYMBOL := PERIODSYMBOL;                                  00029100           
319   LASTPROGPARTWASBODY := FALSE;                                         00029200           
320 (* OPEN RELEVANT FILES *)                                               00029210           
321     RESET(INPUT);                                                       00029220           
322     REWRITE(OUTPUT);                                                    00029230           
323                                                                         00029300           
324 END;                                                                    00029400           
325                                                                         00029500           
326 PROCEDURE WRITEA(CHARACTER: CHAR);                                      00029600           
327                                                                         00029700           
328   VAR                                                                   00029800           
329                        I: WIDTH;                                        00029900           
330                   TESTNO: INTEGER;                                      00030000           
331                                                                         00030100           
332   BEGIN                                                                 00030200           
333     CHARCOUNT := CHARCOUNT + 1;  OLDEST := CHARCOUNT MOD BUFFERSIZE;    00030300           
334     WITH UNWRITTEN[OLDEST] DO                                           00030400           
335       BEGIN                                                             00030500           
336         IF CHARCOUNT > BUFFSZP1                                         00030600           
337         THEN                                                            00030700           
338           BEGIN                                                         00030800           
339             IF CHISENDLINE                                              00030900           
340             THEN                                                        00031000           
341               BEGIN                                                     00031100           
342                 IF INDENTAFTEREOL < 0                                   00031200           
343                 THEN                                                    00031300           
344                   BEGIN                                                 00031400           
345                     WRITE(BLANKS: - INDENTAFTEREOL);                    00031500           
346                     OUTPUTCOL := OUTPUTCOL - INDENTAFTEREOL;            00031600           
347                   END                                                   00031700           
348                 ELSE                                                    00031800           
349                   BEGIN                                                 00031900           
350                     IF INCREMENT < 0                                    00032000           
351                     THEN                                                00032100           
352                       BEGIN                                             00032200           
353                         I := WRITERIGHTCOL - OUTPUTCOL + 1;             00032300           
354                         IF I > 0  THEN WRITE(BLANKS: I);                00032400           
355                         TESTNO := LINENUMBER;  I := 0;                  00032500           
356                         REPEAT TESTNO := TESTNO DIV 10;  I := I + 1;    00032600           
357                         UNTIL TESTNO = 0;                               00032700           
358                         WRITE(ZEROES: (8 - I), LINENUMBER: I);          00032800           
359                         LINENUMBER := LINENUMBER - INCREMENT;           00032900           
360                         IF LINENUMBER > 99999999                        00033000           
361                         THEN LINENUMBER := LINENUMBER - 100000000;      00033100           
362                         WRITELN;                                        00033200           
363                       END                                               00033300           
364                     ELSE                                                00033400           
365                       BEGIN                                             00033500           
366                         WRITELN;                                        00033600           
367                         IF INCREMENT > 0                                00033700           
368                         THEN                                            00033800           
369                           BEGIN                                         00033900           
370                             WRITE(LINENUMBER: 4, ' ');                  00034000           
371                             LINENUMBER := LINENUMBER + INCREMENT;       00034100           
372                           END                                           00034200           
373                       END;                                              00034300           
374                     IF INDENTAFTEREOL > 0                               00034400           
375                     THEN WRITE(BLANKS: INDENTAFTEREOL);                 00034500           
376                     OUTPUTCOL := INDENTAFTEREOL + 1;                    00034600           
377                   END;                                                  00034700           
378                 CHISENDLINE := FALSE;                                   00034800           
379               END (*IF CHISENDLINE*)                                    00034900           
380             ELSE                                                        00035000           
381               BEGIN WRITE(CH);  OUTPUTCOL := OUTPUTCOL + 1;             00035100           
382               END (*ELSE*);                                             00035200           
383           END (*IF CHARCOUNT > *);                                      00035300           
384         CH := CHARACTER;  WRITECOLUMN := WRITECOLUMN + 1;               00035400           
385       END (*WITH*);                                                     00035500           
386   END (*WRITEA*);                                                       00035600           
387                                                                         00035700           
388                                                                         00035800           
389 PROCEDURE FLUSHUNWRITTENBUFFER;                                         00035900           
390                                                                         00036000           
391   BEGIN                                                                 00036100           
392     WRITEA(' ');                                                        00036200           
393     WITH UNWRITTEN[OLDEST] DO                                           00036300           
394       BEGIN CHISENDLINE := TRUE;  INDENTAFTEREOL := 0; END;             00036400           
395     WRITECOLUMN := 0;  FOR I := 0 TO BUFFSZM1 DO WRITEA(' ');           00036500           
396   END (*FLUSHUNWRITTENBUFFER*);                                         00036600           
397                                                                         00036700           
398                                                                         00036800           
399 PROCEDURE STARTNEWLINEANDINDENT;                                        00036900           
400                                                                         00037000           
401   BEGIN                                                                 00037100           
402     IF PACKERISOFF AND DISPLAYISON                                      00037200           
403     THEN                                                                00037300           
404       BEGIN                                                             00037400           
405         WRITEA(' ');  LASTSYMBOL := PERIODSYMBOL;                       00037500           
406         WITH UNWRITTEN[OLDEST] DO                                       00037600           
407           BEGIN                                                         00037700           
408             CHISENDLINE := TRUE;                                        00037800           
409             INDENTAFTEREOL := WRITELEFTCOL + LEFTMARGIN - 1;            00037900           
410           END;                                                          00038000           
411         WRITECOLUMN := WRITELEFTCOL + LEFTMARGIN;                       00038100           
412       END (*IF PACKERISOFF*);                                           00038200           
413   END (*STARTNEWLINEANDINDENT*);                                        00038300           
414                                                                         00038400           
415                                                                         00038500           
416 PROCEDURE READACHARACTER;                                               00038600           
417                                                                         00038700           
418   BEGIN                                                                 00038800           
419     IF READCOLUMN >= READRIGHTCOL                                       00038900           
420     THEN                                                                00039000           
421       BEGIN                                                             00039100           
422         IF READRIGHTCOL < MAXREADRIGHTCOL                               00039200           
423         THEN BEGIN NEXTCHISEOL := TRUE;  READLN END                     00039300           
424         ELSE READCOLUMN := 2;                                           00039400           
425       END                                                               00039500           
426     ELSE                                                                00039600           
427       IF READCOLUMN = 1 THEN                                            00039700           
428         WHILE READCOLUMN < READLEFTCOL DO                               00039800           
429           BEGIN                                                         00039900           
430             IF EOLN(INPUT)  THEN READCOLUMN := 1                        00040000           
431             ELSE BEGIN READCOLUMN := READCOLUMN + 1;  GET(INPUT) END    00040100           
432           END;                                                          00040200           
433     IF NEXTCHISEOL                                                      00040300           
434     THEN                                                                00040400           
435       BEGIN                                                             00040500           
436         CHARACTER := ' ';  NEXTCHISEOL := FALSE;  CHISEOL := TRUE;      00040600           
437         READCOLUMN := 1;                                                00040700           
438         IF NOFORMATTING                                                 00040800           
439         THEN                                                            00040900           
440           BEGIN                                                         00041000           
441             WRITEA(' ');                                                00041100           
442             WITH UNWRITTEN[OLDEST] DO                                   00041200           
443               BEGIN                                                     00041300           
444                 CHISENDLINE := TRUE;                                    00041400           
445                 INDENTAFTEREOL := WRITELEFTCOL - 1;                     00041500           
446               END;                                                      00041600           
447             WRITECOLUMN := WRITELEFTCOL;                                00041700           
448           END;                                                          00041800           
449       END                                                               00041900           
450     ELSE                                                                00042000           
451       IF NOT EOF(INPUT)                                                 00042100           
452       THEN                                                              00042200           
453         BEGIN                                                           00042300           
454           CHARACTER := INPUT ^;  READCOLUMN := READCOLUMN + 1;          00042400           
455           NEXTCHISEOL := EOLN(INPUT);  GET(INPUT);  CHISEOL := FALSE;   00042500           
456           IF NOFORMATTING  THEN WRITEA(CHARACTER);                      00042600           
457         END                                                             00042700           
458       ELSE BEGIN FLUSHUNWRITTENBUFFER;  GOTO 13 END                     00042800           
459   END (*READACHARACTER*);                                               00042900           
460                                                                         00043000           
461                                                                         00043100           
462 PROCEDURE WRITESYMBOL;                                                  00043200           
463                                                                         00043300           
464   VAR                                                                   00043400           
465                        I: WIDTH;                                        00043500           
466      NUMBERBLANKSTOWRITE: OPTIONSIZE;                                   00043600           
467                                                                         00043700           
468   BEGIN                                                                 00043800           
469     IF DISPLAYISON                                                      00043900           
470     THEN                                                                00044000           
471       BEGIN                                                             00044100           
472         NUMBERBLANKSTOWRITE := SYMBOLGAP;                               00044200           
473         IF (LASTSYMBOL IN [LEFTPARENTH, LEFTBRACKET, PERIODSYMBOL]) OR  00044300           
474            (SYMBOLNAME IN [SEMICOLON, RIGHTPARENTH, RIGHTBRACKET,       00044400           
475            COMMASYMBOL, PERIODSYMBOL, COLONSYMBOL]) OR (SYMBOLNAME IN   00044500           
476            [LEFTBRACKET, LEFTPARENTH]) AND (LASTSYMBOL = IDENTIFIER)    00044600           
477         THEN NUMBERBLANKSTOWRITE := 0                                   00044700           
478         ELSE                                                            00044800           
479           IF (SYMBOLNAME IN ALPHASYMBOLS) AND (LASTSYMBOL IN            00044900           
480              ALPHASYMBOLS)                                              00045000           
481           THEN                                                          00045100           
482             IF WRITECOLUMN <= WRITERIGHTCOL THEN                        00045200           
483               BEGIN WRITEA(' ');  NUMBERBLANKSTOWRITE := SYMBOLGAP - 1; 00045300           
484               END;                                                      00045400           
485         IF WRITECOLUMN + LENGTH + NUMBERBLANKSTOWRITE - 1 >             00045500           
486            WRITERIGHTCOL                                                00045600           
487         THEN                                                            00045700           
488           BEGIN                                                         00045800           
489             WRITEA(' ');                                                00045900           
490             WITH UNWRITTEN[OLDEST] DO                                   00046000           
491               BEGIN                                                     00046100           
492                 CHISENDLINE := TRUE;                                    00046200           
493                 IF PACKERISOFF                                          00046300           
494                 THEN                                                    00046400           
495                   BEGIN                                                 00046500           
496                     IF WRITELEFTCOL + LEFTMARGIN + LONGLINEINDENT +     00046600           
497                        LENGTH - 1 > WRITERIGHTCOL                       00046700           
498                     THEN LENGTH := 10;                                  00046800           
499                     INDENTAFTEREOL := WRITELEFTCOL - 1 + LEFTMARGIN +   00046900           
500                        LONGLINEINDENT;                                  00047000           
501                     WRITECOLUMN := WRITELEFTCOL + LEFTMARGIN +          00047100           
502                        LONGLINEINDENT;                                  00047200           
503                   END                                                   00047300           
504                 ELSE                                                    00047400           
505                   BEGIN                                                 00047500           
506                     IF LENGTH > WRITERIGHTCOL - WRITELEFTCOL + 1        00047600           
507                     THEN LENGTH := WRITERIGHTCOL - WRITELEFTCOL + 1;    00047700           
508                     INDENTAFTEREOL := WRITELEFTCOL - 1;                 00047800           
509                     WRITECOLUMN := WRITELEFTCOL;                        00047900           
510                   END;                                                  00048000           
511               END (*WITH*);                                             00048100           
512           END                                                           00048200           
513         ELSE FOR I := 1 TO NUMBERBLANKSTOWRITE DO WRITEA(' ');          00048300           
514         FOR I := 1 TO LENGTH DO WRITEA(SYMBOL[I]);                      00048400           
515       END (*IF DISPLAYISON*);                                           00048500           
516     LASTSYMBOL := SYMBOLNAME;                                           00048600           
517   END (*WRITESYMBOL*);                                                  00048700           
518                                                                         00048800           
519                                                                         00048900           
520 PROCEDURE COPYACHARACTER;                                               00049000           
521                                                                         00049100           
522   BEGIN                                                                 00049200           
523     IF INCOMMENT                                                        00049300           
524     THEN                                                                00049400           
525       BEGIN                                                             00049900           
526         IF DISPLAYISON                                                  00050000           
527         THEN                                                            00050100           
528           BEGIN                                                         00050200           
529             IF WRITECOLUMN > WRITERIGHTCOL THEN                         00050300           
530               BEGIN                                                     00050400           
531                 WHILE (CHARACTER = ' ') AND NOT CHISEOL DO              00050500           
532                   READACHARACTER;                                       00050600           
533                 IF NOT CHISEOL  THEN STARTNEWLINEANDINDENT;             00050700           
534               END;                                                      00050800           
535             IF CHISEOL                                                  00050900           
536             THEN                                                        00051000           
537               BEGIN                                                     00051100           
538                 LEFTMARGIN := 0;  STARTNEWLINEANDINDENT;                00051200           
539                 LEFTMARGIN := ACTUALLEFTMARGIN;                         00051300           
540               END                                                       00051400           
541             ELSE WRITEA(CHARACTER);                                     00051500           
542           END;                                                          00051600           
543         READACHARACTER                                                  00051700           
544       END                                                               00051800           
545   END (*COPYACHARACTER*);                                               00051900           
546                                                                         00052000           
547                                                                         00052100           
548 PROCEDURE DOFORMATTERDIRECTIVES;                                        00052200           
549                                                                         00052300           
550   CONST                                                                 00052400           
551                 INVALID = - 1;                                          00052500           
552                                                                         00052600           
553   TYPE                                                                  00052700           
554              PARAMCOUNT = 1 .. 2;                                       00052800           
555                  PARAMS = ARRAY [PARAMCOUNT] OF INTEGER;                00052900           
556                                                                         00053000           
557   VAR                                                                   00053100           
558            SPECIFICATION: PARAMS;                                       00053200           
559             FORMATOPTION: CHAR;                                         00053300           
560              PREVDISPLAY,                                               00053400           
561         PREVNOFORMATTING: BOOLEAN;                                      00053500           
562               ENDDIRECTV: CHARSET;                                      00053600           
563                                                                         00053700           
564                                                                         00053800           
565   PROCEDURE READIN(N: PARAMCOUNT; VAR SPECIFICATION: PARAMS);           00053900           
566                                                                         00054000           
567     VAR                                                                 00054100           
568                          I: PARAMCOUNT;                                 00054200           
569                                                                         00054300           
570     BEGIN                                                               00054400           
571       FOR I := 1 TO N DO                                                00054500           
572         BEGIN                                                           00054600           
573           WHILE NOT (CHARACTER IN (DIGITS + ENDDIRECTV)) DO             00054700           
574             COPYACHARACTER;                                             00054800           
575           SPECIFICATION[I] := 0;                                        00054900           
576           IF NOT (CHARACTER IN ENDDIRECTV)                              00055000           
577           THEN                                                          00055100           
578             REPEAT                                                      00055200           
579               SPECIFICATION[I] := 10 * SPECIFICATION[I] + ORD(CHARACTER)00055300           
580                  - ORD('0');                                            00055400           
581               COPYACHARACTER;                                           00055500           
582             UNTIL NOT (CHARACTER IN DIGITS)                             00055600           
583           ELSE SPECIFICATION[I] := INVALID;                             00055700           
584         END (*FOR*);                                                    00055800           
585     END (*READIN*);                                                     00055900           
586                                                                         00056000           
587                                                                         00056100           
588   BEGIN (*DOFORMATTERDIRECTIVES*)                                       00056200           
589     ENDDIRECTV := ['*', ']'];                                           00056300           
590     REPEAT                                                              00056400           
591       IF CHARACTER IN ['A', 'B', 'C', 'D', 'E', 'F', 'G', 'I', 'L', 'N',00056500           
592          'P', 'R', 'S', 'W', 'a'..'g', 'i','l','n','p','r','s','w']     00056600           
593       THEN                                                              00056700           
594         BEGIN                                                           00056800           
595           FORMATOPTION := CHARACTER;                                    00056900           
596           CASE FORMATOPTION OF                                          00057000           
597             'A', 'E', 'I', 'G', 'P', 'L', 'S',                          00057100           
598             'a', 'e', 'i', 'g', 'p', 'l', 's':                          00057110           
599               BEGIN                                                     00057200           
600                 READIN(1, SPECIFICATION);                               00057300           
601                 IF (SPECIFICATION[1] < WRITERIGHTCOL - WRITELEFTCOL - 9)00057400           
602                    OR (FORMATOPTION = 'P')                              00057500           
603                 THEN                                                    00057600           
604                   CASE FORMATOPTION OF                                  00057700           
605                     'A','a': DECLARALIGNMENT := SPECIFICATION[1];       00057800           
606                     'E','e':                                            00057900           
607                       IF SPECIFICATION[1] < 4 THEN                      00058000           
608                         BEGIN                                           00058100           
609                           PROCNAMESWANTED := SPECIFICATION[1] > 1;      00058200           
610                           ENDCOMMENTSWANTED := ODD(SPECIFICATION[1]);   00058300           
611                         END;                                            00058400           
612                     'G','g': SYMBOLGAP := SPECIFICATION[1];             00058500           
613                     'I','i': INDENTINDEX := SPECIFICATION[1];           00058600           
614                     'L','l': LONGLINEINDENT := SPECIFICATION[1];        00058700           
615                     'P','p': PROCSEPARATION := SPECIFICATION[1];        00058800           
616                     'S','s': STATMTSEPARATION := SPECIFICATION[1]       00058900           
617                   END (*CASE*);                                         00059000           
618               END (*SINGLE PARAMETERS*);                                00059100           
619             'W', 'R', 'N', 'w', 'r', 'n':                               00059200           
620               BEGIN                                                     00059300           
621                 READIN(2, SPECIFICATION);                               00059400           
622                 IF SPECIFICATION[2] <> INVALID                          00059500           
623                 THEN                                                    00059600           
624                   CASE FORMATOPTION OF                                  00059700           
625                     'W','w':                                            00059800           
626                       IF (SPECIFICATION[1] > 0) AND (SPECIFICATION[2] < 00059900           
627                          BUFFERSIZE - 2) AND (SPECIFICATION[2] -        00060000           
628                          SPECIFICATION[1] > 8)                          00060100           
629                       THEN                                              00060200           
630                         BEGIN                                           00060300           
631                           WRITELEFTCOL := SPECIFICATION[1];             00060400           
632                           WRITERIGHTCOL := SPECIFICATION[2];            00060500           
633                         END;                                            00060600           
634                     'R','r':                                            00060700           
635                       IF (SPECIFICATION[1] > 0) AND (SPECIFICATION[2] - 00060800           
636                          SPECIFICATION[1] > 8)                          00060900           
637                       THEN                                              00061000           
638                         BEGIN                                           00061100           
639                           READLEFTCOL := SPECIFICATION[1];              00061200           
640                           READRIGHTCOL := SPECIFICATION[2];             00061300           
641                         END;                                            00061400           
642                     'N', 'n':                                           00061500           
643                       BEGIN                                             00061600           
644                         LINENUMBER := SPECIFICATION[1];                 00061700           
645                         INCREMENT := SPECIFICATION[2];                  00061800           
646                         WHILE NOT (CHARACTER IN (['<'] + ENDDIRECTV))   00061900           
647                            AND (CHARACTER <> '>') DO                    00062000           
648                           COPYACHARACTER;                               00062100           
649                         IF CHARACTER = '>'                              00062200           
650                         THEN INCREMENT := - INCREMENT                   00062300           
651                       END                                               00062400           
652                   END (*CASE*);                                         00062500           
653               END (*DOUBLE PARAMETERS*);                                00062600           
654             'B', 'C', 'D', 'F', 'b', 'c', 'd', 'f':                     00062700           
655               BEGIN                                                     00062800           
656                 REPEAT COPYACHARACTER;                                  00062900           
657                 UNTIL CHARACTER IN (['+', '-'] + ENDDIRECTV);           00063000           
658                 IF CHARACTER IN ['+', '-']                              00063100           
659                 THEN                                                    00063200           
660                   CASE FORMATOPTION OF                                  00063300           
661                     'B','b':                                            00063400           
662                       IF DISPLAYISON                                    00063500           
663                       THEN BUNCHWANTED := CHARACTER = '+';              00063600           
664                     'C','c': PACKERISOFF := CHARACTER = '-';            00063700           
665                     'D','d':                                            00063800           
666                       BEGIN                                             00063900           
667                         PREVDISPLAY := DISPLAYISON;                     00064000           
668                         DISPLAYISON := CHARACTER = '+';                 00064100           
669                         IF PREVDISPLAY AND NOT DISPLAYISON              00064200           
670                         THEN                                            00064300           
671                           BEGIN                                         00064400           
672                             WRITEA('*');  WRITEA(')');                  00064500           
673                             SAVEDBUNCH := BUNCHWANTED;                  00064600           
674                             BUNCHWANTED := FALSE;                       00064700           
675                           END                                           00064800           
676                         ELSE                                            00064900           
677                           IF NOT PREVDISPLAY AND DISPLAYISON THEN       00065000           
678                             BEGIN                                       00065100           
679                               STARTNEWLINEANDINDENT;  WRITEA('(');      00065200           
680                               WRITEA('*');  BUNCHWANTED := SAVEDBUNCH;  00065300           
681                             END (*IF NOT PREV*);                        00065400           
682                       END (* 'D': *);                                   00065500           
683                     'F','f':                                            00065600           
684                       BEGIN                                             00065700           
685                         PREVNOFORMATTING := NOFORMATTING;               00065800           
686                         NOFORMATTING := CHARACTER = '-';                00065900           
687                         DISPLAYISON := NOT NOFORMATTING;                00066000           
688                         IF PREVNOFORMATTING AND NOT NOFORMATTING        00066100           
689                         THEN READACHARACTER;                            00066200           
690                         IF NOT PREVNOFORMATTING AND NOFORMATTING        00066300           
691                         THEN WRITEA('-');                               00066400           
692                       END;                                              00066500           
693                   END (*CASE*);                                         00066600           
694               END (*BOOLEAN PARAMETERS*)                                00066700           
695           END (*CASE*);                                                 00066800           
696         END (*THEN*)                                                    00066900           
697       ELSE IF NOT (CHARACTER IN ENDDIRECTV)  THEN COPYACHARACTER;       00067000           
698     UNTIL CHARACTER IN ENDDIRECTV;                                      00067100           
699     IF (CHARACTER = ']') AND INCOMMENT  THEN COPYACHARACTER;            00067200           
700   END (*DOFORMATTERDIRECTIVES*);                                        00067300           
701                                                                         00067400           
702                                                                         00067500           
703 PROCEDURE READSYMBOL;                                                   00067600           
704                                                                         00067700           
705   CONST                                                                 00067800           
706              READNEXTCH = TRUE;                                         00067900           
707          DONTREADNEXTCH = FALSE;                                        00068000           
708                                                                         00068100           
709   VAR                                                                   00068200           
710               TESTSYMBOL: ALFA;                                         00068300           
711               CHARNUMBER: WIDTH;                                        00068400           
712                        I: WIDTH;                                        00068500           
713                                                                         00068600           
714                                                                         00068700           
715   PROCEDURE SKIPCOMMENT;                                                00068800           
716                                                                         00068900           
717     BEGIN                                                               00069000           
718       REPEAT WHILE CHARACTER <> '*' DO READACHARACTER;  READACHARACTER  00069100           
719       UNTIL CHARACTER = ')';                                            00069200           
720       READACHARACTER;  LASTSYMBOL := COMMENT;  READSYMBOL               00069300           
721     END (*SKIPCOMMENT*);                                                00069400           
722                                                                         00069500           
723                                                                         00069600           
724   PROCEDURE DOCOMMENT;                                                  00069700           
725                                                                         00069800           
726     VAR                                                                 00069900           
727                          I: OPTIONSIZE;                                 00070000           
728                                                                         00070100           
729                                                                         00070200           
730     PROCEDURE COMPILERDIRECTIVES;                                       00070300           
731                                                                         00070400           
732       BEGIN REPEAT COPYACHARACTER;  UNTIL CHARACTER IN ['[', '*']       00070500           
733       END (*COMPILERDIRECTIVES*);                                       00070600           
734                                                                         00070700           
735                                                                         00070800           
736     BEGIN (*DOCOMMENT*)                                                 00070900           
737       BEGIN                                                             00071000           
738         INCOMMENT := TRUE;                                              00071010           
739         IF LASTSYMBOL IN [COMMENT, SEMICOLON] THEN                      00071100           
740           BEGIN                                                         00071200           
741             LEFTMARGIN := 0;  STARTNEWLINEANDINDENT;                    00071300           
742             LEFTMARGIN := ACTUALLEFTMARGIN;                             00071400           
743           END;                                                          00071500           
744         WRITESYMBOL;  IF CHARACTER = '$'  THEN COMPILERDIRECTIVES;      00071600           
745         IF CHARACTER = '['  THEN DOFORMATTERDIRECTIVES;                 00071700           
746         REPEAT                                                          00071800           
747           WHILE CHARACTER <> '*' DO COPYACHARACTER;  COPYACHARACTER;    00071900           
748         UNTIL CHARACTER = ')';                                          00072000           
749         COPYACHARACTER;  LASTSYMBOL := COMMENT;  READSYMBOL;            00072100           
750         INCOMMENT := FALSE;                                             00072110           
751       END;                                                              00072200           
752     END (*DOCOMMENT*);                                                  00072300           
753                                                                         00072400           
754                                                                         00072500           
755   PROCEDURE CHECKFOR(SECONDCHAR: CHAR; TWOCHARSYMBOL: SYMBOLS;          00072600           
756      READALLOWED: BOOLEAN);                                             00072700           
757                                                                         00072800           
758     BEGIN                                                               00072900           
759       IF READALLOWED THEN                                               00073000           
760         BEGIN                                                           00073100           
761           LENGTH := 1;  SYMBOL[1] := CHARACTER;                         00073200           
762           SYMBOLNAME := NAMEOF[CHARACTER];  READACHARACTER;             00073300           
763         END;                                                            00073400           
764       IF CHARACTER = SECONDCHAR                                         00073500           
765       THEN                                                              00073600           
766         BEGIN                                                           00073700           
767           SYMBOL[2] := CHARACTER;  LENGTH := 2;                         00073800           
768           SYMBOLNAME := TWOCHARSYMBOL;  READACHARACTER;                 00073900           
769           IF (NOT PACKERISOFF) AND (SYMBOLNAME = COMMENT)               00074000           
770           THEN LENGTH := 0                                              00074100           
771         END;                                                            00074200           
772     END (*CHECKFOR*);                                                   00074300           
773                                                                         00074400           
774                                                                         00074500           
775   BEGIN (*READSYMBOL*)                                                  00074600           
776     IF (CHARACTER IN ['A'..'I', 'J'..'R', 'S'..'Z',                     00074700           
777       'a'..'i', 'j'..'r', 's'..'z', '{',                                00074710           
778        '>', '0' .. '9', ' ', '(', '.', ':', '''', '<'])                 00074900           
779     THEN                                                                00075100           
780       CASE CHARACTER OF                                                 00075200           
781         '(':                                                            00075300           
782           BEGIN                                                         00075400           
783             CHECKFOR('*', COMMENT, READNEXTCH);                         00075500           
784             IF (SYMBOLNAME = COMMENT) AND PACKERISOFF  THEN DOCOMMENT   00075600           
785             ELSE IF SYMBOLNAME = COMMENT  THEN SKIPCOMMENT;             00075700           
786           END;                                                          00075800           
787         'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',00075900           
788            'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y',  00076000           
789            'Z', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k',  00076100           
790           'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v',        00076110           
791           'w', 'x', 'y', 'z':                                           00076120           
792           BEGIN                                                         00076200           
793             CHARNUMBER := 1;  SYMBOLISNUMBER := FALSE;                  00076300           
794             REPEAT                                                      00076400           
795               SYMBOL[CHARNUMBER] := CHARACTER;  READACHARACTER;         00076500           
796               CHARNUMBER := CHARNUMBER + 1                              00076600           
797             UNTIL NOT (CHARACTER IN LETTERSANDDIGITS);                  00076700           
798             LENGTH := CHARNUMBER - 1;                                   00076800           
799             FOR CHARNUMBER := CHARNUMBER TO ALFALENG DO                 00076900           
800               SYMBOL[CHARNUMBER] := ' ';                                00077000           
801             PACK(SYMBOL, 1, TESTSYMBOL);  I := 1;                       00077100           
802             PASCALSYMBOL[LASTPASCSYMBOL] := TESTSYMBOL;                 00077200           
803             WHILE PASCALSYMBOL[I] <> TESTSYMBOL DO I := I + 1;          00077300           
804             SYMBOLNAME := PASCSYMBOLNAME[I];                            00077400           
805           END (*LETTER*);                                               00077500           
806         '0', '1', '2', '3', '4', '5', '6', '7', '8', '9':               00077600           
807           BEGIN                                                         00077700           
808             SYMBOLISNUMBER := TRUE;  CHARNUMBER := 1;                   00077800           
809             REPEAT                                                      00077900           
810               SYMBOL[CHARNUMBER] := CHARACTER;  READACHARACTER;         00078000           
811               CHARNUMBER := CHARNUMBER + 1                              00078100           
812             UNTIL NOT (CHARACTER IN DIGITS + ['.']);                    00078200           
813             IF CHARACTER IN ['B', 'E']                                  00078300           
814             THEN                                                        00078400           
815               BEGIN                                                     00078500           
816                 SYMBOL[CHARNUMBER] := CHARACTER;  READACHARACTER;       00078600           
817                 CHARNUMBER := CHARNUMBER + 1;                           00078700           
818                 IF CHARACTER IN DIGITS + ['+', '-'] THEN                00078800           
819                   REPEAT                                                00078900           
820                     SYMBOL[CHARNUMBER] := CHARACTER;  READACHARACTER;   00079000           
821                     CHARNUMBER := CHARNUMBER + 1                        00079100           
822                   UNTIL NOT (CHARACTER IN DIGITS)                       00079200           
823               END;                                                      00079300           
824             LENGTH := CHARNUMBER - 1;  SYMBOLNAME := IDENTIFIER;        00079400           
825           END (*NUMBER*);                                               00079500           
826         ' ':                                                            00079600           
827           BEGIN                                                         00079700           
828             REPEAT READACHARACTER  UNTIL CHARACTER <> ' ';  READSYMBOL  00079800           
829           END;                                                          00079900           
830         '>', ':': CHECKFOR('=', OTHERSYMBOL, READNEXTCH);               00080000           
831         '<':                                                            00080100           
832           BEGIN                                                         00080200           
833             CHECKFOR('=', OTHERSYMBOL, READNEXTCH);                     00080300           
834             IF SYMBOLNAME <> OTHERSYMBOL                                00080400           
835             THEN CHECKFOR('>', OTHERSYMBOL, DONTREADNEXTCH);            00080500           
836           END;                                                          00080600           
837         '.':                                                            00080700           
838           IF LASTSYMBOL <> ENDSYMBOL                                    00080800           
839           THEN CHECKFOR('.', RANGE, READNEXTCH)                         00080900           
840           ELSE SYMBOLNAME := PERIODSYMBOL;                              00081000           
841         '''':                                                           00081100           
842           BEGIN                                                         00081200           
843             CHARNUMBER := 1;                                            00081300           
844             REPEAT                                                      00081400           
845               REPEAT                                                    00081500           
846                 SYMBOL[CHARNUMBER] := CHARACTER;                        00081600           
847                 CHARNUMBER := CHARNUMBER + 1;  READACHARACTER;          00081700           
848               UNTIL CHARACTER = '''';                                   00081800           
849               SYMBOL[CHARNUMBER] := CHARACTER;                          00081900           
850               CHARNUMBER := CHARNUMBER + 1;  READACHARACTER;            00082000           
851             UNTIL CHARACTER <> '''';                                    00082100           
852             LENGTH := CHARNUMBER - 1;  SYMBOLNAME := OTHERSYMBOL;       00082200           
853             IF LENGTH > WRITERIGHTCOL - WRITELEFTCOL + 1                00082300           
854             THEN                                                        00082400           
855               BEGIN                                                     00082500           
856                 FLUSHUNWRITTENBUFFER;  WRITELN;                         00082600           
857                 WRITELN(' *** STRING TOO LONG.');                       00082700           
858                 GOTO 13                                                 00082800           
859               END;                                                      00082900           
860           END; (*STRING*)                                               00083000           
861         '{':                                                            00083010           
862           BEGIN                                                         00083012           
863             INCOMMENT := TRUE;                                          00083014           
864             IF LASTSYMBOL IN [COMMENT, SEMICOLON] THEN                  00083016           
865               BEGIN                                                     00083018           
866                 LEFTMARGIN := 0;  STARTNEWLINEANDINDENT;                00083020           
867                 LEFTMARGIN := ACTUALLEFTMARGIN;                         00083022           
868               END;                                                      00083024           
869             REPEAT                                                      00083026           
870               COPYACHARACTER;                                           00083028           
871             UNTIL CHARACTER = '}';                                      00083030           
872             COPYACHARACTER;  LASTSYMBOL:=COMMENT; READSYMBOL;           00083032           
873           END;                                                          00083034           
874       END (*CASE*)                                                      00083100           
875     ELSE                                                                00083200           
876       BEGIN                                                             00083300           
877         IF (CHARACTER='%') OR                                           00083310           
878           ((CHARACTER='$')AND((READCOLUMN=1)OR(READCOLUMN=2)))          00083312           
879         THEN BEGIN                                                      00083313           
880           IF (CHARACTER='%') AND (READCOLUMN<11) THEN BEGIN             00083314           
881             STARTNEWLINEANDINDENT;                                      00083315           
882           END;                                                          00083316           
883           INCOMMENT:=TRUE;                                              00083317           
884           WHILE NOT CHISEOL DO BEGIN                                    00083318           
885             IF DISPLAYISON THEN WRITEA(CHARACTER);                      00083320           
886             READACHARACTER;                                             00083321           
887           END;                                                          00083322           
888           INCOMMENT:=FALSE;                                             00083325           
889           READACHARACTER;  (* NEXT ONE *)                               00083326           
890           WHILE (CHARACTER=' ') DO READACHARACTER;                      00083327           
891           IF (CHARACTER <> '%') THEN STARTNEWLINEANDINDENT;             00083328           
892           READSYMBOL;                                                   00083350           
893         END ELSE BEGIN                                                  00083360           
894           SYMBOL[1] := CHARACTER;  SYMBOLNAME := NAMEOF[CHARACTER];     00083400           
895           LENGTH := 1;  READACHARACTER                                  00083500           
896         END;                                                            00083510           
897       END                                                               00083600           
898 (* DEBUG*)                                                              00083610           
899 (*                                                                      00083615           
900 ; WRITELN; WRITELN('READSYMBOL ',SYMBOLNAME,' ',CHARACTER);             00083620           
901 *)                                                                      00083621           
902   END (*READSYMBOL*);                                                   00083700           
903                                                                         00083800           
904                                                                         00083900           
905 PROCEDURE CHANGEMARGINTO(NEWLEFTMARGIN: MARGINS);                       00084000           
906                                                                         00084100           
907   VAR                                                                   00084200           
908       INDENTEDLEFTMARGIN: MARGINS;                                      00084300           
909                                                                         00084400           
910   BEGIN                                                                 00084500           
911     ACTUALLEFTMARGIN := NEWLEFTMARGIN;  LEFTMARGIN := NEWLEFTMARGIN;    00084600           
912     IF LEFTMARGIN < 0  THEN LEFTMARGIN := 0                             00084700           
913     ELSE                                                                00084800           
914       BEGIN                                                             00084900           
915         INDENTEDLEFTMARGIN := WRITERIGHTCOL - 9 - LONGLINEINDENT;       00085000           
916         IF LEFTMARGIN > INDENTEDLEFTMARGIN                              00085100           
917         THEN LEFTMARGIN := INDENTEDLEFTMARGIN                           00085200           
918       END                                                               00085300           
919   END (*CHANGEMARGINTO*);                                               00085400           
920                                                                         00085500           
921                                                                         00085600           
922 PROCEDURE DODECLARATIONUNTIL(ENDDECLARATION: SYMBOLSET);                00085700           
923                                                                         00085800           
924                                                                         00085900           
925   PROCEDURE DOPARENTHESES;                                              00086000           
926                                                                         00086100           
927     VAR                                                                 00086200           
928                SAVEDLGLNID: OPTIONSIZE;                                 00086300           
929                                                                         00086400           
930     BEGIN                                                               00086500           
931       SAVEDLGLNID := LONGLINEINDENT;                                    00086600           
932       IF DECLARALIGNMENT > 0                                            00086700           
933       THEN                                                              00086800           
934         BEGIN                                                           00086900           
935           LONGLINEINDENT := WRITECOLUMN + SYMBOLGAP + 1 - LEFTMARGIN -  00087000           
936              WRITELEFTCOL;                                              00087100           
937           REPEAT WRITESYMBOL;  READSYMBOL;                              00087200           
938           UNTIL SYMBOLNAME = RIGHTPARENTH;                              00087300           
939           WRITESYMBOL;  READSYMBOL;                                     00087400           
940         END                                                             00087500           
941       ELSE                                                              00087600           
942         BEGIN                                                           00087700           
943           LONGLINEINDENT := 1;                                          00087800           
944           CHANGEMARGINTO(ACTUALLEFTMARGIN + INDENTINDEX);               00087900           
945           STARTNEWLINEANDINDENT;                                        00088000           
946           REPEAT WRITESYMBOL;  READSYMBOL                               00088100           
947           UNTIL SYMBOLNAME = RIGHTPARENTH;                              00088200           
948           WRITESYMBOL;  READSYMBOL;                                     00088300           
949           CHANGEMARGINTO(ACTUALLEFTMARGIN - INDENTINDEX);               00088400           
950         END (*ELSE*);                                                   00088500           
951       LONGLINEINDENT := SAVEDLGLNID;                                    00088600           
952     END (*DOPARENTHESES*);                                              00088700           
953                                                                         00088800           
954                                                                         00088900           
955   PROCEDURE DOFIELDLISTUNTIL(ENDFIELDLIST: SYMBOLSET);                  00089000           
956                                                                         00089100           
957     VAR                                                                 00089200           
958                    LASTEOL: MARGINS;                                    00089300           
959                ALIGNCOLUMN: WIDTH;                                      00089400           
960                                                                         00089500           
961                                                                         00089600           
962     PROCEDURE DORECORD;                                                 00089700           
963                                                                         00089800           
964       VAR                                                               00089900           
965              SAVEDLEFTMARGIN: WIDTH;                                    00090000           
966                                                                         00090100           
967       BEGIN                                                             00090200           
968         SAVEDLEFTMARGIN := ACTUALLEFTMARGIN;  WRITESYMBOL;  READSYMBOL; 00090300           
969         CHANGEMARGINTO(WRITECOLUMN - 6 + INDENTINDEX - WRITELEFTCOL);   00090400           
970         STARTNEWLINEANDINDENT;  DOFIELDLISTUNTIL([ENDSYMBOL]);          00090500           
971         CHANGEMARGINTO(ACTUALLEFTMARGIN - INDENTINDEX);                 00090600           
972         STARTNEWLINEANDINDENT;  WRITESYMBOL;  READSYMBOL;               00090700           
973         CHANGEMARGINTO(SAVEDLEFTMARGIN);                                00090800           
974       END (*DORECORD*);                                                 00090900           
975                                                                         00091000           
976                                                                         00091100           
977     PROCEDURE DOVARIANTRECORDPART;                                      00091200           
978                                                                         00091300           
979       VAR                                                               00091400           
980              SAVEDLEFTMARGIN,                                           00091500           
981             OTHERSAVEDMARGIN: MARGINS;                                  00091600           
982                                                                         00091700           
983       BEGIN                                                             00091800           
984         OTHERSAVEDMARGIN := ACTUALLEFTMARGIN;                           00091900           
985         IF DECLARALIGNMENT > 0                                          00092000           
986         THEN                                                            00092100           
987           BEGIN                                                         00092200           
988             REPEAT WRITESYMBOL;  READSYMBOL;                            00092300           
989             UNTIL SYMBOLNAME IN [COLONSYMBOL, OFSYMBOL];                00092400           
990             IF SYMBOLNAME = COLONSYMBOL                                 00092500           
991             THEN                                                        00092600           
992               BEGIN                                                     00092700           
993                 WRITESYMBOL;  READSYMBOL;                               00092800           
994                 WITH UNWRITTEN[LASTEOL] DO                              00092900           
995                   BEGIN                                                 00093000           
996                     INDENTAFTEREOL := INDENTAFTEREOL + ALIGNCOLUMN -    00093100           
997                        WRITECOLUMN;                                     00093200           
998                     IF INDENTAFTEREOL < 0  THEN INDENTAFTEREOL := 0;    00093300           
999                   END;                                                  00093400           
1000                 WRITECOLUMN := ALIGNCOLUMN;                             00093500           
1001                 CHANGEMARGINTO(ACTUALLEFTMARGIN + ALIGNCOLUMN -         00093600           
1002                    WRITECOLUMN);                                        00093700           
1003               END;                                                      00093800           
1004           END;                                                          00093900           
1005         IF SYMBOLNAME <> OFSYMBOL THEN                                  00094000           
1006           REPEAT WRITESYMBOL;  READSYMBOL;  UNTIL SYMBOLNAME = OFSYMBOL;00094100           
1007         CHANGEMARGINTO(ACTUALLEFTMARGIN + INDENTINDEX);                 00094200           
1008         REPEAT                                                          00094300           
1009           WRITESYMBOL;  READSYMBOL;                                     00094400           
1010           IF SYMBOLNAME <> ENDSYMBOL                                    00094500           
1011           THEN                                                          00094600           
1012             BEGIN                                                       00094700           
1013               STARTNEWLINEANDINDENT;                                    00094800           
1014               REPEAT WRITESYMBOL;  READSYMBOL;                          00094900           
1015               UNTIL SYMBOLNAME IN [LEFTPARENTH, SEMICOLON, ENDSYMBOL];  00095000           
1016               IF SYMBOLNAME = LEFTPARENTH                               00095100           
1017               THEN                                                      00095200           
1018                 BEGIN                                                   00095300           
1019                   WRITESYMBOL;  READSYMBOL;                             00095400           
1020                   SAVEDLEFTMARGIN := ACTUALLEFTMARGIN;                  00095500           
1021                   CHANGEMARGINTO(WRITECOLUMN - WRITELEFTCOL);           00095600           
1022                   DOFIELDLISTUNTIL([RIGHTPARENTH]);  WRITESYMBOL;       00095700           
1023                   READSYMBOL;  CHANGEMARGINTO(SAVEDLEFTMARGIN);         00095800           
1024                 END;                                                    00095900           
1025             END;                                                        00096000           
1026         UNTIL SYMBOLNAME <> SEMICOLON;                                  00096100           
1027         CHANGEMARGINTO(OTHERSAVEDMARGIN);                               00096200           
1028       END (*DOVARIANTRECORDPART*);                                      00096300           
1029                                                                         00096400           
1030                                                                         00096500           
1031     BEGIN (*DOFIELDLISTUNTIL*)                                          00096600           
1032       LASTEOL := OLDEST;                                                00096700           
1033       IF LASTSYMBOL = LEFTPARENTH                                       00096800           
1034       THEN FOR I := 1 TO DECLARALIGNMENT - LENGTH DO WRITEA(' ');       00096900           
1035       ALIGNCOLUMN := LEFTMARGIN + WRITELEFTCOL + DECLARALIGNMENT + 1;   00097000           
1036       WHILE NOT (SYMBOLNAME IN ENDFIELDLIST) DO                         00097100           
1037         BEGIN                                                           00097200           
1038           IF LASTSYMBOL IN [SEMICOLON, COMMENT] THEN                    00097300           
1039             IF SYMBOLNAME <> SEMICOLON                                  00097400           
1040             THEN BEGIN STARTNEWLINEANDINDENT;  LASTEOL := OLDEST END;   00097500           
1041           IF SYMBOLNAME IN [RECORDSYMBOL, CASESYMBOL, LEFTPARENTH,      00097600           
1042              COMMASYMBOL, COLONSYMBOL, EQUALSYMBOL]                     00097700           
1043           THEN                                                          00097800           
1044             CASE SYMBOLNAME OF                                          00097900           
1045               RECORDSYMBOL: DORECORD;                                   00098000           
1046               CASESYMBOL: DOVARIANTRECORDPART;                          00098100           
1047               LEFTPARENTH: DOPARENTHESES;                               00098200           
1048               COMMASYMBOL, COLONSYMBOL, EQUALSYMBOL:                    00098300           
1049                 BEGIN                                                   00098400           
1050                   WRITESYMBOL;                                          00098500           
1051                   IF DECLARALIGNMENT > 0                                00098600           
1052                   THEN                                                  00098700           
1053                     IF NOT (ENDLABEL <= ENDFIELDLIST)                   00098800           
1054                     THEN                                                00098900           
1055                       BEGIN                                             00099000           
1056                         WITH UNWRITTEN[LASTEOL] DO                      00099100           
1057                           BEGIN                                         00099200           
1058                             INDENTAFTEREOL := INDENTAFTEREOL +          00099300           
1059                                ALIGNCOLUMN - WRITECOLUMN;               00099400           
1060                             IF INDENTAFTEREOL < 0                       00099500           
1061                             THEN INDENTAFTEREOL := 0;                   00099600           
1062                             WRITECOLUMN := ALIGNCOLUMN;                 00099700           
1063                           END;                                          00099800           
1064                         IF SYMBOLNAME = COMMASYMBOL THEN                00099900           
1065                           BEGIN                                         00100000           
1066                             STARTNEWLINEANDINDENT;  LASTEOL := OLDEST;  00100100           
1067                           END;                                          00100200           
1068                       END (*IF DECLARALIGNMENT*);                       00100300           
1069                   READSYMBOL;                                           00100400           
1070                 END (*  ,   :   =  *)                                   00100500           
1071             END (*CASE*)                                                00100600           
1072           ELSE BEGIN WRITESYMBOL;  READSYMBOL END;                      00100700           
1073         END (*WHILE*);                                                  00100800           
1074     END (*DOFIELDLISTUNTIL*);                                           00100900           
1075                                                                         00101000           
1076                                                                         00101100           
1077   BEGIN (*DODECLARATIONUNTIL*)                                          00101200           
1078     STARTNEWLINEANDINDENT;  WRITESYMBOL;                                00101300           
1079     CHANGEMARGINTO(ACTUALLEFTMARGIN + INDENTINDEX);                     00101400           
1080     STARTNEWLINEANDINDENT;  READSYMBOL;                                 00101500           
1081     DOFIELDLISTUNTIL(ENDDECLARATION);  STARTNEWLINEANDINDENT;           00101600           
1082     CHANGEMARGINTO(ACTUALLEFTMARGIN - INDENTINDEX);                     00101700           
1083   END (*DODECLARATIONUNTIL*);                                           00101800           
1084                                                                         00101900           
1085                                                                         00102000           
1086 PROCEDURE DOBLOCK(BLOCKNAME: COMMENTTEXT; BLOCKNMLENGTH: WIDTH);        00102100           
1087                                                                         00102200           
1088   VAR                                                                   00102300           
1089                        I: WIDTH;                                        00102400           
1090        IFTHENBUNCHNEEDED: BOOLEAN;                                      00102500           
1091          ATPROCBEGINNING: BOOLEAN;                                      00102600           
1092                                                                         00102700           
1093                                                                         00102800           
1094   PROCEDURE DOPROCEDURES;                                               00102900           
1095                                                                         00103000           
1096     VAR                                                                 00103100           
1097                          I: 0 .. 20;                                    00103200           
1098                   PROCNAME: COMMENTTEXT;                                00103300           
1099               PROCNMLENGTH: WIDTH;                                      00103400           
1100                                                                         00103500           
1101     BEGIN                                                               00103600           
1102       FOR I := 2 TO PROCSEPARATION DO STARTNEWLINEANDINDENT;            00103700           
1103       STARTNEWLINEANDINDENT;  WRITESYMBOL;  READSYMBOL;                 00103800           
1104       FOR I := 0 TO (LENGTH - 1) DIV ALFALENG DO                        00103900           
1105         PACK(SYMBOL, I * ALFALENG + 1, PROCNAME[I + 1]);                00104000           
1106       PROCNMLENGTH := LENGTH;  WRITESYMBOL;  READSYMBOL;                00104100           
1107       IF SYMBOLNAME = LEFTPARENTH THEN                                  00104200           
1108         BEGIN                                                           00104300           
1109           WRITESYMBOL;                                                  00104400           
1110           REPEAT READSYMBOL;  WRITESYMBOL                               00104500           
1111           UNTIL SYMBOLNAME = RIGHTPARENTH;                              00104600           
1112           READSYMBOL;                                                   00104700           
1113         END;                                                            00104800           
1114       IF SYMBOLNAME = COLONSYMBOL THEN                                  00104900           
1115         REPEAT WRITESYMBOL;  READSYMBOL;  UNTIL SYMBOLNAME = SEMICOLON; 00105000           
1116       WRITESYMBOL;  READSYMBOL;                                         00105100           
1117       CHANGEMARGINTO(ACTUALLEFTMARGIN + INDENTINDEX);                   00105200           
1118       STARTNEWLINEANDINDENT;  LASTPROGPARTWASBODY := FALSE;             00105300           
1119       DOBLOCK(PROCNAME, PROCNMLENGTH);  LASTPROGPARTWASBODY := TRUE;    00105400           
1120       CHANGEMARGINTO(ACTUALLEFTMARGIN - INDENTINDEX);  WRITESYMBOL;     00105500           
1121       READSYMBOL;  STARTNEWLINEANDINDENT;                               00105600           
1122     END (*DOPROCEDURES*);                                               00105700           
1123                                                                         00105800           
1124                                                                         00105900           
1125   PROCEDURE DOSTATEMENT(VAR ADDEDBLANKS: WIDTH; STATMTSYMBOL:           00106000           
1126      COMMENTTEXT; STMTSYMLENGTH: WIDTH);                                00106100           
1127                                                                         00106200           
1128     VAR                                                                 00106300           
1129                          I: WIDTH;                                      00106400           
1130            STATMTBEGINNING: INTEGER;                                    00106500           
1131                 STATMTPART: ARRAY [1 .. 4] OF INTEGER;                  00106600           
1132           BLKSONCURRNTLINE,                                             00106700           
1133        BLKSADDEDBYTHISSTMT: INTEGER;                                    00106800           
1134                 SUCCESSFUL: BOOLEAN;                                    00106900           
1135                                                                         00107000           
1136                                                                         00107100           
1137     PROCEDURE BUNCH(BEGINNING, BREAKPT, ENDING: INTEGER;                00107200           
1138        STATMTSEPARATION: OPTIONSIZE);                                   00107300           
1139                                                                         00107400           
1140       BEGIN                                                             00107500           
1141         IF BUNCHWANTED OR IFTHENBUNCHNEEDED                             00107600           
1142         THEN                                                            00107700           
1143           BEGIN                                                         00107800           
1144             IF STATMTSEPARATION < 1  THEN STATMTSEPARATION := 1;        00107900           
1145             BLKSONCURRNTLINE := BLKSONCURRNTLINE + STATMTSEPARATION - 1;00108000           
1146             SUCCESSFUL := ((ENDING - BEGINNING + BLKSONCURRNTLINE +     00108100           
1147                UNWRITTEN[BEGINNING MOD BUFFERSIZE].INDENTAFTEREOL) <    00108200           
1148                WRITERIGHTCOL) AND (CHARCOUNT - BEGINNING < BUFFERSIZE); 00108300           
1149             IF SUCCESSFUL                                               00108400           
1150             THEN                                                        00108500           
1151               BEGIN                                                     00108600           
1152                 BLKSADDEDBYTHISSTMT := BLKSADDEDBYTHISSTMT +            00108700           
1153                    STATMTSEPARATION - 1;                                00108800           
1154                 UNWRITTEN[BREAKPT MOD BUFFERSIZE].INDENTAFTEREOL := -   00108900           
1155                    STATMTSEPARATION;                                    00109000           
1156               END;                                                      00109100           
1157           END;                                                          00109200           
1158       END (*BUNCH*);                                                    00109300           
1159                                                                         00109400           
1160                                                                         00109500           
1161     PROCEDURE WRITECOMMENT;                                             00109600           
1162                                                                         00109700           
1163       VAR                                                               00109800           
1164                            I: WIDTH;                                    00109900           
1165                  SAVEDLENGTH: WIDTH;                                    00110000           
1166              SAVEDSYMBOLNAME: SYMBOLS;                                  00110100           
1167                   SAVEDCHARS: SYMBOLSTRING;                             00110200           
1168                                                                         00110300           
1169       BEGIN                                                             00110400           
1170         SAVEDSYMBOLNAME := SYMBOLNAME;                                  00110500           
1171         FOR I := 1 TO LENGTH DO SAVEDCHARS[I] := SYMBOL[I];             00110600           
1172         SAVEDLENGTH := LENGTH;  SYMBOLNAME := OTHERSYMBOL;              00110700           
1173         SYMBOL[1] := '(';  SYMBOL[2] := '*';  LENGTH := 2;  WRITESYMBOL;00110800           
1174         FOR I := 0 TO (STMTSYMLENGTH - 1) DIV ALFALENG DO               00110900           
1175           UNPACK(STATMTSYMBOL[I + 1], SYMBOL, (I * ALFALENG + 1));      00111000           
1176         LENGTH := STMTSYMLENGTH;  SYMBOLNAME := PERIODSYMBOL;           00111100           
1177         LASTSYMBOL := PERIODSYMBOL;  WRITESYMBOL;  SYMBOL[1] := '*';    00111200           
1178         SYMBOL[2] := ')';  LENGTH := 2;  WRITESYMBOL;                   00111300           
1179         SYMBOLNAME := SAVEDSYMBOLNAME;  LENGTH := SAVEDLENGTH;          00111400           
1180         FOR I := 1 TO LENGTH DO SYMBOL[I] := SAVEDCHARS[I];             00111500           
1181       END (*WRITECOMMENT*);                                             00111600           
1182                                                                         00111700           
1183                                                                         00111800           
1184     PROCEDURE DOSTMTLIST(ENDLIST: SYMBOLS);                             00111900           
1185                                                                         00112000           
1186       VAR                                                               00112100           
1187                BLKSAFTERPRT2: WIDTH;                                    00112200           
1188                    ATPROCEND: BOOLEAN;                                  00112300           
1189                                                                         00112400           
1190       BEGIN                                                             00112500           
1191         ATPROCEND := ATPROCBEGINNING;  WRITESYMBOL;  READSYMBOL;        00112600           
1192         STATMTPART[1] := CHARCOUNT + 1;  STATMTPART[2] := STATMTPART[1];00112700           
1193         IF SYMBOLNAME <> ENDLIST                                        00112800           
1194         THEN                                                            00112900           
1195           BEGIN                                                         00113000           
1196             IF PROCNAMESWANTED THEN                                     00113100           
1197               IF ATPROCBEGINNING THEN                                   00113200           
1198                 IF LASTPROGPARTWASBODY                                  00113300           
1199                 THEN IF LASTSYMBOL = BEGINSYMBOL  THEN WRITECOMMENT;    00113400           
1200             ATPROCBEGINNING := FALSE;                                   00113500           
1201             DOSTATEMENT(ADDEDBLANKS, STATMTSYMBOL, STMTSYMLENGTH);      00113600           
1202             BLKSAFTERPRT2 := ADDEDBLANKS;                               00113700           
1203             BLKSADDEDBYTHISSTMT := BLKSADDEDBYTHISSTMT + ADDEDBLANKS;   00113800           
1204             WHILE SYMBOLNAME <> ENDLIST DO                              00113900           
1205               BEGIN                                                     00114000           
1206                 WRITESYMBOL;  READSYMBOL;                               00114100           
1207                 IF SYMBOLNAME <> ENDLIST                                00114200           
1208                 THEN                                                    00114300           
1209                   BEGIN                                                 00114400           
1210                     STATMTPART[3] := CHARCOUNT + 1;                     00114500           
1211                     DOSTATEMENT(ADDEDBLANKS, STATMTSYMBOL,              00114600           
1212                       STMTSYMLENGTH);                                   00114700           
1213                     BLKSONCURRNTLINE := ADDEDBLANKS + BLKSAFTERPRT2;    00114800           
1214                     BLKSADDEDBYTHISSTMT := BLKSADDEDBYTHISSTMT +        00114900           
1215                        ADDEDBLANKS;                                     00115000           
1216                     BUNCH(STATMTPART[2], STATMTPART[3], CHARCOUNT,      00115100           
1217                        STATMTSEPARATION);                               00115200           
1218                     IF NOT SUCCESSFUL                                   00115300           
1219                     THEN                                                00115400           
1220                       BEGIN                                             00115500           
1221                         BLKSAFTERPRT2 := ADDEDBLANKS;                   00115600           
1222                         STATMTPART[2] := STATMTPART[3];                 00115700           
1223                       END                                               00115800           
1224                     ELSE BLKSAFTERPRT2 := BLKSONCURRNTLINE;             00115900           
1225                   END;                                                  00116000           
1226               END (*WHILE SYMBOLNAME <> ENDLIST*);                      00116100           
1227           END (*IF SYMBOLNAME <> ENDLIST*);                             00116200           
1228         BLKSONCURRNTLINE := BLKSADDEDBYTHISSTMT;                        00116300           
1229         BUNCH(STATMTBEGINNING, STATMTPART[1], CHARCOUNT, SYMBOLGAP);    00116400           
1230         STARTNEWLINEANDINDENT;  STATMTPART[1] := CHARCOUNT;             00116500           
1231         REPEAT WRITESYMBOL;  READSYMBOL;                                00116600           
1232         UNTIL SYMBOLNAME IN [SEMICOLON, UNTILSYMBOL, ENDSYMBOL,         00116700           
1233            ELSESYMBOL, PERIODSYMBOL];                                   00116800           
1234         IF SUCCESSFUL                                                   00116900           
1235         THEN                                                            00117000           
1236           BEGIN                                                         00117100           
1237             IF ENDLIST = UNTILSYMBOL                                    00117200           
1238             THEN STATMTPART[4] := STATMTSEPARATION                      00117300           
1239             ELSE STATMTPART[4] := SYMBOLGAP;                            00117400           
1240             BUNCH(STATMTBEGINNING, STATMTPART[1], CHARCOUNT,            00117500           
1241                STATMTPART[4]);                                          00117600           
1242           END (*IF SUCCESSFUL*);                                        00117700           
1243         IF NOT (SUCCESSFUL AND BUNCHWANTED)                             00117800           
1244         THEN                                                            00117900           
1245           IF ENDLIST = ENDSYMBOL THEN                                   00118000           
1246             IF LASTSYMBOL = ENDSYMBOL THEN                              00118100           
1247               IF ATPROCEND AND PROCNAMESWANTED  THEN WRITECOMMENT       00118200           
1248               ELSE IF ENDCOMMENTSWANTED  THEN WRITECOMMENT;             00118300           
1249       END (*DOSTMTLIST*);                                               00118400           
1250                                                                         00118500           
1251                                                                         00118600           
1252     BEGIN (*DOSTATEMENT*)                                               00118700           
1253       BLKSONCURRNTLINE := 0;  SUCCESSFUL := FALSE;                      00118800           
1254       BLKSADDEDBYTHISSTMT := 0;                                         00118900           
1255       CHANGEMARGINTO(ACTUALLEFTMARGIN + INDENTINDEX);                   00119000           
1256       STARTNEWLINEANDINDENT;  STATMTBEGINNING := CHARCOUNT;             00119100           
1257       IF SYMBOLISNUMBER                                                 00119200           
1258       THEN                                                              00119300           
1259         BEGIN                                                           00119400           
1260           WITH UNWRITTEN[OLDEST] DO                                     00119500           
1261             BEGIN                                                       00119600           
1262               INDENTAFTEREOL := INDENTAFTEREOL - 1 - LENGTH - SYMBOLGAP;00119700           
1263               IF INDENTAFTEREOL < 0  THEN INDENTAFTEREOL := 0;          00119800           
1264             END;                                                        00119900           
1265           WRITESYMBOL;  READSYMBOL (*WRITE LABEL*);  WRITESYMBOL;       00120000           
1266           READSYMBOL (*WRITE COLON*);                                   00120100           
1267         END;                                                            00120200           
1268       CASE STATEMENTTYPEOF[SYMBOLNAME] OF                               00120300           
1269         FORWITHWHILESTATEMENT:                                          00120400           
1270           BEGIN                                                         00120500           
1271             PACK(SYMBOL, 1, STATMTSYMBOL[1]);  STMTSYMLENGTH := LENGTH; 00120600           
1272             REPEAT WRITESYMBOL;  READSYMBOL                             00120700           
1273             UNTIL SYMBOLNAME = DOSYMBOL;                                00120800           
1274             WRITESYMBOL;  READSYMBOL;  STATMTPART[1] := CHARCOUNT + 1;  00120900           
1275             DOSTATEMENT(ADDEDBLANKS, STATMTSYMBOL, STMTSYMLENGTH);      00121000           
1276             BLKSONCURRNTLINE := BLKSONCURRNTLINE + ADDEDBLANKS;         00121100           
1277             BLKSADDEDBYTHISSTMT := BLKSADDEDBYTHISSTMT + ADDEDBLANKS;   00121200           
1278             BUNCH(STATMTBEGINNING, STATMTPART[1], CHARCOUNT, SYMBOLGAP);00121300           
1279           END;                                                          00121400           
1280         REPEATSTATEMENT: DOSTMTLIST(UNTILSYMBOL);                       00121500           
1281         IFSTATEMENT:                                                    00121600           
1282           BEGIN                                                         00121700           
1283             PACK(SYMBOL, 1, STATMTSYMBOL[1]);  STMTSYMLENGTH := LENGTH; 00121800           
1284             REPEAT WRITESYMBOL;  READSYMBOL                             00121900           
1285             UNTIL SYMBOLNAME = THENSYMBOL;                              00122000           
1286             STARTNEWLINEANDINDENT;  STATMTPART[1] := CHARCOUNT;         00122100           
1287             WRITESYMBOL;  READSYMBOL;  STATMTPART[2] := CHARCOUNT + 1;  00122200           
1288             DOSTATEMENT(ADDEDBLANKS, STATMTSYMBOL, STMTSYMLENGTH);      00122300           
1289 (*DEBUG *)                                                              00122310           
1290 (*                                                                      00122315           
1291  WRITELN; WRITELN('IF1 ',SYMBOLNAME,' ',CHARACTER,' ',SUCCESSFUL,' ',   00122320           
1292     CHARCOUNT,' ',STATMTBEGINNING);                                     00122330           
1293 *)                                                                      00122340           
1294             BLKSONCURRNTLINE := ADDEDBLANKS;                            00122400           
1295             BLKSADDEDBYTHISSTMT := ADDEDBLANKS;                         00122500           
1296             BUNCH(STATMTPART[1], STATMTPART[2], CHARCOUNT, SYMBOLGAP);  00122600           
1297             IF SUCCESSFUL                                               00122700           
1298             THEN                                                        00122800           
1299               BUNCH(STATMTBEGINNING, STATMTPART[1], CHARCOUNT,          00122900           
1300                  STATMTSEPARATION)                                      00123000           
1301             ELSE IFTHENBUNCHNEEDED := TRUE;                             00123100           
1302             IF SYMBOLNAME = ELSESYMBOL                                  00123200           
1303             THEN                                                        00123300           
1304               BEGIN                                                     00123400           
1305                 PACK(SYMBOL, 1, STATMTSYMBOL[1]);                       00123500           
1306                 STMTSYMLENGTH := LENGTH;  IFTHENBUNCHNEEDED := FALSE;   00123600           
1307                 STARTNEWLINEANDINDENT;  STATMTPART[3] := CHARCOUNT;     00123700           
1308                 WRITESYMBOL;  READSYMBOL;                               00123800           
1309                 STATMTPART[4] := CHARCOUNT + 1;                         00123900           
1310                 DOSTATEMENT(ADDEDBLANKS, STATMTSYMBOL, STMTSYMLENGTH);  00124000           
1311                 BLKSONCURRNTLINE := ADDEDBLANKS;                        00124100           
1312                 BLKSADDEDBYTHISSTMT := BLKSADDEDBYTHISSTMT +            00124200           
1313                    ADDEDBLANKS;                                         00124300           
1314                 BUNCH(STATMTPART[3], STATMTPART[4], CHARCOUNT,          00124400           
1315                    SYMBOLGAP);                                          00124500           
1316                 BLKSONCURRNTLINE := BLKSADDEDBYTHISSTMT;                00124600           
1317                 IF SUCCESSFUL THEN                                      00124700           
1318                   BUNCH(STATMTBEGINNING, STATMTPART[3], CHARCOUNT,      00124800           
1319                      STATMTSEPARATION);                                 00124900           
1320               END                                                       00125000           
1321             ELSE                                                        00125100           
1322               IF (CHARCOUNT - STATMTBEGINNING) < BUFFERSIZE             00125200           
1323               THEN                                                      00125300           
1324                 BEGIN                                                   00125400           
1325                   BUNCHWANTED := NOT BUNCHWANTED;                       00125500           
1326                   BLKSONCURRNTLINE := 0;                                00125600           
1327                   BUNCH(STATMTBEGINNING, STATMTPART[1], STATMTPART[2],  00125700           
1328                      SYMBOLGAP);                                        00125800           
1329                   BUNCHWANTED := NOT BUNCHWANTED;                       00125900           
1330                 END;                                                    00126000           
1331             IFTHENBUNCHNEEDED := FALSE;                                 00126100           
1332           END (*IFSTATEMENT*);                                          00126200           
1333         CASESTATEMENT:                                                  00126300           
1334           BEGIN                                                         00126400           
1335             REPEAT WRITESYMBOL;  READSYMBOL                             00126500           
1336             UNTIL SYMBOLNAME = OFSYMBOL;                                00126600           
1337             WRITESYMBOL;  READSYMBOL;                                   00126700           
1338             CHANGEMARGINTO(ACTUALLEFTMARGIN + INDENTINDEX);             00126800           
1339             WHILE NOT (SYMBOLNAME IN [OWISESYMBOL, ENDSYMBOL]) DO       00126900           
1340               BEGIN                                                     00127000           
1341                 STARTNEWLINEANDINDENT;  STATMTPART[1] := CHARCOUNT;     00127100           
1342                 FOR I := 0 TO (LENGTH - 1) DIV ALFALENG DO              00127200           
1343                   PACK(SYMBOL, (I * ALFALENG + 1), STATMTSYMBOL[I + 1]);00127300           
1344                 STMTSYMLENGTH := LENGTH;                                00127400           
1345                 REPEAT WRITESYMBOL;  READSYMBOL                         00127500           
1346                 UNTIL SYMBOLNAME = COLONSYMBOL;                         00127600           
1347                 WRITESYMBOL;  READSYMBOL;                               00127700           
1348                 IF NOT (SYMBOLNAME IN [SEMICOLON, ENDSYMBOL])           00127800           
1349                 THEN                                                    00127900           
1350                   BEGIN                                                 00128000           
1351                     STATMTPART[2] := CHARCOUNT + 1;                     00128100           
1352                     DOSTATEMENT(ADDEDBLANKS, STATMTSYMBOL,              00128200           
1353                        STMTSYMLENGTH);                                  00128300           
1354                     BLKSONCURRNTLINE := ADDEDBLANKS;                    00128400           
1355                     BLKSADDEDBYTHISSTMT := BLKSADDEDBYTHISSTMT +        00128500           
1356                        ADDEDBLANKS;                                     00128600           
1357                     BUNCH(STATMTPART[1], STATMTPART[2], CHARCOUNT,      00128700           
1358                        SYMBOLGAP);                                      00128800           
1359                   END (*IF NOT(SYMBOLNAME...)*);                        00128900           
1360                 IF SYMBOLNAME = SEMICOLON                               00129000           
1361                 THEN BEGIN WRITESYMBOL;  READSYMBOL; END;               00129100           
1362               END;                                                      00129200           
1363             CHANGEMARGINTO(ACTUALLEFTMARGIN - INDENTINDEX);             00129300           
1364             STATMTSYMBOL[1] := 'CASE      ';  STMTSYMLENGTH := 4;       00129400           
1365             IF SYMBOLNAME = OWISESYMBOL                                 00129500           
1366             THEN                                                        00129600           
1367               BEGIN                                                     00129700           
1368                 STARTNEWLINEANDINDENT; DOSTMTLIST(ENDSYMBOL);           00129800           
1369               END                                                       00129900           
1370             ELSE                                                        00130000           
1371               BEGIN                                                     00130100           
1372                 STARTNEWLINEANDINDENT;  WRITESYMBOL;  READSYMBOL;       00130200           
1373                 IF ENDCOMMENTSWANTED AND (LASTSYMBOL = ENDSYMBOL)       00130300           
1374                 THEN WRITECOMMENT                                       00130400           
1375               END;                                                      00130500           
1376           END (*CASESTATEMENT*);                                        00130600           
1377         OTHERSTATEMENT:                                                 00130700           
1378           BEGIN                                                         00130800           
1379             WHILE NOT (SYMBOLNAME IN [SEMICOLON, UNTILSYMBOL, ENDSYMBOL,00130900           
1380                ELSESYMBOL]) DO                                          00131000           
1381               BEGIN WRITESYMBOL;  READSYMBOL END;                       00131100           
1382           END (*OTHER*);                                                00131200           
1383         COMPOUNDSTATEMENT: DOSTMTLIST(ENDSYMBOL)                        00131300           
1384       END (*CASE*);                                                     00131400           
1385       ADDEDBLANKS := BLKSADDEDBYTHISSTMT;                               00131500           
1386       CHANGEMARGINTO(ACTUALLEFTMARGIN - INDENTINDEX);                   00131600           
1387     END (*DOSTATEMENT*);                                                00131700           
1388                                                                         00131800           
1389                                                                         00131900           
1390   BEGIN (*DOBLOCK*)                                                     00132000           
1391     LASTPROGPARTWASBODY := LASTPROGPARTWASBODY AND (SYMBOLNAME =        00132100           
1392        BEGINSYMBOL);                                                    00132200           
1393     IF SYMBOLNAME = LABELSYMBOL  THEN DODECLARATIONUNTIL(ENDLABEL);     00132300           
1394     IF SYMBOLNAME = CONSTSYMBOL  THEN DODECLARATIONUNTIL(ENDCONST);     00132400           
1395     IF SYMBOLNAME = TYPESYMBOL  THEN DODECLARATIONUNTIL(ENDTYPE);       00132500           
1396     IF SYMBOLNAME = VARSYMBOL  THEN DODECLARATIONUNTIL(ENDVAR);         00132600           
1397     IF SYMBOLNAME = VALUESYMBOL  THEN DODECLARATIONUNTIL(ENDVALUE);     00132700           
1398     WHILE SYMBOLNAME IN [FUNCSYMBOL, PROCSYMBOL] DO DOPROCEDURES;       00132800           
1399     IF SYMBOLNAME = BEGINSYMBOL                                         00132900           
1400     THEN                                                                00133000           
1401       BEGIN                                                             00133100           
1402         IF LASTPROGPARTWASBODY                                          00133200           
1403         THEN FOR I := 2 TO PROCSEPARATION DO STARTNEWLINEANDINDENT;     00133300           
1404         IFTHENBUNCHNEEDED := FALSE;  ATPROCBEGINNING := TRUE;           00133400           
1405         CHANGEMARGINTO(ACTUALLEFTMARGIN - INDENTINDEX);                 00133500           
1406         DOSTATEMENT(I, BLOCKNAME, BLOCKNMLENGTH) (* I IS DUMMY PARAM *);00133600           
1407         LASTPROGPARTWASBODY := TRUE;                                    00133700           
1408         CHANGEMARGINTO(ACTUALLEFTMARGIN + INDENTINDEX);                 00133800           
1409       END                                                               00133900           
1410     ELSE BEGIN WRITESYMBOL;  READSYMBOL (*WRITE FORWARD*) END           00134000           
1411   END (*DOBLOCK*);                                                      00134100           
1412                                                                         00134200           
1413                                                                         00137600           
1414 BEGIN (*MAINPROGRAM*)                                                   00137700           
1415   MAIN[1] := 'MAIN      ';  MAINNMLENGTH := 4;                          00137900           
1416   IF EOF(INPUT) THEN BEGIN                                              00138000           
1417     WRITELN(' *** NO PROGRAM FOUND TO SPRUCE.');                        00138010           
1418     HALT;                                                               00138020           
1419   END                                                                   00138030           
1420   ELSE                                                                  00138100           
1421     BEGIN                                                               00138200           
1422       INITIALIZE;  READACHARACTER;  READSYMBOL;                         00138300           
1423       IF SYMBOLNAME <> PROGSYMBOL                                       00138400           
1424       THEN WRITELN(' *** "PROGRAM" EXPECTED.')                          00138500           
1425       ELSE                                                              00138600           
1426         BEGIN                                                           00138700           
1427 (*                                                                      00138800           
1428       ***************************************************************   00138900           
1429       *                                                             *   00139000           
1430       *            F O R M A T    T H E    P R O G R A M            *   00139100           
1431       *            - - - - - -    - - -    - - - - - - -            *   00139200           
1432       *                                                             *   00139300           
1433       ***************************************************************   00139400           
1434 *)                                                                      00139500           
1435           STARTNEWLINEANDINDENT;                                        00139600           
1436           WRITESYMBOL;  READSYMBOL;                                     00139700           
1437           FOR I := 0 TO (LENGTH - 1) DIV ALFALENG DO                    00139800           
1438             PACK(SYMBOL, (I * ALFALENG + 1), MAIN[I + 1]);              00139900           
1439           MAINNMLENGTH := LENGTH;                                       00140000           
1440           REPEAT WRITESYMBOL;  READSYMBOL  UNTIL SYMBOLNAME = SEMICOLON;00140100           
1441           WRITESYMBOL;  READSYMBOL;  STARTNEWLINEANDINDENT;             00140200           
1442           DOBLOCK(MAIN, MAINNMLENGTH);  WRITEA('.');                    00140300           
1443           FLUSHUNWRITTENBUFFER;                                         00140400           
1444           IF SYMBOLNAME <> PERIODSYMBOL                                 00140500           
1445           THEN                                                          00140600           
1446             BEGIN                                                       00140700           
1447           13: WRITELN;  WRITELN(' *** ERRORS FOUND IN PASCAL PROGRAM.');00140800           
1448               HALT;                                                     00140910           
1449             END                                                         00141000           
1450           ELSE (* WRITELN(' SPRUCE COMPLETE.')*);                       00141100           
1451         END;                                                            00141200           
1452     END;                                                                00141300           
1453 END (*MAINPROGRAM*).                                                    00141400           