1
2
3
4
5
6
7
8
9
10
11 display_statement: procedure(p,sourceb,tree_level);
12
13
14
15
16
17
18
19
20
21 dcl (p, q) ptr,
22 tree_level fixed bin,
23 sourceb bit(1) aligned,
24 cu_$arg_count entry returns(fixed bin),
25 display_any_node_name ext entry(char(*) aligned, ptr,fixed bin),
26 (ioa_,ioa_$nnl) ext entry options(variable), display_exp ext entry(ptr,fixed bin),
27 decode_node_id entry(ptr,bit(1) aligned) returns(char(120) varying),
28 ios_$write_ptr entry(ptr,fixed bin,fixed bin),
29 (addr,fixed,length,min,null,ptr) builtin,
30 n fixed bin(15);
31
32 dcl itype fixed bin(15),
33 line char(132) aligned varying,
34 st(0:38) char(12) int static options(constant)
35 init("unknown", "allocate", "assignment", "begin", "call", "close",
36 "declare", "delay", "delete", "display", "do", "else clause",
37 "end", "entry", "exit", "format", "free", "get", "go to", "if",
38 "locate", "null", "on", "open", "procedure", "put", "read",
39 "return", "revert", "rewrite", "signal", "stop",
40 "system", "unlock", "wait", "write", "default","continue","pause");
41
42 %include list;
43 %include nodes;
44 %include source_list;
45 %include statement;
46 %include token_list;
47
48 begin:
49 if p=null
50 then do;
51 call ioa_("^/^vxdisplay_statement: ptr is NULL^/",tree_level);
52 return;
53 end;
54 if p->node.type^=statement_node
55 then do;
56 call display_any_node_name("display_statement: arg is not a statement node,
57 arg =",p,tree_level+1);
58 return;
59 end;
60 itype=fixed(p->statement.statement_type,17,0);
61 if itype > hbound(st,1) then itype = 0;
62 call ioa_("^/^vx^a STATEMENT ^p, next = ^p, back = ^p",tree_level,st(itype),p,p->statement.next,
63 p->statement.back);
64 call ioa_("^vx^a",tree_level,decode_node_id(p,"0"b));
65
66 if cu_$arg_count() > 1
67 then if sourceb
68 then do;
69 m = p->statement.source.segment;
70 if p->statement.source.length ^= 0
71 then do;
72 call ioa_$nnl("^vxSOURCE: ",tree_level);
73 call ios_$write_ptr((source.seg_ptr),(p->statement.
74 source.start),min(p->statement.source.length,120));
75 call ioa_("");
76 end;
77 end;
78 m = p -> object.start;
79 if m ^= 0
80 then if m = p->object.finish then call ioa_("^vxno object code, ic = ^o",tree_level,m);
81 else call ioa_("^vxobject code start = ^o, finish = ^o",tree_level,m,p->object.finish);
82
83 if p->statement.prefix ^= "111110000000"b then call ioa_("^vxprefix = o^4o",tree_level,
84 fixed(p->statement.prefix,12,0));
85 line = "";
86 if p->statement.optimized then line = "optimized ";
87 if p->statement.generated then line = line || "generated ";
88 if p->statement.free_temps then line = line || "free_temps ";
89 if p->statement.LHS_in_RHS then line = line || "LHS_in_RHS ";
90 if p->statement.processed then line = line || "processed ";
91 if p->statement.put_in_profile then line = line || "put_in_profile ";
92 if p->statement.snap then line = line || "snap ";
93 if p->statement.system then line = line || "system ";
94 if p->statement.irreducible then line = line || "irreducible ";
95 if p->statement.checked then line = line || "checked ";
96 if p->statement.save_temps then line = line || "save_temps ";
97 if p->statement.suppress_warnings then line = line || "suppress_warnings ";
98 if p->statement.force_nonquick then line = line || "force_nonquick ";
99 if p->statement.expanded_by_name then line = line || "expanded_by_name ";
100 if length(line) ^= 0 then call ioa_("^vx^a",tree_level,line);
101 m=p->statement.reference_count;
102 if m ^= 0
103 then call ioa_("^vxreference count = ^d",tree_level,m);
104 q=p->statement.reference_list;
105 if q ^= null then call ioa_("^vxreference list = ^p",tree_level,q);
106 q = p -> statement.state_list;
107 if q ^= null then call ioa_("^vxstate list = ^p",tree_level,q);
108 q=p->statement.labels;
109 if q ^= null
110 then do;
111 call ioa_("^vxlabels:",tree_level);
112 do while(q^=null);
113 if q->list.element(2)->node.type=token_node
114 then call ioa_(q->list.element(2)->t_table.string);
115 else call display_exp((q->list.element(2)),tree_level+1);
116 q=q->list.element(1);
117 end;
118 end;
119 q=p->statement.root;
120 if q ^= null
121 then do;
122 call ioa_("^vxroot:",tree_level);
123 call display_exp(q,tree_level+1);
124 end;
125 call ioa_("^vxEND ^a STATEMENT ^p^/",tree_level,st(itype),p);
126 return;
127 end display_statement;