1
2
3
4
5
6 %;
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27 page_trace: pgt: proc;
28
29
30
31 dcl (header, longsw, print_pagefaults, marker_seen, stop_at_marker, count_given) bit (1) aligned,
32 (dp, eptr, tp) ptr,
33 ring_no fixed bin (3),
34 (from, to) char (4) aligned,
35 string char (20),
36 offset fixed bin(18),
37 (next, total, count, i, tc, long, fmtx, start_index) fixed bin,
38 code fixed bin (35),
39 data_area (1024) fixed bin,
40 (time, type, seg_no, page_no, hcscnt) fixed bin,
41 dirname char (168),
42 ename char (32),
43 proc_name char (32),
44 proc_offset fixed bin (18),
45 proc_segno fixed bin,
46 comp_name char (8),
47 entry_name char (32),
48 switch_ptr ptr,
49 ftime float bin;
50
51
52
53 dcl based_char_4 char (4) aligned based,
54 packedptr ptr based unal,
55 targ char (tc) based (tp);
56
57
58
59
60 dcl output_format (0:11) char (50) varying aligned internal static options (constant) initial (
61 "^20x^s^8.2f^3o^6o^5o^2x^s^a",
62 "^20x^s^8.2f^3o^6o^5o^2x^a>^a",
63 "^20a^8.2f^3x^s^6o^5x^s^2x^s^a",
64 "^20a^8.2f^3x^s^6o^5x^s^2x^a>^a",
65 "^20a^8.2f^3x^s^6o^5x^s^2x^s^a$^a",
66 "^20a^8.2f^3x^s^6o^5x^s^2x^a>^a$^a",
67 "^20a^8.2f^3x^s^6x^s^5x^s^2x^s^a",
68 "^20a^8.2f",
69 "^20a^8.2f^3x^s^6o^5x^s^2x^s^a^a|^o",
70 "^20a^8.2f^3x^s^6o^5x^s^2x^a>^a^a|^o",
71 "^20x^s^8.2f^3x^s^6o^5o^2x^s^a",
72 "^20x^s^8.2f^3x^s^6o^5o^2x^a>^a^2s^/^46xby ^a|^o");
73
74
75
76 dcl (active_all_rings_data_$hcscnt fixed bin,
77 iox_$user_output ptr) external static;
78 dcl error_table_$badopt fixed bin (35) external static;
79 dcl error_table_$inconsistent fixed bin (35) external static;
80
81
82
83 dcl hcs_$get_page_trace entry (ptr),
84 hcs_$fs_get_path_name entry (ptr, char(*), fixed bin, char(*), fixed bin(35)),
85 ioa_$ioa_switch entry options (variable),
86 iox_$look_iocb entry (char (*), ptr, fixed bin (35)),
87 get_entry_name_ entry (ptr, char (*), fixed bin, char (8), fixed bin (35)),
88 com_err_ entry options (variable),
89 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)),
90 cu_$arg_count entry returns (fixed bin),
91 interpret_bind_map_ entry (ptr, char(*), fixed bin(18), fixed bin(35)),
92 ring0_get_$name entry (char(*), char(*), ptr, fixed bin (35));
93
94
95
96 dcl (addr, baseno, baseptr, rel, binary, convert, substr, unspec) builtin;
97
98
99
100 dcl (conversion, not_in_read_bracket) condition;
101
102
103
104 %include sys_trace;
105 %include trace_types;
106
107
108
109 dp = addr (data_area);
110 call hcs_$get_page_trace (dp);
111
112 longsw = ""b;
113 count_given = ""b;
114 print_pagefaults = "1"b;
115 stop_at_marker = ""b;
116 from = "";
117 to = "";
118 marker_seen = "0"b;
119
120 hcscnt = active_all_rings_data_$hcscnt;
121 switch_ptr = iox_$user_output;
122
123 next = dp -> trace.next_free;
124 count, total = dp -> trace.last_available;
125
126 do i = 1 to cu_$arg_count ();
127 call cu_$arg_ptr (i, tp, tc, code);
128 if targ = "-long" | targ = "-lg" then longsw = "1"b;
129 else if targ = "-no_header" | targ = "-nhe" then header = "0"b;
130 else if targ = "-output_switch" | targ = "-os" then do;
131 i = i + 1;
132 call cu_$arg_ptr (i, tp, tc, code);
133 if code ^= 0 then do;
134 call com_err_ (code, "page_trace", "-output_switch must be followed by a switch name.");
135 return;
136 end;
137 call iox_$look_iocb (targ, switch_ptr, code);
138 if code ^= 0 then do;
139 call com_err_ (code, "page_trace", "Switch ^a not found.", targ);
140 return;
141 end;
142 end;
143 else if targ = "-from" | targ = "-fm" then do;
144 i = i + 1;
145 call cu_$arg_ptr (i, tp, tc, code);
146 if code ^= 0 then do;
147 call com_err_ (code, "page_trace", "-from must be followed by a character string.");
148 return;
149 end;
150 from = targ;
151 end;
152 else if targ = "-to" then do;
153 i = i + 1;
154 call cu_$arg_ptr (i, tp, tc, code);
155 if code ^= 0 then do;
156 call com_err_ (code, "page_trace", "-to must be followed by a character string.");
157 return;
158 end;
159 stop_at_marker = "1"b;
160 to = targ;
161 end;
162 else if targ = "-npf" | targ = "-no_pagefaults" then print_pagefaults = ""b;
163 else if substr (targ, 1, 1) = "-" then do;
164 call com_err_ (error_table_$badopt, "page_trace", "^a", targ);
165 return;
166 end;
167 else do;
168 count_given = "1"b;
169 on conversion go to bad_count;
170 count = convert (count, targ);
171 revert conversion;
172 if count <= 0 | count > total then do;
173 bad_count:
174 call com_err_ (0, "page_trace", "Invalid count value given, ^a", targ);
175 return;
176 end;
177 end;
178 end;
179
180 if count_given & (from ^= "" | to ^= "") then do;
181 call com_err_ (error_table_$inconsistent, "page_trace",
182 "count and ^[-from ^]^[-to ^]", (from ^= ""), (to ^= ""));
183 return;
184 end;
185
186 if header
187 then call ioa_$ioa_switch (switch_ptr, "^/^-^-Elapsed^/ Trace Type Time (ms) Ring Segno Page^-Segment^/");
188
189 if count > next
190 then start_index = total + next - count + 1;
191 else start_index = next - count + 1;
192
193 if from ^= ""
194 then if count > next
195 then do i = start_index to total, 1 to next;
196 trace_ptr = addr (dp -> trace.data (i));
197 if trace_ptr -> page_trace_entry.type = marker_type
198 then if trace_ptr -> based_char_4 = from
199 then do;
200 start_index = i;
201 go to scan;
202 end;
203 count = count - 1;
204 end;
205 else do i = start_index to next;
206 trace_ptr = addr (dp -> trace.data (i));
207 if trace_ptr -> page_trace_entry.type = marker_type
208 then if trace_ptr -> based_char_4 = from
209 then do;
210 start_index = i;
211 go to scan;
212 end;
213 count = count - 1;
214 end;
215
216 scan:
217 if count > next
218 then do i = start_index to total, 1 to next;
219 trace_ptr = addr (dp -> trace.data (i));
220 call output;
221 if stop_at_marker
222 then if trace_ptr -> page_trace_entry.type = marker_type
223 then if trace_ptr -> based_char_4 = to
224 then go to done;
225 end;
226 else do i = start_index to next;
227 trace_ptr = addr (dp -> trace.data (i));
228 call output;
229 if stop_at_marker
230 then if trace_ptr -> page_trace_entry.type = marker_type
231 then if trace_ptr -> based_char_4 = to
232 then go to done;
233 end;
234
235 done:
236 call ioa_$ioa_switch (switch_ptr, "");
237 return;
238 ^L
239 output: proc;
240
241 if unspec (trace_ptr -> page_trace_entry) = "0"b
242 then return;
243
244 type = trace_ptr -> page_trace_entry.type;
245 time = trace_ptr -> page_trace_entry.time;
246 if time = 65535 then ftime = 0e0;
247 else ftime = time*64/1e3;
248
249 if type = page_fault_type | type = seg_fault_start
250 | type = seg_fault_end
251 | type = boundfault_start | type = boundfault_end
252 then seg_no = trace_ptr -> page_trace_entry.segment_number;
253
254 else if type = extended_page_fault_type
255 then seg_no = binary (trace_ptr -> extended_page_trace_entry.tsr_segno_1
256 || trace_ptr -> extended_page_trace_entry.tsr_segno_2, 12);
257
258 else if type = linkage_fault_end
259 then do;
260 eptr = trace_ptr -> packedptr;
261 call get_entry_name_ (eptr, entry_name, seg_no, comp_name, code);
262 if entry_name = "" then entry_name = "0";
263 end;
264
265 else if type = linkage_fault_start then do;
266 eptr = trace_ptr->packedptr;
267 offset = binary(rel(eptr),18);
268 entry_name = "";
269 on not_in_read_bracket goto ISGATE;
270 call interpret_bind_map_(eptr,entry_name,offset,code );
271 revert not_in_read_bracket;
272 ISGATE:
273 if entry_name ^= "" then entry_name = ": " || entry_name;
274 seg_no = binary(baseno(eptr),18);
275 end;
276
277 else seg_no = -1;
278
279 if seg_no ^= -1 then call get_segment_name (seg_no, dirname, ename);
280 else dirname, ename = "";
281
282
283
284 page_no = 0;
285 ring_no = 0;
286 proc_name = "";
287 proc_segno = 0;
288 proc_offset = 0;
289 long = binary (longsw, 1);
290
291 if type = page_fault_type then do;
292 if ^print_pagefaults then return;
293 page_no = trace_ptr -> page_trace_entry.page_number;
294 ring_no = trace_ptr -> page_trace_entry.ring;
295 fmtx = 0 + long;
296 end;
297 else if type = extended_page_fault_type then do;
298 page_no = trace_ptr -> extended_page_trace_entry.tsr_pageno;
299 proc_segno = trace_ptr -> extended_page_trace_entry.psr_segno;
300 proc_offset = trace_ptr -> extended_page_trace_entry.psr_offset;
301 call get_segment_name (proc_segno, (""), proc_name);
302 fmtx = 10 + long;
303 end;
304 else if type = seg_fault_start then do;
305 string = "SEG-FAULT-START";
306 fmtx = 2 + long;
307 end;
308 else if type = seg_fault_end then do;
309 string = "SEG-FAULT-END";
310 fmtx = 2 + long;
311 end;
312 else if type = boundfault_start then do;
313 string = "BOUND-FAULT-START";
314 fmtx = 2 + long;
315 end;
316 else if type = boundfault_end then do;
317 string = "BOUND-FAULT-END";
318 fmtx = 2 + long;
319 end;
320 else if type = linkage_fault_start then do;
321 if seg_no = 0 then do;
322 string = "MAKE-PTR-CALL";
323 fmtx = 7;
324 end;
325 else do;
326 string = "LINKAGE FAULT BY";
327 fmtx = 8 + long;
328 end;
329 end;
330 else if type = linkage_fault_end then do;
331 string = "RESOLVED LINK TO";
332 fmtx = 4 + long;
333 end;
334 else if type = signaller_type then do;
335 string = "SIGNAL GENERATED";
336 fmtx = 6;
337 ename = trace_ptr -> based_char_4;
338 end;
339 else if type = restart_fault_type then do;
340 string = "SIGNAL RESTARTED";
341 fmtx = 7;
342 end;
343 else if type = reschedule_type then do;
344 string = "RESCHEDULING";
345 fmtx = 7;
346 end;
347 else if type = marker_type then do;
348 string = "USER MARKER";
349 fmtx = 6;
350 ename = trace_ptr -> based_char_4;
351 end;
352 else do;
353 string = "UNRECOGNIZABLE ENTRY";
354 fmtx = 6;
355 ename = trace_ptr -> based_char_4;
356 end;
357
358 call ioa_$ioa_switch (switch_ptr, output_format (fmtx),
359 string, ftime, ring_no, seg_no, page_no, dirname, ename,
360 entry_name, offset, proc_name, proc_offset);
361
362 return;
363 end;
364 %page;
365 print_trace_entry: entry (a_trace_ptr, a_switch_ptr, a_longsw);
366
367
368
369
370
371 dcl a_trace_ptr ptr;
372 dcl a_switch_ptr ptr;
373 dcl a_longsw bit (1) aligned;
374
375 hcscnt = active_all_rings_data_$hcscnt;
376 switch_ptr = a_switch_ptr;
377 trace_ptr = a_trace_ptr;
378 longsw = a_longsw;
379 print_pagefaults = "1"b;
380
381 call output;
382
383 return;
384
385 %page;
386 get_segment_name:
387 proc (segment_number, dname, ename);
388
389 dcl segment_number fixed bin;
390 dcl dname char (*);
391 dcl ename char (*);
392
393 dcl temp fixed bin;
394
395 if segment_number >= active_all_rings_data_$hcscnt then do;
396 call hcs_$fs_get_path_name (baseptr (segment_number), dname, temp, ename, code);
397 if code ^= 0 then do;
398 dname = "";
399 ename = "*** unknown segment ***";
400 end;
401 else if ^longsw then if ename = "" then ename = ">";
402 end;
403 else do;
404 call ring0_get_$name (dname, ename, baseptr (segment_number), code);
405 dname = "";
406 end;
407
408 end get_segment_name;
409
410 end page_trace;