1
2
3
4
5
6
7
8
9
10
11 ts_: tedshow_:
12 proc options (variable);
13 goto start;
14
15 init: entry;
16 stk_init = "1"b;
17 return;
18
19 dcl stk (0:20) char (8) var int static;
20 dcl stkl fixed bin int static init (0);
21 dcl stk_init bit (1) int static init ("1"b);
22 dcl prefix char (1) int static init (" ");
23
24 dcl concat char (1024)var;
25 dcl work char (256) var;
26 dcl token char (8) var;
27 dcl name char (8) var;
28 dcl abp ptr based (arg_p);
29 dcl active bit (1);
30 dcl argct fixed bin;
31 dcl argno fixed bin;
32 dcl arg_l fixed bin (21);
33 dcl arg_p ptr;
34 dcl arg char (arg_l) based (arg_p);
35 dcl code fixed bin (35);
36 dcl CR bit (1);
37 dcl cu_$arg_count entry (fixed bin, fixed bin(35));
38 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35));
39 dcl td fixed bin;
40 dcl tedshow_ entry() options (variable);
41 dcl new_name bit (1);
42 dcl gvx_mark char (1);
43 dcl NLct fixed bin;
44 dcl i fixed bin;
45 dcl ioa_$ioa_switch entry() options(variable);
46 dcl ioa_$ioa_switch_nnl
47 entry() options(variable);
48 dcl printing char (96) int static options (constant) init (
49 " !""#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLM" ||
50 "NOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~");
51
52 start:
53 CR = ""b;
54 concat = "";
55 if stk_init
56 then do;
57 stk_init = "0"b;
58 stk(*)="???";
59 stkl = 0;
60 prefix = "@";
61 end;
62
63 call cu_$arg_count (argct, code);
64 if (code ^= 0)
65 then do;
66 call com_err_ (code, "tedshow_");
67 return;
68 end;
69 call cu_$arg_ptr (1, arg_p, arg_l, code);
70 if (code ^= 0)
71 then do;
72 call com_err_ (code, "tedshow_");
73 return;
74 end;
75 bp = abp;
76 dbase_p = ptr (bp, 0);
77 if (dbase.version ^= dbase_vers_3)
78 | (verify (dbase.rq_id, "0123456789.") ^= 0)
79 | (verify (dbase.dir_db, printing) ^= 0)
80 | (verify (dbase.person, printing) ^= 0)
81 | (verify (dbase.project, printing) ^= 0)
82 then dbase_p = null();
83 else do;
84 dcl set_lock_$lock entry (bit(36) aligned, fixed bin, fixed bin(35));
85 dcl error_table_$locked_by_this_process fixed bin(35) ext static;
86 if (dbase.recurs = 0)
87 | (dbase.lock = ""b)
88 then active = ""b;
89 else do;
90
91
92
93 call set_lock_$lock ((dbase.lock), -1, code);
94
95 if (code = error_table_$locked_by_this_process)
96 then active = "1"b;
97 else active = ""b;
98 end;
99 end;
100 name = stk(stkl);
101 prefix = " ";
102 new_name = ""b;
103 do argno = 2 to argct;
104 call cu_$arg_ptr (argno, arg_p, arg_l, code);
105 concat = concat || " ";
106 concat = concat || arg;
107 work = ltrim (arg);
108 do while (work ^= "");
109 token = before (work, " ");
110 if new_name
111 then do;
112 new_name = ""b;
113 name = token;
114 if (prefix = "..")
115 then call ioa_$ioa_switch (db_output, "^a", name);
116 else do;
117 do td = 1 to stkl while (stkl > 0);
118 call ioa_$ioa_switch_nnl (db_output,
119 "^[>^;:^]^a", (td = 1), stk (td));
120 end;
121 call ioa_$ioa_switch (db_output, "^[>^;:^]^a", (stkl < 1), name);
122 if (prefix = ">")
123 then do;
124 stkl = min (hbound (stk, 1), stkl + 1);
125 stk (stkl) = name;
126 end;
127 end;
128 end;
129 else do;
130 if (substr (token, length (token), 1) = ",")
131 then do;
132 NLct = 0;
133 token = substr (token, 1, length (token) - 1);
134 end;
135 else NLct = 1;
136 if (token = "*")
137 | (token = "<")
138 then do;
139 prefix = token;
140 end;
141 else if (token = ">")
142 | (token = ".")
143 | (token = "..")
144 then do;
145 prefix = token;
146 new_name = "1"b;
147 end;
148 else if (substr (token, 1, 1) = "[")
149 then do;
150 token = "";
151 call heading;
152 i = index (work, "]");
153 if (i = 0)
154 then i = length (work) - 1;
155 else i = i - 2;
156 call ioa_$ioa_switch_nnl (db_output,
157 "^a", substr (work, 2, i));
158 CR = "1"b;
159 work = substr (work, i+1);
160 end;
161 else if (token = "max")
162 then do;
163 token = ":";
164 call heading;
165 call ioa_$ioa_switch (db_output, "b(^a) max= 1:^i(^i^[ PSEUDO^]",
166 b.name, b.maxl, b.maxln, b.pseudo);
167 last_bname = b.name;
168 end;
169 else if (token = "re")
170 then do;
171 if (dbase_p = null())
172 then goto not_avail;
173 call tedsrch_$dis_exp (addr (dbase.regexp));
174 end;
175 else if (token = "cf")
176 then do;
177 comptr = bp;
178 gvx_mark = "";
179 call cf_dumper;
180 end;
181 else if (token = "gvx")
182 then do;
183 comptr = bp;
184 call gvx_dumper;
185 end;
186 else if (token = "b_")
187 then call des (addr (b.b_));
188 else if (token = "b_*")
189 then do;
190 if (dbase_p = null())
191 then goto not_avail;
192 do i = 0 to dbase.bufnum;
193 bp = addr (DATABASE.cb(i));
194 call ioa_$ioa_switch_nnl (db_output,
195 "b(^a)^21t^15p spa=^2i,^2i,^2i ",
196 b.name, b.cur.sp, b.cur.sn, b.cur.pn, b.cur.ast);
197 call des$no_last (addr (b.b_));
198 end;
199 end;
200 else if (substr (token, 1, 2) = "b(")
201 & (substr (token, length (token), 1) = ")")
202 then do;
203 if (dbase_p = null())
204 then goto not_avail;
205 token = substr (token, 3, length (token) - 3);
206 bp = null();
207 do i = 0 to dbase.bufnum;
208 bp = addr (DATABASE.cb(i));
209 if (b.name = token)
210 then goto found;
211 end;
212 call ioa_$ioa_switch (db_output, "*** b(^a) not found", token);
213 return;
214 found:
215 call ioa_$ioa_switch (db_output, "
216 end;
217 else if (token = "nb")
218 then call des (addr (b.newb));
219 else if (token = "ex")
220 then call des (addr (b.ex));
221 else if (token = "bx")
222 then do;
223 token = "b_";
224 call des (addr (b.b_));
225 token = "ex";
226 call des (addr (b.ex));
227 end;
228 else if (token = "so.ex")
229 then do;
230 if (dbase_p = null())
231 then goto not_avail;
232 sv_p = ptr (dbase.seg_p (3), b.stack_o);
233 token = "sex";
234 call des (addr (sv.ex));
235 end;
236 else if (token = "so.a0")
237 then do;
238 if (dbase_p = null())
239 then goto not_avail;
240 sv_p = ptr (dbase.seg_p (3), b.stack_o);
241 token = "sa0";
242 call des (addr (sv.a0));
243 end;
244 else if (token = "a0")
245 then do;
246 ad_b, ad_e = 0;
247 goto do_adr;
248 end;
249 else if (token = "a1")
250 then do;
251 ad_b, ad_e = 1;
252 goto do_adr;
253 end;
254 else if (token = "a2")
255 then do;
256 ad_b, ad_e = 2;
257 goto do_adr;
258 end;
259 else if (token = "adr")
260 then do;
261 ad_b = 0;
262 ad_e = 2;
263 hold_prefix = prefix;
264 prefix = " ";
265 dcl hold_prefix char (1);
266 dcl (ad_b, ad_e) fixed bin;
267 do_adr:
268 if (ad_b ^= ad_e)
269 then do;
270 prefix = hold_prefix;
271 token = "b_";
272 call des (addr (b.b_));
273 end;
274 do i = ad_b to ad_e;
275 token = "a";
276 token = token || ltrim (char (i));
277 if b.present (i)
278 then token = token || "p";
279 call des (addr (b.a_ (i)));
280 end;
281 end;
282 else if (token = "cd")
283 then call des (addr (b.cd));
284 else if (token = "gb")
285 then call des (addr (b.gb));
286 else if (token = "na")
287 then call des (addr (b.newa));
288 else if (token = "rt")
289 then call des (addr (b.rel_temp));
290 else if (token = "t0")
291 then call des (addr (b.temp (0)));
292 else if (token = "t1")
293 then call des (addr (b.temp (1)));
294 else if (token = "t2")
295 then call des (addr (b.temp (2)));
296 else if (token = "rl")
297 then do;
298 if (dbase_p = null())
299 then goto not_avail;
300 call pspa (addr (dbase.rl.part1));
301 token = "";
302 call des$no_last (addr (dbase.rl.part2));
303 end;
304 else if (token = "cur")
305 then call pspa (addr (b.cur));
306 else if (token = "pend")
307 then do;
308 if (unspec (b.pend) ^= unspec (b.cur))
309 then call pspa (addr (b.pend));
310 end;
311 else if (token = "base")
312 then do;
313 if (dbase_p = null())
314 then goto not_avail;
315 call dump_stk (1);
316 call dump_base;
317 end;
318 else if (token = "segs")
319 then do;
320 if (dbase_p = null())
321 then goto not_avail;
322 call segs;
323 end;
324 else if (token = "bcb")
325 then call bcb;
326 else if (token = "stkall")
327 then do;
328 if (dbase_p = null())
329 then goto not_avail;
330 call dump_stk (1);
331 end;
332 else if (token = "stktop")
333 then do;
334 if (dbase_p = null())
335 then goto not_avail;
336 call dump_stk (dbase.stk_info.level);
337 end;
338 else if (substr (token, 1, 1) = "?")
339 then do;
340 if (token = "?")
341 then do;
342 do qm = 1 to hbound (item, 1);
343 call ioa_$nnl (" ""^a""", substr (item(qm), 1, 6));
344 end;
345 call ioa_$nnl ("^2/");
346 end;
347 else do;
348 token = substr (token, 2);
349 done = ""b;
350 do qm = 1 to hbound (item, 1) while (^done);
351 if (substr (item(qm), 1, 6) = token)
352 then do;
353 call ioa_$nnl ("^7a ^a^/", token, substr (item(qm), 7));
354 done = "1"b;
355 end;
356 end;
357 if ^done
358 then call ioa_$nnl ("""^a"" is not defined^/", token);
359 end;
360
361
362 dcl qm fixed bin;
363 dcl done bit (1);
364 dcl ioa_$nnl entry() options(variable);
365 dcl item (39) char (18) int static options (constant) init (
366 "?
367 "?X
368 "*
369 ".
370 "..
371 "<
372 "> X
373 "[X
374 "[X]
375 "a0
376 "a1
377 "a2
378 "adr
379 "b_
380 "b_*
381 "base
382 "bcb
383 "bx
384 "cd
385 "cf
386 "cur
387 "ex
388 "gb
389 "gvx
390 "max
391 "na
392 "nb
393 "pend
394 "re
395 "rl
396 "rt
397 "segs
398 "so.a0
399 "so.ex
400 "stkall
401 "stktop
402 "t0
403 "t1
404 "t2
405 end;
406 else do;
407 call ioa_$ioa_switch (db_output, "??? ^a", token);
408 end;
409 if (prefix = "<") & (token ^= "<")
410 then do;
411 do td = 1 to stkl while (stkl > 0);
412 call ioa_$ioa_switch_nnl (db_output,
413 "^[^/^]^1a^a", CR, prefix, stk (td));
414 CR = ""b;
415 prefix = ":";
416 end;
417 call ioa_$ioa_switch (db_output, "");
418 stkl = max (0, stkl - 1);
419 name = stk (stkl);
420 prefix = " ";
421 end;
422 end;
423 work = ltrim (after (work, " "));
424 end;
425 end;
426 if CR then call ioa_$ioa_switch (db_output, "");
427 return;
428
429 not_avail:
430 call ioa_$ioa_switch (db_output, "tedshow_: dbase_p not available to do ^a.", token);
431 return;
432
433 heading: proc;
434
435 if move_right
436 then call ioa_$ioa_switch_nnl (db_output,
437 "^2-");
438 call ioa_$ioa_switch_nnl (db_output,
439 " :^4a", token);
440
441 end heading;
442
443 des: proc (bd_p);
444 dcl bd_p ptr;
445
446 dcl 1 bd like buf_des based (bd_p);
447
448 if (last_bname ^= b.name)
449 then do;
450 call ioa_$ioa_switch (db_output, "^2- :
451 last_bname = b.name;
452 end;
453 if (unspec (bd) = unspec (tedcommon_$no_data))
454 then do;
455 return;
456 end;
457
458 des$no_last: entry (bd_p);
459
460 call heading;
461 call ioa_$ioa_switch (db_output,
462 "l=^4i:^i(^i^v.1tr=^4i:^i(^i^[ lv=^i
463 ^6xex_next:ex_EOD^v.1tex_lre:ex_last^]",
464 bd.l.le, bd.l.re, bd.l.ln, indent,
465 bd.r.le, bd.r.re, bd.r.ln, (token="ex"), dbase.stk_info.level, indent);
466 end des; %skip (2);
467 pspa: proc (sd_p);
468 dcl (
469 sd_p ptr
470 ) parm;
471 dcl 1 sd like seg_des based (sd_p);
472
473
474
475 if (unspec (sd) = unspec (tedcommon_$no_seg))
476 then do;
477 return;
478 end;
479 call heading;
480 call ioa_$ioa_switch (db_output,
481 "^p sn=^i pn=^i ast=^i^[(255K)^;(64K)^;(16K)^;(4K)^;(1K)^]",
482 sd.sp, sd.sn, sd.pn, sd.ast, sd.ast);
483
484 end pspa; %skip (3);
485 segs: proc;
486
487 call ioa_$ioa_switch (db_output, " .. ................ r/u c/l");
488 do i = -1 to dbase.seg_ct;
489 if (dbase.seg_p (i) ^= null ())
490 then do;
491 if active
492 then do;
493 call hcs_$fs_get_path_name (dbase.seg_p (i),
494 dname, 0, ename, code);
495 if (code ^= 0) then call com_err_ (code, "get_pn", "^p",
496 dbase.seg_p (i));
497 call hcs_$status_long (dname, ename, 1, addr (sb),
498 null(), code);
499 if (code ^= 0) then call com_err_ (code, "stat_lg", "^a > ^a",
500 dname, ename);
501 call ioa_$ioa_switch_nnl (db_output,
502 " ^2i ^16p ^3i ^3i", i, dbase.seg_p (i),
503 sb.records_used, sb.current_length);
504 end;
505 else call ioa_$ioa_switch_nnl (db_output,
506 " ^2i ^16p ??? ???", i, dbase.seg_p (i));
507
508 if (i = 0)
509 then call ioa_$ioa_switch (db_output, " segs=^b",
510 substr (dbase.inuse_seg,1,dbase.seg_ct));
511 else if (i = 1)
512 then call ioa_$ioa_switch (db_output, " 1K=^b 4K=^b", dbase.inuse_1K,dbase.inuse_4K);
513 else if (i = 2)
514 then call ioa_$ioa_switch (db_output, " 16K=^b", dbase.inuse_16K);
515 else call ioa_$ioa_switch (db_output, "");
516 end;
517 end;
518
519 dcl hcs_$status_long entry (char(*), char(*), fixed bin(1), ptr, ptr,
520 fixed bin(35));
521 dcl hcs_$fs_get_path_name entry (ptr, char(*), fixed bin, char(*),
522 fixed bin(35));
523 dcl dname char (168);
524 dcl ename char (32);
525 dcl code fixed bin (35);
526 %include status_structures;
527 dcl 1 sb like status_branch;
528
529
530 end segs;
531 dump_base: proc;
532
533
534 call ioa_$ioa_switch (db_output, " version=^i recurs=^i bwd=^p cba_p=^p eval_p=^p",
535 dbase.version, dbase.recurs, dbase.bwd, dbase.cba_p, dbase.eval_p);
536 call segs;
537
538 call ioa_$ioa_switch (db_output, " inuse:16K=^.b 4K=^.b 1K=^.b seg=^.b",
539 dbase.inuse_16K, dbase.inuse_4K, dbase.inuse_1K,
540 substr (dbase.inuse_seg, 1, dbase.seg_ct + 1));
541 dcl date_time_ entry options (variable) returns (char (21));
542 call ioa_$ioa_switch (db_output, " time=^a ^a seg_ct=^i argct=^i S_count=^i",
543 date_time_ (dbase.time), dbase.rq_id, dbase.seg_ct, dbase.argct,
544 dbase.S_count);
545 call ioa_$ioa_switch (db_output, " not_read_ct=^i at_break=^i bufnum=^i lock=^.3b",
546 dbase.not_read_ct, dbase.at_break, dbase.bufnum, dbase.lock);
547 call ioa_$ioa_switch (db_output, " cb_c_r=^6.3b cb_w_r=^6.3b", dbase.cb_c_r, dbase.cb_w_r);
548 call ioa_$ioa_switch (db_output, " ^[ flow^]^[ break^]^[ edit^]^[ input^]^[ old^]"
549 || "^[ read^]^[ lit^]",
550 dbase.flow_sw, dbase.break_sw, dbase.edit_sw, dbase.input_sw,
551 dbase.old_style, dbase.read_sw, dbase.lit_sw);
552 call ioa_$ioa_switch (db_output, " name=^a ^a.^a comment=^a", dbase.tedname,
553 dbase.person, dbase.project, dbase.comment);
554 call ioa_$ioa_switch (db_output, " dir_db=^a^[ REMOTE^]", dbase.dir_db, dbase.remote_sw);
555 call ioa_$ioa_switch (db_output, " error=""^a"" err_go=""^a""", dbase.err_msg, dbase.err_go);
556 call tedshow_ (dbase_p, "rl");
557
558 do i = 0 to dbase.bufnum;
559 call tedshow_ (addr (DATABASE.cb(i)),
560 "..", ltrim(char(i)), "bcb");
561 end;
562
563 end dump_base;
564 dcl 1 DATABASE based (dbase_p),
565 2 zzzzzz like dbase,
566 2 cb (0:DATABASE.bufnum) like b;
567 dump_stk: proc (lower);
568 dcl lower fixed bin (21);
569 dcl seg_fault_error condition;
570 dcl j fixed bin (21);
571 dcl tbp ptr;
572 dcl str char (2048)based;
573
574 on condition (seg_fault_error)
575 begin;
576 call ioa_$ioa_switch (db_output, " curp=x|x top=x level=x next=x");
577 goto seg_flt;
578 end;
579 call ioa_$ioa_switch (db_output, " curp=^p top=^p level=^d next=^d",
580 dbase.stk_info.curp, dbase.stk_info.top, dbase.stk_info.level,
581 dbase.stk_info.next);
582 if (dbase.seg_p (3) = null ()) | (dbase.stk_info.level = 0) | ^active
583 then return;
584 sv_p = dbase.stk_info.top;
585 dcl dd (2) char (80)var int static options(constant) init (
586 " lvl) this ...sv..... ...bcb.... (lines) .link. b.ex..",
587 "^04i) ^04i ^00000010p ^00000010p (^005i) ^06.3b ^4i,^4i,^4i,^4i^/^-b(^a) pn=^i");
588 call ioa_$ioa_switch (db_output, dd (1));
589 do i = dbase.stk_info.level to lower by -1;
590 tbp = sv.bp;
591 call tedcount_lines_ (tbp, 1, tbp -> b.maxl, j);
592 call ioa_$ioa_switch (db_output, dd (2), i, sv.this, sv_p, tbp, j, sv.stackl, sv.ex.l.le,
593 sv.ex.l.re, sv.ex.r.le, sv.ex.r.re, tbp -> b.name, sv.pn);
594 if (sv.pn > 0)
595 then call ioa_$ioa_switch (db_output, "^2-""^va""", sv.pl (0),
596 substr (sv.pp (0) -> str, 1, sv.pl (0)));
597 sv_p = sv.prev;
598 end;
599 seg_flt:
600 revert condition (seg_fault_error);
601 end dump_stk;
602
603 bcb: proc;
604
605 call heading;
606 if (b.name = "")
607 then do;
608 call ioa_$ioa_switch (db_output, " ^10p EMPTY", bp);
609 end;
610 else do;
611 call ioa_$ioa_switch (db_output, " ^10p old=^i,^i new=^i,^i",
612 bp, b.old.le, b.old.re, b.new.le, b.new.re);
613 stkl = stkl + 1;
614 stk (stkl) = "..";
615 call tedshow_ (bp, "max cur b_ nb ex a0 a1 a2 cd gb na rt t0 t1 t2");
616 stkl = stkl - 1;
617 if b.mod_sw | b.terminate | b.get_bit_count | b.force_name
618 | b.no_io | b.not_pasted | b.initiate | b.ck_ptr_sw
619 then call ioa_$ioa_switch (db_output, " ^[ mod^]^[ term^]^[ getbc^]^[ force^]"
620 || "^[ ^I/O^]^[ ^^paste^]^[ init^]^[ ckptr^]",
621 b.mod_sw, b.terminate, b.get_bit_count, b.force_name, b.no_io,
622 b.not_pasted, b.initiate, b.ck_ptr_sw);
623 if (b.dname ^= "")
624 then call ioa_$ioa_switch (db_output, "^12x^a^[ > ^a ^a ^a^[ [trust]^]^]",
625 b.dname, b.file_sw, b.ename, b.kind, b.cname,
626 b.trust_sw);
627 end;
628 end bcb;%page;
629 gvx_dumper: proc;
630 dcl ti fixed bin;
631
632 call ioa_$ioa_switch (db_output, "^[^14p^;^s^]max=^i tot=^i srch=^i mk=^i ic=^i", db_gv,
633 comptr, gvx.max_len, gvx.tot_len, gvx.srch_len, gvx.mk_list, gvx.ic);
634
635 ti = gvx.ic;
636 gvx_mark = "~";
637 gvx.ic = 1;
638 do while (gvx.ic < gvx.tot_len);
639 if (gvx.ic = gvx.srch_len+1)
640 then call ioa_$ioa_switch (db_output, "^[^14x^] |
641 call cf_dumper;
642 gvx.ic = gvx.ic + cf.siz;
643 end;
644 call ioa_$ioa_switch (db_output, "^[^14p^;^s^] |
645 addr (gvx.word (gvx.ic)), gvx.tot_len);
646 gvx.ic = ti;
647
648 end gvx_dumper;%skip(5);
649 cf_dumper: proc;
650
651 re_dump:
652 if (gvx.ic > gvx.tot_len)
653 then do;
654 call ioa_$ioa_switch (db_output, "ERROR: ic=^i > tot=^i", gvx.ic, gvx.tot_len);
655 return;
656 end;
657 cfp = addr (gvx.word (gvx.ic));
658 call ioa_$ioa_switch_nnl (db_output,
659 "^[^14p^;^s^]^1a^[^p^-^;^s^]^3i# ^2iop ^3isiz ^3ilen ",
660 db_gv, cfp, gvx_mark, lg_sw, cfp, gvx.ic, cf.op, cf.siz, cf.len);
661 if (cf.op >= -7) & (cf.op <= 22)
662 then goto show (cf.op);
663 call ioa_$ioa_switch (db_output, " ERROR");
664 return;
665
666 show (-7):
667 call ioa_$ioa_switch (db_output, "success");
668 return;
669 show (-6):
670 call ioa_$ioa_switch (db_output, "t=^i f=^i //", cft.t, cft.f);
671 exp_p = addr (cft.cexpml);
672 goto regexp;
673 show (-5):
674 call ioa_$ioa_switch (db_output, "t=^i f=^i ^a", cft.t, cft.f, cft.da);
675 return;
676 show (-4):
677 call ioa_$ioa_switch (db_output, "(r) ^a", cf.da);
678 return;
679 show (-3):
680 call ioa_$ioa_switch (db_output, "^a\=", cf.da);
681 return;
682 show (-2):
683 call ioa_$ioa_switch (db_output, "&");
684 return;
685 show (-1):
686 call ioa_$ioa_switch (db_output, """^va""", cf.len, cf.da);
687 return;
688 show (00):
689 call ioa_$ioa_switch (db_output, "EOP");
690 return;
691 show (01):
692 call ioa_$ioa_switch (db_output, "(^i,^i)", cfa.ad1, cfa.ad2);
693 return;
694 show (04):
695 show (05):
696 show (06):
697 show (07):
698 call ioa_$ioa_switch (db_output, "^a(^.3b) ^i", substr (op_mnem, cf.op, 1), cfmk.cb_r,
699 cfmk.link);
700 return;
701 show (11):
702 show (12):
703 call ioa_$ioa_switch (db_output, "^a|^a|", substr (op_mnem, cf.op, 1), cf.da);
704 return;
705 show (17):
706 call ioa_$ioa_switch (db_output, "^a", cf.da);
707 return;
708 show (18):
709 show (19):
710 show (20):
711 call ioa_$ioa_switch (db_output, "^a ^va\f", substr (op_mnem, cf.op, 1), cf.len, cf.da);
712 return;
713 show (08):
714 show (15):
715 show (16):
716 call ioa_$ioa_switch (db_output, "^a/.../", substr (op_mnem, cf.op, 1));
717 exp_p = addr (cfx.cexpml);
718 regexp:
719 call tedsrch_$dis_exp (exp_p);
720 return;
721
722 dcl exp_p ptr;
723
724 show (02):
725 show (03):
726 show (09):
727 show (10):
728 show (13):
729 show (14):
730 show (22):
731 call ioa_$ioa_switch (db_output, "^a", substr (op_mnem, cf.op, 1));
732 return;
733 show (21):
734 call ioa_$ioa_switch (db_output, "SP shouldn't be here");
735 return;
736
737
738
739 dcl op_mnem char (22) int static init ("(pPKMkmsd=tTlLuU{aci >");
740
741 end cf_dumper;%skip(3);
742 dcl com_err_ entry() options(variable);
743 dcl tedsrch_$dis_exp entry (ptr);
744 dcl last_bname char(16) int static init ("");
745 dcl (
746 addr, after, before, char, hbound, index, length, ltrim, max, min, null, ptr, substr, unspec, verify
747 ) builtin;
748
749 bf: entry; indent = 17; return;
750 dcl indent fixed bin int static init (26);
751 mlf: entry; move_right = ""b; return;
752 mln: entry; move_right = "1"b; return;
753 dcl move_right bit (1) int static init (""b);
754 lgf: entry; lg_sw = ""b; return;
755 lgn: entry; lg_sw = "1"b; return;
756 dcl lg_sw bit (1) int static init (""b);
757 %include tedgvd;
758 %include tedcommon_;
759 %include tedbcb;
760 %include tedbase;
761 %include tedstk;
762 dcl tedcount_lines_ entry (
763 ptr,
764 fixed bin (21),
765 fixed bin (21),
766 fixed bin (21)
767 );
768
769
770 end tedshow_;