1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19 display_array: proc(a,tree_level);
20
21 dcl tree_level fixed bin;
22 dcl (a,p,b) ptr;
23 dcl units(0:7) char(5) int aligned static init("
24 dcl i fixed bin(31);
25 dcl c char(16) varying;
26 dcl display_exp external entry(ptr,fixed bin), display_any_node_name ext entry(char(*) aligned,ptr,fixed bin),
27 ioa_ entry options(variable),
28 (fixed,null) builtin;
29
30 dcl display_stat_$brief_display bit(1) ext static;
31
32 dcl boundary_type(7) char(5) aligned int static
33 init("bit", "digit", "byte", "half", "word", "mod2", "mod4");
34
35 %include array;
36 %include nodes;
37 begin:
38 p = a;
39 if p = null then do;
40 call ioa_("^/^vxdisplay_array: ptr is NULL^/",tree_level);
41 return;
42 end;
43
44 if p -> node.type = bound_node
45 then do;
46 call display_bounds(p,tree_level+1);
47 return;
48 end;
49
50 if p -> node.type ^= array_node then do;
51 call display_any_node_name("display_array: arg is not an array node,
52 arg =",p,tree_level+1);
53 return;
54 end;
55
56 if p -> array.interleaved then c = " is interleaved"; else c = "";
57 call ioa_("^/^vxARRAY ^p^a, dimensions = ^d",tree_level,p,c,p -> array.number_of_dimensions);
58
59 i=p->array.own_number_of_dimensions;
60 if i ^= 0 then
61 call ioa_("^vxown_number_of_dimensions = ^d",tree_level,i);
62
63 i = p -> array.element_boundary;
64 if i ^= 0 then call ioa_("^vxelement boundary is ^a",tree_level,(boundary_type(i)));
65
66 i = p -> array.size_units;
67 if i ^= 0 then call ioa_("^vxsize units are ^a",tree_level,(boundary_type(i)));
68
69 call ioa_("^vxoffset units are ^a",tree_level,units(p->array.offset_units));
70
71 b=p->array.element_descriptor;
72 if b ^= null then call show_exp("element descriptor",tree_level);
73
74 b=p->array.virtual_origin;
75 if b ^= null then call show_exp("virtual origin",tree_level);
76
77 b = p -> array.symtab_virtual_origin;
78 if b ^= null then call show_exp("symtab virtual origin",tree_level);
79
80 i=p->array.c_virtual_origin;
81 if i ^= 0 then
82 call ioa_("^vxc_virtual_origin = ^d",tree_level,i);
83
84 b=p->array.element_size;
85 if b ^= null then call show_exp("element size",tree_level);
86
87 b = p -> array.symtab_element_size;
88 if b ^= null then call show_exp("symtab element size",tree_level);
89
90 i=p->array.c_element_size;
91 if i ^= 0 then
92 call ioa_("^vxc_element_size = ^d",tree_level,i);
93
94 b=p->array.element_size_bits;
95 if b ^= null then call show_exp("bit element size",tree_level);
96
97 i=p->array.c_element_size_bits;
98 if i ^= 0 then
99 call ioa_("^vxc_element_size_bits = ^d",tree_level,i);
100
101 p=p->array.bounds;
102 call ioa_("^vxbounds of ARRAY ^p:",tree_level,p);
103 call display_bounds(p,tree_level+1);
104 call ioa_("^vxEND ARRAY ^p^/",tree_level,p);
105 return;
106
107 display_bounds: procedure (s,tree_level);
108 dcl (p,s) ptr;
109 dcl tree_level fixed bin;
110
111 p=s;
112 test_bounds:
113 if p = null then do;
114 call ioa_("^/^vxbounds ptr is NULL^/b",tree_level);
115 return;
116 end;
117
118 if p->node.type ^= bound_node then do;
119 call display_any_node_name("display_array: arg is not a bound node,
120 arg =",p,tree_level+1);
121 return;
122 end;
123
124 next: if p = null then return;
125
126 call ioa_("^/^vxBOUND ^p",tree_level,p);
127
128 b = p->bound.lower;
129 if b ^= null then call show_exp("lower bound",tree_level);
130
131 i=p->bound.c_lower;
132 if i ^= 0 then call ioa_("^vxc_lower bound = ^d",tree_level,i);
133
134 b=p->bound.upper;
135 if b ^= null then call show_exp("upper bound",tree_level);
136
137 i=p->bound.c_upper;
138 if i ^= 0 then call ioa_("^vxc_upper bound = ^d",tree_level,i);
139
140 b=p->bound.multiplier;
141 if b ^= null then call show_exp("multiplier",tree_level);
142
143 i=p->bound.c_multiplier;
144 if i ^= 0 then call ioa_("^vxc_multiplier = ^d",tree_level,i);
145
146 b=p->bound.desc_multiplier;
147 if b ^= null then call show_exp("descriptor multiplier",tree_level);
148
149 i=p->bound.c_desc_multiplier;
150 if i ^= 0 then call ioa_("^vxc_desc_multiplier = ^d",tree_level,i);
151
152 b = p -> bound.symtab_lower;
153 if b ^= null then call show_exp("symtab lower",tree_level);
154
155 b = p -> bound.symtab_upper;
156 if b ^= null then call show_exp("symtab upper",tree_level);
157
158 b = p -> bound.symtab_multiplier;
159 if b ^= null then call show_exp("symtab multiplier",tree_level);
160
161 call ioa_("^vxEND BOUND ^p^/",tree_level,p);
162 p = p->bound.next;
163 go to next;
164 end display_bounds;
165
166 show_exp: proc(mess,tree_level);
167
168 dcl tree_level fixed bin;
169 dcl mess char(*) aligned;
170
171 if display_stat_$brief_display then call ioa_("^vx^a = ^p",tree_level,mess,b);
172 else do;
173 call ioa_("^vx^a exp follows",tree_level,mess);
174 call display_exp(b,tree_level+1);
175 call ioa_("^vx^a ended",tree_level,mess);
176 end;
177
178 end;
179
180 end;