1 /* START OF:        rdc_end_.incl.pl1               *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
  2 
  3 
  4 /****^  HISTORY COMMENTS:
  5   1) change(86-02-14,GWMay), approve(), audit(), install():
  6      old history comments:
  7       0) Created: April, 1974 by G. C. Dixon
  8       1) Modified: Feb, 1975  by G. C. Dixon
  9          a) support for Version 2.0 of reduction_compiler.
 10       2) Modified: Feb, 1981  by G. C. Dixon
 11          a) support for Version  2.2 of reduction_compiler
 12       3) Modified: Aug, 1983  by G. C. Dixon - support for Version 2.3 of
 13                         reductions command.
 14   2) change(86-03-04,GDixon), approve(86-03-04,MCR7362), audit(86-03-17,GWMay),
 15      install(86-03-17,MR12.0-1032):
 16      Changed how the PUSH DOWN LANGUAGE (SPDL) definition of <no-token> is
 17      implemented to avoid references through a null pointer.  The two
 18      accepted uses are:
 19 
 20         / <no-token>               / ... / ... \
 21                     A
 22                     |
 23            Pthis_token (points to top of push down stack)
 24 
 25      which checks to see if the push down stack is totally exhausted (ie,
 26      Ptoken = null); and:
 27 
 28         / SPEC1 ... SPECN <no-token>         / ... / ... \
 29                            A
 30                            |
 31                  Pthis_token (points to top of push down stack)
 32 
 33      which checks to see whether SPECN is topmost on the push down stack
 34      AND is the final token in the input list.
 35                                                    END HISTORY COMMENTS */
 36 
 37 
 38 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
 39           /*                                                                                        */
 40           /* NAME:  rdc_end_.incl.pl1                                                               */
 41           /*                                                                                        */
 42           /*      This include segment is used by compilers generated by the reduction_compiler.    */
 43           /* Such compilers include a SEMANTIC_ANALYSIS subroutine generated by the                 */
 44           /* reduction_compiler.  This subroutine compares a chain of input tokens with token       */
 45           /* requirements specified in reductions.  The code in this include segment performs the   */
 46           /* actual comparisons.  This code is the middle part of the SEMANTIC_ANALYSIS procedure.  */
 47           /*                                                                                        */
 48           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
 49 
 50           TRACING = TRACING;                                /* Kludge to prevent pl1 from making TRACING      */
 51                                                             /*   options(constant) because it is never set.   */
 52           NRED = 1;
 53           go to RD_TEST_REDUCTION;
 54 
 55 RD_NEXT_REDUCTION:
 56           NRED = NRED + 1;
 57 
 58 RD_TEST_REDUCTION:
 59           PRED = addr(REDUCTION(NRED));
 60           Ptoken = Pthis_token;
 61 
 62           do I = RED.TOKEN_REQD.IFIRST to RED.TOKEN_REQD.ILAST by DIRECTION;
 63                PTOKEN_REQD = addr(TOKEN_REQUIREMENT(I));
 64                if Ptoken = null then do;
 65                     if TOKEN_REQD.FORM = 0 then             /* No more tokens.  Only matches <no-token> spec. */
 66                          if TOKEN_REQD.TYPE = 1 then
 67                               go to RD_TEST_TOKEN(1);
 68                     go to RD_NEXT_REDUCTION;
 69                     end;
 70                if TOKEN_REQD.FORM = 0 then do;              /* built-in syntax function.                      */
 71                     go to RD_TEST_TOKEN(TOKEN_REQD.TYPE);
 72 
 73 RD_TEST_TOKEN(1):   if SPDL then                            /* <no-token>                                     */
 74                                                             /* In push-down-language, there are 2             */
 75                                                             /*   interpretations of <no-token>.               */
 76                          if      RED.TOKEN_REQD.IFIRST = RED.TOKEN_REQD.ILAST &
 77                                  Ptoken = null then         /* When <no-token> is only spec, the spec asks    */
 78                               go to RD_MATCH_NO_TOKEN;      /* "Is push down stack empty (all input gone)?"   */
 79                          else if RED.TOKEN_REQD.IFIRST^= RED.TOKEN_REQD.ILAST &
 80                                  RED.TOKEN_REQD.IFIRST = I &
 81                                  token.Pnext = null then    /* For SPEC1 ... SPECN <no-token>, the spec asks  */
 82                               go to RD_MATCH_NO_TOKEN;      /* "Are the topmost tokens on stack SPEC1 - SPECN,*/
 83                                                             /*  and is SPECN the final input token?"          */
 84                          else go to RD_NEXT_REDUCTION;      /* Those are the only two defs allowed in push    */
 85                                                             /* down language mode for <no-token>.             */
 86                     else if Ptoken = null then
 87                          go to RD_MATCH_NO_TOKEN;
 88                     go to RD_NEXT_REDUCTION;
 89 
 90 RD_TEST_TOKEN(2):   go to RD_MATCH;                         /* <any-token>                                    */
 91 ^L
 92 RD_TEST_TOKEN(3):   if token.Lvalue > 0 &                   /* <name>                                         */
 93                        token.Lvalue <= 32 & ^token.S.quoted_string then
 94                          if search(substr(token_value,1,1),"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")
 95                          > 0 then
 96                               if verify(token_value,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_$")
 97                               = 0 then
 98                                    go to RD_MATCH;
 99                     go to RD_NEXT_REDUCTION;
100 
101 RD_TEST_TOKEN(4):                                           /* <decimal-integer>                              */
102                     if token.Nvalue ^= 0 then               /* token already determined to be a number.       */
103                          go to RD_MATCH;
104                     if token.S.quoted_string then
105                          go to RD_NEXT_REDUCTION;
106                     NUMBER = cv_dec_check_ (token_value, CODE);
107                     if CODE = 0 then do;
108                          token.Nvalue = NUMBER;
109                          go to RD_MATCH;
110                          end;
111                     go to RD_NEXT_REDUCTION;
112 
113 RD_TEST_TOKEN(5):   if token.Lvalue = 1 then                /* <BS>                                           */
114                          if token_value = BACKSPACE & ^token.S.quoted_string then
115                               go to RD_MATCH;
116                     go to RD_NEXT_REDUCTION;
117 
118 RD_TEST_TOKEN(6):   if token.S.quoted_string then           /* <quoted-string>                                */
119                          go to RD_MATCH;
120                     go to RD_NEXT_REDUCTION;
121                     end;
122 
123                else if TOKEN_REQD.FORM > 0 then do;         /* absolute syntax specification.                 */
124                     if token.S.quoted_string then
125                          go to RD_NEXT_REDUCTION;
126                     PTOKEN_REQD_VALUE = addr(substr(TOKEN_STRINGS,TOKEN_REQD_STRING.I));
127                     LTOKEN_REQD_VALUE = TOKEN_REQD_STRING.L;
128                     if token_value = TOKEN_REQD_VALUE then
129                          go to RD_MATCH;
130                     go to RD_NEXT_REDUCTION;
131                     end;
132 
133           /* END OF:          rdc_end_.incl.pl1               *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */