1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 /* display array|bound nodes,
 12     modified on 26 August by PAG for Version II */
 13 /*        Modified again on:  19 October 1970 PG */
 14 /*        Modified on:         2 December 1970 jk  */
 15 /*        Modified on:         7 January 1971 by BLW */
 16 /*        Modified on:        25 April 1979 by PCK to implement 4-bit decimal */
 17 /*        Modified on:        29 November 1979 by PCK to display tree level indented output */
 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("----","bits","digit","byte","half","word","mod2","mod4");
 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;