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 display_text: proc (t_pt, r_pt, s_pt, delta, number);
26
27
28
29 dcl t_pt ptr,
30 r_pt ptr,
31 s_pt ptr,
32 delta fixed bin,
33 number fixed bin;
34
35 dcl (p, q, s, sym_pt, tok_pt, line_pt, pt) ptr,
36 (i, j, k, m, mop, n, save_k, irand, nrands, ndesc) fixed bin,
37 (fract_offset, offset, size, scale) fixed bin (18),
38 (ignore_ic_mod, double, eis, eis_desc, need_comma, ext_base, itag, has_ic, decimal) bit (1),
39 ht char (1) int static aligned init (" "),
40 htht char (2) int static aligned init (" "),
41 c char (1),
42 cstring char (12),
43 op_code char (5),
44 tag char (3),
45 line char (256);
46
47
48
49 dcl binoct entry (aligned bit (*)) returns (char (12) aligned),
50 pl1_print$string_ptr_nl entry (ptr, fixed bin);
51
52
53
54 dcl (cg_static_$text_pos fixed bin,
55 pl1_operators_$operator_table,
56 pl1_operator_names_$first fixed bin (18),
57 pl1_operator_names_$pl1_operator_names_
58 ) external static;
59
60
61
62 dcl (addr, addrel, char, divide, fixed, length, ltrim, min, null, ptr, rel, string, substr) builtin;
63
64 %include operator_names;
65
66 %include op_mnemonic_dcl_;
67
68 dcl 1 name_pair aligned based (p),
69 2 rel_ptr unaligned bit (18),
70 2 size unaligned bit (18);
71
72 dcl based_string aligned char (size) based (p);
73
74 dcl digit (0:9) char (1) aligned int static
75 init ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9");
76
77 dcl relocation (-1:11) char (1) aligned int static
78 init ("a", "t", "1", "2", "3", "l", "d", "s", "7", "8", "i", "r", "e");
79
80 dcl base (0:7) char (4) aligned int static
81 init ("pr0|", "pr1|", "pr2|", "pr3|", "pr4|", "pr5|", "pr6|", "pr7|");
82
83 dcl modifier (0:63) char (3) aligned int static
84 init ("n", "au", "qu", "du", "ic", "al", "ql", "dl",
85 "0", "1", "2", "3", "4", "5", "6", "7",
86 "*", "au*", "qu*", "...", "ic*", "al*", "ql*", "...",
87 "0*", "1*", "2*", "3*", "4*", "5*", "6*", "7*",
88 (8) (1)"...",
89 (8) (1)"...",
90 "*n", "*au", "*qu", "...", "*ic", "*al", "*ql", "...",
91 "*0", "*1", "*2", "*3", "*4", "*5", "*6", "*7");
92
93 dcl word (0:1) bit (36) aligned based (p);
94
95 dcl 1 instruction based (p) aligned,
96 2 base unaligned bit (3),
97 2 offset unaligned bit (15),
98 2 op_code unaligned bit (10),
99 2 unused unaligned bit (1),
100 2 ext_base unaligned bit (1),
101 2 tag unaligned bit (6);
102
103 dcl 1 half based (p) aligned,
104 2 left unaligned bit (18),
105 2 right unaligned bit (18);
106
107 dcl 1 rel_tab based (p) aligned,
108 2 dummy_l unaligned bit (14),
109 2 left unaligned bit (4),
110 2 dummy_r unaligned bit (14),
111 2 right unaligned bit (4);
112
113 dcl 1 mod_factor aligned,
114 2 ext_base bit (1) unal,
115 2 length_in_reg bit (1) unal,
116 2 indirect_descriptor bit (1) unal,
117 2 tag bit (4) unal;
118
119 dcl mf (3) fixed bin (6) int static init (30, 12, 3);
120
121 dcl 1 packed_ptr_st based aligned,
122 2 packed_ptr ptr unal;
123
124 dcl (ebase, len_reg, ic) (3) bit (1) aligned;
125 dcl desc_word char (8) varying;
126
127 dcl desc_op (0:9) char (8) varying int static
128 init ("desc9a", "descb", "desc9fl", "desc9ls", "desc9ts", "desc9ns", "desc4fl", "desc4ls", "desc4ts", "desc4ns");
129
130 dcl eis_modifier (0:15) char (3) aligned int static
131 init ("n", "au", "qu", "du", "ic", "al", "ql", "...",
132 "x0", "x1", "x2", "x3", "x4", "x5", "x6", "x7");
133
134 dcl bool_word (0:15) char (6) aligned int static varying
135 init ("clear", "and", "andnot", "move", "andnot", "", "xor", "or",
136 "", "", "", "", "invert", "", "nand", "set");
137
138 dcl 1 descriptor based aligned,
139 2 address bit (18) unal,
140 2 char bit (2) unal,
141 2 bit bit (4) unal,
142 2 length bit (12) unal;
143
144 dcl 1 four_bit_descriptor based aligned,
145 2 address bit (18) unal,
146 2 char bit (3) unal,
147 2 bit bit (3) unal,
148 2 length bit (12) unal;
149
150 %include symbol;
151 %include token;
152 %include declare_type;
153 %include cgsystem;
154 %include nodes;
155
156 begin: p = addrel (t_pt, delta);
157 q = addrel (r_pt, delta);
158 s = addrel (s_pt, delta);
159
160 line_pt = addr (line);
161 eis = "0"b;
162 irand = 0;
163
164 do i = 1 to number;
165
166 tag = " ";
167 substr (line, 1, 6) = binoct (rel (p));
168 substr (line, 7, 2) = " ";
169
170 call insert_relocation;
171
172 cstring = binoct (p -> word (0));
173
174 if ^eis
175 then do;
176 mop = fixed (p -> instruction.op_code, 10);
177 op_mnemonic_ptr = addr (op_mnemonic_$op_mnemonic_ (mop));
178 op_code = op_mnemonic.name;
179 end;
180 else do;
181 mop = 0;
182 op_mnemonic_ptr = addr (op_mnemonic_$op_mnemonic_ (0));
183 end;
184
185 if op_code = ".... "
186 then do;
187 not_ins: substr (line, 13, 3) = " ";
188 substr (line, 16, 5) = substr (cstring, 1, 5);
189 substr (line, 21, 7) = substr (cstring, 6, 7);
190 k = 28;
191 goto prt;
192 end;
193
194 if op_mnemonic.num_words > 1
195 then do;
196
197
198
199 call init_eis;
200
201 substr (line, 13, 4) = substr (cstring, 1, 3);
202 substr (line, 17, 4) = substr (cstring, 4, 3);
203 substr (line, 21, 4) = substr (cstring, 7, 3);
204 substr (line, 25, 3) = substr (cstring, 10, 3);
205
206 substr (line, 28, 1) = ht;
207 substr (line, 29, 5) = op_code;
208 substr (line, 34, 1) = ht;
209
210 k = 35;
211
212 do j = 1 to ndesc;
213 string (mod_factor) = substr (p -> word (0), mf (j), 7);
214 ebase (j) = mod_factor.ext_base;
215 len_reg (j) = mod_factor.length_in_reg;
216
217 substr (line, k, 1) = "(";
218 k = k + 1;
219 need_comma = "0"b;
220
221 if ebase (j)
222 then do;
223 substr (line, k, 2) = "pr";
224 k = k + 2;
225 need_comma = "1"b;
226 end;
227
228 if len_reg (j)
229 then do;
230 if need_comma
231 then do;
232 substr (line, k, 1) = ",";
233 k = k + 1;
234 end;
235 substr (line, k, 2) = "rl";
236 k = k + 2;
237 need_comma = "1"b;
238 end;
239
240 if mod_factor.tag
241 then do;
242 if need_comma
243 then do;
244 substr (line, k, 1) = ",";
245 k = k + 1;
246 end;
247 ic (j) = mod_factor.tag = "0100"b;
248 substr (line, k, 2) = eis_modifier (fixed (mod_factor.tag, 4));
249 k = k + 2;
250 end;
251 else ic (j) = "0"b;
252
253 substr (line, k, 2) = "),";
254 k = k + 2;
255 end;
256
257
258 if substr (p -> word (0), 10, 1)
259 then do;
260 substr (line, k, 12) = "enablefault,";
261 k = k + 12;
262 end;
263
264 if desc_word = "desc9a" | desc_word = "desc4a"
265 then if ndesc < 3
266 then if (substr (op_code, 1, 3) ^= "scd") & (substr (op_code, 1, 3) ^= "tct")
267 then do;
268 if substr (op_code, 1, 3) = "scm"
269 then substr (line, k, 5) = "mask(";
270 else substr (line, k, 5) = "fill(";
271
272 k = k + 5;
273 substr (line, k, 3) = substr (cstring, 1, 3);
274 k = k + 3;
275 substr (line, k, 1) = ")";
276 k = k + 1;
277 end;
278 else k = k - 1;
279 else k = k - 1;
280 else if desc_word = "descb"
281 then do;
282 substr (line, k, 5) = "fill(";
283 k = k + 5;
284 substr (line, k, 1) = digit (fixed (substr (p -> word (0), 1, 1), 1));
285 k = k + 1;
286 substr (line, k, 1) = ")";
287 k = k + 1;
288 if op_code ^= "cmpb "
289 then do;
290 substr (line, k, 6) = ",bool(";
291 k = k + 6;
292 j = fixed (substr (p -> word (0), 6, 4), 4);
293 m = length (bool_word (j));
294 if m > 0
295 then do;
296 substr (line, k, m) = bool_word (j);
297 k = k + m;
298 end;
299 else do;
300 substr (line, k, 1) = digit (fixed (substr (p -> word (0), 6, 1), 1));
301 substr (line, k + 1, 1) = digit (fixed (substr (p -> word (0), 7, 3), 3));
302 k = k + 2;
303 end;
304 substr (line, k, 1) = ")";
305 k = k + 1;
306 end;
307 end;
308 else if substr (p -> word (0), 11, 1)
309 then do;
310 substr (line, k, 5) = "round";
311 k = k + 5;
312 end;
313 else k = k - 1;
314
315 irand = 0;
316 go to prt;
317 end;
318
319 double, ignore_ic_mod = "0"b;
320
321 eis_desc = eis & desc_word ^= "arg";
322 if eis_desc
323 then do;
324 substr (line, 13, 2) = " ";
325 substr (line, 15, 6) = substr (cstring, 2, 5);
326 substr (line, 21, 3) = substr (cstring, 7, 2);
327 substr (line, 24, 4) = substr (cstring, 9, 4);
328
329 substr (line, 28, 1) = ht;
330
331 if decimal
332 then desc_word = desc_op (2 + fixed (p -> four_bit_descriptor.bit, 3));
333 else if desc_word = "desc9a" & p -> four_bit_descriptor.bit = "100"b
334 then desc_word = "desc4a";
335 if irand > 1
336 then if op_code = "dtb " | op_code = "mvne "
337 then desc_word = desc_op (0);
338 else ;
339 else if op_code = "btd "
340 then desc_word = desc_op (0);
341
342 substr (line, 29, length (desc_word)) = desc_word;
343 k = length (desc_word) + 29;
344
345 ext_base = ebase (irand);
346 itag = len_reg (irand);
347 if itag
348 then tag = eis_modifier (fixed (substr (p -> descriptor.length, 9, 4), 4));
349 has_ic = ic (irand);
350 go to chk_ext;
351 end;
352
353 if op_code = "rpd " then goto set;
354 if op_code = "rpt " then goto set;
355
356 if p -> instruction.unused then goto not_ins;
357
358 if op_mnemonic.num_desc ^= 0
359 then do;
360 tag = substr (binoct ((p -> instruction.tag)), 1, 2);
361 ignore_ic_mod = "1"b;
362 goto set;
363 end;
364
365 if p -> instruction.tag
366 then do;
367 tag = modifier (fixed (p -> instruction.tag, 6));
368 if tag = "..." then goto not_ins;
369 end;
370
371 set: substr (line, 13, 2) = " ";
372 substr (line, 15, 6) = substr (cstring, 2, 5);
373 substr (line, 21, 5) = substr (cstring, 7, 4);
374 substr (line, 26, 2) = substr (cstring, 11, 2);
375
376 substr (line, 28, 1) = ht;
377 k = 29;
378
379 if ^eis & op_mnemonic.dtype = 1 & ^p -> instruction.ext_base
380 then op_code = rtrim (op_code) || "x";
381 substr (line, k, 5) = op_code;
382
383 c = substr (line, k + 3, 1);
384
385 double = substr (op_code, 1, 2) = "df" | substr (op_code, 3, 2) = "aq" | substr (op_code, 4, 2) = "aq";
386
387 ext_base = p -> instruction.ext_base | (^eis & op_mnemonic.dtype = 1);
388
389 itag = p -> instruction.tag ^= "000000"b;
390 has_ic = p -> instruction.tag = "000100"b;
391
392 k = 34;
393 chk_ext:
394 chk_ext1: substr (line, k, 1) = ht;
395 k = k + 1;
396
397 save_k = k;
398
399 if ^eis
400 then if p -> instruction.unused
401 then do;
402
403
404
405 tag = digit (fixed (p -> instruction.tag, 6));
406 offset = fixed (substr (p -> half.left, 1, 8), 8);
407 ignore_ic_mod = "1"b;
408 goto sk;
409 end;
410
411 if ext_base
412 then do;
413 substr (line, k, 4) = base (fixed (p -> instruction.base, 3));
414 offset = fixed (p -> instruction.offset, 15);
415 if offset > 16384 then offset = offset - 32768;
416 k = k + 4;
417 j = 13;
418 end;
419 else do;
420 offset = fixed (p -> half.left, 18);
421
422 if offset > 131072
423 then do;
424 if tag = "du " then goto sk;
425 if tag = "dl " then goto sk;
426 offset = offset - 262144;
427 end;
428
429 sk: j = 14;
430 end;
431
432 substr (line, j, 1) = cstring;
433
434 call bin2dec (offset);
435
436 if eis_desc
437 then do;
438 if desc_word = "descb"
439 then fract_offset = fixed (p -> descriptor.char, 2) * bits_per_char + fixed (p -> descriptor.bit, 4);
440 else if substr (desc_word, 1, 5) = "desc4"
441 then fract_offset = fixed (p -> four_bit_descriptor.char, 3);
442 else fract_offset = fixed (p -> descriptor.char, 2);
443 if fract_offset ^= 0
444 then do;
445 substr (line, k, 1) = "(";
446 k = k + 1;
447 call bin2dec (fract_offset);
448 substr (line, k, 1) = ")";
449 k = k + 1;
450 end;
451 end;
452
453 if itag
454 then do;
455 substr (line, k, 1) = ",";
456 substr (line, k + 1, 3) = tag;
457
458 k = k + 2;
459 if substr (line, k, 1) ^= " " then k = k + 1;
460 if substr (line, k, 1) ^= " " then k = k + 1;
461 end;
462 else if eis_desc
463 then do;
464 substr (line, k, 1) = ",";
465 k = k + 1;
466 if desc_word = "desc9ls" | desc_word = "desc4ls"
467 then do;
468 call bin2dec (fixed (substr (p -> descriptor.length, 7, 6), 6));
469 substr (line, k, 1) = ",";
470 k = k + 1;
471 scale = fixed (substr (p -> descriptor.length, 1, 6), 6);
472 if scale >= 32
473 then scale = scale - 64;
474 call bin2dec (scale);
475 end;
476 else call bin2dec (fixed (p -> descriptor.length, 12));
477 end;
478
479 if ignore_ic_mod then goto chk_base;
480
481 if has_ic
482 then do;
483 substr (line, k, 2) = htht;
484 k = k + 2;
485
486 pt = addrel (p, offset - irand);
487 substr (line, k, 6) = binoct (rel (pt));
488
489 k = k + 6;
490
491 if substr (op_code, 1, 1) = "t" then goto prt;
492 if fixed (rel (pt), 18) > cg_static_$text_pos then goto prt;
493
494 substr (line, k, 1) = " ";
495 k = k + 1;
496
497 equal: substr (line, k, 2) = "= ";
498 substr (line, k + 2, 12) = binoct (pt -> word (0));
499 k = k + 14;
500
501 if double
502 then do;
503 substr (line, k, 1) = " ";
504 substr (line, k + 1, 12) = binoct (pt -> word (1));
505 k = k + 13;
506 end;
507
508 goto prt;
509 end;
510
511 chk_base: if ^ext_base then goto prt;
512
513 if p -> instruction.base ^= "000"b & op_code ^= "tsp2"
514 then do;
515 if s -> word (0) = "0"b then goto prt;
516
517 sym_pt = s -> packed_ptr;
518 if sym_pt = null then goto prt;
519
520 if sym_pt -> symbol.dcl_type = by_compiler
521 then if ^sym_pt -> symbol.entry
522 then goto prt;
523
524 j = 2 - divide (k - save_k, 10, 17, 0);
525 substr (line, k, j) = htht;
526 k = k + j;
527
528 if sym_pt -> node.type = label_node
529 then go to put;
530
531 tok_pt = sym_pt -> symbol.father;
532 if tok_pt = null then goto put;
533
534 do while (tok_pt -> symbol.father ^= null);
535 tok_pt = tok_pt -> symbol.father;
536 end;
537
538 tok_pt = tok_pt -> symbol.token;
539 j = tok_pt -> token.size;
540 substr (line, k, j) = tok_pt -> token.string;
541 k = k + j;
542
543 substr (line, k, 1) = ".";
544 k = k + 1;
545
546 put: tok_pt = sym_pt -> symbol.token;
547 j = tok_pt -> token.size;
548 substr (line, k, j) = tok_pt -> token.string;
549 k = k + j;
550
551 goto prt;
552 end;
553
554 if op_code = "xec "
555 then do;
556 pt = addrel (addr (pl1_operators_$operator_table), offset);
557 mop = fixed (pt -> instruction.op_code, 10);
558 op_mnemonic_ptr = addr (op_mnemonic_$op_mnemonic_ (mop));
559 if op_mnemonic.num_words > 1
560 then do;
561
562
563
564 call init_eis;
565
566 do j = 1 to ndesc;
567 ebase (j) = "1"b;
568 len_reg (j) = ^decimal;
569 ic (j) = "0"b;
570 end;
571
572 irand = 0;
573 end;
574 end;
575
576 if itag then goto prt;
577
578 if substr (op_code, 1, 1) ^= "t"
579 then do;
580 if offset >= pl1_operator_names_$first then goto prt;
581 pt = addrel (addr (pl1_operators_$operator_table), offset);
582 substr (line, k, 2) = htht;
583 k = k + 2;
584 goto equal;
585 end;
586
587 op_names_pt = addr (pl1_operator_names_$pl1_operator_names_);
588
589 if offset >= operator_names.first & offset <= operator_names.last
590 then do;
591 pt = addr (operator_names.names (offset));
592 goto str_info;
593 end;
594
595 else if offset >= operator_names.first_special & offset <= operator_names.last_special
596 then do;
597 do j = 1 to operator_names.number_special;
598 if operator_names.special (j).offset = offset
599 then do;
600 pt = addr (operator_names.special (j).namep);
601 goto str_info;
602 end;
603 end;
604 goto prt;
605 end;
606 str_info: size = fixed (pt -> name_pair.size, 18);
607 pt = ptr (pt, pt -> name_pair.rel_ptr);
608
609 substr (line, k, 2) = htht;
610 k = k + 2;
611
612 substr (line, k, size) = pt -> based_string;
613 k = size + k;
614
615 prt: call pl1_print$string_ptr_nl (line_pt, k - 1);
616
617 if eis
618 then do;
619 irand = irand + 1;
620 if irand > nrands
621 then do;
622 eis = "0"b;
623 irand = 0;
624 end;
625 else if irand > ndesc
626 then op_code, desc_word = "arg";
627 end;
628
629 p = addrel (p, 1);
630 q = addrel (q, 1);
631 s = addrel (s, 1);
632 end;
633
634 return;
635
636 display_text$display_abs: entry (t_pt, r_pt, n_words);
637
638 dcl n_words fixed bin;
639
640 p = t_pt;
641 q = r_pt;
642 line_pt = addr (line);
643
644 do i = 1 to n_words;
645
646 substr (line, 1, 6) = binoct (rel (p));
647 substr (line, 7, 2) = " ";
648 call insert_relocation;
649 substr (line, 13, 3) = " ";
650 substr (line, 16, 12) = binoct (p -> word (0));
651
652 k = 27;
653
654 call pl1_print$string_ptr_nl (line_pt, k);
655 p = addrel (p, 1);
656 q = addrel (q, 1);
657 end;
658
659 return;
660
661 display_text$display_ascii: entry (t_pt, n_chars);
662
663 dcl n_chars fixed bin;
664
665 dcl nc fixed bin,
666 char_string char (4) aligned based (p);
667
668 p = t_pt;
669 nc = n_chars;
670 line_pt = addr (line);
671
672
673 do i = 1 by 4 to nc;
674
675 substr (line, 1, 6) = binoct (rel (p));
676 substr (line, 7, 2) = " ";
677 substr (line, 9, 4) = "aa ";
678
679 cstring = binoct (p -> word (0));
680 k = 13;
681 do j = 1 by 3 to 12;
682 substr (line, k, 4) = substr (cstring, j, 3);
683 k = k + 4;
684 end;
685
686 substr (line, 28, 1) = ht;
687
688 k = min (4, nc - i + 1);
689 substr (line, 29, k) = substr (p -> char_string, 1, k);
690
691 call pl1_print$string_ptr_nl (line_pt, k + 28);
692 p = addrel (p, 1);
693 end;
694
695
696 insert_relocation: proc;
697
698
699
700 if r_pt = null
701 then do;
702 substr (line, 9, 4) = "aa ";
703 return;
704 end;
705
706 if q -> rel_tab.dummy_l then k = fixed (q -> rel_tab.left, 4);
707 else k = -1;
708
709 substr (line, 9, 1) = relocation (k);
710
711 if q -> rel_tab.dummy_r then k = fixed (q -> rel_tab.right, 4);
712 else k = -1;
713
714 substr (line, 10, 3) = relocation (k);
715
716 end;
717
718
719 bin2dec: proc (number);
720
721 dcl number fixed bin (18);
722
723 substr (line, k, length (ltrim (char (number)))) = ltrim (char (number));
724 k = k + length (ltrim (char (number)));
725
726 end;
727
728
729 init_eis: proc;
730
731 eis = "1"b;
732 nrands = op_mnemonic.num_words - 1;
733 ndesc = op_mnemonic.num_desc;
734 decimal = op_mnemonic.dtype = 2;
735 desc_word = desc_op (op_mnemonic.dtype);
736
737 end;
738
739 end;