home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / print / adafmt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-03  |  139.2 KB  |  2,511 lines
  1. (*====================================================================*)
  2. (*                                                                    *)
  3. (*  PROGRAM TITLE: ADA PRETTYPRINTING PROGRAM                         *)
  4. (*                                                                    *)
  5. (*  AUTHORS: MARLOW HENNE AIR FORCE ARMANENT LABORATORY(DLMM) AND     *)
  6. (*           LARRY NEAL, GENERAL RESEARCH CORP,FT WALTON BEACH,FLA    *)
  7. (*                                                                    *)
  8. (*  HISTORY: THIS PROGRAM IS AN ADAPTION OF A PASCAL PRETTYPRINTER    *)
  9. (*           WRITTEN ORIGINALLY BY JON F. HUERAS AND HENRY F.         *)
  10. (*           LEDGARDOF THE COMPUTER AND INFORMATION SCIENCE DEPARTMENT*)
  11. (*           UNIVERSITY OF MASSACHUSETTS, AMHERST IN AUGUST 1976,     *)
  12. (*           WITH EARLIER VERSIONS AND CONTRIBUTIONS BY RNADY CHOW    *)
  13. (*           AND JOHN GORMAN.  CONTRIBUTIONS TO THE ORIGNIAL PASCAL   *)
  14. (*           WAS ALSO MADE TO MODIFY IT FOR THE CDC-6000 PASCAL       *)
  15. (*           RELEASE 3 BY RICK L. MARCUS,UNIVERSITY COMPUTER CENTER,  *)
  16. (*           UNIVERSITY OF MINNESOTA IN SEPTEMBER 1978.               *)
  17. (*                                                                    *)
  18. (*  PROGRAM SUMMARY:                                                  *)
  19. (*                                                                    *)
  20. (*     THIS PROGRAM TAKES AS INPUT AN ADA PROGRAM AND                 *)
  21. (*     REFORMATS THE PROGRAM ACCORDING TO A STANDARD SET OF           *)
  22. (*     PRETTYPRINTING RULES. THE PRETTYPRINTED PROGRAM IS GIVEN       *)
  23. (*     AS OUTPUT.  THE PRETTYPRINTING RULES ARE GIVEN BELOW.          *)
  24. (*                                                                    *)
  25. (*     NO ATTEMPT IS MADE TO DETECT OR CORRECT SYNTACTIC ERRORS IN    *)
  26. (*     THE USER'S PROGRAM.  HOWEVER, SYNTACTIC ERRORS MAY RESULT IN   *)
  27. (*     ERRONEOUS PRETTYPRINTING.                                      *)
  28. (*                                                                    *)
  29. (*                                                                    *)
  30. (*  INPUT FILE: INPUT   - A FILE OF CHARACTERS, PRESUMABLY AN         *)
  31. (*                        ADA PROGRAM OR PROGRAM FRAGMENT.            *)
  32. (*                                                                    *)
  33. (*  OUTPUT FILE: OUTPUT - THE PRETTYPRINTED PROGRAM.                  *)
  34. (*                                                                    *)
  35. (*  PROCEURES/FUNCTIONS USED                                          *)
  36. (*                          INITIALIZE                                *)
  37. (*                          GETSYMBOL                                 *)
  38. (*                          INSERTCR                                  *)
  39. (*                          INSERTBLANKLINE                           *)
  40. (*                          LSHIFT                                    *)
  41. (*                          INSERTSPACE                               *)
  42. (*                          PPSYMBOL                                  *)
  43. (*                          RSHIFT                                    *)
  44. (*                          GOBBLE                                    *)
  45. (*                          STACKFULL                                 *)
  46. (*                          PUSHSTACK                                 *)
  47. (*                                                                    *)
  48. (*====================================================================*)
  49. (*====================================================================*)
  50. (*                                                                    *)
  51. (*                    ADA PRETTYPRINTING RULES                        *)
  52. (*                                                                    *)
  53. (*                                                                    *)
  54. (*  [ GENERAL PRETTYPRINTING RULES ]                                  *)
  55. (*                                                                    *)
  56. (*   1.   COMMENTS ARE LEFT WHERE THEY ARE FOUND, UNLESS              *)
  57. (*     THEY ARE SHIFTED RIGHT BY PRECEEDING TEXT ON A LINE.           *)
  58. (*                                                                    *)
  59. (*   2.   ALL STATEMENTS AND DECLARATIONS BEGIN ON SEPARATE LINES     *)
  60. (*     WITH ONE EXCEPTION BEING THE CONTEXT_SPECIFICATION USING A     *)
  61. (*     WITH_CLAUSE AND A USE_CLAUSE.  FOR EXAMPLE THE FOLLOWING       *)
  62. (*     CONTEXT_SPECIFICATION WOULD APPEAR ON THE SAME LINE:           *)
  63. (*                                                                    *)
  64. (*       WITH TEXT_IO, REAL_OPERATIONS; USE REAL_OPERATIONS;          *)
  65. (*                                                                    *)
  66. (*                                                                    *)
  67. (*   3.   NO LINE MAY BE GREATER THAN 80 CHARACTERS LONG.  ANY LINE   *)
  68. (*     LONGER THAN THIS IS CONTINUED ON A SEPARATE LINE.              *)
  69. (*                                                                    *)
  70. (*   4.  THE KEYWORDS                                                 *)
  71. (*          "BEGIN"                                                   *)
  72. (*          "LOOP"(EXCEPT WHEN USED FOLLOWING A ITERATION CLAUSE)     *)
  73. (*          "ELSE"                                                    *)
  74. (*          "DECLARE"                                                 *)
  75. (*          "EXCEPTION"(EXCEPT WHEN USED AS AN EXCEPTION_DECLARATION  *)
  76. (*                      OR AS A RENAMING_DECLARATION)                 *)
  77. (*          "SELECT"                                                  *)
  78. (*          "PRIVATE"(EXCEPT WHEN USED AS A PRIVATE_TYPE_DEFINITION)  *)
  79. (*          "GENERIC"                                                 *)
  80. (*          "OR"(EXCEPT WHEN USED AS A LOGICAL_OPERATOR)              *)
  81. (*       ARE FORCED TO STAND ON LINES BY THEMSELVES(OR POSSIBLY       *)
  82. (*       FOLLOWED BY SUPPORTING COMMENTS)                             *)
  83. (*                                                                    *)
  84. (*   5.   A BLANK LINE IS FORCED BEFORE THE KEYWORDS                  *)
  85. (*     "PROCEDURE", "FUNCTION", "PACKAGE", "EXCEPTION",               *)
  86. (*     "TASK", "GENERIC", AND "PRIVATE"(EXCEPT WHEN USED              *)
  87. (*     AS A PRIVATE_TYPE_DECLARATION)                                 *)
  88. (*   6.   A SPACE IS FORCED BEFORE AND AFTER THE SYMBOLS ":=".        *)
  89. (*     ADDITIONALLY, A SPACE IS FORCED AFTER THE SYMBOL ":".          *)
  90. (*   7.  THE FOLLOWING SYNTATIC CHANGE IS FORCED BY THE PRETTYPRINTER *)
  91. (*     PROGRAM:                                                       *)
  92. (*            END [ IDENTIFIER] ::= END IDENTIFIER                    *)
  93. (*   8.  THE FOLLOWING SIMPLE STATEMENTS BEGIN ON A SEPARATE LINE     *)
  94. (*     BUT DO NOT AFFECT INDENTATION:                                 *)
  95. (*                                                                    *)
  96. (*           ASSIGNMENT_STATEMENTS                                    *)
  97. (*           RETURN_STATEMENTS                                        *)
  98. (*           EXIT_STATEMENTS                                          *)
  99. (*           GOTO_STATEMENTS                                          *)
  100. (*           PROCEDURE_CALLS                                          *)
  101. (*           RAISE_STATEMENTS                                         *)
  102. (*           CODE_STATEMENTS                                          *)
  103. (*           ENTRY_CALL_STATEMENTS                                    *)
  104. (*           ABORT_STATEMENTS                                         *)
  105. (*           DELAY_STATEMENTS                                         *)
  106. (*           NULL_STATEMENTS                                          *)
  107. (*   9.  THE FOLLOWING COMPOUND STATEMENTS ARE INDENTED               *)
  108. (*       AS FOLLOWS:                                                  *)
  109. (*                                                                    *)
  110. (*          A. GENERAL IF_STATEMENTS                                  *)
  111. (*                                                                    *)
  112. (*             IF CONDITION THEN                                      *)
  113. (*                SEQUENCE_OF_STATEMENTS                              *)
  114. (*             ELSIF CONDITION THEN                                   *)
  115. (*                SEQUENCE_OF_STATEMENTS                              *)
  116. (*              .                                                     *)
  117. (*              .                                                     *)
  118. (*             ELSE                                                   *)
  119. (*                SEQUENCE_OF_STATEMENTS                              *)
  120. (*             END IF;                                                *)
  121. (*                                                                    *)
  122. (*          B. GENERAL CASE_STATEMENTS                                *)
  123. (*                                                                    *)
  124. (*             CASE EXPRESSION IS                                     *)
  125. (*                WHEN CHOICE =>                                      *)
  126. (*                   SEQUENCE_OF_STATEMENTS                           *)
  127. (*                 .                                                  *)
  128. (*                 .                                                  *)
  129. (*                WHEN CHOICE =>                                      *)
  130. (*                   SEQUENCE_OF_STATEMENTS                           *)
  131. (*                WHEN OTHERS =>                                      *)
  132. (*                   SEQUENCE_OF_STATEMENTS                           *)
  133. (*                END CASE;                                           *)
  134. (*                                                                    *)
  135. (*         C. GENERAL LOOP_STATEMENTS                                 *)
  136. (*                                                                    *)
  137. (*            1.  BASIC_LOOP                                          *)
  138. (*                                                                    *)
  139. (*               LOOP                                                 *)
  140. (*                  SEQUENCE_OF_STATEMENTS                            *)
  141. (*               END LOOP;                                            *)
  142. (*                                                                    *)
  143. (*            2.  FOR_LOOP                                            *)
  144. (*                                                                    *)
  145. (*                FOR LOOP_PARAMETER IN DISCRETE_RANGE LOOP           *)
  146. (*                   SEQUENCE_OF_STATEMENTS                           *)
  147. (*                END LOOP;                                           *)
  148. (*                                                                    *)
  149. (*            3.  WHILE_LOOP                                          *)
  150. (*                                                                    *)
  151. (*                WHILE CONDITION LOOP                                *)
  152. (*                   SEQUENCE_OF_STATEMENTS                           *)
  153. (*                END LOOP;                                           *)
  154. (*                                                                    *)
  155. (*         D.  GENERAL ACCEPT_STATEMENTS                              *)
  156. (*                                                                    *)
  157. (*             ACCEPT ENTRY_NAME [ FORMAL_PART ] DO                   *)
  158. (*                SEQUENCE_OF_STATEMENTS                              *)
  159. (*             END ENTRY_NAME;                                        *)
  160. (*                                                                    *)
  161. (*         E.  GENERAL SELECT_STATEMENTS                              *)
  162. (*                                                                    *)
  163. (*             1.  SELECTIVE_WAIT STATEMENTS                          *)
  164. (*                                                                    *)
  165. (*                 SELECT                                             *)
  166. (*                 WHEN CONDITION =>                                  *)
  167. (*                    SELECT_ALTERNATIVE                              *)
  168. (*                 OR                                                 *)
  169. (*                 WHEN CONDITION =>                                  *)
  170. (*                    SELECT_ALTERNATIVE                              *)
  171. (*                 ELSE                                               *)
  172. (*                    SEQUENCE_OF_STATEMENTS                          *)
  173. (*                 END SELECT;                                        *)
  174. (*                                                                    *)
  175. (*             2.  CONDITIONAL_ENTRY_CALL STATEMENTS                  *)
  176. (*                                                                    *)
  177. (*                 SELECT                                             *)
  178. (*                    ENTRY_CALL;                                     *)
  179. (*                 ELSE                                               *)
  180. (*                    SEQUENCE_OF_STATEMENTS                          *)
  181. (*                 END SELECT;                                        *)
  182. (*                                                                    *)
  183. (*             3.  TIMED_ENTRY_CALL STATEMENTS                        *)
  184. (*                                                                    *)
  185. (*                 SELECT                                             *)
  186. (*                    ENTRY_CALL;                                     *)
  187. (*                    SEQUENCE_OF_STATEMENTS                          *)
  188. (*                 OR                                                 *)
  189. (*                    DELAY_STATEMENT                                 *)
  190. (*                    SEQUENCE_OF_STATEMENTS                          *)
  191. (*                 END SELECT;                                        *)
  192. (*                                                                    *)
  193. (*         F.  BLOCKS                                                 *)
  194. (*                                                                    *)
  195. (*             BLOCKNAME:                                             *)
  196. (*             DECLARE                                                *)
  197. (*                DECLARATIVE_PART                                    *)
  198. (*             BEGIN                                                  *)
  199. (*                SEQUENCE_OF_STATEMENTS                              *)
  200. (*             END BLOCKNAME;                                         *)
  201. (*                                                                    *)
  202. (*====================================================================*)
  203. (*====================================================================*)
  204. (*                      GENERAL ALGORITHM                             *)
  205. (*                                                                    *)
  206. (*                                                                    *)
  207. (*      THE STRATEGY OF THE PRETTYPRINTER IS TO SCAN SYMBOLS FROM     *)
  208. (*   THE INPUT PROGRAM AND MAP EACH SYMBOL INTO A PRETTYPRINTING      *)
  209. (*   ACTION, INDEPENDENTLY OF THE CONTEXT IN WHICH THE SYMBOL         *)
  210. (*   APPEARS.  THIS IS ACCOMPLISHED BY A TABLE OF PRETTYPRINTING      *)
  211. (*   OPTIONS.                                                         *)
  212. (*                                                                    *)
  213. (*      FOR EACH DISTINGUISHED SYMBOL IN THE TABLE, THERE IS AN       *)
  214. (*   ASSOCIATED SET OF OPTIONS.  IF THE OPTION HAS BEEN SELECTED FOR  *)
  215. (*   THE SYMBOL BEING SCANNED, THEN THE ACTION CORRESPONDING WITH     *)
  216. (*   EACH OPTION IS PERFORMED.                                        *)
  217. (*                                                                    *)
  218. (*      THE BASIC ACTIONS INVOLVED IN PRETTYPRINTING ARE THE INDENT-  *)
  219. (*   ATION AND DE-INDENTATION OF THE MARGIN.  EACH TIME THE MARGIN IS *)
  220. (*   INDENTED, THE PREVIOUS VALUE OF THE MARGIN IS PUSHED ONTO A      *)
  221. (*   STACK, ALONG WITH THE NAME OF THE SYMBOL THAT CAUSED IT TO BE    *)
  222. (*   INDENTED.  EACH TIME THE MARGIN IS DE-INDENTED, THE STACK IS     *)
  223. (*   POPPED OFF TO OBTAIN THE PREVIOUS VALUE OF THE MARGIN.           *)
  224. (*                                                                    *)
  225. (*      THE PRETTYPRINTING OPTIONS ARE PROCESSED IN THE FOLLOWING     *)
  226. (*   ORDER, AND INVOKE THE FOLLOWING ACTIONS:                         *)
  227. (*                                                                    *)
  228. (*                                                                    *)
  229. (*     CRSUPPRESS      - IF A CARRIAGE RETURN HAS BEEN INSERTED       *)
  230. (*                       FOLLOWING THE PREVIOUS SYMBOL, THEN IT IS    *)
  231. (*                       INHIBITED UNTIL THE NEXT SYMBOL IS PRINTED.  *)
  232. (*                                                                    *)
  233. (*     CRBEFORE        - A CARRIAGE RETURN IS INSERTED BEFORE THE     *)
  234. (*                       CURRENT SYMBOL (UNLESS ONE IS ALREADY THERE) *)
  235. (*                                                                    *)
  236. (*     BLANKLINEBEFORE - A BLANK LINE IS INSERTED BEFORE THE CURRENT  *)
  237. (*                       SYMBOL (UNLESS ALREADY THERE).               *)
  238. (*                                                                    *)
  239. (*     DINDENT         - THE STACK IS UNCONDITIONALLY POPPED AND THE  *)
  240. (*                       MARGIN IS DE-INDENTED.                       *)
  241. (*                                                                    *)
  242. (*     SPACEBEFORE     - A SPACE IS INSERTED BEFORE THE SYMBOL BEING  *)
  243. (*                       SCANNED (UNLESS ALREADY THERE).              *)
  244. (*                                                                    *)
  245. (*     [ THE SYMBOL IS PRINTED AT THIS POINT ]                        *)
  246. (*                                                                    *)
  247. (*     SPACEAFTER      - A SPACE IS INSERTED AFTER THE SYMBOL BEING   *)
  248. (*                       SCANNED (UNLESS ALREADY THERE).              *)
  249. (*                                                                    *)
  250. (*     GOBBLESYMBOLS   - SYMBOLS ARE CONTINUOUSLY SCANNED AND PRINTED *)
  251. (*                       WITHOUT ANY PROCESSING UNTIL ONE OF THE      *)
  252. (*                       SPECIFIED SYMBOLS IS SEEN (BUT NOT GOBBLED). *)
  253. (*                                                                    *)
  254. (*     INDENTBYTAB     - THE MARGIN IS INDENTED BY A STANDARD AMOUNT  *)
  255. (*                       FROM THE PREVIOUS MARGIN.                    *)
  256. (*                                                                    *)
  257. (*     INDENTMARGIN    - THE MARGIN IS INDENTED BY A STANDARD AMOUNT  *)
  258. (*                       FROM THE PREVIOUS MARGIN.                    *)
  259. (*                                                                    *)
  260. (*     CRAFTER         - A CARRIAGE RETURN IS INSERTED FOLLOWING THE  *)
  261. (*                       SYMBOL SCANNED.                              *)
  262. (*                                                                    *)
  263. (*                                                                    *)
  264. (*                                                                    *)
  265. (*====================================================================*)
  266. PROGRAM PRETTYPRINT( (* FROM *)  INPUT,
  267.                      (* TO *)    OUTPUT );
  268. CONST
  269.       MAXSYMBOLSIZE = 200; (* THE MAXIMUM SIZE (IN CHARACTERS) OF A   *)
  270.                            (* SYMBOL SCANNED BY THE LEXICAL SCANNER.  *)
  271.       MAXSTACKSIZE  = 50;  (* THE MAXIMUM NUMBER OF SYMBOLS CAUSING   *)
  272.                            (* INDENTATION THAT MAY BE STACKED.        *)
  273.       MAXKEYLENGTH  =  10; (* THE MAXIMUM LENGTH (IN CHARACTERS) OF A *)
  274.                            (* PASCAL RESERVED KEYWORD.                *)
  275.       MAXLINESIZE   =  80; (* THE MAXIMUM SIZE (IN CHARACTERS) OF A   *)
  276.                            (* LINE OUTPUT BY THE PRETTYPRINTER.       *)
  277.       SLOFAIL1      =  30; (* UP TO THIS COLUMN POSITION, EACH TIME   *)
  278.                            (* "INDENTBYTAB" IS INVOKED, THE MARGIN    *)
  279.                            (* WILL BE INDENTED BY "INDENT1".          *)
  280.       SLOFAIL2      =  48; (* UP TO THIS COLUMN POSITION, EACH TIME   *)
  281.                            (* "INDENTBYTAB" IS INVOKED, THE MARGIN    *)
  282.                            (* WILL BE INDENTED BY "INDENT2".  BEYOND  *)
  283.                            (* THIS, NO INDENTATION OCCURS.            *)
  284.       INDENT1       =   3; (* UP TO THE COLUMN POSTION,SLOFAIL1, EACH *)
  285.                            (* TIME "INDENTBYTAB" IS INVOKED,THE MARGIN*)
  286.                            (* WILL BE INDENTED THIS MUCH.             *)
  287.       INDENT2       =   1; (* WHEN THE COLUMN POSITION IS BETWEEN     *)
  288.                            (* SLOFAIL1 AND SLOFAIL2, EACH TIME THE    *)
  289.                            (* "INDENTBYTAB" IS INVOKED, THE MARGIN    *)
  290.                            (* WILL BE INDENTED THIS MUCH.             *)
  291.       SPACE         = ' ';
  292. TYPE
  293.        KEYSYMBOL = ( FUNCSYM         , PROCSYM         , ISSYM       ,
  294.                      WHENSYM         , LOOPSYM         , TYPESYM     ,
  295.                      BEGINSYM        , RECORDSYM       , EXCEPTIONSYM,
  296.                      CASESYM         , USESYM          , EXITSYM     ,
  297.                      FORSYM          , WHILESYM        , WITHSYM     ,
  298.                      DOSYM           , IFSYM           , THENSYM     ,
  299.                      ELSESYM         , SPECIALLOOPSYM  , SPECIALISSYM,
  300.                      SEPARATESYM     , SPECIALUSESYM   , SPECIALORSYM,
  301.                      ELSIFSYM        , PACKAGESYM      , GENERICSYM  ,
  302.                      TASKSYM         , DECLARESYM      , SELECTSYM   ,
  303.                      ORSYM           , ACCEPTSYM       , BODYSYM     ,
  304.                      SPEXCEPTIONSYM  , PRIVATESYM      , ENDSYM      ,
  305.                      BECOMES         , ARROWSYM        , OPENCOMMENT ,
  306.                      SEMICOLON       , SPSEMICOLON     , COLON       ,
  307.                      EQUALS          , OPENPAREN       , CLOSEPAREN  ,
  308.                      UNDSCORE        , SPECIALCOLON    , PERIOD      ,
  309.                      ENDOFFILE       , OTHERSYM        );
  310.           OPTION = ( CRSUPPRESS      ,
  311.                      CRBEFORE        ,
  312.                      BLANKLINEBEFORE ,
  313.                      DINDENT         ,
  314.                      SPACEBEFORE     ,
  315.                      SPACEAFTER      ,
  316.                      GOBBLESYMBOLS   ,
  317.                      INDENTMARGIN    ,
  318.                      INDENTBYTAB     ,
  319.                      CRAFTER         );
  320.        OPTIONSET = SET OF OPTION;
  321.        KEYSYMSET = SET OF KEYSYMBOL;
  322.       TABLEENTRY = RECORD
  323.                      OPTIONSSELECTED  : OPTIONSET;
  324.                      GOBBLETERMINATORS: KEYSYMSET
  325.                    END;
  326.      OPTIONTABLE = ARRAY [ KEYSYMBOL ] OF TABLEENTRY;
  327.              KEY = PACKED ARRAY [ 1..MAXKEYLENGTH ] OF CHAR;
  328.     KEYWORDTABLE = ARRAY [ FUNCSYM..ENDSYM ] OF KEY;
  329.      SPECIALCHAR = PACKED ARRAY [ 1..2 ] OF CHAR;
  330.        DBLCHRSET = SET OF BECOMES..OPENCOMMENT;
  331.     DBLCHARTABLE = ARRAY [ BECOMES..OPENCOMMENT ] OF SPECIALCHAR;
  332.     SGLCHARTABLE = ARRAY [ SEMICOLON..PERIOD ] OF CHAR;
  333.           STRING = ARRAY [ 1..MAXSYMBOLSIZE ] OF CHAR;
  334.           SYMBOL = RECORD
  335.                        NAME        : KEYSYMBOL;
  336.                        VALU        : STRING;
  337.                        LENGTH      : INTEGER;
  338.                        SPACESBEFORE: INTEGER;
  339.                        CRSBEFORE   : INTEGER
  340.                    END;
  341.       SYMBOLINFO = ^SYMBOL;
  342.         CHARNAME = ( LETTER        ,  UNDERSCORE  ,    DIGIT     ,
  343.                      BLANK         ,  QUOTE       ,    ENDOFLINE ,
  344.                      FILEMARK      ,  OTHERCHAR   );
  345.         CHARINFO = RECORD
  346.                       NAME : CHARNAME;
  347.                       VALU : CHAR
  348.                    END;
  349.       STACKENTRY = RECORD
  350.                      INDENTSYMBOL : KEYSYMBOL;
  351.                      PREVMARGIN   : INTEGER;
  352.                      ENDSYMBOL    : STRING;
  353.                      LLENGTH      : INTEGER
  354.                    END;
  355.      SYMBOLSTACK = ARRAY [ 1..MAXSTACKSIZE ] OF STACKENTRY;
  356. VAR
  357.       LOOPSWITCH,        (* USED TO SWITCH BETWEEN A BASIC LOOP AND
  358.                             AND A BASIC_LOOP USED WITH A ITERATION_
  359.                             CLAUSE                                   *)
  360.        USESWITCH,        (* USED TO DETECT A REPRESENTATION_SPECI-
  361.                             FICATION AS OPPOSED TO A USE CLAUSE      *)
  362.         ORSWITCH,        (* USED TO DIFFERIENTATE BETWEEN A LOGICAL
  363.                             OPERATOR AND SELECTIVE-WAIT AND TIMED_
  364.                             ENTRIE_CALLS                             *)
  365.         WITHSEEN,        (* USED TO DETECT THE PRESENCE OF A WITH_
  366.                             CLAUSE-USE_CLAUSE COMBINATION            *)
  367.         ISSWITCH,        (* USED TO DIFFERIENTATE BETWEEN A USESYM
  368.                             AND A SPECIALISSYM                       *)
  369.        CRPENDING  : BOOLEAN;
  370.              TOP,       (* NUMBER OF RECORDS ON THE STACK            *)
  371.         STARTPOS,       (* STARTING POSITION OF LAST SYMBOL WRITTEN  *)
  372.      PARENINDENT,       (* USED FOR INDENTION FOR: DISCRIMINANT_PART
  373.                            OF RECORDS; FORMAL_PART OF SUBPROGRAM
  374.                            DECLARATIONS; GENERIC_FORMAL_PARAMETER LIST*)
  375.     PARENCOUNTER,       (* INDICATES THE LEVEL OF NESTING OF PAREN-
  376.                            THESES SETS                               *)
  377.       PREVMARGIN,       (* VALUE OF PREVIOUS MARGIN, STORED ON STACK *)
  378.      CURRLINEPOS,       (* CURRENT LINE POSITION OF THE OUTPUT FILE  *)
  379.       CURRMARGIN  :  INTEGER;
  380.         CURRCHAR,
  381.         NEXTCHAR  : CHARINFO;
  382.     ENDIDENTIFIER : STACKENTRY;
  383.          CURRSYM,
  384.          NEXTSYM  : SYMBOLINFO;
  385.         PPOPTION  : OPTIONTABLE;
  386.          KEYWORD  : KEYWORDTABLE;
  387.         DBLCHARS  : DBLCHRSET;
  388.          DBLCHAR  : DBLCHARTABLE;
  389.          SGLCHAR  : SGLCHARTABLE;
  390.            STACK  : SYMBOLSTACK;
  391. (*=********************************************************************)
  392. (**********************************************************************)
  393. (***                                                                ***)
  394. (***   NAME                                                         ***)
  395. (***         GETCHAR                                                ***)
  396. (***                                                                ***)
  397. (***   DESCRIPTION                                                  ***)
  398. (***         THE PURPOSE OF THIS PROCEDURE IS THREEFOLD;            ***)
  399. (***            A- BEFORE FETCHING THE NEST CHARACTER FROM THE      ***)
  400. (***               INPUT-FILE,IT UPDATES THE CURRENT-CHARACTER      ***)
  401. (***               TO THE VALUE OF THE PREVIOUS NEXT-CHARACTER.     ***)
  402. (***            B- EXAMINATION AND CLASSIFICATION OF THE CHARACTER  ***)
  403. (***               NAME OF THE NEXT CHARACTER ON THE INPUT FILE.    ***)
  404. (***            C- READ THE NEXT CHARACTER FROM THE INPUT FILE.     ***)
  405. (***                                                                ***)
  406. (***   INPUTS                                                       ***)
  407. (***            NONE                                                ***)
  408. (***                                                                ***)
  409. (***   OUTPUTS                                                      ***)
  410. (***            CURRCHAR                                            ***)
  411. (***            NEXTCHAR                                            ***)
  412. (***                                                                ***)
  413. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  414. (***            NONE                                                ***)
  415. (***                                                                ***)
  416. (***   REFERENCED BY                                                ***)
  417. (***                STORENEXTCHAR                                   ***)
  418. (***                SKIPSPACES                                      ***)
  419. (***                INITIALIZE                                      ***)
  420. (***                                                                ***)
  421. (**********************************************************************)
  422. PROCEDURE GETCHAR( (* FROM INPUT *)
  423.                    (* UPDATING *)  VAR NEXTCHAR  : CHARINFO;
  424.                    (* RETURNING *) VAR CURRCHAR  : CHARINFO );
  425. BEGIN (* GETCHAR *)
  426.    CURRCHAR := NEXTCHAR;
  427.    WITH NEXTCHAR DO
  428.       BEGIN
  429.             IF EOF(INPUT)
  430.             THEN
  431.                NAME  := FILEMARK
  432.             ELSE
  433.                IF EOLN(INPUT)
  434.                THEN
  435.                   NAME  := ENDOFLINE
  436.                ELSE
  437.                   IF INPUT^ IN ['A'..'Z','a'..'z']
  438.                   THEN
  439.                      NAME  := LETTER
  440.                   ELSE
  441.                      IF INPUT^ = '_'
  442.                      THEN
  443.                         NAME  := UNDERSCORE
  444.                      ELSE
  445.                         IF INPUT^ IN ['0'..'9']
  446.                         THEN
  447.                            NAME  := DIGIT
  448.                         ELSE
  449.                            IF INPUT^ = '"'
  450.                            THEN
  451.                               NAME  := QUOTE
  452.                            ELSE
  453.                               IF INPUT^ = SPACE
  454.                               THEN
  455.                                  NAME := BLANK
  456.                               ELSE
  457.                                  NAME := OTHERCHAR;
  458.             IF NAME IN [ FILEMARK, ENDOFLINE ]
  459.             THEN
  460.                VALU := SPACE
  461.             ELSE
  462.                VALU := INPUT^;
  463.             IF NAME <> FILEMARK
  464.             THEN
  465.                GET(INPUT)
  466.    END (* WITH *)
  467. END; (* GETCHAR *)
  468. (*=********************************************************************)
  469. (**********************************************************************)
  470. (***                                                                ***)
  471. (***   NAME                                                         ***)
  472. (***           STORENEXTCHAR                                        ***)
  473. (***                                                                ***)
  474. (***   DESCRIPTION                                                  ***)
  475. (***          THE ADA PRETTYPRINTER PROCESSES ONE TOKEN AT A TIME.  ***)
  476. (***       THE INPUT-FILE IS CONTINOUSLY READ, ONE CHARACTER AT A   ***)
  477. (***       TIME, UNTIL A COMPLETE TOKEN IS OBTAINED.  THIS PROCED-  ***)
  478. (***       URE PROVIDES THE BUFFER TO STORE THE INPUT CHARACTER     ***)
  479. (***       UNTIL A COMPLETE TOKEN STORED.                           ***)
  480. (***                                                                ***)
  481. (***                                                                ***)
  482. (***   INPUTS                                                       ***)
  483. (***       CURRCHAR.VALUE--THE VALUE OF THE CURRENT CHARACTER.      ***)
  484. (***       LENGTH-- THE NUMBER OF CHARACTERS PRESENTLY STORED       ***)
  485. (***                IN THE INPUT BUFFER.                            ***)
  486. (***                                                                ***)
  487. (***   OUTPUTS                                                      ***)
  488. (***       LENGTH-- THE UPDATED LENGTH OF THE PRESENT INPUT         ***)
  489. (***                CHARACTER STRING.                               ***)
  490. (***       VALU-- ARRAY WHOSE COMPONETS CONTAINS THE CHARACTERS     ***)
  491. (***              OF THE CURRENT TOKEN OF THE INPUT FILE.           ***)
  492. (***                                                                ***)
  493. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  494. (***                  GETCHAR                                       ***)
  495. (***                                                                ***)
  496. (***   REFERENCED BY                                                ***)
  497. (***                  GETCOMMENT                                    ***)
  498. (***                  GETIDENTIFIER                                 ***)
  499. (***                  GETNUMBER                                     ***)
  500. (***                  GETSTRINGLITERAL                              ***)
  501. (***                  GETSPECIALCHAR                                ***)
  502. (***                  GETNEXTSYMBOL                                 ***)
  503. (***                                                                ***)
  504. (**********************************************************************)
  505. PROCEDURE STORENEXTCHAR( (* FROM INPUT *)
  506.                          (* UPDATING *)    VAR LENGTH    : INTEGER;
  507.                                            VAR CURRCHAR,
  508.                                                NEXTCHAR  : CHARINFO;
  509.                          (* PLACING IN *)  VAR VALU      : STRING   );
  510. BEGIN (* STORENEXTCHAR *)
  511.    GETCHAR( (* FROM INPUT *)
  512.             (* UPDATING *)  NEXTCHAR,
  513.             (* RETURNING *) CURRCHAR  );
  514.    IF LENGTH < MAXSYMBOLSIZE
  515.       THEN
  516.          BEGIN
  517.             LENGTH := LENGTH + 1;
  518.             VALU [LENGTH] := CURRCHAR.VALU
  519.          END
  520. END; (* STORENEXTCHAR *)
  521. (*=********************************************************************)
  522. (**********************************************************************)
  523. (***                                                                ***)
  524. (***   NAME                                                         ***)
  525. (***              SKIPSPACES                                        ***)
  526. (***                                                                ***)
  527. (***   DESCRIPTION                                                  ***)
  528. (***          THE PURPOSE OF THIS PROCEDURE IS TO CONTINOUSLY READ  ***)
  529. (***     THE INPUT FILE UNTIL A CHARACTER IS READ WHICH IS NOT      ***)
  530. (***     A BLANK.  THE NUMBER OF BLANKS READ IS RECORDED AS WELL    ***)
  531. (***     AS THE NUMBER OF CARRIAGE RETURNS ENCOUNTERED.             ***)
  532. (***                                                                ***)
  533. (***   INPUTS                                                       ***)
  534. (***       CURRCHAR.NAME-- FROM THE INPUT FILE                      ***)
  535. (***                                                                ***)
  536. (***   OUTPUTS                                                      ***)
  537. (***       SPACESBEFORE-- NUMBER OF SPACES ENCOUNTERED PRIOR TO     ***)
  538. (***                      NEXT SYMBOL ON THE INPUT FILE.            ***)
  539. (***       CRSBEFORE----- NUMBER OF CARRIAGE RETURNS ENCOUNTERED    ***)
  540. (***                      INPUT FILE PRIOR TO THE NEXT SYMBOL.      ***)
  541. (***                                                                ***)
  542. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  543. (***                    GETCHAR                                     ***)
  544. (***                                                                ***)
  545. (***   REFERENCED BY                                                ***)
  546. (***                    GETSYMBOL                                   ***)
  547. (***                                                                ***)
  548. (**********************************************************************)
  549. PROCEDURE SKIPSPACES(
  550.                       (* UPDATING *)  VAR CURRCHAR,
  551.                                           NEXTCHAR     : CHARINFO;
  552.                       (* RETURNING *) VAR SPACESBEFORE,
  553.                                           CRSBEFORE    : INTEGER  );
  554. BEGIN (* SKIPSPACES *)
  555.    SPACESBEFORE := 0;
  556.    CRSBEFORE    := 0;
  557.    WHILE NEXTCHAR.NAME IN [ BLANK, ENDOFLINE ] DO
  558.       BEGIN
  559.           GETCHAR( (* FROM INPUT *)
  560.                    (* UPDATING *)  NEXTCHAR,
  561.                    (* RETURNING *) CURRCHAR  );
  562.           CASE CURRCHAR.NAME OF
  563.              ENDOFLINE:  BEGIN
  564.                             SPACESBEFORE := 0;
  565.                             CRSBEFORE    := CRSBEFORE + 1;
  566.                           END;
  567.              BLANK    :   SPACESBEFORE := SPACESBEFORE + 1;
  568.          END; (*CASE*)
  569.    END (* WHILE *)
  570. END; (* SKIPSPACES *)
  571. (*=********************************************************************)
  572. (**********************************************************************)
  573. (***                                                                ***)
  574. (***   NAME                                                         ***)
  575. (***                 GETCOMMENT                                     ***)
  576. (***                                                                ***)
  577. (***   DESCRIPTION                                                  ***)
  578. (***          THE PURPOSE OF THIS PROCEDURE IS TO CONTINOUSLY       ***)
  579. (***      READ AND STORE ALL CHARACTERS FROM THE INPUT FILE         ***)
  580. (***      UNTIL THE OF END OF A LINE (WHICH REPRESENTS THE END      ***)
  581. (***      OF THE COMMENT) IS DETECTED.                              ***)
  582. (***                                                                ***)
  583. (***   INPUTS                                                       ***)
  584. (***       NEXTCHAR.NAME-- THE NAME OF THE NEXT CHARACTER FROM      ***)
  585. (***                       THE INPUT FILE (USED TO TERMINATE THE    ***)
  586. (***                       READ OPERATIONS).                        ***)
  587. (***                                                                ***)
  588. (***   OUTPUTS                                                      ***)
  589. (***       NONE                                                     ***)
  590. (***                                                                ***)
  591. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  592. (***                     STORENEXTCHAR                              ***)
  593. (***                                                                ***)
  594. (***   REFERENCED BY                                                ***)
  595. (***                     GETNEXTSYMBOL                              ***)
  596. (***                                                                ***)
  597. (**********************************************************************)
  598. PROCEDURE GETCOMMENT( (* FROM INPUT *)
  599.                       (* UPDATING *) VAR CURRCHAR,
  600.                                          NEXTCHAR  : CHARINFO;
  601.                                      VAR NAME      : KEYSYMBOL;
  602.                                      VAR VALU      : STRING;
  603.                                      VAR LENGTH    : INTEGER   );
  604. BEGIN (* GETCOMMENT *)
  605.    NAME := OPENCOMMENT;
  606.    WHILE NOT (   (NEXTCHAR.NAME = ENDOFLINE)
  607.               OR (NEXTCHAR.NAME = FILEMARK)) DO
  608.       STORENEXTCHAR( (* FROM INPUT *)
  609.                      (* UPDATING   *)   LENGTH,
  610.                                       CURRCHAR,
  611.                                       NEXTCHAR,
  612.                      (* IN         *)     VALU);
  613. END; (* GETCOMMENT *)
  614. (*=********************************************************************)
  615. (**********************************************************************)
  616. (***                                                                ***)
  617. (***   NAME                                                         ***)
  618. (***             IDTYPE                                             ***)
  619. (***                                                                ***)
  620. (***   DESCRIPTION                                                  ***)
  621. (***             AFTER A INPUT TOKEN IS DETERMINED TO BE AN         ***)
  622. (***      IDENTIFIER, IT IS NECESSARY TO DETERMINE IF               ***)
  623. (***      THE IDENTIFIER IS ONE OF THE KEYWORDS IN THE KEYWORD-     ***)
  624. (***      TABLE WHICH REQUIRES SPECIAL PROCESSING.  IF IT IS        ***)
  625. (***      NOT A KEYWORD, THEN IT IS NAMED AN "OTHERSYM" FOR PRO-    ***)
  626. (***      PROCESSING.  THIS IS ACCOMPLISHED BY:                     ***)
  627. (***           A- WRITING THE IDENTIFIER INTO KEYVALU WHICH IS      ***)
  628. (***              AN OBJECT OF THE PACKED ARRAY "KEY".              ***)
  629. (***           B- FILLING THE REST OF THE PACKED ARRAY WITH         ***)
  630. (***              BLANKS UP TO MAXKEYLENGTH.                        ***)
  631. (***           C- LOOPING THROUGH THE KEYWORDTABLE AND COMPARING    ***)
  632. (***              "KEYVALU" TO KEYWORD.                             ***)
  633. (***           D- IF A COMPARISON IS TRUE THEN THE IDENTIFIER IS    ***)
  634. (***              ASSIGNED THE VALUE OF THE KEYSYMBOL.              ***)
  635. (***                                                                ***)
  636. (***   INPUTS                                                       ***)
  637. (***            LENGTH-- THE NUMBER OF CHARACTER IN THE STRING      ***)
  638. (***                     OF THE NAME OF THE IDENTIFIER.             ***)
  639. (***            VALU---- THE ARRAY WHOSE COMPONETS ARE THE CHAR-    ***)
  640. (***                     ACTERS OF THE NAME OF THE IDENTIFIER.      ***)
  641. (***                                                                ***)
  642. (***   OUTPUTS                                                      ***)
  643. (***            IDTYPE-- EQUAL "OTHERSYM" IF VALU IS NOT IN THE     ***)
  644. (***                     KEYWORDTABLE.  IF VALU IS FOUND IN THE     ***)
  645. (***                     KEYWORDTABLE THE IDTYPE IS SET TO THIS     ***)
  646. (***                     SYMBOL.                                    ***)
  647. (***                                                                ***)
  648. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  649. (***                   NONE                                         ***)
  650. (***                                                                ***)
  651. (***   REFERENCED BY                                                ***)
  652. (***                   GETIDENTIFIER                                ***)
  653. (***                                                                ***)
  654. (**********************************************************************)
  655. FUNCTION IDTYPE( (* OF *)        VALU   : STRING;
  656.                  (* USING *)     LENGTH : INTEGER )
  657.                  (* RETURNING *)                   : KEYSYMBOL;
  658. VAR
  659.           I : INTEGER;
  660.     KEYVALU : KEY;
  661.         HIT : BOOLEAN;
  662.     THISKEY : KEYSYMBOL;
  663. BEGIN (* IDTYPE *)
  664.    IDTYPE := OTHERSYM;
  665.    IF LENGTH <= MAXKEYLENGTH
  666.       THEN
  667.          BEGIN
  668.             FOR I := 1 TO LENGTH DO
  669.               IF ORD(VALU[I]) > ORD('Z')
  670.                 THEN 
  671.                   KEYVALU[I] := CHR(ORD(VALU[I])-32)
  672.                 ELSE
  673.                   KEYVALU [I] := VALU [I];
  674.             FOR I := LENGTH + 1 TO MAXKEYLENGTH DO
  675.                KEYVALU [I] := SPACE;
  676.             THISKEY := FUNCSYM;
  677.             HIT     := FALSE;
  678.             WHILE NOT (HIT OR (THISKEY = SUCC(ENDSYM))) DO
  679.                IF KEYVALU = KEYWORD [THISKEY]
  680.                   THEN
  681.                      HIT := TRUE
  682.                   ELSE
  683.                      THISKEY := SUCC(THISKEY);
  684.             IF HIT
  685.                THEN
  686.                   IDTYPE := THISKEY
  687.          END;
  688. END; (* IDTYPE *)
  689. (*=********************************************************************)
  690. (**********************************************************************)
  691. (***                                                                ***)
  692. (***   NAME                                                         ***)
  693. (***             GETIDENTIFIER                                      ***)
  694. (***                                                                ***)
  695. (***   DESCRIPTION                                                  ***)
  696. (***             WHEN THE FIRST CHARACTER OF A TOKEN FROM           ***)
  697. (***      THE INPUT FILE IS A LETER (A..Z) , THEN THIS PRO-         ***)
  698. (***      CEDURE IS CALLED AND WILL CONTINUE TO READ AND STORE      ***)
  699. (***      CHARACTERS FROM THE INPUT FILE AS LONG AS THEY ARE        ***)
  700. (***      LETTERS (A..Z), NUMBERS (0..9) OR AN UNDERSCORE (_).      ***)
  701. (***      AFTER THE COMPLETE TOKEN IS READ AND STORED, A CALL       ***)
  702. (***      TO FUNCTION IDTYPE IS MADE TO IDENTIFY THE SPECIFIC       ***)
  703. (***      SYMBOL.                                                   ***)
  704. (***                                                                ***)
  705. (***   INPUTS                                                       ***)
  706. (***            NEXTCHAR.NAME-- THE NAME OF THE NEXT CHARACTER      ***)
  707. (***                            FROM THE INPUT FILE.                ***)
  708. (***                                                                ***)
  709. (***   OUTPUTS                                                      ***)
  710. (***            NONE                                                ***)
  711. (***                                                                ***)
  712. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  713. (***                    STORENEXTCHAR                               ***)
  714. (***                    IDTYPE                                      ***)
  715. (***                                                                ***)
  716. (***   REFERENCED BY                                                ***)
  717. (***                    GETNEXTSYMBOL                               ***)
  718. (***                                                                ***)
  719. (**********************************************************************)
  720. PROCEDURE GETIDENTIFIER( (* FROM INPUT *)
  721.                          (* UPDATING *)  VAR CURRCHAR,
  722.                                              NEXTCHAR  : CHARINFO;
  723.                          (* RETURNING *) VAR NAME      : KEYSYMBOL;
  724.                                          VAR VALU      : STRING;
  725.                                          VAR LENGTH    : INTEGER   );
  726. BEGIN (* GETIDENTIFIER *)
  727.    WHILE NEXTCHAR.NAME IN [ LETTER .. DIGIT ] DO
  728.       STORENEXTCHAR( (* FROM INPUT *)
  729.                      (* UPDATING *) LENGTH,
  730.                                     CURRCHAR,
  731.                                     NEXTCHAR,
  732.                      (* IN *)       VALU      );
  733.    NAME := IDTYPE( (* OF *)    VALU,
  734.                    (* USING *) LENGTH );
  735. END; (* GETIDENTIFIER *)
  736. (*=********************************************************************)
  737. (**********************************************************************)
  738. (***                                                                ***)
  739. (***   NAME                                                         ***)
  740. (***               GETNUMBER                                        ***)
  741. (***                                                                ***)
  742. (***   DESCRIPTION                                                  ***)
  743. (***           WHEN THE FIRST CHARACTER OF A TOKEN FROM THE         ***)
  744. (***       FILE IS A DIGIT (0..9), THEN THIS PROCEDURE IS           ***)
  745. (***       CALLED TO CONTINUOUSLY READ AND STORE CHARACTERS         ***)
  746. (***       FROM THE INPUT FILE AS LONG AS THEY ARE DIGITS OR        ***)
  747. (***       AN UNDERSCORE (_).  AFTER THE COMPLETE TOKEN IS          ***)
  748. (***       READ AND STORED, THE NUMBER IS ASSIGNED THE NAME         ***)
  749. (***       "OTHERSYM" FOR FURTHER PROCESSISNG.                      ***)
  750. (***                                                                ***)
  751. (***   INPUTS                                                       ***)
  752. (***       NEXTCHAR--FROM THE INPUT FILE                            ***)
  753. (***                                                                ***)
  754. (***   OUTPUTS                                                      ***)
  755. (***       NAME---- CURRENT TOKEN("CURRSYM") AND IS EQUAL           ***)
  756. (***                TO "OTHERSYM"                                   ***)
  757. (***       LENGTH-- NUMBER OF CHARACTERS IN THE NUMBER              ***)
  758. (***       VALU---- PACKED ARRAY CONTAINING THE CHARACTERS          ***)
  759. (***                (DIGITS, UNDERSCORES) OF THE NUMBER             ***)
  760. (***                                                                ***)
  761. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  762. (***                   STORENEXTCHAR                                ***)
  763. (***                                                                ***)
  764. (***   REFERENCED BY                                                ***)
  765. (***                   GETNEXTSYMBOL                                ***)
  766. (***                                                                ***)
  767. (**********************************************************************)
  768. PROCEDURE GETNUMBER( (* FROM INPUT *)
  769.                      (* UPDATING *)  VAR CURRCHAR,
  770.                                          NEXTCHAR  : CHARINFO;
  771.                      (* RETURNING *) VAR NAME      : KEYSYMBOL;
  772.                                      VAR VALU      : STRING;
  773.                                      VAR LENGTH    : INTEGER   );
  774. BEGIN (* GETNUMBER *)
  775.    WHILE NEXTCHAR.NAME IN [ DIGIT, UNDERSCORE ] DO
  776.       STORENEXTCHAR( (* FROM INPUT *)
  777.                      (* UPDATING *) LENGTH,
  778.                                     CURRCHAR,
  779.                                     NEXTCHAR,
  780.                      (* IN *)       VALU      );
  781.    NAME := OTHERSYM
  782. END; (* GETNUMBER *)
  783. (*=********************************************************************)
  784. (**********************************************************************)
  785. (***                                                                ***)
  786. (***   NAME                                                         ***)
  787. (***           GETSTRINGLITERAL                                     ***)
  788. (***                                                                ***)
  789. (***   DESCRIPTION                                                  ***)
  790. (***           WHEN THE FIRST CHARACTER OF A TOKEN FROM THE         ***)
  791. (***      INPUT FILE IS A QUOTE ('), THEN THIS PROCEDURE IS         ***)
  792. (***      CALLED BY THE PROCEDURE GETNEXTSYMBOL TO CONTINUOUSLY     ***)
  793. (***      READ AND STORE CHARACTERS FROM THE INPUT FILE UNTIL       ***)
  794. (***      THE ENTIRE CHARACTER LITERAL IS READ AND STORED. BE-      ***)
  795. (***      "OTHERSYM" FOR SUBSEQUENT PROCESSING.                     ***)
  796. (***                                                                ***)
  797. (***   INPUTS                                                       ***)
  798. (***      NEXTCHAR.NAME -- NAME OF THE NEXT CHARACTER FROM THE      ***)
  799. (***                       INPUT FILE.                              ***)
  800. (***                                                                ***)
  801. (***   OUTPUTS                                                      ***)
  802. (***      NAME --- NAME OF CURRENT SYMBOL AND EQUALS "OTHERSYM".    ***)
  803. (***      LENGTH - NUMBER OF CHARACTERS IN THE CHARACTER LITERAL    ***)
  804. (***               INCLUDING THE QUOTE CHARACTERS.                  ***)
  805. (***      VALU --- PACKED ARRAY CONTAINING THE CHARACTER OF THE     ***)
  806. (***               CHARACTERAL LITERAL.                             ***)
  807. (***                                                                ***)
  808. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  809. (***                  STORENEXTCHAR                                 ***)
  810. (***                                                                ***)
  811. (***   REFERENCED BY                                                ***)
  812. (***                  GETNEXTSYMBOL                                 ***)
  813. (***                                                                ***)
  814. (**********************************************************************)
  815. PROCEDURE GETSTRINGLITERAL( (* FROM INPUT *)
  816.                           (* UPDATING *)  VAR CURRCHAR,
  817.                                               NEXTCHAR  : CHARINFO;
  818.                           (* RETURNING *) VAR NAME      : KEYSYMBOL;
  819.                                           VAR VALU      : STRING;
  820.                                           VAR LENGTH    : INTEGER   );
  821. BEGIN (* GETSTRINGLITERAL *)
  822.    WHILE NEXTCHAR.NAME = QUOTE DO
  823.       BEGIN
  824.          STORENEXTCHAR( (* FROM INPUT *)
  825.                         (* UPDATING *) LENGTH,
  826.                                        CURRCHAR,
  827.                                        NEXTCHAR,
  828.                         (* IN *)       VALU      );
  829.          WHILE NOT(NEXTCHAR.NAME IN [ QUOTE, ENDOFLINE, FILEMARK ]) DO
  830.             STORENEXTCHAR( (* FROM INPUT *)
  831.                            (* UPDATING *) LENGTH,
  832.                                           CURRCHAR,
  833.                                           NEXTCHAR,
  834.                            (* IN *)       VALU      );
  835.          IF NEXTCHAR.NAME = QUOTE
  836.             THEN
  837.                STORENEXTCHAR( (* FROM INPUT *)
  838.                               (* UPDATING *) LENGTH,
  839.                                              CURRCHAR,
  840.                                              NEXTCHAR,
  841.                               (* IN *)       VALU      )
  842.       END;
  843.    NAME := OTHERSYM
  844. END; (* GETSTRINGLITERAL *)
  845. (*=********************************************************************)
  846. (**********************************************************************)
  847. (***                                                                ***)
  848. (***   NAME                                                         ***)
  849. (***                 CHARTYPE                                       ***)
  850. (***                                                                ***)
  851. (***   DESCRIPTION                                                  ***)
  852. (***           THIS FUNCTION WILL LOOP THROUGH A SET OF             ***)
  853. (***       SPECIAL CHARACTERS TO SEE IF THE CURRENT CHAR-           ***)
  854. (***       ACTER(FIRST CHARACTER OF THE NEXT TOKEN ON THE           ***)
  855. (***       INPUT FILE) AND POSSIBLY THE NEXT CHARACTER (            ***)
  856. (***       NEXTCHAR) BELONG TO THE SET OF (':=', '=>',              ***)
  857. (***       '--', ';', ':', '_', '(', ')', '=').  IF SO,             ***)
  858. (***       THE NAME OF THE SYMBOL IS RETURNED.  IF NOT              ***)
  859. (***       "OTHERSYM" IS RETURNED.                                  ***)
  860. (***                                                                ***)
  861. (***   INPUTS                                                       ***)
  862. (***       CURRCHAR -- FROM THE INPUT FILE                          ***)
  863. (***       NEXTCHAR -- FROM THE INPUT FILE                          ***)
  864. (***                                                                ***)
  865. (***   OUTPUTS                                                      ***)
  866. (***       CHARTYPE -- NAME OF THE SYMBOL IF FOUND,                 ***)
  867. (***                   OTHERWISE EQUALS "OTHERSYM".                 ***)
  868. (***                                                                ***)
  869. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  870. (***                    NONE                                        ***)
  871. (***                                                                ***)
  872. (***   REFERENCED BY                                                ***)
  873. (***                    GETSPECIALCHAR                              ***)
  874. (***                                                                ***)
  875. (**********************************************************************)
  876. FUNCTION CHARTYPE( (* OF *)        CURRCHAR,
  877.                                    NEXTCHAR : CHARINFO )
  878.                    (* RETURNING *)                      : KEYSYMBOL;
  879. VAR
  880.     NEXTTWOCHARS: SPECIALCHAR;
  881.     HIT: BOOLEAN;
  882.     THISCHAR: KEYSYMBOL;
  883. BEGIN (* CHARTYPE *)
  884.    NEXTTWOCHARS[1] := CURRCHAR.VALU;
  885.    NEXTTWOCHARS[2] := NEXTCHAR.VALU;
  886.    THISCHAR := BECOMES;
  887.    HIT      := FALSE;
  888.    WHILE NOT(HIT OR (THISCHAR = SEMICOLON)) DO
  889.       IF NEXTTWOCHARS = DBLCHAR [THISCHAR]
  890.          THEN
  891.             HIT := TRUE
  892.          ELSE
  893.             THISCHAR := SUCC(THISCHAR);
  894.    IF NOT HIT
  895.       THEN
  896.          BEGIN
  897.             THISCHAR := SEMICOLON;
  898.             WHILE NOT(HIT OR (PRED(THISCHAR) = PERIOD)) DO
  899.                IF CURRCHAR.VALU = SGLCHAR [THISCHAR]
  900.                   THEN
  901.                      HIT := TRUE
  902.                   ELSE
  903.                      THISCHAR := SUCC(THISCHAR)
  904.          END;
  905.    IF HIT
  906.       THEN
  907.          CHARTYPE := THISCHAR
  908.       ELSE
  909.          CHARTYPE := OTHERSYM
  910. END; (* CHARTYPE *)
  911. (*=********************************************************************)
  912. (**********************************************************************)
  913. (***                                                                ***)
  914. (***   NAME                                                         ***)
  915. (***                   GETSPECIALCHAR                               ***)
  916. (***                                                                ***)
  917. (***   DESCRIPTION                                                  ***)
  918. (***          IF THE NAME OF THE FIRST CHARACTER OF THE NEXT        ***)
  919. (***     TOKEN FROM THE INPUT FILE IS NOT IN ( FILEMARK, END-       ***)
  920. (***     OFLINE, LETTER, UNDERSCORE, DIGIT, QUOTE, SPACE, BLANK)    ***)
  921. (***     THEN IT IS INITIALLY LABLED AS A "OTHERCHAR".  THIS        ***)
  922. (***     PROCEDURE WILL CALL THE FUNCTION CHARTYPE TO ATTEMPT       ***)
  923. (***     TO FURTHER IDENTIFY IT FOR SPECIALIZED PROCESSING.         ***)
  924. (***                                                                ***)
  925. (***   INPUTS                                                       ***)
  926. (***        CURRCHAR -- FROM THE INPUT FILE                         ***)
  927. (***        NEXTCHAR -- FROM THE INPUT FILE                         ***)
  928. (***                                                                ***)
  929. (***   OUTPUTS                                                      ***)
  930. (***        NAME --- NAME OF THE CURRENT SYMBOL                     ***)
  931. (***        LENGTH - NUMBER OF CHARACTERS OF THE SYMBOL             ***)
  932. (***        VALU --- PACKED ARRAY CONTAINING THE CHARACTERS         ***)
  933. (***                 OF THE SYMBOL.                                 ***)
  934. (***                                                                ***)
  935. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  936. (***                      STORENEXTCHAR                             ***)
  937. (***                                                                ***)
  938. (***   REFERENCED BY                                                ***)
  939. (***                      GETNEXTSYMBOL                             ***)
  940. (***                                                                ***)
  941. (**********************************************************************)
  942. PROCEDURE GETSPECIALCHAR( (* FROM INPUT *)
  943.                           (* UPDATING *)  VAR CURRCHAR,
  944.                                               NEXTCHAR  : CHARINFO;
  945.                           (* RETURNING *) VAR NAME      : KEYSYMBOL;
  946.                                           VAR VALU      : STRING;
  947.                                           VAR LENGTH    : INTEGER   );
  948. BEGIN (* GETSPECIALCHAR *)
  949.    STORENEXTCHAR( (* FROM INPUT *)
  950.                   (* UPDATING *) LENGTH,
  951.                                  CURRCHAR,
  952.                                  NEXTCHAR,
  953.                   (* IN *)       VALU      );
  954.    NAME := CHARTYPE( (* OF *) CURRCHAR,
  955.                               NEXTCHAR );
  956.    IF NAME IN DBLCHARS
  957.       THEN
  958.          STORENEXTCHAR( (* FROM INPUT *)
  959.                         (* UPDATING *) LENGTH,
  960.                                        CURRCHAR,
  961.                                        NEXTCHAR,
  962.                         (* IN *)       VALU      )
  963. END; (* GETSPECIALCHAR *)
  964. (*=********************************************************************)
  965. (**********************************************************************)
  966. (***                                                                ***)
  967. (***   NAME                                                         ***)
  968. (***             CHECKSYMBOL                                        ***)
  969. (***                                                                ***)
  970. (***   DESCRIPTION                                                  ***)
  971. (***                                                                ***)
  972. (***      IN MANY APPLICATIONS THE INDENTATION OF KEYWORDS VARIES   ***)
  973. (***    AS A FUNCTION OF IT APPLICATION.  SUCH IS THE CASE FOR THE  ***)
  974. (***    ADA PRETTYPRINTER.  THE PURPOSE OF THIS PROCEDURE IS TO     ***)
  975. (***    DETERMINE THE APPLICATION IN ORDER TO PROPERLY PERFORM THE  ***)
  976. (***    FORMATTING OF THE OUTPUT.  THIS PROCEDURE WILL:             ***)
  977. (***                                                                ***)
  978. (***       A-  DIFFERIENTIATE BETWEEN A "BASIC_LOOP" ACTING ALONE   ***)
  979. (***           OR USED IN CONJUNCTION WITH A "ITERATION_CLAUSE".    ***)
  980. (***           THIS IS ACCOMPLISHED BY SETTING A FLAG, "LOOPSWITCH",***)
  981. (***           WHENEVER A "FOR" OR A "WHILE" KEYWORD IS ENCOUNTERED ***)
  982. (***           AND RESETTING IT WHEN A ";" IS PROCESSED(INDICATING  ***)
  983. (***           THE END OF THE RANGE OF THE "LOOPSWITCH").  WHEN THE ***)
  984. (***           "BASIC_LOOP" IS USED ALONE, THE KEYWORD "LOOP" IS    ***)
  985. (***           FORCED ON A LINE BY ITSELF AND THE "SEQUENCE_OF_     ***)
  986. (***           STATEMENTS" IS INDENTED.                             ***)
  987. (***                                                                ***)
  988. (***       B-  DETECT THE USE OF "SELECTIVE_WAIT" AND "TIMED_ENTRY_ ***)
  989. (***           CALL" STATEMENTS.  THIS IS REQUIRED TO PROPERLY PRO- ***)
  990. (***           CESS THE KEYOWRD "OR" TO DIFFERIENTIATE ITS USEAGE   ***)
  991. (***           WITH THESE STATEMENTS AS OPPOSED TO A "LOGICAL_OPER- ***)
  992. (***           ATOR".  WHEN THE KEYWORD "SELECT" IS PROCESSED.  THE ***)
  993. (***           SWITCH IS RESET WHEN THE "END SELECT" IS PROCESSED.  ***)
  994. (***                                                                ***)
  995. (***       C-  DETECT THE USE OF "REPRESENTATION_SPECIFICATION".    ***)
  996. (***           THIS IS NECESSARY BECAUSE OF THE "FOR-LOOP" STATE-   ***)
  997. (***           MENTS. THE PRETTYPRINTER ASSUMES THAT WHEN A "FOR"   ***)
  998. (***           IS ENCOUNTERED THAT THE STATEMENT IS A "FOR-LOOP"    ***)
  999. (***           STATEMENT AND THE MARGIN IS INDENTED.  HOWEVER, IF   ***)
  1000. (***           A "USE" KEYWORD IS DETECTED PRIOR TO A "LOOP" KEY-   ***)
  1001. (***           WORD, THEN IT IS EVIDENT THAT THE STATEMENT BEING    ***)
  1002. (***           PROCESSED IS A "REPRESENTATION_SPECIFICATION" AND    ***)
  1003. (***           THE MARGIN IS DEINDENTED.                            ***)
  1004. (***                                                                ***)
  1005. (***       D-  DETECT THE PRESENCE OF A "WITH_CLAUSE-USE_CLAUSE"    ***)
  1006. (***           COMBINATION.  THIS IS THE ONLY CASE WHEN TWO STATE-  ***)
  1007. (***           MENTS ARE ALLOWED ON THE SAME LINE ACCORDING TO THE  ***)
  1008. (***           RULES.  THIS IS ACCOMPLISHED BY:                     ***)
  1009. (***                                                                ***)
  1010. (***              1-  FIRST, THE SETTING OF THE FLAG, "WITHSEEN",   ***)
  1011. (***                  UPON DETECTION OF THE KEYWORD "WITH".         ***)
  1012. (***              2-  WHEN THE NEXT ";" IS PROCESSED, EXAMINE THE   ***)
  1013. (***                  KEYWORD AND IF IT IS A "USE" KEYWORD THEN     ***)
  1014. (***                  SUPPRESS A CARRIAGE RETURN FOLLOWING THE SEMI-***)
  1015. (***                  COLON.                                        ***)
  1016. (***                                                                ***)
  1017. (***       E-  DETECT THE PRESENCE OF A BODY STUB.  THIS IS NECES-  ***)
  1018. (***           SARY BECAUSE THE PRETTYPRINTER ASSUMES THAT WHEN ANY ***)
  1019. (***           ONE OF THE KEYWORDS "PROCEDURE", "FUNCTION", "TASK"  ***)
  1020. (***           OR "PACKAGE" IS DECTED FOLLOWED BY THE KEYWORD "IS"  ***)
  1021. (***           THAT A FULL COMPILATION UNIT IS BEING PROCESSED      ***)
  1022. (***           WHICH CALLS FOR A CARRIAGE RETURN FOLLOWING THE      ***)
  1023. (***           KEYWORD "IS".  IF THE NEXT SYMBOL IS THE KEYWORD     ***)
  1024. (***           "SEPARATE" THEN THE PRETTYPRINTER CORRECTS ITSELF    ***)
  1025. (***           KNOWS THAT IT IS NOW PROCESSING A "BODY_STUB" AND    ***)
  1026. (***           SUPPRESSES THE CARRIAGE RETURN.                      ***)
  1027. (***                                                                ***)
  1028. (***       F-  DIFFERIENTIATE BETWEEN AN "EXCEPTION_DECLARATION"    ***)
  1029. (***           AND AN "EXCEPTION_HANDLER".  THIS IS ACCOMPLISHED    ***)
  1030. (***           BY EXAMINING THE CURRENT SYMBOL AND THE NEXT SYMBOL  ***)
  1031. (***           TOGETHER.  IF THE CURRENT SYMBOL IS A COLON,":",     ***)
  1032. (***           AND IF THE NEXT SYMBOL IS THE KEYWORD "EXCEPTION",   ***)
  1033. (***           THEN IT IS AN "EXCEPTION_DECLARATION", OTHERWISE     ***)
  1034. (***           IT IS AN "EXCEPTION_HANDLER".                        ***)
  1035. (***                                                                ***)
  1036. (***       G-  DETECT THE PRESENCE OF A BLOCK.. THIS IS ACCOMP-     ***)
  1037. (***           LISHED BY ALSO EXAMINING THE CURRENT SYMBOL AND THE  ***)
  1038. (***           COLLECTIVELY.  IF THEY ARE ":" AND "DECLARE" OR      ***)
  1039. (***           ":" AND "BEGIN" THEN A BLOCK IS BEING PROCESSED.     ***)
  1040. (***                                                                ***)
  1041. (***       H-  DIFFERIENTIATE BETWEEN A "SUBPROGRAM_DECLARATION"    ***)
  1042. (***           AND A "SUBPROGRAM_SPECIFICATION".  THIS IS ACCOMP-   ***)
  1043. (***           LISHED BY:                                           ***)
  1044. (***                                                                ***)
  1045. (***              1-  IF THE KEYWORD "PROCEDURE", "FUNCTION",       ***)
  1046. (***                  "TASK" OR "PACKAGE" IS ENCOUNTERED, ASSUME    ***)
  1047. (***                  IT IS A "SUBPROGRAM_SPECIFICATION" AND SET    ***)
  1048. (***                  THE MARGIN FOR INDENTATION.                   ***)
  1049. (***              2-  IF, HOWEVER, A SEMICOLON,";", IS ENCOUNTERED  ***)
  1050. (***                  PRIOR TO THE KEYWORD "IS", THEN DEINDENT THE  ***)
  1051. (***                  MARGIN.                                       ***)
  1052. (***                                                                ***)
  1053. (***   INPUTS                                                       ***)
  1054. (***           CURRSYM--FROM THE INPUT FILE                         ***)
  1055. (***           NEXTSYM--FROM THE INPUT FILE                         ***)
  1056. (***                                                                ***)
  1057. (***   OUTPUTS                                                      ***)
  1058. (***           CURRSYM                                              ***)
  1059. (***           NEXTSYM                                              ***)
  1060. (***           LOOPSWITCH                                           ***)
  1061. (***           ORSWITCH                                             ***)
  1062. (***           USESWITCH                                            ***)
  1063. (***           ISSWITCH                                             ***)
  1064. (***           WITHSEEN                                             ***)
  1065. (***                                                                ***)
  1066. (***   PROCEDURE REFERENCED BY:                                     ***)
  1067. (***                 GETNEXTSYMBOL                                  ***)
  1068. (***                                                                ***)
  1069. (**********************************************************************)
  1070. PROCEDURE CHECKSYMBOL( VAR PARM : SYMBOLINFO);
  1071. BEGIN (*CHECKSYMBOL*)
  1072.   WITH PARM^ DO
  1073.     CASE NAME OF
  1074.         FORSYM     : BEGIN
  1075.                         LOOPSWITCH := TRUE;
  1076.                         USESWITCH  := TRUE;
  1077.                      END;
  1078.         USESYM     : IF USESWITCH
  1079.                         THEN
  1080.                            BEGIN
  1081.                               USESWITCH     := FALSE;
  1082.                               NEXTSYM^.NAME := SPECIALUSESYM;
  1083.                            END;
  1084.         SELECTSYM  : ORSWITCH := TRUE;
  1085.         ORSYM      : IF ORSWITCH
  1086.                         THEN
  1087.                            CURRSYM^.NAME := SPECIALORSYM;
  1088.         ENDSYM     : ORSWITCH := FALSE;
  1089.         LOOPSYM    : IF LOOPSWITCH
  1090.                         THEN
  1091.                            BEGIN
  1092.                               LOOPSWITCH    := FALSE;
  1093.                               NEXTSYM^.NAME := SPECIALLOOPSYM;
  1094.                            END;
  1095.         WHILESYM   : LOOPSWITCH := TRUE;
  1096.         WITHSYM    : WITHSEEN := TRUE;
  1097.         SEMICOLON   : BEGIN
  1098.                         IF NEXTSYM^.NAME = USESYM
  1099.                             THEN
  1100.                                 CURRSYM^.NAME := SPSEMICOLON;
  1101.                         WITHSEEN   := FALSE;
  1102.                         IF NOT(NEXTSYM^.NAME IN [ FORSYM, WHILESYM ])
  1103.                             THEN
  1104.                                LOOPSWITCH := FALSE;
  1105.                         IF PARENCOUNTER = 0
  1106.                            THEN
  1107.                               ISSWITCH   := FALSE;
  1108.                       END;
  1109.         SEPARATESYM :  IF ISSWITCH
  1110.                           THEN
  1111.                             ISSWITCH := FALSE;
  1112.         PROCSYM,
  1113.         FUNCSYM,
  1114.         TASKSYM,
  1115.         PACKAGESYM  :  BEGIN
  1116.                           ISSWITCH := TRUE;
  1117.                           ENDIDENTIFIER.ENDSYMBOL := NEXTSYM^.VALU;
  1118.                           ENDIDENTIFIER.LLENGTH   := NEXTSYM^.LENGTH;
  1119.                        END;
  1120.         CASESYM     :  ISSWITCH := TRUE;
  1121.         ACCEPTSYM,
  1122.         BODYSYM     :  BEGIN
  1123.                           ENDIDENTIFIER.ENDSYMBOL := NEXTSYM^.VALU;
  1124.                           ENDIDENTIFIER.LLENGTH   := NEXTSYM^.LENGTH;
  1125.                        END;
  1126.         ISSYM       :  IF ISSWITCH
  1127.                           THEN
  1128.                              BEGIN
  1129.                                 ISSWITCH := FALSE;
  1130.                                 CURRSYM^.NAME := SPECIALISSYM;
  1131.                              END;
  1132.         COLON       : IF NAME IN [ DECLARESYM, BEGINSYM ]
  1133.                         THEN
  1134.                            CURRSYM^.NAME := SPECIALCOLON
  1135.                         ELSE
  1136.                            IF NEXTSYM^.NAME = EXCEPTIONSYM
  1137.                               THEN
  1138.                                  NEXTSYM^.NAME := SPEXCEPTIONSYM;
  1139.    END; (*CASE*)
  1140. END; (*CHECKSYMBOL*)
  1141. (*=********************************************************************)
  1142. (**********************************************************************)
  1143. (***                                                                ***)
  1144. (***   NAME                                                         ***)
  1145. (***                    GETNEXTSYMBOL                               ***)
  1146. (***                                                                ***)
  1147. (***   DESCRIPTION                                                  ***)
  1148. (***                                                                ***)
  1149. (***       THIS PROCEDURE EXAMINES THE NEXT CHARACTER NAME OF THE   ***)
  1150. (***    FIRST CHARACTER OF THE NEXT TOKEN ON THE INPUT FILE TO DET- ***)
  1151. (***    MINE THE TYPE OF THE NEXT TOKEN AND THEN CALLS THE APPRO-   ***)
  1152. (***    PRIATE PROCEDURE TO FETCH THE TOKEN.                        ***)
  1153. (***                                                                ***)
  1154. (***   INPUTS                                                       ***)
  1155. (***          NEXTCHAR------FROM THE INPUT FILE                     ***)
  1156. (***          GOBBLESWITCH--TRUE IF IN THE GOBBLE MODE              ***)
  1157. (***          NAME----------COMPONET OF "NEXTSYM"                   ***)
  1158. (***                                                                ***)
  1159. (***   OUTPUTS                                                      ***)
  1160. (***          CURRCHAR--UPDATED VALUE                               ***)
  1161. (***          NEXTCHAR--UPDATED VALUE                               ***)
  1162. (***          NAME------OF NEXT SYMBOL                              ***)
  1163. (***          LENGTH----NUMBER OF CHARACTERS IN NAME STRING         ***)
  1164. (***          VALU------ARRAY WHOSE COMPONETS CONTAINS THE          ***)
  1165. (***                    CHARACTERS OF THE NAME                      ***)
  1166. (***                                                                ***)
  1167. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  1168. (***                    GETIDENTIFIER                               ***)
  1169. (***                    STORENEXTCHAR                               ***)
  1170. (***                    GETNUMBER                                   ***)
  1171. (***                    GETSTRINGLITERAL                            ***)
  1172. (***                    GETSPECIALCHAR                              ***)
  1173. (***                    GETCOMMENT                                  ***)
  1174. (***                                                                ***)
  1175. (***   REFERENCED BY                                                ***)
  1176. (***                    GETSYMBOL                                   ***)
  1177. (***                                                                ***)
  1178. (**********************************************************************)
  1179. PROCEDURE GETNEXTSYMBOL( (* FROM INPUT *)
  1180.                          (* UPDATING *)  VAR CURRCHAR,
  1181.                                              NEXTCHAR  : CHARINFO;
  1182.                          (* RETURNING *) VAR NAME      : KEYSYMBOL;
  1183.                                          VAR VALU      : STRING;
  1184.                                          VAR LENGTH    : INTEGER   );
  1185. BEGIN (* GETNEXTSYMBOL *)
  1186.    CASE NEXTCHAR.NAME OF
  1187.       LETTER      : GETIDENTIFIER( (* FROM INPUT *)
  1188.                                    (* UPDATING *)  CURRCHAR,
  1189.                                                    NEXTCHAR,
  1190.                                    (* RETURNING *) NAME,
  1191.                                                    VALU,
  1192.                                                    LENGTH    );
  1193.       UNDERSCORE  : BEGIN
  1194.                        STORENEXTCHAR(LENGTH  , CURRCHAR,
  1195.                                      NEXTCHAR, VALU);
  1196.                        GETNEXTSYMBOL ( CURRCHAR,
  1197.                                        NEXTCHAR,
  1198.                                        NAME,
  1199.                                        VALU,
  1200.                                        LENGTH );
  1201.                     END;
  1202.       DIGIT       : GETNUMBER( (* FROM INPUT *)
  1203.                                (* UPDATING *)  CURRCHAR,
  1204.                                                NEXTCHAR,
  1205.                                (* RETURNING *) NAME,
  1206.                                                VALU,
  1207.                                                LENGTH    );
  1208.       QUOTE       : GETSTRINGLITERAL( (* FROM INPUT *)
  1209.                                     (* UPDATING *)  CURRCHAR,
  1210.                                                     NEXTCHAR,
  1211.                                     (* RETURNING *) NAME,
  1212.                                                     VALU,
  1213.                                                     LENGTH    );
  1214.       OTHERCHAR   : BEGIN
  1215.                        GETSPECIALCHAR( (* FROM INPUT *)
  1216.                                        (* UPDATING *)  CURRCHAR,
  1217.                                                        NEXTCHAR,
  1218.                                        (* RETURNING *) NAME,
  1219.                                                        VALU,
  1220.                                                        LENGTH    );
  1221.                        IF NAME=OPENCOMMENT
  1222.                           THEN
  1223.                              GETCOMMENT( (* FROM INPUT *)
  1224.                                          (* UPDATING *) CURRCHAR,
  1225.                                                         NEXTCHAR,
  1226.                                                         NAME,
  1227.                                                         VALU,
  1228.                                                         LENGTH);
  1229.                     END;
  1230.       FILEMARK    : NAME := ENDOFFILE
  1231.    END (* CASE *);
  1232. END; (* GETNEXTSYMBOL *)
  1233. (*=********************************************************************)
  1234. (**********************************************************************)
  1235. (***                                                                ***)
  1236. (***   NAME                                                         ***)
  1237. (***                    GETSYMBOL                                   ***)
  1238. (***                                                                ***)
  1239. (***   DESCRIPTION                                                  ***)
  1240. (***                                                                ***)
  1241. (***         THE PURPOSE OF THIS PROCEDURE IS TO UPDATE THE CURRENT ***)
  1242. (***     SYMBOL TO THE VALUE OF THE PLREVIOUS "NEXTSYM".  THE NEXT  ***)
  1243. (***     SYMBOL FROM THE INPUT FILE IS FETCHED AND THE VARIABLE     ***)
  1244. (***     "NEXTSYM" IS UPDATED WITH THIS SYMBOL.  THIS PROCEDURE     ***)
  1245. (***     ALSO RESTRICTS THE NUMBER OF SPACES BETWEEN SYMBOL TO ONE  ***)
  1246. (***    AND REMOVES EXTRANEOUS BLANK LINES FROM THE OUTPUT          ***)
  1247. (***                                                                ***)
  1248. (***   INPUTS                                                       ***)
  1249. (***          CURRSYM ----- FROM THE INPUT FILE                     ***)
  1250. (***          NEXTSYM ----- FROM THE INPUT FILE                     ***)
  1251. (***          CURRLINEPOS-- OF THE OUTPUT FILE                      ***)
  1252. (***                                                                ***)
  1253. (***   OUTPUTS                                                      ***)
  1254. (***          CURRCHAR ---- UPDATED VALUE                           ***)
  1255. (***          NEXTCHAR ---- UPDATED VALUE                           ***)
  1256. (***          CURRSYM  ---- UPDATED VALUE                           ***)
  1257. (***          NEXTSYM  ---- UPDATED VALUE                           ***)
  1258. (***          STARTPOS ---- SAVED FOR INDENTATION PURPOSES          ***)
  1259. (***                                                                ***)
  1260. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  1261. (***                    SKIPSPACES                                  ***)
  1262. (***                    CHECKSYMBOL                                 ***)
  1263. (***                    GETNEXTSYMBOL                               ***)
  1264. (***                                                                ***)
  1265. (***   REFERENCED BY                                                ***)
  1266. (***                    INITIALIZE                                  ***)
  1267. (***                    GOBBLE                                      ***)
  1268. (***                    PRINTENDIDENTIFIER                          ***)
  1269. (***                                                                ***)
  1270. (**********************************************************************)
  1271. PROCEDURE GETSYMBOL( (* FROM INPUT *)
  1272.                      (* UPDATING *)  VAR NEXTSYM   : SYMBOLINFO;
  1273.                      (* RETURNING *) VAR CURRSYM   : SYMBOLINFO );
  1274. VAR
  1275.     DUMMY: SYMBOLINFO;
  1276. BEGIN (* GETSYMBOL *)
  1277.    DUMMY   := CURRSYM;
  1278.    CURRSYM := NEXTSYM;
  1279.    NEXTSYM := DUMMY  ;
  1280.    WITH NEXTSYM^ DO
  1281.       BEGIN
  1282.          SKIPSPACES(
  1283.                    (* UPDATING *)  CURRCHAR,
  1284.                                    NEXTCHAR,
  1285.                    (* RETURNING *) SPACESBEFORE,
  1286.                                    CRSBEFORE     );
  1287.          LENGTH := 0;
  1288.          GETNEXTSYMBOL( (* FROM INPUT *)
  1289.                       (* UPDATING *)  CURRCHAR,
  1290.                                       NEXTCHAR,
  1291.                       (* RETURNING *) NAME,
  1292.                                       VALU,
  1293.                                       LENGTH    );
  1294.           IF NAME IN [ OPENPAREN, CLOSEPAREN ]
  1295.              THEN
  1296.                 IF NAME = OPENPAREN
  1297.                    THEN
  1298.                       BEGIN
  1299.                          PARENCOUNTER := PARENCOUNTER + 1;
  1300.                          IF PARENCOUNTER = 1
  1301.                             THEN
  1302.                                IF CURRSYM^.CRSBEFORE = 0
  1303.                                   THEN
  1304.                                       PARENINDENT := CURRLINEPOS +
  1305.                                               CURRSYM^.LENGTH + 1
  1306.                                   ELSE
  1307.                                       PARENINDENT := CURRMARGIN +
  1308.                                               CURRSYM^.LENGTH +1;
  1309.                       END
  1310.                    ELSE
  1311.                       PARENCOUNTER := PARENCOUNTER - 1;
  1312.          IF PARENCOUNTER >= 1
  1313.             THEN
  1314.                IF NAME IN [SEMICOLON, OPENCOMMENT, OPENPAREN ]
  1315.                   THEN
  1316.                      STARTPOS := CURRLINEPOS
  1317.                   ELSE
  1318.                      NAME := OTHERSYM;
  1319.          IF (SPACESBEFORE > 1) AND
  1320.             (NOT(NAME = OPENCOMMENT))
  1321.              THEN
  1322.                 SPACESBEFORE := 1;
  1323.          IF (CURRLINEPOS+CURRSYM^.LENGTH<= MAXLINESIZE)AND
  1324.             (NOT(CURRSYM^.NAME = OPENCOMMENT))
  1325.             THEN
  1326.                CURRSYM^.CRSBEFORE := 0;
  1327.          IF NAME IN [ SELECTSYM, ORSYM    , SEPARATESYM,
  1328.                       FORSYM   , WHILESYM , LOOPSYM    ,
  1329.                       ENDSYM   , WITHSYM  , USESYM     ]
  1330.              THEN
  1331.                   CHECKSYMBOL(NEXTSYM);
  1332.          IF CURRSYM^.NAME IN [ PACKAGESYM, FUNCSYM, ACCEPTSYM,
  1333.                                PROCSYM   , CASESYM, TASKSYM  ,
  1334.                                BODYSYM   , ISSYM  , COLON    ,
  1335.                                SEMICOLON ]
  1336.              THEN
  1337.                 CHECKSYMBOL(CURRSYM);
  1338.       END (* WITH *)
  1339. END; (* GETSYMBOL *)
  1340. (**********************************************************************)
  1341. (**********************************************************************)
  1342. (***                                                                ***)
  1343. (***   NAME                                                         ***)
  1344. (***                        INITIALIZE                              ***)
  1345. (***                                                                ***)
  1346. (***   DESCRIPTION                                                  ***)
  1347. (***                                                                ***)
  1348. (***        THE PRIMARY FUNCTION OF THIS PROCEDURE IS TO SET THE    ***)
  1349. (***    PROCESSING OPTIONS SELECTED FROM THE SET OF OPTIONS FOR     ***)
  1350. (***    EACH SYMBOL TO PROCESED AS WELL AS THE GOBBLE SYMBOLS IF    ***)
  1351. (***    THE OPTION "GOBBLESYMBOL" IS SELECTED.  ADDITIONALLY THE    ***)
  1352. (***    "NEXTCHAR" IS FETCH FROM THE INPUT FILE TO INITIATE THE     ***)
  1353. (***    THE INPUTTING OF THE INPUT FILE.  A CALL TO GETSYMBOL THEN  ***)
  1354. (***    INITIALIZES THE "NEXTSYM" AS WELL AS UPDATING OF "NEXTCHAR" ***)
  1355. (***    AND "CURRCHAR".  FINALLY OTHER GOBAL VARIABLES AND ARRAYS   ***)
  1356. (***    ARE INITIALIZED.                                            ***)
  1357. (***                                                                ***)
  1358. (***   INPUTS                                                       ***)
  1359. (***            NONE                                                ***)
  1360. (***                                                                ***)
  1361. (***   OUTPUTS                                                      ***)
  1362. (***            CURRCHAR                                            ***)
  1363. (***            NEXTCHAR                                            ***)
  1364. (***            CURRSYM                                             ***)
  1365. (***            NEXTSYM                                             ***)
  1366. (***                                                                ***)
  1367. (***   INITIALIZES                                                  ***)
  1368. (***            TOP                                                 ***)
  1369. (***            CURRLINPOS                                          ***)
  1370. (***            CURRMARGIN                                          ***)
  1371. (***            KEYWORD                                             ***)
  1372. (***            DBLCHARS                                            ***)
  1373. (***            SGLCHAR                                             ***)
  1374. (***            LOOPSWITCH                                          ***)
  1375. (***            USESWITCH                                           ***)
  1376. (***            WITHSEEN                                            ***)
  1377. (***            ORSWITCH                                            ***)
  1378. (***            CRPENDING                                           ***)
  1379. (***            ISSWITCH                                            ***)
  1380. (***            CURRCHAR                                            ***)
  1381. (***            NEXTCHAR                                            ***)
  1382. (***            CURRSYM                                             ***)
  1383. (***            NEXTSYM                                             ***)
  1384. (***            PPOPTION                                            ***)
  1385. (***                                                                ***)
  1386. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  1387. (***                    GETSYMBOL                                   ***)
  1388. (***                                                                ***)
  1389. (***   REFERENCED BY                                                ***)
  1390. (***                    PRETTYPRINT                                 ***)
  1391. (***                                                                ***)
  1392. (**********************************************************************)
  1393. PROCEDURE INITIALIZE;
  1394. BEGIN (* INITIALIZE *)
  1395.    LINELIMIT(OUTPUT,MAXINT);
  1396.    TOP         := 0;
  1397.    CURRLINEPOS := 0;
  1398.    CURRMARGIN  := 0;
  1399.    PARENCOUNTER:= 0;
  1400.    KEYWORD [ FUNCSYM        ] := 'FUNCTION  ' ;
  1401.    KEYWORD [ PROCSYM        ] := 'PROCEDURE ' ;
  1402.    KEYWORD [ ISSYM          ] := 'IS        ' ;
  1403.    KEYWORD [ SPECIALISSYM   ] := 'IS        ' ;
  1404.    KEYWORD [ TYPESYM        ] := 'TYPE      ' ;
  1405.    KEYWORD [ BEGINSYM       ] := 'BEGIN     ' ;
  1406.    KEYWORD [ RECORDSYM      ] := 'RECORD    ' ;
  1407.    KEYWORD [ CASESYM        ] := 'CASE      ' ;
  1408.    KEYWORD [ FORSYM         ] := 'FOR       ' ;
  1409.    KEYWORD [ WHENSYM        ] := 'WHEN      ' ;
  1410.    KEYWORD [ WHILESYM       ] := 'WHILE     ' ;
  1411.    KEYWORD [ USESYM         ] := 'USE       ' ;
  1412.    KEYWORD [ SPECIALUSESYM  ] := 'USE       ' ;
  1413.    KEYWORD [ LOOPSYM        ] := 'LOOP      ' ;
  1414.    KEYWORD [ SPECIALLOOPSYM ] := 'LOOP      ' ;
  1415.    KEYWORD [ WITHSYM        ] := 'WITH      ' ;
  1416.    KEYWORD [ DOSYM          ] := 'DO        ' ;
  1417.    KEYWORD [ IFSYM          ] := 'IF        ' ;
  1418.    KEYWORD [ THENSYM        ] := 'THEN      ' ;
  1419.    KEYWORD [ ELSESYM        ] := 'ELSE      ' ;
  1420.    KEYWORD [ ELSIFSYM       ] := 'ELSIF     ' ;
  1421.    KEYWORD [ ENDSYM         ] := 'END       ' ;
  1422.    KEYWORD [ EXITSYM        ] := 'EXIT      ' ;
  1423.    KEYWORD [ PACKAGESYM     ] := 'PACKAGE   ' ;
  1424.    KEYWORD [ TASKSYM        ] := 'TASK      ' ;
  1425.    KEYWORD [ GENERICSYM     ] := 'GENERIC   ' ;
  1426.    KEYWORD [ EXCEPTIONSYM   ] := 'EXCEPTION ' ;
  1427.    KEYWORD [ SPEXCEPTIONSYM ] := 'EXCEPTION ' ;
  1428.    KEYWORD [ PRIVATESYM     ] := 'PRIVATE   ' ;
  1429.    KEYWORD [ SELECTSYM      ] := 'SELECT    ' ;
  1430.    KEYWORD [ ORSYM          ] := 'OR        ' ;
  1431.    KEYWORD [ SPECIALORSYM   ] := 'OR        ' ;
  1432.    KEYWORD [ DECLARESYM     ] := 'DECLARE   ' ;
  1433.    KEYWORD [ SEPARATESYM    ] := 'SEPARATE  ' ;
  1434.    KEYWORD [ ACCEPTSYM      ] := 'ACCEPT    ' ;
  1435.    KEYWORD [ BODYSYM        ] := 'BODY      ' ;
  1436.    DBLCHARS := [ BECOMES, ARROWSYM,  OPENCOMMENT ];
  1437.    DBLCHAR [ BECOMES     ]  := ':=';
  1438.    DBLCHAR [ OPENCOMMENT ]  := '--';
  1439.    DBLCHAR [ ARROWSYM    ]  := '=>';
  1440.    SGLCHAR [ SEMICOLON    ] := ';' ;
  1441.    SGLCHAR [ SPSEMICOLON  ] := ';' ;
  1442.    SGLCHAR [ COLON        ] := ':' ;
  1443.    SGLCHAR [ SPECIALCOLON ] := ':' ;
  1444.    SGLCHAR [ UNDSCORE     ] := '_' ;
  1445.    SGLCHAR [ EQUALS       ] := '=' ;
  1446.    SGLCHAR [ OPENPAREN    ] := '(' ;
  1447.    SGLCHAR [ CLOSEPAREN   ] := ')' ;
  1448.    SGLCHAR [ PERIOD       ] := '.' ;
  1449.    LOOPSWITCH    := FALSE;
  1450.    USESWITCH     := FALSE;
  1451.    WITHSEEN      := FALSE;
  1452.    ORSWITCH      := FALSE;
  1453.    ISSWITCH      := FALSE;
  1454.    CRPENDING     := FALSE;
  1455.    GETCHAR( (* FROM INPUT *)
  1456.             (* UPDATING *)  NEXTCHAR,
  1457.             (* RETURNING *) CURRCHAR  );
  1458.    NEW(CURRSYM);
  1459.    NEW(NEXTSYM);
  1460.    GETSYMBOL( (* FROM INPUT *)
  1461.               (* UPDATING *)  NEXTSYM,
  1462.               (* RETURNING *) CURRSYM  );
  1463.    WITH PPOPTION [ FUNCSYM ] DO
  1464.       BEGIN
  1465.          OPTIONSSELECTED   := [ BLANKLINEBEFORE,
  1466.                                 GOBBLESYMBOLS  ,
  1467.                                 SPACEAFTER     ];
  1468.          GOBBLETERMINATORS := [ ISSYM,
  1469.                                 SEMICOLON      ];
  1470.       END;
  1471.    WITH PPOPTION [ PROCSYM ] DO
  1472.       BEGIN
  1473.          OPTIONSSELECTED   := [ BLANKLINEBEFORE,
  1474.                                 GOBBLESYMBOLS  ,
  1475.                                 SPACEAFTER     ];
  1476.          GOBBLETERMINATORS := [ ISSYM,
  1477.                                 OPENCOMMENT,
  1478.                                 SEMICOLON      ];
  1479.       END;
  1480.    WITH PPOPTION [ SPECIALISSYM ] DO
  1481.       BEGIN
  1482.          OPTIONSSELECTED   := [ SPACEBEFORE    ,
  1483.                                 INDENTMARGIN   ,
  1484.                                 CRAFTER        ];
  1485.          GOBBLETERMINATORS := []
  1486.       END;
  1487.    WITH PPOPTION [ ISSYM ] DO
  1488.       BEGIN
  1489.          OPTIONSSELECTED   := [ SPACEAFTER     ,
  1490.                                 GOBBLESYMBOLS  ];
  1491.          GOBBLETERMINATORS := [ SEMICOLON      ,
  1492.                                  RECORDSYM     ]
  1493.      END;
  1494.    WITH PPOPTION [ TYPESYM ] DO
  1495.       BEGIN
  1496.           OPTIONSSELECTED   := [ SPACEAFTER   ,
  1497.                                  GOBBLESYMBOLS];
  1498.           GOBBLETERMINATORS := [ SEMICOLON    ,
  1499.                                  RECORDSYM    ,
  1500.                                  ISSYM        ]
  1501.       END;
  1502.    WITH PPOPTION [ TASKSYM ] DO
  1503.       BEGIN
  1504.          OPTIONSSELECTED   := [ BLANKLINEBEFORE,
  1505.                                 GOBBLESYMBOLS  ];
  1506.          GOBBLETERMINATORS := [ ISSYM          ,
  1507.                                 BODYSYM        ,
  1508.                                 SEMICOLON      ]
  1509.       END;
  1510.    WITH PPOPTION [ GENERICSYM ] DO
  1511.       BEGIN
  1512.          OPTIONSSELECTED   := [ BLANKLINEBEFORE,
  1513.                                 CRAFTER        ];
  1514.          GOBBLETERMINATORS := []
  1515.       END;
  1516.    WITH PPOPTION [ PACKAGESYM ] DO
  1517.       BEGIN
  1518.          OPTIONSSELECTED   := [ BLANKLINEBEFORE,
  1519.                                 GOBBLESYMBOLS  ];
  1520.          GOBBLETERMINATORS := [ ISSYM          ,
  1521.                                 BODYSYM        ,
  1522.                                 SEMICOLON      ]
  1523.       END;
  1524.    WITH PPOPTION [ BEGINSYM ] DO
  1525.       BEGIN
  1526.          OPTIONSSELECTED   := [ INDENTBYTAB    ,
  1527.                                 DINDENT        ,
  1528.                                 CRAFTER        ];
  1529.          GOBBLETERMINATORS := []
  1530.       END;
  1531.    WITH PPOPTION [ USESYM ] DO
  1532.       BEGIN
  1533.          OPTIONSSELECTED   := [];
  1534.          GOBBLETERMINATORS := []
  1535.       END;
  1536.    WITH PPOPTION [ SPECIALUSESYM ] DO
  1537.       BEGIN
  1538.          OPTIONSSELECTED   := [ DINDENT        ];
  1539.          GOBBLETERMINATORS := []
  1540.       END;
  1541.    WITH PPOPTION [ RECORDSYM ] DO
  1542.       BEGIN
  1543.          OPTIONSSELECTED   := [ CRAFTER        ,
  1544.                                 CRSUPPRESS     ,
  1545.                                 INDENTMARGIN   ];
  1546.          GOBBLETERMINATORS := []
  1547.       END;
  1548.    WITH PPOPTION [ CASESYM ] DO
  1549.       BEGIN
  1550.          OPTIONSSELECTED   := [ SPACEAFTER     ,
  1551.                                 GOBBLESYMBOLS  ];
  1552.          GOBBLETERMINATORS := [ ISSYM          ]
  1553.       END;
  1554.    WITH PPOPTION [ EXITSYM ] DO
  1555.       BEGIN
  1556.          OPTIONSSELECTED   := [ SPACEAFTER     ,
  1557.                                 GOBBLESYMBOLS  ];
  1558.          GOBBLETERMINATORS := [ SEMICOLON      ]
  1559.       END;
  1560.    WITH PPOPTION [ FORSYM ] DO
  1561.       BEGIN
  1562.          OPTIONSSELECTED   := [ SPACEAFTER     ,
  1563.                                 CRBEFORE       ,
  1564.                                 INDENTBYTAB    ,
  1565.                                 GOBBLESYMBOLS  ];
  1566.          GOBBLETERMINATORS := [ SPECIALLOOPSYM ,
  1567.                                 SPECIALUSESYM  ,
  1568.                                 USESYM         ]
  1569.       END;
  1570.    WITH PPOPTION [ SPECIALLOOPSYM ] DO
  1571.       BEGIN
  1572.          OPTIONSSELECTED   := [ SPACEBEFORE    ,
  1573.                                 CRSUPPRESS     ,
  1574.                                 CRAFTER        ];
  1575.          GOBBLETERMINATORS := []
  1576.       END;
  1577.    WITH PPOPTION [ LOOPSYM ] DO
  1578.       BEGIN
  1579.          OPTIONSSELECTED   := [ INDENTBYTAB    ,
  1580.                                 CRAFTER        ];
  1581.          GOBBLETERMINATORS := []
  1582.       END;
  1583.    WITH PPOPTION [ WHILESYM ] DO
  1584.       BEGIN
  1585.          OPTIONSSELECTED   := [ SPACEAFTER     ,
  1586.                                 CRBEFORE       ,
  1587.                                 INDENTBYTAB    ,
  1588.                                 GOBBLESYMBOLS  ];
  1589.          GOBBLETERMINATORS := [ SPECIALLOOPSYM ,
  1590.                                 OPENCOMMENT    ]
  1591.       END;
  1592.    WITH PPOPTION [ WITHSYM ] DO
  1593.       BEGIN
  1594.          OPTIONSSELECTED   := [ SPACEAFTER     ];
  1595.          GOBBLETERMINATORS := []
  1596.       END;
  1597.    WITH PPOPTION [ DOSYM ] DO
  1598.       BEGIN
  1599.          OPTIONSSELECTED   := [ CRSUPPRESS     ,
  1600.                                 SPACEBEFORE    ,
  1601.                                 INDENTMARGIN   ,
  1602.                                 CRAFTER        ];
  1603.          GOBBLETERMINATORS := []
  1604.       END;
  1605.    WITH PPOPTION [ IFSYM ] DO
  1606.       BEGIN
  1607.          OPTIONSSELECTED   := [ SPACEAFTER     ,
  1608.                                 CRBEFORE       ,
  1609.                                 INDENTBYTAB    ,
  1610.                                 GOBBLESYMBOLS  ];
  1611.          GOBBLETERMINATORS := [ THENSYM        ,
  1612.                                 OPENCOMMENT   ]
  1613.       END;
  1614.    WITH PPOPTION [ THENSYM ] DO
  1615.       BEGIN
  1616.          OPTIONSSELECTED   := [ SPACEBEFORE    ,
  1617.                                 CRAFTER        ];
  1618.          GOBBLETERMINATORS := []
  1619.       END;
  1620.    WITH PPOPTION [ ELSESYM ] DO
  1621.       BEGIN
  1622.          OPTIONSSELECTED   := [ CRBEFORE       ,
  1623.                                 DINDENT        ,
  1624.                                 INDENTBYTAB    ,
  1625.                                 CRAFTER        ];
  1626.          GOBBLETERMINATORS := []
  1627.       END;
  1628.    WITH PPOPTION [ ELSIFSYM ] DO
  1629.       BEGIN
  1630.          OPTIONSSELECTED   := [ DINDENT        ,
  1631.                                 CRBEFORE       ,
  1632.                                 INDENTBYTAB    ,
  1633.                                 GOBBLESYMBOLS  ];
  1634.          GOBBLETERMINATORS := [ THENSYM        ];
  1635.      END;
  1636.    WITH PPOPTION [ ENDSYM ] DO
  1637.       BEGIN
  1638.          OPTIONSSELECTED   := [ DINDENT        ,
  1639.                                 GOBBLESYMBOLS  ,
  1640.                                 CRBEFORE       ];
  1641.          GOBBLETERMINATORS := [ SEMICOLON      ];
  1642.       END;
  1643.    WITH PPOPTION [ WHENSYM ] DO
  1644.       BEGIN
  1645.          OPTIONSSELECTED   := [ INDENTBYTAB    ,
  1646.                                 DINDENT        ,
  1647.                                 GOBBLESYMBOLS  ];
  1648.          GOBBLETERMINATORS := [ ARROWSYM       ]
  1649.       END;
  1650.    WITH PPOPTION [ EXCEPTIONSYM ] DO
  1651.       BEGIN
  1652.          OPTIONSSELECTED   := [ BLANKLINEBEFORE,
  1653.                                 CRAFTER        ];
  1654.          GOBBLETERMINATORS := []
  1655.       END;
  1656.    WITH PPOPTION [ SPEXCEPTIONSYM ] DO
  1657.       BEGIN
  1658.          OPTIONSSELECTED   := [];
  1659.          GOBBLETERMINATORS := []
  1660.       END;
  1661.    WITH PPOPTION [ PRIVATESYM ] DO
  1662.       BEGIN
  1663.          OPTIONSSELECTED   := [ BLANKLINEBEFORE,
  1664.                                 INDENTBYTAB    ,
  1665.                                 CRAFTER        ];
  1666.          GOBBLETERMINATORS := []
  1667.       END;
  1668.    WITH PPOPTION [ ACCEPTSYM ] DO
  1669.       BEGIN
  1670.          OPTIONSSELECTED   := [];
  1671.          GOBBLETERMINATORS := []
  1672.       END;
  1673.    WITH PPOPTION [ SELECTSYM ] DO
  1674.       BEGIN
  1675.          OPTIONSSELECTED   := [ CRBEFORE       ,
  1676.                                 INDENTBYTAB    ,
  1677.                                 CRAFTER        ];
  1678.          GOBBLETERMINATORS := []
  1679.       END;
  1680.    WITH PPOPTION [ BODYSYM ] DO
  1681.       BEGIN
  1682.          OPTIONSSELECTED   := [ GOBBLESYMBOLS  ];
  1683.          GOBBLETERMINATORS := [ ISSYM          ,
  1684.                                 SEMICOLON      ];
  1685.       END;
  1686.    WITH PPOPTION [ ORSYM ] DO
  1687.       BEGIN
  1688.          OPTIONSSELECTED   := [];
  1689.          GOBBLETERMINATORS := []
  1690.       END;
  1691.    WITH PPOPTION [ SPECIALORSYM ] DO
  1692.       BEGIN
  1693.          OPTIONSSELECTED   := [ CRBEFORE       ,
  1694.                                 DINDENT        ,
  1695.                                 INDENTBYTAB    ,
  1696.                                 CRAFTER        ];
  1697.          GOBBLETERMINATORS := []
  1698.       END;
  1699.    WITH PPOPTION [ DECLARESYM ] DO
  1700.       BEGIN
  1701.          OPTIONSSELECTED   := [ CRBEFORE       ,
  1702.                                 INDENTBYTAB    ,
  1703.                                 CRAFTER        ];
  1704.          GOBBLETERMINATORS := []
  1705.       END;
  1706.    WITH PPOPTION [ SEPARATESYM ] DO
  1707.       BEGIN
  1708.          OPTIONSSELECTED   := [ BLANKLINEBEFORE ];
  1709.          GOBBLETERMINATORS := []
  1710.       END;
  1711.    WITH PPOPTION [ ARROWSYM ] DO
  1712.       BEGIN
  1713.          OPTIONSSELECTED   := [ SPACEBEFORE    ,
  1714.                                 CRSUPPRESS     ,
  1715.                                 CRAFTER        ];
  1716.          GOBBLETERMINATORS := []
  1717.       END;
  1718.    WITH PPOPTION [ BECOMES ] DO
  1719.       BEGIN
  1720.          OPTIONSSELECTED   := [ SPACEBEFORE    ,
  1721.                                 SPACEAFTER     ,
  1722.                                 GOBBLESYMBOLS  ];
  1723.          GOBBLETERMINATORS := [ SEMICOLON      ]
  1724.       END;
  1725.    WITH PPOPTION [ OPENCOMMENT ] DO
  1726.       BEGIN
  1727.          OPTIONSSELECTED   := [ CRSUPPRESS     ,
  1728.                                 CRAFTER        ];
  1729.          GOBBLETERMINATORS := []
  1730.       END;
  1731.    WITH PPOPTION [ SEMICOLON ] DO
  1732.       BEGIN
  1733.          OPTIONSSELECTED   := [ CRAFTER        ];
  1734.          GOBBLETERMINATORS := []
  1735.       END;
  1736.    WITH PPOPTION [ SPSEMICOLON ] DO
  1737.       BEGIN
  1738.          OPTIONSSELECTED   := [ CRSUPPRESS     ];
  1739.          GOBBLETERMINATORS := []
  1740.       END;
  1741.    WITH PPOPTION [ COLON ] DO
  1742.       BEGIN
  1743.          OPTIONSSELECTED   := [ SPACEAFTER     ];
  1744.          GOBBLETERMINATORS := []
  1745.       END;
  1746.    WITH PPOPTION [ SPECIALCOLON ] DO
  1747.       BEGIN
  1748.          OPTIONSSELECTED   := [ CRAFTER        ];
  1749.          GOBBLETERMINATORS := []
  1750.       END;
  1751.    WITH PPOPTION [ EQUALS ] DO
  1752.       BEGIN
  1753.          OPTIONSSELECTED   := [ SPACEBEFORE    ,
  1754.                                 SPACEAFTER     ];
  1755.          GOBBLETERMINATORS := []
  1756.       END;
  1757.    WITH PPOPTION [ OPENPAREN ] DO
  1758.       BEGIN
  1759.          OPTIONSSELECTED   := [ GOBBLESYMBOLS  ];
  1760.          GOBBLETERMINATORS := [ CLOSEPAREN     ]
  1761.       END;
  1762.    WITH PPOPTION [ CLOSEPAREN ] DO
  1763.       BEGIN
  1764.          OPTIONSSELECTED   := [];
  1765.          GOBBLETERMINATORS := []
  1766.       END;
  1767.    WITH PPOPTION [ PERIOD ] DO
  1768.       BEGIN
  1769.          OPTIONSSELECTED   := [ CRSUPPRESS     ];
  1770.          GOBBLETERMINATORS := []
  1771.       END;
  1772.    WITH PPOPTION [ ENDOFFILE ] DO
  1773.       BEGIN
  1774.          OPTIONSSELECTED   := [];
  1775.          GOBBLETERMINATORS := []
  1776.       END;
  1777.    WITH PPOPTION [ OTHERSYM ] DO
  1778.       BEGIN
  1779.          OPTIONSSELECTED   := [];
  1780.          GOBBLETERMINATORS := []
  1781.       END
  1782. END; (* INITIALIZE *)
  1783. (*=********************************************************************)
  1784. (**********************************************************************)
  1785. (***                                                                ***)
  1786. (***   NAME                                                         ***)
  1787. (***                STACKEMPTY                                      ***)
  1788. (***                                                                ***)
  1789. (***   DESCRIPTION                                                  ***)
  1790. (***                                                                ***)
  1791. (***                  THIS FUNCTION CHECKS TO ENSURE THAT THE       ***)
  1792. (***              STACK IS NOT EMPTY.  THIS IS ACCOMPLISHED BY      ***)
  1793. (***              EXAMINATION OF THE TOP OF THE STACK INDICATOR,    ***)
  1794. (***              "TOP". IF ZERO THEN THIS FUNCTION RETURNS A       ***)
  1795. (***              VALUE OF FALSE, OTHERWISE TRUE IS RETURNED.       ***)
  1796. (***                                                                ***)
  1797. (***   INPUTS                                                       ***)
  1798. (***              TOP----TOP OF STACK INDICATOR                     ***)
  1799. (***                                                                ***)
  1800. (***   OUTPUTS                                                      ***)
  1801. (***              STACKEMPTY--EQUAL TRUE IF "TOP" EQUALS ZERO,      ***)
  1802. (***                          OTHERWISE FALSE.                      ***)
  1803. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  1804. (***                   NONE                                         ***)
  1805. (***                                                                ***)
  1806. (***   REFERENCED BY                                                ***)
  1807. (***                   LSHIFT                                       ***)
  1808. (***                                                                ***)
  1809. (**********************************************************************)
  1810. FUNCTION STACKEMPTY (* RETURNING *) : BOOLEAN;
  1811. BEGIN (* STACKEMPTY *)
  1812.    IF TOP = 0
  1813.       THEN
  1814.          STACKEMPTY := TRUE
  1815.       ELSE
  1816.          STACKEMPTY := FALSE
  1817. END; (* STACKEMPTY *)
  1818. (*=********************************************************************)
  1819. (**********************************************************************)
  1820. (***                                                                ***)
  1821. (***   NAME                                                         ***)
  1822. (***                 STACKFULL                                      ***)
  1823. (***                                                                ***)
  1824. (***   DESCRIPTION                                                  ***)
  1825. (***                                                                ***)
  1826. (***              THIS FUNCTON CHECKS TO ENSURE THAT THE            ***)
  1827. (***         STACK IS NOT FULL.  THIS IS ACCOMPLISHED BY            ***)
  1828. (***         EXAMINTION OF THE TOP-OF-THE-STACK INDICATOR,          ***)
  1829. (***         "TOP".  IF IT EQUALS THE MAXIMUN THEN THIS             ***)
  1830. (***         RETURNS TRUE, OTHERWISE FALSE IS RETURNED.             ***)
  1831. (***                                                                ***)
  1832. (***   INPUTS                                                       ***)
  1833. (***         TOP---TOP-OF-THE-STACK INDICATOR                       ***)
  1834. (***                                                                ***)
  1835. (***   OUTPUTS                                                      ***)
  1836. (***         STACKFULL--EQUALS TRUE IF TOP EQUAL MAXSTACKSIZE,      ***)
  1837. (***                    OTHERWISE FALSE                             ***)
  1838. (***                                                                ***)
  1839. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  1840. (***                   NONE                                         ***)
  1841. (***                                                                ***)
  1842. (***   REFERENCED BY                                                ***)
  1843. (***                   RSHIFT                                       ***)
  1844. (***                   PRINTENDIDENTIFIER                           ***)
  1845. (***                                                                ***)
  1846. (**********************************************************************)
  1847. FUNCTION STACKFULL (* RETURNING *) : BOOLEAN;
  1848. BEGIN (* STACKFULL *)
  1849.    IF TOP = MAXSTACKSIZE
  1850.       THEN
  1851.          STACKFULL := TRUE
  1852.       ELSE
  1853.          STACKFULL := FALSE
  1854. END; (* STACKFULL *)
  1855. (*=********************************************************************)
  1856. (**********************************************************************)
  1857. (***                                                                ***)
  1858. (***   NAME                                                         ***)
  1859. (***                   PUSHSTACK                                    ***)
  1860. (***                                                                ***)
  1861. (***   DESCRIPTION                                                  ***)
  1862. (***                                                                ***)
  1863. (***             THIS PROCEDURE SAVES THE RECORD ENDIDENTIFIER      ***)
  1864. (***         ONTO THE STACK FOR LATER RETREIVAL.  THIS IS USED      ***)
  1865. (***         TO SAVE THE VALUE OF THE ENDIDENTIFIER SYMBOL FOR      ***)
  1866. (***         FOR AUTOMATIC INSERTION FOLLOWING AN "END" IF ONE      ***)
  1867. (***         IS NOT ALREADY PRESENT.                                ***)
  1868. (***                                                                ***)
  1869. (***   INPUTS                                                       ***)
  1870. (***         TOP -------TOP-OF-THE-STACK INDICATOR                  ***)
  1871. (***         PREVMARGIN                                             ***)
  1872. (***         ENDSYMBOL                                              ***)
  1873. (***         LLENGTH                                                ***)
  1874. (***                                                                ***)
  1875. (***   OUTPUTS                                                      ***)
  1876. (***         TOP ------UPDATED VALUE                                ***)
  1877. (***                                                                ***)
  1878. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  1879. (***                   NONE                                         ***)
  1880. (***                                                                ***)
  1881. (***   REFERENCED BY                                                ***)
  1882. (***                   RSHIFT                                       ***)
  1883. (***                   PRETTYPRINT                                  ***)
  1884. (***                                                                ***)
  1885. (**********************************************************************)
  1886. PROCEDURE PUSHSTACK( INDENTSYMBOL : KEYSYMBOL;
  1887.                      PREVMARGIN     : INTEGER;
  1888.                      ENDSYMBOL      : STRING;
  1889.                      LLENGTH        : INTEGER );
  1890. BEGIN (* PUSHSTACK *)
  1891.    TOP := TOP + 1;
  1892.    STACK[TOP].PREVMARGIN   := PREVMARGIN;
  1893.    STACK[TOP].ENDSYMBOL    := ENDSYMBOL;
  1894.    STACK[TOP].LLENGTH      := LLENGTH;
  1895. END; (* PUSHSTACK *)
  1896. (*=********************************************************************)
  1897. (**********************************************************************)
  1898. (***                                                                ***)
  1899. (***   NAME                                                         ***)
  1900. (***                 WRITECRS                                       ***)
  1901. (***                                                                ***)
  1902. (***   DESCRIPTION                                                  ***)
  1903. (***             THIS PROCEDURE WRITES TO THE OUTPUT FILE.  IF      ***)
  1904. (***         "CRSBEFORES" EQUALS ZERO, THEN NOTHING IS WRITTEN.     ***)
  1905. (***         IF "CRSBEFORE" EQUALS N, THEN N-1 BLANK LINES ARE      ***)
  1906. (***         INSERTED AND THE CURRENT LINE POSTION SET TO ZERO      ***)
  1907. (***         IN ALL CASES WHREE N IF GREATER THAN ZERO.             ***)
  1908. (***                                                                ***)
  1909. (***                                                                ***)
  1910. (***   INPUTS                                                       ***)
  1911. (***         NUMBEROFCRS--- NUMBER OF CARRIAGE RETURNS TO BE        ***)
  1912. (***                        OUTPUT PRIOR TO OUTPUTING THE           ***)
  1913. (***                        CURRENT SYMBOL                          ***)
  1914. (***                                                                ***)
  1915. (***   OUTPUTS                                                      ***)
  1916. (***         CURRLINEPOS--- SET TO ZERO                             ***)
  1917. (***                                                                ***)
  1918. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  1919. (***                   NONE                                         ***)
  1920. (***                                                                ***)
  1921. (***   REFERENCED BY                                                ***)
  1922. (***                   INSERTCR                                     ***)
  1923. (***                   INSERTBLANKLINE                              ***)
  1924. (***                   PPSYMBOL                                     ***)
  1925. (***                                                                ***)
  1926. (**********************************************************************)
  1927. PROCEDURE WRITECRS( (* USING *)          NUMBEROFCRS : INTEGER;
  1928.                     (* UPDATING *)   VAR CURRLINEPOS : INTEGER
  1929.                     (* WRITING TO OUTPUT *)                  );
  1930. VAR
  1931.     I: INTEGER;
  1932. BEGIN (* WRITECRS *)
  1933.    IF NUMBEROFCRS > 0
  1934.       THEN
  1935.          BEGIN
  1936.             FOR I := 1 TO NUMBEROFCRS DO
  1937.                WRITELN;
  1938.               CURRLINEPOS  := 0
  1939.          END
  1940. END; (* WRITECRS *)
  1941. (*=********************************************************************)
  1942. (**********************************************************************)
  1943. (***                                                                ***)
  1944. (***   NAME                                                         ***)
  1945. (***                 INSERTCR                                       ***)
  1946. (***                                                                ***)
  1947. (***   DESCRIPTION                                                  ***)
  1948. (***                                                                ***)
  1949. (***              THIS PROCEDURE CHECKS TO SEE IF A NEW LINE IS     ***)
  1950. (***         INDICATED PRIOR TO THE OUTPUTTING OF THE CURRENT       ***)
  1951. (***         SYMBOL.  IF NOT, THEN A CALL "PROCEDURE WRITECRS"      ***)
  1952. (***         IS MADE TO OUTPUT A CARRIAGE RETURN.                   ***)
  1953. (***                                                                ***)
  1954. (***                                                                ***)
  1955. (***                                                                ***)
  1956. (***   INPUTS                                                       ***)
  1957. (***          CURRSYM^.CRSBEFORE -- NUMBER OF CARRIAGE RETURNS      ***)
  1958. (***                                INDICATED PRIOR TO THE OUT-     ***)
  1959. (***                                PUTTING OF THE CURRENT SYMBOL   ***)
  1960. (***                                                                ***)
  1961. (***   OUTPUTS                                                      ***)
  1962. (***          CURRSYM^.SPACESBEFORE-- SET TO ZERO                   ***)
  1963. (***                                                                ***)
  1964. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  1965. (***                   WRITECRS                                     ***)
  1966. (***                                                                ***)
  1967. (***   REFERENCED BY                                                ***)
  1968. (***                   PRETTYPRINT                                  ***)
  1969. (***                                                                ***)
  1970. (**********************************************************************)
  1971. PROCEDURE INSERTCR( (* UPDATING *)   VAR CURRSYM    : SYMBOLINFO
  1972.                     (* WRITING TO OUTPUT *)                     );
  1973. CONST
  1974.       ONCE = 1;
  1975. BEGIN (* INSERTCR *)
  1976.    IF CURRSYM^.CRSBEFORE = 0
  1977.       THEN
  1978.          BEGIN
  1979.             WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS
  1980.                             (* WRITING TO OUTPUT *)       );
  1981.             CURRSYM^.SPACESBEFORE := 0
  1982.          END
  1983. END; (* INSERTCR *)
  1984. (*=********************************************************************)
  1985. (**********************************************************************)
  1986. (***                                                                ***)
  1987. (***   NAME                                                         ***)
  1988. (***                      INSERTBLANKLINE                           ***)
  1989. (***                                                                ***)
  1990. (***   DESCRIPTION                                                  ***)
  1991. (***              THIS PROCEDURE CAUSES A BLANKLINE TO BE WRITTEN   ***)
  1992. (***         ON THE OUTPUT FILE IF ONE IS NOT ALREADY REQUIRED.     ***)
  1993. (***                                                                ***)
  1994. (***   INPUTS                                                       ***)
  1995. (***           CURRSYM^.CRSBEFORE--- CHECKS TO SEE IF A BLANK-      ***)
  1996. (***                                 LINE IS INDICATED ALREADY      ***)
  1997. (***                                                                ***)
  1998. (***           CURRLINEPOS --------- OF THE OUTPUT FILE             ***)
  1999. (***                                                                ***)
  2000. (***                                                                ***)
  2001. (***   OUTPUTS                                                      ***)
  2002. (***           CURRSYM^.SPACESBEFORE-- SET TO ZERO IF A BLANK-      ***)
  2003. (***                                   LINE IS INSERTED             ***)
  2004. (***                                                                ***)
  2005. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  2006. (***                   WRITECRS                                     ***)
  2007. (***                                                                ***)
  2008. (***   REFERENCED BY                                                ***)
  2009. (***                   PRETTYPRINT                                  ***)
  2010. (***                                                                ***)
  2011. (**********************************************************************)
  2012. PROCEDURE INSERTBLANKLINE( (* UPDATING *)   VAR CURRSYM : SYMBOLINFO
  2013.                            (* WRITING TO OUTPUT *)                  );
  2014. CONST
  2015.       ONCE  = 1;
  2016.       TWICE = 2;
  2017. BEGIN (* INSERTBLANKLINE *)
  2018.    IF CURRSYM^.CRSBEFORE = 0
  2019.       THEN
  2020.          BEGIN
  2021.             IF CURRLINEPOS = 0
  2022.                THEN
  2023.                   WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS
  2024.                                  (* WRITING TO OUTPUT *)     )
  2025.                ELSE
  2026.                   WRITECRS( TWICE, (* UPDATING *)   CURRLINEPOS
  2027.                                    (* WRITING TO OUTPUT *)      );
  2028.             CURRSYM^.SPACESBEFORE := 0
  2029.          END
  2030.       ELSE
  2031.          IF CURRSYM^.CRSBEFORE = 1
  2032.             THEN
  2033.                IF CURRLINEPOS > 0
  2034.                   THEN
  2035.                      WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS
  2036.                                       (* WRITING TO OUTPUT *)      )
  2037. END; (* INSERTBLANKLINE *)
  2038. (*=********************************************************************)
  2039. (**********************************************************************)
  2040. (***                                                                ***)
  2041. (***   NAME                                                         ***)
  2042. (***                        LSHIFT                                  ***)
  2043. (***                                                                ***)
  2044. (***   DESCRIPTION                                                  ***)
  2045. (***                                                                ***)
  2046. (***              THIS PROCEDURE CAUSE THE MARGIN TO BE RESET       ***)
  2047. (***          TO THE VALUE WHICH IS WAS PREVIOUSLY.  THIS VALUE     ***)
  2048. (***          VALUE IS OBTSAINED FROM THE TOP OF THE STACK.         ***)
  2049. (***                                                                ***)
  2050. (***                                                                ***)
  2051. (***                                                                ***)
  2052. (***   INPUTS                                                       ***)
  2053. (***          STACK[TOP]                                            ***)
  2054. (***          TOP                                                   ***)
  2055. (***                                                                ***)
  2056. (***   OUTPUTS                                                      ***)
  2057. (***          TOP                                                   ***)
  2058. (***          CURRMARGIN                                            ***)
  2059. (***          ENDIDENTIFIER                                         ***)
  2060. (***                                                                ***)
  2061. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  2062. (***                    STACKEMPTY                                  ***)
  2063. (***                                                                ***)
  2064. (***   REFERENCED BY                                                ***)
  2065. (***                    GOBBLE                                      ***)
  2066. (***                    PRETTYPRINT                                 ***)
  2067. (***                                                                ***)
  2068. (**********************************************************************)
  2069. PROCEDURE LSHIFT;
  2070. BEGIN (* LSHIFT *)
  2071.    IF NOT STACKEMPTY
  2072.       THEN
  2073.          BEGIN
  2074.             CURRMARGIN              := STACK[TOP].PREVMARGIN;
  2075.             ENDIDENTIFIER.ENDSYMBOL := STACK[TOP].ENDSYMBOL;
  2076.             ENDIDENTIFIER.LLENGTH   := STACK[TOP].LLENGTH;
  2077.             TOP                     := TOP - 1
  2078.          END
  2079.       ELSE
  2080.          PREVMARGIN                 := 0
  2081. END; (* LSHIFT *)
  2082. (*=********************************************************************)
  2083. (**********************************************************************)
  2084. (***                                                                ***)
  2085. (***   NAME                                                         ***)
  2086. (***                     INSERTSPACE                                ***)
  2087. (***                                                                ***)
  2088. (***   DESCRIPTION                                                  ***)
  2089. (***                                                                ***)
  2090. (***                THIS PROCEDURE WRITES A SINGLE SPACE ON THE     ***)
  2091. (***           OUTPUT FILE.  BEFORE RETURNING, IT PERFORMS SOME     ***)
  2092. (***           HOUSEKEEPING FUNCTIONS TO UPDATE THE CURRENT LINE    ***)
  2093. (***           POSITION INDICATOR OF THE OUTPUT FILE, AND TO        ***)
  2094. (***           ADJUST THE NUMBER OF SPACES TO BE PRINTED PRIOR      ***)
  2095. (***           TO THE OUTPUTTING OF THE CURRENT SYMBOL              ***)
  2096. (***                                                                ***)
  2097. (***   INPUTS                                                       ***)
  2098. (***           CURRLINEPOS---OF THE OUTPUT FILE                     ***)
  2099. (***           SYMBOL                                               ***)
  2100. (***                                                                ***)
  2101. (***                                                                ***)
  2102. (***   OUTPUTS                                                      ***)
  2103. (***           CURRLINEPOS                                          ***)
  2104. (***           SYMBOL                                               ***)
  2105. (***                                                                ***)
  2106. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  2107. (***                   NONE                                         ***)
  2108. (***                                                                ***)
  2109. (***   REFERENCED BY                                                ***)
  2110. (***                   PRINTENDIDENTIFIER                           ***)
  2111. (***                                                                ***)
  2112. (**********************************************************************)
  2113. PROCEDURE INSERTSPACE( (* USING *)      VAR SYMBOL     : SYMBOLINFO
  2114.                        (* WRITING TO OUTPUT *)                      );
  2115. BEGIN (* INSERTSPACE *)
  2116.    IF CURRLINEPOS < MAXLINESIZE
  2117.       THEN
  2118.          BEGIN
  2119.             WRITE(SPACE);
  2120.             CURRLINEPOS := CURRLINEPOS + 1;
  2121.             WITH SYMBOL^ DO
  2122.                IF (CRSBEFORE = 0) AND (SPACESBEFORE > 0)
  2123.                   THEN
  2124.                      SPACESBEFORE := SPACESBEFORE - 1
  2125.          END
  2126. END; (* INSERTSPACE *)
  2127. (*=********************************************************************)
  2128. (**********************************************************************)
  2129. (***                                                                ***)
  2130. (***   NAME                                                         ***)
  2131. (***                 MOVELINEPOS                                    ***)
  2132. (***                                                                ***)
  2133. (***   DESCRIPTION                                                  ***)
  2134. (***                                                                ***)
  2135. (***              THIS PROCEDURE WRITES SPACES ON THE OUTPUT        ***)
  2136. (***          FILE FROM THE CURRENT LINE POSITION PLUS ONE TO       ***)
  2137. (***          NEW LINE POSITION.                                    ***)
  2138. (***                                                                ***)
  2139. (***                                                                ***)
  2140. (***                                                                ***)
  2141. (***   INPUTS                                                       ***)
  2142. (***          CURRLINEPOS--- OF THE OUTPUT FILE                     ***)
  2143. (***          NEWLINEPOS---- NEW POSITION REQUIRED                  ***)
  2144. (***                                                                ***)
  2145. (***   OUTPUTS                                                      ***)
  2146. (***          CURRLINEPOS--- SET EQUAL TO "NEWLINEPOS"              ***)
  2147. (***                                                                ***)
  2148. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  2149. (***                  NONE                                          ***)
  2150. (***                                                                ***)
  2151. (***   REFERENCED BY                                                ***)
  2152. (***                  PPSYMBOL                                      ***)
  2153. (***                                                                ***)
  2154. (**********************************************************************)
  2155. PROCEDURE MOVELINEPOS( (* TO *)       NEWLINEPOS  : INTEGER;
  2156.                        (* FROM *) VAR CURRLINEPOS : INTEGER
  2157.                        (* WRITING TO OUTPUT *)              );
  2158. VAR
  2159.    I: INTEGER;
  2160. BEGIN (* MOVELINEPOS *)
  2161.    FOR I := CURRLINEPOS+1 TO NEWLINEPOS DO
  2162.       WRITE(SPACE);
  2163.    CURRLINEPOS := NEWLINEPOS
  2164. END; (* MOVELINEPOS *)
  2165. (*=********************************************************************)
  2166. (**********************************************************************)
  2167. (***                                                                ***)
  2168. (***   NAME                                                         ***)
  2169. (***                  PRINTSYMBOL                                   ***)
  2170. (***                                                                ***)
  2171. (***   DESCRIPTION                                                  ***)
  2172. (***                                                                ***)
  2173. (***              THIS PROCEDURE WRITES THE CURRENT SYMBOL TO       ***)
  2174. (***        THE OUTPUT FILES AND UPDATES THE CURRENT LINE POS-      ***)
  2175. (***        ITION PRIOR TO RETURNING.                               ***)
  2176. (***                                                                ***)
  2177. (***                                                                ***)
  2178. (***   INPUTS                                                       ***)
  2179. (***          CURRSYM -----OF THE INPUT FILE                        ***)
  2180. (***          CURRLINEPOS--OF THE OUTPUT FILE                       ***)
  2181. (***                                                                ***)
  2182. (***   OUTPUTS                                                      ***)
  2183. (***          CURRLINEPOS--UPDATED CURRENT LINE POSITION            ***)
  2184. (***          STARTPOS-----STARTING POSITION OF LAST SYMBOL WRITTEN ***)
  2185. (***                                                                ***)
  2186. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  2187. (***                  NONE                                          ***)
  2188. (***                                                                ***)
  2189. (***   REFERENCED BY                                                ***)
  2190. (***                  PPSYMBOL                                      ***)
  2191. (***                                                                ***)
  2192. (**********************************************************************)
  2193. PROCEDURE PRINTSYMBOL( (* IN *)             CURRSYM     : SYMBOLINFO;
  2194.                        (* UPDATING *)   VAR CURRLINEPOS : INTEGER
  2195.                        (* WRITING TO OUTPUT *)                       );
  2196. VAR
  2197.    I: INTEGER;
  2198. BEGIN (* PRINTSYMBOL *)
  2199.    WITH CURRSYM^ DO
  2200.       BEGIN
  2201.          FOR I := 1 TO LENGTH DO
  2202.             WRITE(VALU[I]);
  2203.          STARTPOS := CURRLINEPOS; (* SAVE START POS FOR TAB PURPOSES *)
  2204.          CURRLINEPOS := CURRLINEPOS + LENGTH
  2205.       END (* WITH *)
  2206. END; (* PRINTSYMBOL *)
  2207. (*=********************************************************************)
  2208. (**********************************************************************)
  2209. (***                                                                ***)
  2210. (***   NAME                                                         ***)
  2211. (***                 PPSYMBOL                                       ***)
  2212. (***                                                                ***)
  2213. (***   DESCRIPTION                                                  ***)
  2214. (***                                                                ***)
  2215. (***             THIS PROCEDURE DETERMINES THE PROPER POSITION OF   ***)
  2216. (***          THE WRITE HEAD OF THE OUTPUT FILE ACCORDING TO THE    ***)
  2217. (***          VALUES OF "CURRLINEPOS", "CRSBEFORE", "SPACESBEFORE", ***)
  2218. (***          AND "LENGTH".  THE OUTPUT FILE IS POSITIONED TO THIS  ***)
  2219. (***          POSITION VIA CALLS  TO "PROCEDURE WRITECRS" AND "PRO  ***)
  2220. (***          CEDURE MOVELINEPOS" TO MOVE THE CURRENT LINE POSITION ***)
  2221. (***          TO THE NEW LINE POSITION.  THE CURRENT SYMBOL IS THEN ***)
  2222. (***          OUTPUTTED VIA A CALL TO "PROCEDURE PRINTSYMBOL".      ***)
  2223. (***                                                                ***)
  2224. (***   INPUTS                                                       ***)
  2225. (***          CURRLINEPOS---OF THE OUTPUT FILE                      ***)
  2226. (***          CURRSYM-------OF THE INPUT FILE                       ***)
  2227. (***          CURRMARGIN----CURRENT MARGIN FOR INDENTATION          ***)
  2228. (***          PARENINDENT---MARGIN FOR INDENTION FOR CERTAIN LISTS  ***)
  2229. (***                                                                ***)
  2230. (***   OUTPUTS                                                      ***)
  2231. (***          NEWLINEPOS----NEW POSITION THAT CURRENT LINE POSITION ***)
  2232. (***                        MUST BE RELOCATED TO BEFORE OUTPUTTING  ***)
  2233. (***                        THE CURRENT CYMBOL                      ***)
  2234. (***          CURRLINEPOS---UPDATED CURRENT LINE POSITION           ***)
  2235. (***                                                                ***)
  2236. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  2237. (***                     WRITECRS                                   ***)
  2238. (***                     MOVELINEPOS                                ***)
  2239. (***                     PRINTSYMBOL                                ***)
  2240. (***                                                                ***)
  2241. (***   REFERENCED BY                                                ***)
  2242. (***                     GOBBLE                                     ***)
  2243. (***                     PRETTYPRINT                                ***)
  2244. (***                                                                ***)
  2245. (**********************************************************************)
  2246. PROCEDURE PPSYMBOL( (* IN *)             CURRSYM    : SYMBOLINFO
  2247.                     (* WRITING TO OUTPUT *)                      );
  2248. CONST
  2249.       ONCE  = 1;
  2250. VAR
  2251.     NEWLINEPOS: INTEGER;
  2252. BEGIN (* PPSYMBOL *)
  2253.    WITH CURRSYM^ DO
  2254.       BEGIN
  2255.          WRITECRS( (* USING *)      CRSBEFORE,
  2256.                    (* UPDATING *)   CURRLINEPOS
  2257.                    (* WRITING TO OUTPUT *)      );
  2258.          IF (CURRLINEPOS + SPACESBEFORE > CURRMARGIN)
  2259.             OR (NAME IN [ OPENCOMMENT ])
  2260.             THEN
  2261.                NEWLINEPOS := CURRLINEPOS + SPACESBEFORE
  2262.             ELSE
  2263.                IF (PARENCOUNTER > 0) AND
  2264.                   (NEXTSYM^.NAME <> OPENPAREN)
  2265.                   THEN
  2266.                      NEWLINEPOS := PARENINDENT
  2267.                   ELSE
  2268.                      NEWLINEPOS := CURRMARGIN;
  2269.          IF NEWLINEPOS + LENGTH > MAXLINESIZE
  2270.             THEN
  2271.                BEGIN
  2272.                   WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS
  2273.                                   (* WRITING TO OUTPUT *)       );
  2274.                   IF CURRMARGIN + LENGTH <= MAXLINESIZE
  2275.                      THEN
  2276.                         NEWLINEPOS := CURRMARGIN
  2277.                      ELSE
  2278.                         IF LENGTH < MAXLINESIZE
  2279.                            THEN
  2280.                               NEWLINEPOS := MAXLINESIZE - LENGTH
  2281.                            ELSE
  2282.                               NEWLINEPOS := 0
  2283.                END;
  2284.          MOVELINEPOS( (* TO *)    NEWLINEPOS,
  2285.                       (* FROM *)  CURRLINEPOS
  2286.                       (* IN OUTPUT *)        );
  2287.          PRINTSYMBOL( (* IN *)         CURRSYM,
  2288.                       (* UPDATING *)   CURRLINEPOS
  2289.                       (* WRITING TO OUTPUT *)      )
  2290.       END (* WITH *)
  2291. END; (* PPSYMBOL *)
  2292. (*=********************************************************************)
  2293. (**********************************************************************)
  2294. (***                                                                ***)
  2295. (***   NAME                                                         ***)
  2296. (***                GOBBLE                                          ***)
  2297. (***                                                                ***)
  2298. (***   DESCRIPTION                                                  ***)
  2299. (***                                                                ***)
  2300. (***               THIS PROCEDURE "GOBBLES" SYMBOLS FROM THE IN-    ***)
  2301. (***         PUT FILE AND OUTPUTS THEM ONTO THE OUTPUT FILE UNTIL   ***)
  2302. (***         A SYMBOL IS ENCOUNTERED WHICH IS ONE OF THE TERMIN-    ***)
  2303. (***         ATORS.                                                 ***)
  2304. (***                                                                ***)
  2305. (***   INPUTS                                                       ***)
  2306. (***         TERMINATORS---LIST OF SYMBOLS WHICH TERMINATE THE      ***)
  2307. (***                       "GOBBLE" MODE.                           ***)
  2308. (***         CURRSYM-------OF THE INPUT FILE                        ***)
  2309. (***         NEXTSYM-------OF THE INPUT FILE                        ***)
  2310. (***                                                                ***)
  2311. (***   OUTPUTS                                                      ***)
  2312. (***         CURRSYM-------UPDATED                                  ***)
  2313. (***         NEXTSYM-------UPDATED                                  ***)
  2314. (***                                                                ***)
  2315. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  2316. (***                  GETSYMBOL                                     ***)
  2317. (***                  PPSYMBOL                                      ***)
  2318. (***                  LSHIFT                                        ***)
  2319. (***                                                                ***)
  2320. (***   REFERENCED BY                                                ***)
  2321. (***                  PRETTYPRINT                                   ***)
  2322. (***                                                                ***)
  2323. (**********************************************************************)
  2324. PROCEDURE GOBBLE( (* SYMBOLS FROM INPUT *)
  2325.                   (* UP TO *)            TERMINATORS : KEYSYMSET;
  2326.                   (* UPDATING *)     VAR CURRSYM,
  2327.                                          NEXTSYM     : SYMBOLINFO
  2328.                   (* WRITING TO OUTPUT *)                         );
  2329. BEGIN (* GOBBLE *)
  2330.    WHILE NOT(NEXTSYM^.NAME IN (TERMINATORS + [ENDOFFILE])) DO
  2331.       BEGIN
  2332.          GETSYMBOL( (* FROM INPUT *)
  2333.                     (* UPDATING *)  NEXTSYM,
  2334.                     (* RETURNING *) CURRSYM   );
  2335.          PPSYMBOL( (* IN *)         CURRSYM
  2336.                    (* WRITING TO OUTPUT *)   )
  2337.       END; (* WHILE *)
  2338. END; (* GOBBLE *)
  2339. (*=********************************************************************)
  2340. (**********************************************************************)
  2341. (***                                                                ***)
  2342. (***   NAME                                                         ***)
  2343. (***                    RSHIFT                                      ***)
  2344. (***                                                                ***)
  2345. (***   DESCRIPTION                                                  ***)
  2346. (***                                                                ***)
  2347. (***              THIS PROCEDURE INDENTS THE CURRENT MARGIN BY A    ***)
  2348. (***           AMOUNT.  THE PREVIOUS MARGIN IS SAVED BY BEING       ***)
  2349. (***           PUSHED ONTO A STACK FOR LATER RETREIVAL.             ***)
  2350. (***                                                                ***)
  2351. (***   INPUTS                                                       ***)
  2352. (***           ENDIDENTIFIER---RECORD CONTAINING A "END IDENT-      ***)
  2353. (***                           IFIER" NAME ,VALU AND LENGTH         ***)
  2354. (***           CURRMARGIN                                           ***)
  2355. (***           CURRSYM                                              ***)
  2356. (***           STARTPOS                                             ***)
  2357. (***                                                                ***)
  2358. (***   OUTPUTS                                                      ***)
  2359. (***           CURRMARGIN                                           ***)
  2360. (***                                                                ***)
  2361. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  2362. (***                   STACKFULL                                    ***)
  2363. (***                   PUSHSTACK                                    ***)
  2364. (***                                                                ***)
  2365. (***   REFERENCED BY                                                ***)
  2366. (***                   PRETTYPRINT                                  ***)
  2367. (***                                                                ***)
  2368. (**********************************************************************)
  2369. PROCEDURE RSHIFT( (* USING *) CURRSYM : KEYSYMBOL );
  2370. BEGIN (* RSHIFT *)
  2371.    IF NOT STACKFULL
  2372.       THEN
  2373.          PUSHSTACK( (* USING *) CURRSYM,
  2374.                                 CURRMARGIN,
  2375.                                 ENDIDENTIFIER.ENDSYMBOL,
  2376.                                 ENDIDENTIFIER.LLENGTH );
  2377.    (* IF EXTRA INDENTATION WAS USED, UPDATE MARGIN. *)
  2378.    IF STARTPOS > CURRMARGIN
  2379.       THEN
  2380.          CURRMARGIN := STARTPOS;
  2381.    IF CURRMARGIN < SLOFAIL1
  2382.       THEN
  2383.          CURRMARGIN := CURRMARGIN + INDENT1
  2384.       ELSE
  2385.          IF CURRMARGIN < SLOFAIL2
  2386.             THEN
  2387.                CURRMARGIN := CURRMARGIN + INDENT2
  2388. END; (* RSHIFT *)
  2389. (*=********************************************************************)
  2390. (**********************************************************************)
  2391. (***                                                                ***)
  2392. (***   NAME                                                         ***)
  2393. (***               PRINTENDIDENTIFIER                               ***)
  2394. (***                                                                ***)
  2395. (***   DESCRIPTION                                                  ***)
  2396. (***         THIS PROCEDURE WRITE TO THE OUTPUT FILE AFTER THE      ***)
  2397. (***     KEYWORD "END" OF THE BLOCK WHICH IS TERMINATED.  BEFORE    ***)
  2398. (***     RETURNING, THE STARTING POSITION AND THE CURRENT LINE      ***)
  2399. (***     ARE UPDATED.                                               ***)
  2400. (***                                                                ***)
  2401. (***   INPUTS                                                       ***)
  2402. (***       CURRLINEPOS--OF THE OUTPUT FILE                          ***)
  2403. (***       ENDIDENTIFIER.LLENGTH--THE NUMBER OF CHARACTER IN THE    ***)
  2404. (***                              IDENTIFIER-NAME-STRING.           ***)
  2405. (***       ENDIDENTIFIER.ENDSYMBOL-- AN ARRAY CONTAINING THE CHAR-  ***)
  2406. (***                                 OF THE IDENTIFIER-NAME-STRING. ***)
  2407. (***                                                                ***)
  2408. (***   OUTPUTS                                                      ***)
  2409. (***       CURRLINEPOS--UDATED NEW LINE POSITION AFTER OUTPUTING.   ***)
  2410. (***       STARTPOS--STARTING POSITION OF LAST SYMBOL WRITTEN       ***)
  2411. (***                 PURPOSES.                                      ***)
  2412. (***       A ENDIDENTIFIER IS WRITTEN ON THE OUTPUT FILE            ***)
  2413. (***                                                                ***)
  2414. (***   PROCEDURES/FUNCTIONS USED                                    ***)
  2415. (***                   NONE                                         ***)
  2416. (***                                                                ***)
  2417. (***   REFERENCED BY                                                ***)
  2418. (***                   PRETTYPRINT                                  ***)
  2419. (***                                                                ***)
  2420. (**********************************************************************)
  2421.  PROCEDURE PRINTENDIDENTIFIER;
  2422.    VAR
  2423.       I:INTEGER;
  2424.    BEGIN
  2425.          WITH ENDIDENTIFIER DO
  2426.             BEGIN
  2427.                WRITE(SPACE);
  2428.                FOR I := 1 TO LLENGTH DO
  2429.                   WRITE(ENDSYMBOL[I]);
  2430.                STARTPOS := CURRLINEPOS;
  2431.                CURRLINEPOS := CURRLINEPOS + LLENGTH;
  2432.             END; (* WITH *);
  2433.    END;(* PRINTENDIDENTIFIER *)
  2434. BEGIN (* PRETTYPRINT *)
  2435.    INITIALIZE;
  2436.    WHILE (NEXTSYM^.NAME <> ENDOFFILE) DO
  2437.       BEGIN
  2438.          GETSYMBOL( (* FROM INPUT *)
  2439.                     (* UPDATING *)  NEXTSYM,
  2440.                     (* RETURNING *) CURRSYM   );
  2441.          WITH PPOPTION [CURRSYM^.NAME] DO
  2442.             BEGIN
  2443.                IF (CRPENDING AND NOT(CRSUPPRESS IN OPTIONSSELECTED))
  2444.                  OR (CRBEFORE IN OPTIONSSELECTED)
  2445.                   THEN
  2446.                      BEGIN
  2447.                         INSERTCR( (* USING *)      CURRSYM
  2448.                                   (* WRITING TO OUTPUT *)  );
  2449.                         CRPENDING := FALSE
  2450.                      END;
  2451.                IF BLANKLINEBEFORE IN OPTIONSSELECTED
  2452.                   THEN
  2453.                      BEGIN
  2454.                         INSERTBLANKLINE( (* USING *)      CURRSYM
  2455.                                          (* WRITING TO OUTPUT *)  );
  2456.                         CRPENDING := FALSE
  2457.                      END;
  2458.                IF DINDENT IN OPTIONSSELECTED
  2459.                   THEN
  2460.                      LSHIFT;
  2461.                IF SPACEBEFORE IN OPTIONSSELECTED
  2462.                   THEN
  2463.                      INSERTSPACE( (* USING *)      CURRSYM
  2464.                                   (* WRITING TO OUTPUT *)   );
  2465.                PPSYMBOL( (* IN *)         CURRSYM
  2466.                          (* WRITING TO OUTPUT *)   );
  2467.                IF SPACEAFTER IN OPTIONSSELECTED
  2468.                   THEN
  2469.                      INSERTSPACE( (* USING *)      NEXTSYM
  2470.                                   (* WRITING TO OUTPUT *)    );
  2471.                IF CURRSYM^.NAME = ENDSYM
  2472.                   THEN IF NEXTSYM^.NAME = SEMICOLON
  2473.                           THEN
  2474.                              PRINTENDIDENTIFIER;
  2475.                IF INDENTBYTAB IN OPTIONSSELECTED
  2476.                   THEN
  2477.                      RSHIFT( (* USING *) CURRSYM^.NAME );
  2478.                IF GOBBLESYMBOLS IN OPTIONSSELECTED
  2479.                   THEN
  2480.                      GOBBLE( (* SYMBOLS FROM INPUT *)
  2481.                              (* UP TO *)        GOBBLETERMINATORS,
  2482.                              (* UPDATING *)     CURRSYM,
  2483.                                                 NEXTSYM
  2484.                              (* WRITING TO OUTPUT *)                 );
  2485.                IF INDENTMARGIN IN OPTIONSSELECTED
  2486.                   THEN
  2487.                     BEGIN
  2488.                       IF NOT STACKFULL
  2489.                          THEN
  2490.                             PUSHSTACK(CURRSYM^.NAME,
  2491.                                       CURRMARGIN,
  2492.                                       ENDIDENTIFIER.ENDSYMBOL,
  2493.                                       ENDIDENTIFIER.LLENGTH );
  2494.                       IF CURRMARGIN < SLOFAIL1
  2495.                          THEN
  2496.                             CURRMARGIN := CURRMARGIN + INDENT1
  2497.                          ELSE
  2498.                             IF CURRMARGIN < SLOFAIL2
  2499.                                THEN
  2500.                                   CURRMARGIN:=CURRMARGIN+INDENT2
  2501.                    END;
  2502.                IF CRAFTER IN OPTIONSSELECTED
  2503.                   THEN
  2504.                      CRPENDING := TRUE
  2505.             END (* WITH *)
  2506.       END; (* WHILE *)
  2507.    IF CRPENDING
  2508.       THEN
  2509.          WRITELN
  2510. END.
  2511.