1
2
3
4
5
6
7
8
9
10
11 show_statement: proc(string);
12
13
14
15
16 dcl string char(*);
17
18 dcl (k,n) fixed bin(15),
19 tree_level fixed bin initial(0),
20 ln fixed bin(15),
21 (sn,fn) fixed bin(6),
22 p ptr,
23 number int static fixed bin(31),
24 any int static bit(1),
25 pl1_stat_$root ptr ext,
26 ioa_ entry options(variable),
27 cv_dec_ entry(char(*) aligned) returns(fixed bin),
28 display_statement entry(ptr,bit(1) aligned,fixed bin);
29
30 dcl (fixed,index,null,substr) builtin;
31
32
33 %include block;
34 %include statement;
35
36 if pl1_stat_$root = null
37 then do;
38 call ioa_("No tree available");
39 return;
40 end;
41 if string = "" then do;
42 call ioa_("show_statement line#.statement# (s# is opt.)");
43 return;
44 end;
45
46 fn = 0;
47
48 n = index(string,".");
49
50 if n = 0
51 then do;
52 any = "1"b;
53 ln = cv_dec_((string));
54 sn = 0;
55 end;
56 else do;
57 any = "0"b;
58 k = index(substr(string,n+1),".");
59 if k = 0
60 then do;
61 ln = cv_dec_(substr(string,1,n-1));
62 sn = cv_dec_(substr(string,n+1));
63 end;
64 else do;
65 fn = cv_dec_(substr(string,1,n-1));
66 ln = cv_dec_(substr(string,n+1,k-1));
67 sn = cv_dec_(substr(string,n+k+1));
68 end;
69 end;
70
71 if any then call ioa_("Searching for line ^d",ln);
72 else call ioa_("Searching for statement ^d on line ^d",sn,ln);
73
74 number = 0;
75 call show_stm(pl1_stat_$root -> block.son,tree_level+1);
76
77 if number = 0 then call ioa_("Statement not found.");
78
79 show_stm: proc(ptx,tree_level);
80
81 dcl ptx ptr unaligned;
82 dcl tree_level fixed bin;
83
84 dcl (p,q,pt) ptr;
85
86 pt = ptx;
87 if pt = null then return;
88
89 call ioa_("^/^vxStart of block ^p",tree_level,pt);
90
91 p = pt -> block.prologue;
92
93 call check_stm(p,tree_level);
94
95 p = pt -> block.main;
96
97 call check_stm(p,tree_level);
98
99 q = pt -> block.son;
100
101
102
103 do while(q^=null);
104 call show_stm((q),tree_level+1);
105 q = q -> block.brother;
106 end;
107
108 call ioa_("^vxEnd of block ^p^/",tree_level,pt);
109
110 end;
111
112
113 check_stm: proc(pt,tree_level);
114
115 dcl (pt,q) ptr,
116 tree_level fixed bin,
117 this_sn fixed bin(9);
118
119 q = pt;
120 do while(q ^= null);
121
122 if any then this_sn = 0;
123 else this_sn = fixed(q -> statement.statement_number,5);
124
125 if fixed(q -> statement.line_number,14) = ln
126 then if this_sn = sn
127 then if fixed(q -> statement.file_number,8) = fn
128 then do;
129 number = number + 1;
130 call display_statement(q,"1"b,tree_level+1);
131 end;
132
133 q = q -> statement.next;
134 end;
135
136 end;
137
138 end;