1
2
3
4
5
6
7
8
9
10
11 db_print: proc (arg_iocb_ptr, arg_output_switch, data_ptr, mode, rel_offset, arg_no_prt, sntp, data_type, data_size);
12
13
14
15
16
17
18
19 dcl arg_iocb_ptr ptr;
20 dcl arg_output_switch char (32);
21 dcl data_type fixed bin;
22 dcl data_size fixed bin;
23 dcl data_ptr ptr,
24 mode char (*) aligned,
25 (rel_offset, arg_no_prt) fixed bin;
26
27
28
29 dcl
30 print_text_ ext entry (ptr, fixed bin, char (*) aligned),
31 db_get_sym ext entry (ptr),
32 get_wdir_ ext entry returns (char (168) aligned),
33 ioa_$ioa_switch entry options (variable),
34 ioa_$ioa_switch_nnl entry options (variable),
35 ioa_$rsnnl entry options (variable),
36 db_line_no ext entry (ptr, fixed bin, fixed bin, fixed bin, fixed bin);
37 dcl comp_8_to_ascii_ entry (bit (*), char (*));
38 dcl gr_print_ entry (char (*));
39 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
40 dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
41 dcl iox_$put_chars entry (ptr, ptr, fixed bin, fixed bin (35));
42 dcl stu_$get_line entry (ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin);
43 dcl com_err_ entry options (variable);
44 dcl condition_ entry (char (*), entry);
45 dcl reversion_ entry (char (*));
46
47
48
49 dcl string char (64),
50 num fixed bin,
51 iocb_ptr ptr,
52 output_switch char (32) aligned;
53
54 dcl
55 i9 fixed bin (9),
56 (no_prt, j, k, first, line_no, no, okp) fixed bin,
57 code fixed bin (35),
58 i fixed bin;
59
60
61 dcl line_offset fixed bin;
62 dcl line_length fixed bin;
63 dcl file fixed bin;
64
65 dcl smap_ptr ptr;
66 dcl packed_ptr ptr unal based (pp);
67 dcl packed_bit_offset bit (6) based (pp);
68
69 dcl hp ptr;
70 dcl pp ptr,
71 based_ptr ptr based;
72
73 dcl
74 bits bit (arg_no_prt) based (pp),
75 cbit_offset char (8) aligned,
76 str char (no_prt) based (pp);
77
78 dcl 1 copy_its aligned like its ;
79
80
81 dcl format char (20) var aligned init ("^6o ^6o ^v(^");
82 dcl per_line fixed bin init (4);
83 dcl octal bit (1) init ("0"b);
84 dcl packed_decimal bit (1) init ("0"b);
85 dcl float bit (1) init ("0"b);
86 dcl (offset, loc) fixed bin;
87 dcl 1 ff aligned based (pp),
88 2 (w0, w1, w2, w3, w4) fixed bin (35);
89 dcl print_err bit (1) init ("1"b);
90
91
92
93 declare (addr, addrel, baseno, binary, divide, fixed, max, min, null, ptr, rel, substr, mod, unspec, hbound) builtin;
94
95
96
97 dcl iox_$user_output ptr ext;
98
99
100
101 dcl bit_loc (8) int static options (constant) init (0, 5, 9, 14, 18, 23, 27, 32);
102 dcl last_source char (32) static init (" ");
103 dcl MODES (21) char (6) static init ("a", "b", "p", "P", "i", "I", "l", "s", "o", "h", "d", "f", "e", "g",
104 "x", "comp-6", "comp-7", "comp-8", "comp-5", "fl", "el");
105
106
107
108 %include component_info;
109 %include db_snt;
110 %include its;
111 %include std_symbol_header;
112 %include source_map;
113 ^L
114
115
116 if arg_iocb_ptr = null then do;
117 iocb_ptr = iox_$user_output;
118 output_switch = "user_output";
119 end;
120 else do;
121 output_switch = arg_output_switch;
122 iocb_ptr = arg_iocb_ptr;
123 end;
124
125 no_prt = max (1, arg_no_prt);
126 pp = data_ptr;
127 offset = rel_offset;
128 loc = fixed (rel (pp), 17);
129
130 call condition_ ("out_of_bounds", oob_handler);
131
132 do j = 1 to hbound (MODES, 1) while (mode ^= MODES (j));
133 end;
134 if j > hbound (MODES, 1) then do;
135 call ioa_$ioa_switch (iocb_ptr, "^NUndefined output mode ""^a""^O", mode);
136 return;
137 end;
138
139 goto label (j);
140
141
142 label (1):
143 label (15):
144
145 call ioa_$ioa_switch_nnl (iocb_ptr, "^6o ^6o """, loc, offset);
146
147 if arg_no_prt > 0 then do;
148 call iox_$put_chars (iocb_ptr, pp, arg_no_prt, code);
149 if code ^= 0 then call com_err_ (code, "debug");
150 end;
151 call ioa_$ioa_switch (iocb_ptr, """");
152 return;
153
154
155 label (2):
156 call ioa_$ioa_switch (iocb_ptr, "^6o ^6o ""^b""b", loc, offset, bits);
157 return;
158
159
160 label (3):
161 label (4):
162
163 if data_size = 36 then no = 1;
164 else no = 2;
165
166 do j = 1 to no_prt;
167
168 if no = 2 then do;
169 if pp -> its.its_mod ^= "100011"b | pp -> its.mod
170 then call ioa_$ioa_switch (iocb_ptr, "^6o ^6o ^w ^w", loc, offset, w0, w1);
171 else do;
172 i9 = fixed (pp -> its.bit_offset, 9);
173 if i9 ^= 0 then call ioa_$rsnnl ("(^d)", cbit_offset, okp, i9);
174 else cbit_offset = "";
175 call ioa_$ioa_switch (iocb_ptr, "^6o ^6o ^o|^o^a", loc, offset, fixed (baseno (pp -> based_ptr), 18), fixed (rel (pp -> based_ptr), 18), cbit_offset);
176 end;
177 end;
178
179 else do;
180 if binary (packed_bit_offset) > 35
181 then call ioa_$ioa_switch (iocb_ptr, "^6o ^6o ^w", loc, offset, pp -> w0);
182 else call ioa_$ioa_switch (iocb_ptr, "^6o ^6o ^p", loc, offset, packed_ptr);
183 end;
184
185 pp = addrel (pp, no);
186 loc = loc + no;
187 offset = offset + no;
188 end;
189 return;
190
191
192 label (5):
193 label (6):
194 if sntp = null then okp = 0;
195 else okp = 1;
196 j = 0;
197
198 do while (j < no_prt);
199
200 if okp = 1 then do;
201
202 call db_line_no (sntp, loc, first, no, line_no);
203 if first < 0 then do;
204 okp = 0;
205 no = no_prt - j;
206 end;
207 else do;
208 call ioa_$ioa_switch (iocb_ptr, "LINE NUMBER ^d", line_no);
209 no = no - loc + first;
210 end;
211 end;
212 else no = no_prt;
213
214 no = min (no, no_prt - j);
215 call print_text_ (pp, no, output_switch);
216 loc = loc + no;
217 pp = addrel (pp, no);
218 j = j + no;
219 end;
220 return;
221
222
223 label (7):
224 do j = 1 to no_prt;
225 call db_line_no (sntp, loc, first, no, line_no);
226 if first < 0 then goto ERROR_NO_LINE;
227 call ioa_$ioa_switch (iocb_ptr, "LINE NUMBER ^d", line_no);
228 call print_text_ (ptr (pp, first), no, output_switch);
229 loc = loc + no;
230 end;
231
232 return;
233
234
235 label (8):
236 call print_source;
237 return;
238
239
240 label (9):
241 label (10):
242 octal = "1"b;
243 format = format || ".3b ^)";
244 if mode = "o" then per_line = 8;
245 call print_data;
246 return;
247
248
249 label (11):
250 label (16):
251 label (17):
252 format = format || "13d^)";
253 call print_data;
254 return;
255
256
257 label (12):
258 float = "1"b;
259 format = format || "8.4f^)";
260 call print_data;
261 return;
262
263
264 label (13):
265 float = "1"b;
266 format = format || "8e^)";
267 call print_data;
268 return;
269
270
271
272 label (20):
273 float = "1"b;
274 format = format || "19.6f^)";
275 call print_data;
276 return;
277
278
279
280 label (21):
281 float = "1"b;
282 format = format || "19e ^)";
283 call print_data;
284 return;
285
286
287 label (14):
288 call gr_print_ (str);
289 return;
290
291
292 label (18):
293 label (19):
294 packed_decimal = "1"b;
295 call print_data;
296 return;
297
298 out:
299 return;
300 ERROR_NO_LINE: call ioa_$ioa_switch (iocb_ptr, "Cannot get line.");
301 return;
302
303
304
305
306
307
308
309
310 print_data: proc;
311
312 dcl same bit (1) init ("0"b);
313 dcl print_equal bit (1);
314 dcl d_size fixed bin;
315 dcl fl (4) float bin (63);
316 dcl fx (4) fixed bin (71);
317 dcl b bit (256);
318 dcl d fixed bin;
319 dcl num_digits fixed bin;
320 dcl check_ptr bit (1) aligned;
321 dcl add_bit bit (1) aligned;
322 dcl next_p ptr;
323
324 dcl fxb (8) fixed bin (35) based (pp);
325 dcl bits (16) bit (d_size) based (pp);
326 dcl based_comp bit (data_size+1) unal based (next_p);
327
328 dcl data_line bit (data_line_len*2) unal based (pp);
329 dcl data_line_len fixed bin;
330
331 d_size = data_size;
332 if d_size = 0 then d_size = 36;
333 if d_size >72 & ^packed_decimal then d_size = 36;
334 data_line_len = d_size * per_line;
335
336
337
338
339
340 check_ptr = "0"b;
341 if packed_decimal then do;
342 num_digits = divide (d_size *2+1, 9, 17, 0);
343 check_ptr = (mod (num_digits, 2) ^= 0);
344 unspec (copy_its) = unspec (pp);
345 num = fixed (copy_its.bit_offset, 6);
346 do i = 1 to 8 while (num > bit_loc (i));
347 end;
348
349
350 if num ^= bit_loc (i) then do;
351 i = min (i, 8);
352 copy_its.bit_offset = substr (unspec (bit_loc (i)), 31, 6);
353 unspec (pp) = unspec (copy_its);
354 end;
355 add_bit = "1"b;
356
357
358
359 if check_ptr then data_line_len = data_line_len +2;
360 end;
361 k = loc - offset;
362
363 do while (no_prt > 0);
364 per_line = min (no_prt, per_line);
365 if same then if print_equal then do;
366 call ioa_$ioa_switch (iocb_ptr, "======");
367 print_equal = "0"b;
368 end;
369 else;
370
371 else do;
372
373 if octal then do;
374 if d_size = 36
375 then call ioa_$ioa_switch (iocb_ptr, format, loc, offset, per_line, bits);
376
377
378 else do;
379 call ioa_$ioa_switch_nnl (iocb_ptr, "^6o ^6o ", loc, offset);
380 do j = 1 to per_line;
381 b = "0"b;
382 d = divide (d_size+2, 3, 17, 0);
383 substr (b, d*3-d_size+1, d_size) = bits (j);
384 call ioa_$ioa_switch_nnl (iocb_ptr, " ^v.3b", d, b);
385 end;
386 call ioa_$ioa_switch (iocb_ptr, "");
387 end;
388 end;
389
390 else if float then do;
391 do j = 1 to per_line;
392 fl (j) = 0;
393 unspec (fl (j)) = unspec (bits (j));
394 end;
395 call ioa_$ioa_switch (iocb_ptr, format, loc, offset, per_line, fl);
396 end;
397
398
399 else if packed_decimal then do;
400 call ioa_$ioa_switch_nnl (iocb_ptr, "^6o ^6o ", loc, offset, per_line);
401 next_p = pp;
402 do j = 1 to per_line;
403 call comp_8_to_ascii_ (based_comp, string);
404 call ioa_$ioa_switch_nnl (iocb_ptr, " ^a", substr (string, 1, num_digits));
405
406 next_p = addr (next_p -> bits (2));
407
408
409 if check_ptr then do;
410 if add_bit then do;
411 unspec (copy_its) = unspec (next_p);
412 num = fixed (copy_its.bit_offset, 6)+1;
413 copy_its.bit_offset = substr (unspec (num), 31, 6);
414 unspec (next_p) = unspec (copy_its);
415 end;
416 add_bit = ^add_bit;
417 end;
418 end;
419 call ioa_$ioa_switch (iocb_ptr, "");
420 end;
421 else do;
422
423 if d_size = 36 then call ioa_$ioa_switch (iocb_ptr, format, loc, offset, per_line, fxb);
424
425 else do;
426 do j = 1 to per_line;
427 if substr (bits (j), 1, 1) = "1"b then fx (j) = -1;
428 else fx (j) = 0;
429 substr (unspec (fx (j)), 73-d_size, d_size) = bits (j);
430 end;
431 call ioa_$ioa_switch (iocb_ptr, format, loc, offset, per_line, fx);
432
433 end;
434 end;
435 end;
436
437 if ^same then print_equal = "1"b;
438
439
440
441 no_prt = no_prt - per_line;
442 if no_prt > 0 then do;
443 if no_prt >= per_line then j = data_line_len;
444 else j = no_prt * d_size;
445 if check_ptr & (no_prt < 4) then same = "0"b;
446 else if substr (data_line, 1, j) = substr (data_line, data_line_len + 1, j) then same = "1"b;
447 else same = "0"b;
448 end;
449 pp = addr (substr (data_line, data_line_len+1, 1));
450 loc = fixed (rel (pp), 17);
451 offset = loc - k;
452
453 end;
454
455 end print_data;
456
457
458
459
460
461
462
463
464 print_source: proc;
465
466 dcl source_based char (2) based (source_ptr);
467 dcl source_dir char (168);
468 dcl source_ent char (32);
469 dcl source_len fixed bin;
470 dcl source_name char (source_len) based (source_name_ptr);
471 dcl source_name_ptr ptr;
472 dcl source_ptr ptr;
473
474 if sntp -> snt.symflag then call db_get_sym (sntp);
475
476 if snt.std then do;
477 hp = snt.headp;
478 call stu_$get_line (hp, loc, no_prt, line_no, line_offset, line_length, file);
479
480 if line_no = -1 | line_length = 0 then go to ERROR_NO_LINE;
481 file = file + 1;
482
483 if hp -> std_symbol_header.source_map = (18)"0"b then go to ERROR_NO_LINE;
484 smap_ptr = addrel (hp, hp -> std_symbol_header.source_map);
485 source_name_ptr = addrel (hp, smap_ptr -> source_map.map (file).pathname.offset);
486 source_len = fixed (smap_ptr -> source_map.map (file).pathname.size, 18);
487
488
489
490 call expand_pathname_ (source_name, source_dir, source_ent, code);
491
492 call hcs_$initiate (source_dir, source_ent, "", 0, 1, source_ptr, code);
493
494
495
496 if source_ptr = null () then do;
497
498 if source_ent = last_source then print_err = "0"b;
499 if print_err then call ioa_$ioa_switch (iocb_ptr, "Cannot initiate source. ^a>^a", source_dir,
500 source_ent);
501
502 source_dir = get_wdir_ ();
503 call hcs_$initiate (source_dir, source_ent, "", 0, 1, source_ptr, code);
504
505 if source_ptr = null () then do;
506 if ^print_err then call ioa_$ioa_switch (iocb_ptr, "Cannot initiate source. ^a>^a",
507 source_dir, source_ent);
508 return;
509 end;
510 if print_err then call ioa_$ioa_switch (iocb_ptr, "Using source ^a>^a", source_dir, source_ent);
511
512 end;
513 last_source = source_ent;
514
515
516
517 call iox_$put_chars (iocb_ptr, addr (substr (source_based, line_offset+1, 1)), line_length, code);
518 call ioa_$ioa_switch (iocb_ptr, "");
519 return;
520 end;
521
522 else call ioa_$ioa_switch (iocb_ptr, "Version 1 object segments are not supported by debug.");
523
524 return;
525
526 end print_source;
527
528
529 oob_handler: proc (mcp, name, x_p, y_p, cont_sw);
530
531
532
533
534
535
536 dcl name char (*);
537 dcl (x_p, y_p) ptr;
538 dcl cont_sw bit (1) aligned;
539
540 %include mc;
541
542
543 scup = addr (mcp -> mc.scu);
544 if scu.tpr.tsr = substr (baseno (pp), 4) then do;
545 call reversion_ ("out_of_bounds");
546 call ioa_$ioa_switch (iocb_ptr, "Request goes beyond end of segment.");
547 go to out;
548 end;
549
550
551
552 cont_sw = "1"b;
553 return;
554
555 end oob_handler;
556 end db_print;