1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1988                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         *********************************************************** */
  8 %;
  9 /* ******************************************************
 10    *                                                    *
 11    *                                                    *
 12    * Copyright (c) 1972 by Massachusetts Institute of   *
 13    * Technology and Honeywell Information Systems, Inc. *
 14    *                                                    *
 15    *                                                    *
 16    ****************************************************** */
 17 
 18 table_:
 19      procedure (dowhat, xsym, xval, xflags, xaddr) returns (fixed binary (17));
 20                               /* assignment table routine for symbols in the program being assembled */
 21 
 22 /*
 23           Modified for new hashing schema on 02/10/76 by Eugene E Wiatrowski.
 24           Modified on 11/28/72 at 19:21:37 by R F Mabee.
 25           by RFM on 28 August and 22 November 1972 to fix little bugs.
 26           by RFM on 23 July 1972 to keep referencing line numbers for each name.
 27                               This makes it possible for ALM to produce a cross reference table.
 28           by RHG on 3 June 1971 to fix flagging of multiply defined symbols
 29                               and to let multiply defined symbols keep the first value given them
 30           by RHG on 22 Sept 1970 to submit an unexpanded copy (source got expanded accidentally)
 31           by RHG on 17 August 1970 at 1842 to spot multiply defined symbols of different classes
 32 */
 33 
 34 
 35 
 36 /* for entering and searching for symbols in table.
 37    the table consists of a list structure in 211 parallel
 38    lists, one entry for each item in the table. each entry
 39    consists of a pointer block containing the symbol value and
 40    flags, and a pointer to the symbol stored in a variable
 41    length ascii type string. Both search and assign entries
 42    are contained in this program. */
 43 
 44 % include alm_xref_nodes;
 45 
 46 % include alm_options;
 47 
 48 %include varcom;
 49 
 50 %include concom;
 51 
 52 %include erflgs;
 53 
 54 %include codtab;
 55 
 56 
 57  declare   (dowhat, xsym (8), xval, xflags, xcls, xslink,
 58           words (-2:5), boxno, tval, tflags, yflags, tcls, xaddr,
 59           l, k, link, nwrds) fixed binary (26),
 60           result fixed binary, line_no fixed binary (35),
 61           tree_rel fixed binary, tree_ptr pointer,
 62           line_list_rel bit (18), line_list_ptr pointer,
 63           last_line_rel bit (18), last_line_ptr pointer;
 64  declare  internal_return label local;
 65 
 66           /* EXTERNAL FUNCTIONS */
 67  declare  glpl_$clh external entry (fixed binary (26)) returns (fixed binary (26)),
 68           glpl_$crh external entry (fixed binary (26)) returns (fixed binary (26)),
 69           glpl_$cwrd external entry (fixed binary (26)) returns (fixed binary (26)),
 70           utils_$rs external entry (fixed binary (26), fixed binary (26)) returns (fixed binary (26)),
 71           glpl_$glwrd external entry (fixed binary (26), fixed binary (26)) returns (fixed binary (26)),
 72           glpl_$setblk external entry (fixed binary(26), fixed binary(26)) returns (fixed binary(26)),
 73           utils_$nswrds external entry (fixed binary (26)) returns (fixed binary (26)),
 74           utils_$compare_acc external entry (fixed binary (26), fixed binary (26)) returns (fixed binary (26));
 75 
 76           /* EXTERNAL ENTRIES */
 77  declare  prnter_$prnter_ external entry (char (*)),
 78           glpl_$slwrd external entry (fixed binary (26), fixed binary (26), fixed binary (26)),
 79           glpl_$storl external entry (fixed binary (26), fixed binary (26)),
 80           glpl_$storr external entry (fixed binary (26), fixed binary (26)),
 81           utils_$abort external entry;
 82 
 83           declare (eb_data_$rho, eb_data_$twop18) external fixed binary (35) aligned;
 84 
 85  declare  eb_data_$lavptr external pointer;
 86 
 87  declare   (slink, xslink_ptr) pointer;
 88 
 89 dcl       mod_2_sum bit(36) aligned;
 90 
 91 dcl       bit_array(8) bit(36) aligned based;
 92 
 93  declare  1 bsym based aligned,
 94             2 nc fixed bin (8) unal,
 95             2 ch char (0 refer (bsym.nc)) unal;
 96 
 97  declare  1 word based aligned,
 98             2 left bit (18) unaligned,
 99             2 right bit (18) unaligned;
100 
101  declare  twop18 fixed binary (20) internal static initial (262144);
102 
103  declare   (abs, addr, addrel, bit, fixed, mod, pointer, rel) builtin;
104 
105 
106 label_0100:
107           result = 1;                   /* Preset for happy return. */
108 
109           if (dowhat = iassgn) then goto label_1000;
110           if (dowhat = iserch) then goto label_2000;
111           call prnter_$prnter_ ("fatal error in the assembler (TABLE)"); call utils_$abort;
112 
113 
114 /* assign entry, first search table. */
115 label_1000:
116 
117           internal_return = label_1010;
118           goto label_3000;
119 
120 /* analyze result of table search. */
121 label_1010:
122 
123           if (link = 0) then goto label_1020;
124           goto label_1030;
125 
126 /* not now in table, hence assign directly. */
127 label_1020:
128 
129 
130           if xsym (1) > eb_data_$twop18 then xslink = glpl_$setblk (xsym (1),nwrds); /* assign symbol if there is one in SYM */
131 
132           words (0), words (-1), words (-2) = 0;
133           words (1) = glpl_$glwrd (xslink, box (boxno));
134           words (2) = glpl_$glwrd (xflags,xval);
135           if (xflags = fmlcrf) then goto label_1026;
136           words (3) = glpl_$glwrd (xaddr, fixed (addr (xval) -> word.left, 18));
137           l = 3;
138           if xflags = 0 then l = 5;
139 label_1022:
140 
141           link = glpl_$setblk (words (-2), l + 3) + 3;
142           box (boxno) = link;
143           if (xflags = fmlcrf) then xaddr = link;
144 
145 /* Insert new symbol into tree as well as hash table. */
146 
147           if tnoxref ^= 0 then goto all_done;               /* Don't bother unless user wants result. */
148 
149           tree_ptr = addr (symbol_tree_rel);
150 tree_loop:          tree_rel = tree_ptr -> symbol_tree_node.high_sublist;                 /* Which must be the first word. */
151                     if tree_rel = 0 then goto tree_done;
152                     tree_ptr = pointer (eb_data_$lavptr, tree_rel);
153                     if utils_$compare_acc (xslink, fixed (tree_ptr -> symbol_tree_node.name_rel, 18)) < 0 then tree_ptr = addrel (tree_ptr, 1);
154                     goto tree_loop;
155 tree_done:tree_ptr -> symbol_tree_node.high_sublist = link - 3;
156           goto make_line_node;
157 
158 /* set up entry for multiple location counters. */
159 label_1026:
160 
161           words (3) = 0;
162           words (4) = xval;
163           words (5) = 0;
164           l = 5;
165           goto label_1022;
166 
167 /* entry found table, check for consistency and redefinition. */
168 label_1030:
169 
170           if (unspec (tflags) & unspec (fdef)) = "0"b then goto label_1040;
171           if unspec (tflags) & unspec (fset) then goto label_1070;
172           if unspec (tflags) & unspec (fmul) then goto label_1062;
173           if tcls = xcls then if tval = xval then goto label_1050;
174           if unspec (xflags) & unspec (fdef) then goto label_1060;
175           goto label_1050;
176 
177 /* assign new value and flags to undefined symbol. */
178 label_1040:
179           unspec (yflags) = unspec (tflags) | unspec (xflags);
180           call glpl_$slwrd (link+1, yflags, xval);
181 
182           if xflags = fmlcrf then do;
183                     call glpl_$slwrd (link + 2, 0, 0);
184                     call glpl_$slwrd (link + 3, 0, xval);
185                     call glpl_$slwrd (link + 4, 0, 0);
186                     end;
187           else call glpl_$slwrd (link + 2, xaddr, fixed (addr (xval) -> word.left, 18));
188 
189 /* simple return for equivalent assignments. */
190 label_1050:
191 
192           goto make_line_node;
193 
194 /* error if multiple non-equivalent assignment. */
195 label_1060:
196           unspec (yflags) = unspec (tflags) | unspec (fmul);
197           call glpl_$storl (link+1, yflags);
198 label_1062:
199           prntm = 1;
200           result = 0;
201           goto make_line_node;
202 
203 label_1070:
204 
205           call glpl_$slwrd (link+1,xflags,xval);
206           call glpl_$storr (link + 2, fixed (addr (xval) -> word.left, 18));
207           goto make_line_node;
208 
209 
210 /* search entry, first search table. */
211 label_2000:
212 
213           internal_return = label_2010;
214           goto label_3000;
215 
216 /* analyze search results. */
217 label_2010:
218 
219           if xcls ^= 0 then if xcls ^= tcls then goto label_2020;
220           if link ^= 0 then if unspec (tflags) & unspec (fdef) then goto label_2030;
221 
222 /* value not found, give bad return. */
223 label_2020:
224 
225           xval = 0;
226           xaddr = 0;
227           return (0);
228 
229 /* found in table, check for errors and return value. */
230 label_2030:
231 
232           if unspec (tflags) & unspec (fmul) then prntm = 1;
233           if unspec (tflags) & unspec (fphs) then prntp = 1;
234           xval = tval;
235           xaddr = 0;
236           if (unspec (tflags) & unspec (flocrf)) = unspec (flocrf) then xaddr = glpl_$clh (link+2);
237           if (unspec (tflags) & unspec (fmlcrf)) = unspec (fmlcrf) then xaddr = link;
238 
239 /* Come here on both search and assign entries, to append line number node to list for symbol. */
240 
241 make_line_node:
242           if tnoxref ^= 0 then goto all_done;               /* Skip this extra work if xref not needed. */
243           if binlin = 0 then goto all_done;                 /* Initialization reference (probably). */
244 
245           line_no = binlin + fixed (rel (include_info_stack), 18) * twop18;
246           line_list_ptr, tree_ptr = pointer (eb_data_$lavptr, link - 1);
247 line_loop:line_list_rel = line_list_ptr -> line_node.backward_rel;
248           if line_list_rel = "0"b then do;
249                     line_list_ptr = tree_ptr;
250                     goto line_end;
251                     end;
252           line_list_ptr = pointer (eb_data_$lavptr, line_list_rel);
253           if line_list_ptr -> line_node.line_no > line_no then goto line_loop;
254           if line_list_ptr -> line_node.line_no = line_no then goto all_done;
255 
256 line_end: last_line_rel = line_list_ptr -> line_node.forward_rel;
257           if last_line_rel = "0"b then last_line_ptr = tree_ptr;
258           else last_line_ptr = pointer (eb_data_$lavptr, last_line_rel);
259 
260           addr (words (1)) -> line_node.line_no = line_no;
261           addr (words (1)) -> line_node.forward_rel = last_line_rel;
262           addr (words (1)) -> line_node.backward_rel = line_list_rel;
263           link = glpl_$setblk (words (1), 2);
264           line_list_ptr -> line_node.forward_rel, last_line_ptr -> line_node.backward_rel = bit (fixed (link, 18));
265 
266 all_done: return (result);
267 
268 
269 /* table search routine, reached by assign goto linkage. */
270 label_3000:
271 
272 
273 
274           nwrds = utils_$nswrds (xsym (1));
275 
276           if xsym (1) > eb_data_$twop18 then xslink_ptr = addr (xsym (1));
277 
278           else do;
279                     xslink = xsym (1);
280                     xslink_ptr = pointer (eb_data_$lavptr, xslink);
281           end;
282 
283           mod_2_sum = xslink_ptr -> bit_array(1);
284 
285           do k = 2 to nwrds;
286              mod_2_sum = bool(mod_2_sum,xslink_ptr -> bit_array(k),"0110"b);
287           end;
288 
289           boxno = mod(binary(mod_2_sum,35),nboxes);
290 
291           link = box (boxno);
292 label_3010:
293           if link = 0 then goto search_done;
294           slink = pointer (eb_data_$lavptr,glpl_$clh (link));
295 label_3020:
296           if (xslink_ptr -> bsym.ch ^= slink -> bsym.ch) then goto label_3030;
297 
298           tflags = glpl_$clh (link + 1);
299           tval = glpl_$crh (link + 1);
300           if tflags ^= fmlcrf then tval = tval + glpl_$crh (link + 2) * twop18;
301           xcls = utils_$rs (xflags,15);
302           tcls = utils_$rs (tflags,15);
303 search_done:
304           goto internal_return;
305 label_3030:
306 
307           link = glpl_$crh (link);
308           goto label_3010;
309 
310 
311      end table_;