1 /****^  ********************************************
  2         *                                          *
  3         * Copyright, (C) Honeywell Bull Inc., 1988 *
  4         *                                          *
  5         ******************************************** */
  6 
  7 
  8 /****^  HISTORY COMMENTS:
  9   1) change(88-01-26,RWaters), approve(88-01-26,MCR7724), audit(88-02-05,Huen),
 10      install(88-02-16,MR12.2-1024):
 11      Expand the uses of options (constant) variables.
 12   2) change(91-01-18,Blackmore), approve(91-01-18,MCR8234),
 13      audit(91-12-05,Huen), install(92-04-24,MR12.5-1011):
 14      Add 'token_lookup' procedure to allow scoping rules to be followed during
 15      resolution of references to constant values.
 16                                                    END HISTORY COMMENTS */
 17 
 18 constant_token:
 19           proc (blk_ptr, token_ptr, type_mask, desired_type) returns (bit (9));
 20 
 21 dcl (blk_ptr, token_ptr) pointer parameter;
 22 dcl desired_type bit (9) aligned parameter;
 23 dcl type_mask bit (9) aligned parameter;
 24 
 25 /* This routine is passed a pointer to a token, a mask to check token types
 26    against a desired token type, and a desired token type.
 27 
 28    It will check the current token, to see if it is a symbol which is
 29    static options (constant) initial (...), of a type which is acceptable
 30    through the mask.  If so, it will change the token pointer to point to
 31    the token for the constant which initializes this variable, and will
 32    return the token type of the constant.  This essentially replaces
 33    constants for use in areas where a variable of any type will be seen
 34    as a syntax error, even though use of a constant would be wonderful for
 35    producing understandable and taylorable code. */
 36 
 37 /* Modified: Jan 28,88 by RW to fix 1994 and 2186. */
 38 
 39 %page;
 40 %include block;
 41 %page;
 42 %include cross_reference;
 43 %include list;
 44 %include nodes;
 45 %page;
 46 %include symbol;
 47 %page;
 48 %include token;
 49 %include token_list;
 50 %page;
 51 %include token_types;
 52 %page;
 53 dcl 1 t like token based (token_ptr);
 54 
 55 dcl d ptr;
 56 dcl symp ptr;
 57 dcl 1 sym like symbol based (symp);
 58 
 59 declare   pl1_stat_$table bit (1) aligned external static;
 60 
 61 dcl (null, string) builtin;
 62 
 63 /* If it is a symbol which is
 64    static options (constant) initialized (), then we will return, not the
 65    pointer to its token, but the pointer to the initializing token which
 66    defines its value.  We will also cross-reference this reference, since
 67    we will no longer see the real token, only its value. */
 68 
 69                symp = token_lookup (blk_ptr, token_ptr);
 70                if symp = null () then return (t.type);
 71                if  sym.node_type ^= symbol_node then
 72                     return (t.type);
 73 
 74 /* It is a symbol, determine if it is allocated in text, initialed, fixed and
 75    static. */
 76 
 77                if sym.initial ^= null () & ^sym.dimensioned then
 78                     if sym.initialed & sym.alloc_in_text & sym.static &
 79                     sym.initial -> list.number = 3
 80                     then do;  /* no expression */
 81                          if sym.initial -> list.element (3) ^= null () then return (t.type);
 82                          if (type_mask & sym.initial -> list.element (2) -> t.type) ^=
 83                               (type_mask & desired_type) then return (t.type);
 84 
 85 /* decimal integer token, update the token pointer. */
 86 
 87                          token_ptr = sym.initial -> list.element (2);
 88 
 89 /* re-use constant token.  We will now cross-reference this variable, since
 90    it now disappears from the view of the parser. */
 91 
 92                          d = create_cross_reference ();
 93                          d -> cross_reference.next = sym.cross_references;
 94                          sym.cross_references = d;
 95                          string (d -> cross_reference.source_id)
 96                               = string (pl1_stat_$statement_id);
 97                          if pl1_stat_$table then
 98                               sym.allocate, sym.put_in_symtab = "1"b; /* to find it later */
 99                     end;
100                     return (t.type);
101 %page;
102 token_lookup: proc (blk, t_ptr) returns (ptr);
103 /* Return a pointer to the symbol (or label) represented by the token referred
104    to by t_ptr, in the scope of the block pointed to by 'blk'. */
105 
106 dcl  (blk, t_ptr, sym_ptr, partial_ptr, b) ptr;
107 dcl  num_partials           fixed bin (15);
108 
109 /* search for an applicable declaration symbol for which this is a fully
110    qualified reference.  Remember any applicable declaration for which this is
111    a partially qualified reference.  If two or more applicable declarations can
112    be found and this is not a fully qualified reference to any of them, this is
113    an ambiguous reference.  If only one applicable declaration can be found,
114    this is a valid partially qualified reference to that declaration.
115    The search for an applicable declaration begins in the current block and
116    continues outward until the first applicable declaration is found.
117    After the first applicable declaration is found, all additional searching is
118    confined to the block in which the first applicable declaration was found. */
119 
120     num_partials = 0;
121     partial_ptr = null;
122 
123     b = blk;
124     do while (b ^= null);                                   /* While more blocks to search. */
125 
126       sym_ptr = t_ptr -> token.declaration;
127       do while (sym_ptr ^= null);                           /* While more symbols to look at. */
128 
129         if sym_ptr -> symbol.block_node = b then
130           do;                                               /* In proper scope. */
131           if (sym_ptr -> node.type = label_node)            /* If we have a label or fully qualified */
132                | ^(sym_ptr -> symbol.member) then return(sym_ptr);/* symbol, then we're successful. */
133           num_partials = num_partials + 1;                  /* Otherwise reference is partially qualified. */
134           partial_ptr = sym_ptr;
135         end;                                                /* End: In proper scope. */
136 
137         sym_ptr = sym_ptr -> symbol.multi_use;
138       end;                                                  /* End: While more symbols to look at. */
139 
140       if num_partials > 0 then b = null; else b = b -> block.father;
141     end;                                                    /* End: While more blocks to search. */
142 
143 /* Here we either have a partially qualified reference, or no reference. */
144     if num_partials > 1 then partial_ptr = null;            /* Ambiguous reference */
145     return (partial_ptr);
146 
147   end token_lookup;
148 %page;
149 defer_constant_token_list:
150           entry (blk_ptr, index, stop_type);
151 
152 /* accept a list of tokens and defer all indentifiers which represent a
153    static options (constant) to refer to the actual constant token, rather
154    than the variable. */
155 
156 dcl index fixed bin parameter;
157 dcl stop_type bit (9) aligned parameter;
158 
159 dcl k fixed bin;
160 dcl dummy_type bit (9) aligned;
161 
162           k = index;
163           do while (t_table.type ^= semi_colon & t_table.type^=stop_type);
164                if (t_table.type & is_identifier) = identifier then
165                     dummy_type = constant_token (blk_ptr, token_list (k), is_constant, dec_integer);
166                if (t_table.type & is_delimiter) ^= is_delimiter &
167                     (token_list (k+1) -> t_table.type & is_identifier) =
168                     identifier then return;
169                k = k + 1;
170           end;
171           return;
172 %page;
173 %include language_utility;
174           end constant_token;