1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19 display_symbol: proc(a,tree_level);
20
21 dcl (a,p,q,vector) ptr,
22 line char(96),
23 tree_level fixed bin,
24 lp fixed bin;
25
26 dcl i fixed bin(31);
27 dcl n fixed bin(15);
28 dcl k fixed bin;
29 dcl based_bitstring bit(36) aligned based;
30
31 dcl display_any_node_name ext entry(char(*) aligned, ptr,fixed bin);
32 dcl ioa_ ext entry options(variable);
33 dcl decode_node_id entry(ptr,bit(1)) returns(char(120) varying);
34 dcl ( display_array, display_exp, display_constant)
35 ext entry(ptr,fixed bin);
36 dcl (fixed,string,length,null) builtin;
37
38 dcl display_stat_$brief_display bit(1) ext static;
39
40 dcl boundary_type(0:7) char(5) int static aligned init("
41 dcl declare_type(0:5) char(8) int static init("
42 "implicit","compiler");
43
44
45 % include symbol;
46 %include default;
47 %include label;
48 %include statement;
49 % include nodes;
50 %include token_list;
51 %include list;
52 %include label_array_element;
53 %include declare_type;
54
55 dcl names(89) char(20) varying int static initial(
56
57
58
59 "structure",
60 "fixed",
61 "float",
62 "bit",
63 "char",
64 "ptr",
65 "offset",
66 "area",
67 "label",
68 "entry",
69 "file",
70 "arg_descriptor",
71 "storage_block",
72 "unused_1",
73 "condition",
74 "format",
75 "builtin",
76 "generic",
77 "picture",
78
79
80
81 "dimensioned",
82 "initialed",
83 "aligned",
84 "unaligned",
85 "signed",
86 "unsigned",
87 "precision",
88 "varying",
89 "local",
90 "decimal",
91 "binary",
92 "real",
93 "complex",
94 "variable",
95 "reducible",
96 "irreducible",
97 "returns",
98 "position",
99 "internal",
100 "external",
101 "like",
102 "member",
103 "non_varying",
104 "options",
105 "variable_arg_list",
106 "alloc_in_text",
107
108
109
110 "auto",
111 "based",
112 "static",
113 "controlled",
114 "defined",
115 "parameter",
116 "param_desc",
117 "constant",
118 "temporary",
119 "return_value",
120
121
122
123 "print",
124 "input",
125 "output",
126 "update",
127 "stream",
128 "reserved_1",
129 "record",
130 "sequential",
131 "direct",
132 "interactive",
133 "reserved_2",
134 "reserved_3",
135 "stringvalue",
136 "keyed",
137 "reserved_4",
138 "environment",
139
140
141
142 "aliasable",
143 "packed",
144 "passed_as_arg",
145 "allocate",
146 "set",
147 "exp_extents",
148 "refer_extents",
149 "star_extents",
150 "isub",
151 "put_in_symtab",
152 "contiguous",
153 "put_data",
154 "overlayed",
155 "error",
156 "symtab_processed",
157 "overlayed_by_builtin",
158 "defaulted",
159 "connected"
160 );
161
162 p=a;
163
164 if p = null then do;
165 call ioa_("^/^vxdisplay_symbol: ptr is NULL^/",tree_level);
166 return;
167 end;
168
169 if p->node.type=label_node
170 then do;
171 call ioa_("^/^vxLABEL ^p is ^a",tree_level,p,p->label.token->t_table.string);
172 if p->label.statement ^= null
173 then if ^ p->label.array
174 then call ioa_("^vxfor ^a",tree_level,decode_node_id((p -> label.statement),"0"b));
175 else do;
176 call ioa_("^vxfor:",tree_level);
177 vector = p->label.statement;
178
179 if vector -> node.type = label_array_element_node
180 then do while(vector ^= null);
181 call ioa_("^vx^4x^a",tree_level,decode_node_id((vector->label_array_element.statement),"0"b));
182 vector = vector->label_array_element.next;
183 end;
184
185 else do i = 1 to vector->list.number;
186 if vector->element(i) = null
187 then call ioa_("^vx^4xNULL",tree_level);
188 else call ioa_("^vx^4x^a",tree_level,decode_node_id((vector->element(i)),"0"b));
189 end;
190 end;
191 call ioa_("^vxdeclared by ^a",tree_level,declare_type(fixed(p->label.dcl_type,3,0)));
192 call ioa_("^vxblock = ^p, token = ^p, next = ^p, statement = ^p",tree_level,
193 p->label.block_node,p->label.token,p->label.next,p->label.statement);
194 if p->label.allocated then call ioa_("^vxallocated bit is ON",tree_level);
195 i=p->label.location;
196 if i ^= 0 then call ioa_("^vxlocation = ^6w",tree_level,i);
197 if p->label.array then call ioa_("^vxarray bit is ON, low bound = ^d, high bound = ^d",tree_level,
198 p -> label.low_bound,p -> label.high_bound);
199 call ioa_("^vxEND LABEL ^p^/",tree_level,p);
200 return;
201 end;
202
203
204 if p->node.type = default_node
205 then do;
206 call ioa_("^/^vxDEFAULT ^p, ^a",tree_level,p,decode_node_id(p,"0"b));
207
208 q = p -> default.predicate;
209 if q ^= null then call show_exp("predicate");
210
211 if p->default.system then call ioa_("^vxdefault is system",tree_level);
212 if p->default.error then call ioa_("^vxdefault is error",tree_level);
213 if p->default.no_defaults then call ioa_("^vxdefault is no defaults",tree_level);
214
215 call ioa_("^vxsymbol for default follows",tree_level);
216 call display_symbol((p -> default.symbol),tree_level+1);
217
218 call ioa_("^vxEND DEFAULT ^p^/",tree_level,p);
219 return;
220
221 end;
222
223 if p->symbol.node_type ^= symbol_node then do;
224 call display_any_node_name("display_symbol: arg is not a symbol node,
225 arg =",p,tree_level+1);
226 return;
227 end;
228
229 call ioa_("^/^vxSYMBOL ^p, is ^a",tree_level,p,p->symbol.token->t_table.string);
230 if p -> symbol.dcl_type = by_declare
231 then call ioa_("^vxdeclared by declare on ^a",tree_level,decode_node_id(p,"0"b));
232 else call ioa_("^vxdeclared by ^a",tree_level,declare_type(fixed(p -> symbol.dcl_type,17,0)));
233
234 call ioa_("^vxblock = ^p, token = ^p, next = ^p",tree_level,
235 p->symbol.block_node,p->symbol.token,
236 p->symbol.next);
237
238 if p->symbol.multi_use ^= null then call ioa_("^vxmulti_use = ^p",tree_level,p->symbol.multi_use);
239
240 k = p->symbol.level;
241 if k ^= 0 then call ioa_("^vxlevel = ^d",tree_level,k);
242
243 k = p->symbol.scale;
244 if k ^= 0 then call ioa_("^vxscale = ^d",tree_level,k);
245
246 k = fixed(p -> symbol.runtime,18);
247 if k ^= 0 then call ioa_("^vxruntime = ^o",tree_level,k);
248
249 k = fixed(p -> symbol.runtime_offset,18);
250 if k ^= 0 then call ioa_("^vxruntime offset = ^o",tree_level,k);
251
252 if p->symbol.father ^= null then call ioa_("^vxfather = ^p",tree_level,p->symbol.father);
253 if p->symbol.brother ^= null then call ioa_("^vxbrother = ^p",tree_level,p->symbol.brother);
254 if p->symbol.son ^= null then call ioa_("^vxson = ^p",tree_level,p->symbol.son);
255
256 i=p->symbol.boundary;
257 if i ^= 0 then call ioa_("^vxboundary is ^a",tree_level,boundary_type(i));
258
259 if p->symbol.allocated then call ioa_("^vxallocated bit is ON",tree_level);
260
261 i=p->symbol.location;
262 if i^= 0 then call ioa_("^vxlocation = ^6w (^d decimal)",tree_level,i,i);
263
264 q=p->symbol.cross_references;
265 if q ^= null then call ioa_("^vxcross_ref = ^p",tree_level,q);
266
267 i=p->symbol.c_word_size;
268 if i ^= 0 then call ioa_("^vxc_word_size = ^d",tree_level,i);
269
270 i=p->symbol.c_bit_size;
271 if i ^= 0 then call ioa_("^vxc_bit_size = ^d",tree_level,i);
272
273 i=p->symbol.c_dcl_size;
274 if i ^= 0 then call ioa_("^vxc_dcl_size = ^d",tree_level,i);
275
276 if string(p -> symbol.attributes) = "0"b
277 then do;
278 call ioa_("^vxNo attributes",tree_level);
279 goto long;
280 end;
281
282 line = "Attributes:";
283 lp = 13;
284
285 do i = 1 to length(string(p -> symbol.attributes));
286 if substr(string(p -> symbol.attributes),i,1)
287 then if i <= hbound(names,1)
288 then do;
289 n = length(names(i));
290 substr(line,lp,n) = names(i);
291 lp = lp + n + 1;
292
293 if lp > 72
294 then do;
295 call ioa_("^vx^a",tree_level,line);
296 line = "";
297 lp = 1;
298 end;
299
300 end;
301 end;
302
303 if lp > 1 then call ioa_("^vx^a",tree_level,line);
304
305 long: if p -> node.type ^= symbol_node then goto done;
306
307 q=p->symbol.initial;
308 if p->symbol.constant
309 then if q = null then call ioa_("^vxconstant value ptr is NULL",tree_level);
310 else call display_constant(p,tree_level+1);
311 else do;
312 if q ^= null
313 then if q->node.type ^= list_node then call display_any_node_name("initial= ",q,tree_level+1);
314 else call show("initial attributes",display_initial);
315 end;
316
317 if p->symbol.picture
318 then do;
319 call ioa_("^vxpicture attributes follows:",tree_level);
320 if p->pic_fixed then call ioa_("^vxpic_fixed",tree_level);
321 if p->pic_float then call ioa_("^vxpic_float",tree_level);
322 if p->pic_char then call ioa_("^vxpic_char ",tree_level);
323
324 call ioa_("^vxpic_scale = ^d, pic_size = ^d",tree_level,p->pic_scale,p->pic_size);
325 call ioa_("^vxend of picture attributes",tree_level);
326 end;
327
328
329 q=p->symbol.array;
330 if q ^= null then call show("array data",display_array);
331
332 q=p->symbol.descriptor;
333 if q ^= null then call show_exp("descriptor");
334
335 q=p->symbol.equivalence;
336 if q ^= null then call show_exp("equivalences");
337
338 q=p->symbol.reference;
339 if q ^= null then do;
340 call ioa_("^vxreference follows:",tree_level);
341 call display_exp(q,tree_level+1);
342 end;
343
344
345 q = p->symbol.general;
346 if q ^= null then call display_any_node_name("general = ",q,tree_level+1);
347
348 q = p -> symbol.word_size;
349 if q ^= null then call show_exp("word size exp");
350
351 q=p->symbol.bit_size;
352 if q ^= null then call show_exp("bit size exp");
353
354 q=p->symbol.dcl_size;
355 if q ^= null then call show_exp("dcl size exp");
356
357 q = p -> symbol.symtab_size;
358 if q ^= null then call show_exp("symtab size exp");
359
360 done:
361
362 call ioa_("^vxEND SYMBOL ^p^/",tree_level,p);
363
364 return;
365
366 show_exp: proc(message);
367
368 dcl message char(*) aligned;
369
370 if display_stat_$brief_display
371 then call ioa_("^vx^a = ^p",tree_level,message,q);
372 else do;
373 call ioa_("^vx^a:",tree_level,message);
374 call display_exp(q,tree_level+1);
375 end;
376
377 end;
378
379 show: proc(message,prog);
380
381 dcl message char(*) aligned,
382 prog entry(ptr,fixed bin);
383
384 if display_stat_$brief_display
385 then call ioa_("^vx^a = ^p",tree_level,message,q);
386 else do;
387 call ioa_("^vx^a:",tree_level,message);
388 call prog(q,tree_level+1);
389 end;
390
391 end;
392
393 display_initial: proc(listp);
394
395 dcl (listp,q) ptr;
396
397 q=listp;
398 do while(q^=null);
399 call ioa_("^vxfactor = ",tree_level);
400 call display_exp((q->list.element(1)),tree_level+1);
401 if q->list.element(2) ^= null
402 then if q->list.element(2)->node.type ^= list_node
403 then do;
404 call ioa_("^vxvalue =",tree_level);
405 call display_exp((q->list.element(2)),tree_level+1);
406 end;
407 else call display_initial((q->list.element(2)));
408 else call ioa_("vx^a",tree_level,"value = ""*""");
409 q=q->list.element(3);
410 end;
411 end display_initial;
412
413 end display_symbol;