1
2
3
4
5
6
7
8
9
10
11 db_regs: procedure;
12
13
14
15 debug
16
17 debug
18
19
20
21
22
23
24
25
26
27 dcl db_mc_ptr ptr, debug
28
29
30 Note
31
32
33 name char(4) aligned,
34 debug
35
36
37 print_mode fixed bin,
38
39 value bit(72) aligned; debug
40
41
42
43
44
45
46
47
48
49
50
51 dcl block_ptr ptr,
52
53
54 work_ptr ptr;
55
56 dcl indp ptr;
57
58 dcl delim char(2);
59
60 dcl namex fixed bin,
61
62 userx fixed bin,
63
64
65 i fixed bin;
66
67 dcl len fixed bin;
68
69
70
71
72
73
74 dcl source_string char (72) varying;
75
76
77
78
79
80
81
82
83
84
85 dcl ( print_word1, print_word2, print_word3, print_word4 )
86 bit(36) init( "0"b );
87
88
89
90
91
92
93 dcl float_val float bin(63);
94
95
96 dcl print_request bit (1) init ("0"b);
97
98
99
100
101
102
103
104
105
106 dcl 1 float_overlay aligned based(addr(float_val)),
107 2 exponent unal bit(8),
108 2 a_part unal bit(36),
109 2 q_part unal bit(27);
110
111
112
113
114 dcl block (0:7) bit(36) based;
115 dcl eight_words bit(288) based aligned;
116
117
118
119
120 dcl ptr_bit_string bit(72) based;
121
122 dcl based_ptr ptr based;
123
124 dcl ind_bits bit(14) based(indp);
125
126
127
128
129
130
131
132 debug
133
134 debug
135
136
137
138 Note
139
140
141
142
143
144
145 dcl print_label_table ( -1:33 ) fixed bin internal static
146
147
148
149 init ( 0,
150 (8) 6,
151 (8) 7,
152 9,
153 1,
154 2,
155 3,
156 4,
157 5,
158 10,
159 11,
160 12,
161 13,
162 14,
163 15,
164 16,
165 17,
166 18,
167 19,
168 20,
169 8);
170
171
172
173 dcl get_ass_label_table ( -1:33 ) fixed bin internal static
174
175
176
177 init ( 0,
178 (8) 2,
179 (8) 3,
180 5,
181 1,
182 1,
183 1,
184 1,
185 1,
186 6,
187 7,
188 8,
189 9,
190 10,
191 11,
192 12,
193 13,
194 14,
195 1,
196 1,
197 4);
198
199
200
201
202
203
204 dcl ind_names (14) char(4) int static initial
205 ("zero",
206 "neg ",
207 "cary",
208 "ovfl",
209 "eovf",
210 "eufl",
211 "oflm",
212 "tro ",
213 "par ",
214 "parm",
215 "^bar",
216 "tru ",
217 "mif ",
218 "abs ");
219
220
221
222
223
224
225 Note
226 debug
227 debug
228
229
230
231
232
233
234 dcl (num_user_regs fixed bin init(0),
235
236 max_num_user_regs fixed bin init(16) ) internal static;
237
238
239 dcl user_reg_names(16) char(4) internal static;
240
241 dcl user_reg_values(16) bit(36) internal static;
242
243
244
245
246
247
248
249
250
251
252 %include db_ext_stat_;
253
254 dcl print_text_$format ext entry ( ptr, char(*) var ),
255
256 ioa_$ioa_stream ext entry options(variable);
257
258 dcl ioa_$rsnnl ext entry options(variable);
259
260
261
262 dcl ( addr, substr ) builtin;
263
264 % include db_data_map;
265
266 % include its;
267 % include mc;
268
269
270
271 print: entry ( db_mc_ptr, name, print_mode );
272
273 print_request = "1"b;
274
275 call get_namex;
276
277
278
279
280
281
282 goto print_label( print_label_table(namex) );
283
284
285
286
287
288
289 get: entry ( db_mc_ptr, name, value, print_mode );
290
291
292 call get_namex;
293
294
295 value = "0"b;
296
297
298 goto get_label( get_ass_label_table(namex) );
299
300
301
302
303
304
305 assign: entry ( db_mc_ptr, name, value, print_mode );
306
307
308 call get_namex;
309
310
311 print_word1 = substr( value, 1,36);
312 print_word2 = substr( value,37,36);
313
314
315
316 goto assign_label( get_ass_label_table(namex) );
317
318
319
320
321
322
323
324
325
326 print_label(0):
327 get_label(0):
328 assign_label(0):
329
330 return;
331
332
333
334
335
336
337
338
339 no_mc_data:
340
341 if print_mode = 0
342
343 then call ioa_$ioa_stream (debug_output, "No mc data.");
344
345
346 else do;
347 call ioa_$ioa_stream (debug_output, "No fault frame found in stack trace.");
348 end;
349
350
351 return;
352
353 get_namex: procedure;
354
355
356
357 debug
358
359
360
361
362
363
364
365
366
367 mcp = db_mc_ptr;
368 debug
369
370
371 debug
372
373
374
375
376
377
378 do namex = 0 to db_data$n_regs;
379
380 if name = db_data$names(namex)
381
382
383 then if db_mc_ptr = null()
384
385
386 then goto no_mc_data;
387
388 else do;
389 scup = addr( mcp -> mc.scu );
390 return;
391 end;
392
393 end;
394
395
396
397
398
399
400
401
402 do userx = 1 to num_user_regs;
403
404 if name = user_reg_names(userx) then return;
405
406 end;
407
408
409
410
411
412
413
414
415 if print_request then do;
416 call ioa_$ioa_stream (debug_output, "User register not defined. ^a", name);
417 namex = -1;
418 return;
419 end;
420 if userx > max_num_user_regs
421
422 then do;
423 call ioa_$ioa_stream (debug_output, "User register ^a not initialized - max number exceded",name);
424 namex = -1;
425 return;
426 end;
427
428
429
430
431
432 num_user_regs = userx;
433
434
435 user_reg_names(userx) = name;
436
437 user_reg_values(userx) = "0"b;
438
439
440
441
442 if print_mode ^= 0
443
444 then call ioa_$ioa_stream (debug_output, "Creating new user register ^a", name );
445
446
447 end get_namex;
448
449
450 debug
451
452
453
454
455
456
457
458 print_label(1):
459
460 if print_mode ^= 0
461 then call ioa_$ioa_stream (debug_output, "All ""machine conditions"" data.");
462
463 call print_prs;
464
465 call print_regs;
466
467 call print_scu;
468
469 if print_mode ^= 0
470 then call ioa_$ioa_stream (debug_output, "^/The 8 words after the SCU data");
471 block_ptr = addr( mcp -> mc.mask );
472 call print_block;
473
474 block_ptr = addr( mcp -> mc.eis_info );
475 if block_ptr -> eight_words ^= "0"b then do;
476 if print_mode ^= 0
477 then call ioa_$ioa_stream (debug_output, "^/EIS info");
478 call print_block;
479 end;
480
481 call print_user_regs;
482
483 return;
484
485
486
487
488
489
490
491 print_label(2):
492
493 call print_prs;
494 return;
495
496
497 print_prs: procedure;
498
499 call ioa_$ioa_stream (debug_output, "^/Pointer Registers");
500
501 do i = 0 to 7;
502 call ioa_$ioa_stream (debug_output, "^a^-^p",db_data$names(i), mcp->mc.prs(i));
503 end;
504
505 end print_prs;
506
507
508
509
510
511
512
513
514
515 print_label(3):
516
517 call print_regs;
518 return;
519
520
521 print_regs: procedure;
522
523 if print_mode ^= 0
524
525 then do;
526
527 call ioa_$ioa_stream (debug_output, "^/Index and other Registers");
528
529 do i = 0 to 7;
530 call ioa_$ioa_stream (debug_output, "^a^-^.3b", db_data$names(i+8), mcp->mc.regs.x(i));
531 end;
532 end;
533
534
535 else do;
536
537 call ioa_$ioa_stream (debug_output, "^-^.3b ^.3b ^.3b ^.3b",
538 mc.regs.x(0), mc.regs.x(1), mc.regs.x(2), mc.regs.x(3));
539 call ioa_$ioa_stream (debug_output, "^-^.3b ^.3b ^.3b ^.3b",
540 mc.regs.x(4), mc.regs.x(5), mc.regs.x(6), mc.regs.x(7));
541
542 end;
543 call ioa_$ioa_stream (debug_output, "a^-^w^/q^-^w", mcp->mc.regs.a, mcp->mc.regs.q);
544
545 call print_exp;
546 call print_tr;
547 call print_ralr;
548
549 end print_regs;
550
551
552
553
554
555
556
557
558
559 print_label(4):
560
561 call print_scu;
562 return;
563
564
565 print_scu: procedure;
566
567 if print_mode ^= 0
568
569 then do;
570 call ioa_$ioa_stream (debug_output, "^/SCU data");
571 call print_ppr;
572 call print_tpr;
573 call ioa_$ioa_stream (debug_output, "^/");
574 call print_even;
575 call print_odd;
576 call print_ind;
577 call ioa_$ioa_stream (debug_output, "The SCU data as a block");
578 end;
579
580 block_ptr = scup;
581 call print_block;
582
583 end print_scu;
584
585
586
587
588
589
590
591 print_label(5):
592
593 call print_user_regs;
594 return;
595
596
597 print_user_regs: procedure;
598
599 if num_user_regs = 0
600
601 then do;
602 if print_mode ^= 0
603 then call ioa_$ioa_stream (debug_output, "^/No user defined registers");
604 return;
605 end;
606
607 if print_mode ^= 0
608 then call ioa_$ioa_stream (debug_output, "^/User defined registers");
609
610 do i = 1 to num_user_regs;
611 call ioa_$ioa_stream (debug_output, "^a^-^w", user_reg_names(i), user_reg_values(i));
612 end;
613
614 end print_user_regs;
615
616
617
618
619
620
621
622 print_label(6):
623
624 call ioa_$ioa_stream (debug_output, "^a^-^p",db_data$names(namex), mcp->mc.prs(namex));
625 return;
626
627
628
629
630
631
632
633 print_label(7):
634
635 call ioa_$ioa_stream (debug_output, "^a^-^.3b", db_data$names(namex), mcp->mc.regs.x(namex-8) );
636 return;
637
638
639
640
641
642
643
644 print_label(8):
645
646 call ioa_$ioa_stream (debug_output, "^a^-^w", user_reg_names(userx), user_reg_values(userx));
647 return;
648
649
650
651
652
653
654
655 print_label(9):
656
657 call ioa_$ioa_stream (debug_output, "aq^-^w ^w", mcp -> mc.regs.a, mcp -> mc.regs.q);
658 return;
659
660
661 print_label(10):
662
663 call ioa_$ioa_stream (debug_output, "a^-^w", mcp->mc.regs.a);
664 return;
665
666
667
668 print_label(11):
669
670 call ioa_$ioa_stream (debug_output, "q^-^w", mcp->mc.regs.q);
671 return;
672
673
674
675
676
677
678
679 print_label(12):
680
681 call print_exp;
682 return;
683
684 print_exp: procedure;
685
686 call ioa_$ioa_stream (debug_output, "exp^-^.3b", "0"b || mc.regs.e);
687
688 end print_exp;
689
690
691
692
693
694
695
696
697 print_label(13):
698
699 call print_tr;
700 return;
701
702
703 print_tr: procedure;
704
705 call ioa_$ioa_stream (debug_output, "tr^-^.3b", mcp->mc.regs.t);
706
707 end print_tr;
708
709
710
711
712
713
714
715 print_label(14):
716
717 call print_ralr;
718 return;
719
720
721 print_ralr: procedure;
722
723 call ioa_$ioa_stream (debug_output, "ralr^-^.3b", mc.regs.ralr);
724
725 end print_ralr;
726
727
728
729
730
731
732 print_label(15):
733
734 call print_ppr;
735 return;
736
737
738 print_ppr: procedure;
739
740 if print_mode ^= 0
741 then call ioa_$ioa_stream (debug_output, "^/ppr:^-prr psr p ic");
742
743 call ioa_$ioa_stream (debug_output, "^- ^.3b ^.3b ^.1b ^.3b", scu.ppr.prr,
744 scu.ppr.psr, scu.ppr.p, scu.ilc);
745
746 end print_ppr;
747
748
749
750
751
752
753
754 print_label(16):
755
756 call print_tpr;
757 return;
758
759
760 print_tpr: procedure;
761
762 if print_mode ^= 0
763 then call ioa_$ioa_stream (debug_output, "^/tpr:^-trr tsr tbr ca");
764
765 call ioa_$ioa_stream (debug_output, "^- ^.3b ^.3b ^.3b ^.3b", scu.tpr.trr,
766 scu.tpr.tsr, scu.tpr_tbr, scu.ca);
767
768 end print_tpr;
769
770
771
772
773
774
775
776 print_label(17):
777
778 call print_even;
779 return;
780
781 print_even: procedure;
782
783 call print_text_$format( addr( scup -> scu.even_inst), source_string);
784
785 call ioa_$ioa_stream (debug_output, "even^-^a", source_string );
786
787 end print_even;
788
789
790
791 print_label(18):
792
793 call print_odd;
794 return;
795
796
797 print_odd: procedure;
798
799 call print_text_$format( addr( scup -> scu.odd_inst), source_string);
800
801 call ioa_$ioa_stream (debug_output, "odd^-^a", source_string);
802
803 end print_odd;
804
805
806
807 print_label(19):
808
809 call print_ind;
810 return;
811
812
813
814 print_label(20):
815
816 float_overlay.exponent = mc.e;
817 float_overlay.a_part = mc.a;
818 float_overlay.q_part = mc.q;
819
820 call ioa_$ioa_stream (debug_output, "eaq^-^e",float_val);
821 return;
822
823
824 print_ind: procedure;
825
826 indp = addr(scup -> scu.ir);
827
828 delim = "";
829 source_string = "";
830
831 if indp -> ind_bits = (14)"0"b
832 then source_string = "none";
833
834 else
835 do i = 1 to 14;
836 if substr (indp -> ind_bits, i, 1)
837 then do;
838
839 call ioa_$rsnnl ("^a^a^a", source_string, len, source_string,
840 delim, ind_names(i) );
841 delim = ", ";
842 end;
843 end;
844
845 call ioa_$ioa_stream (debug_output, "indicators: ^a", source_string);
846
847 end print_ind;
848
849
850
851
852
853
854
855
856
857
858
859
860 print_block: procedure;
861
862 call ioa_$ioa_stream (debug_output, "^/^-^w ^w ^w ^w",
863 block_ptr->block(0), block_ptr->block(1), block_ptr->block(2), block_ptr->block(3));
864
865 call ioa_$ioa_stream (debug_output, "^-^w ^w ^w ^w",
866 block_ptr->block(4), block_ptr->block(5), block_ptr->block(6), block_ptr->block(7));
867
868 end print_block;
869
870 note
871
872
873
874
875
876
877
878
879
880
881 get_label(1):
882
883 return;
884
885
886
887
888 get_label(2):
889
890 value = addr( mcp -> mc.prs(namex)) -> ptr_bit_string;
891 return;
892
893
894
895
896 get_label(3):
897
898 substr( value, 55, 18 ) = mcp -> mc.regs.x(namex-8);
899 return;
900
901
902
903 get_label(4):
904
905 substr( value, 37, 36 ) = user_reg_values(userx);
906 return;
907
908
909
910
911 get_label(5):
912
913 substr( value, 1, 36 ) = mcp -> mc.regs.a;
914 substr( value, 37, 36 ) = mcp -> mc.regs.q;
915 return;
916
917
918
919
920 get_label(6):
921
922 substr( value, 37, 36 ) = mcp -> mc.regs.a;
923 return;
924
925
926
927
928 get_label(7):
929
930 substr( value, 37, 36 ) = mcp -> regs.q;
931 return;
932
933
934
935
936 get_label(8):
937
938 substr( value, 65, 8 ) = mcp -> mc.regs.e;
939 return;
940
941
942
943 get_label(9):
944
945 substr( value, 46, 27 ) = mcp -> mc.regs.t;
946 return;
947
948
949
950
951 get_label(10):
952
953 substr( value, 70, 3 ) = mcp -> mc.regs.ralr;
954 return;
955
956
957
958
959 get_label(11):
960
961 work_ptr = addr( value );
962 work_ptr -> its.segno = scup -> scu.ppr.psr;
963 work_ptr -> its.ringno = scup -> scu.ppr.prr;
964 substr( value, 3, 1 ) = scup -> scu.ppr.p;
965 work_ptr -> its.offset = scup -> scu.ilc;
966 return;
967
968
969
970
971 get_label(12):
972
973 work_ptr = addr( value );
974 work_ptr -> its.segno = scup -> scu.tpr.tsr;
975 work_ptr -> its.ringno = scup -> scu.tpr.trr;
976 work_ptr -> its.bit_offset = scup -> scu.tpr_tbr;
977 work_ptr -> its.offset = scup -> scu.ca;
978 return;
979
980
981
982
983 get_label(13):
984
985 substr( value, 37, 36 ) = scup -> scu.even_inst;
986 return;
987
988
989
990
991 get_label(14):
992
993 substr( value, 37, 36 ) = scup -> scu.odd_inst;
994 return;
995
996 note
997
998 Note
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009 assign_label(1):
1010
1011 call ioa_$ioa_stream (debug_output, "The debug name ^a cannot be used in an assignment command.",
1012 db_data$names(namex));
1013 return;
1014
1015 assign_label(2):
1016
1017 if print_mode = 1
1018
1019 then call ioa_$ioa_stream (debug_output, "^a changed from ^p to ^p",
1020 db_data$names(namex), mcp -> mc.prs(namex), addr(value) -> based_ptr);
1021
1022 addr( mcp -> mc.prs(namex)) -> ptr_bit_string = value;
1023
1024 return;
1025
1026 assign_label(3):
1027
1028 if print_mode = 1
1029 then do;
1030 call ioa_$ioa_stream (debug_output, "^a changed from ^.3b to ^.3b",
1031 db_data$names(namex), mc.regs.x(namex-8), substr(print_word2, 19, 18));
1032 end;
1033
1034 mcp -> mc.regs.x(namex-8) = substr( print_word2, 19, 18 );
1035
1036 return;
1037
1038 assign_label(4):
1039
1040 if print_mode = 1
1041
1042 then call ioa_$ioa_stream (debug_output, "^a changed from ^w to ^w",
1043 user_reg_names(userx), user_reg_values(userx), print_word2);
1044
1045 user_reg_values(userx) = print_word2;
1046
1047 return;
1048
1049 assign_label(5):
1050
1051 if print_mode = 1
1052
1053 then call ioa_$ioa_stream (debug_output, "aq changed from ^w^w to ^w^w",
1054 mcp -> mc.regs.a, mcp -> mc.regs.q, print_word1, print_word2);
1055
1056 mcp -> mc.regs.a = print_word1;
1057 mcp -> mc.regs.q = print_word2;
1058
1059 return;
1060
1061 assign_label(6):
1062
1063 if print_mode = 1
1064
1065 then call ioa_$ioa_stream (debug_output, "a changed from ^w to ^w",
1066 mcp -> mc.regs.a, print_word2);
1067
1068 mcp -> mc.regs.a = print_word2;
1069
1070 return;
1071
1072 assign_label(7):
1073
1074 if print_mode = 1 then
1075 call ioa_$ioa_stream (debug_output, "q changed from ^w to ^w",
1076 mcp -> mc.regs.q, print_word2);
1077
1078 mcp -> mc.regs.q = print_word2;
1079
1080 return;
1081
1082 assign_label(8):
1083
1084 if print_mode = 1
1085 then do;
1086 call ioa_$ioa_stream (debug_output, "exp changed from ^.3b to ^.3b",
1087 "0"b || mc.regs.e, "0"b || substr(print_word2, 29, 8));
1088 end;
1089
1090 mcp -> mc.regs.e = substr( print_word2, 29, 8 );
1091
1092 return;
1093
1094 assign_label(9):
1095
1096 if print_mode = 1
1097 then do;
1098 call ioa_$ioa_stream (debug_output, "tr changed from ^.3b to ^.3b",
1099 mc.regs.t, substr(print_word2, 10, 27));
1100 end;
1101
1102 mcp -> mc.regs.t = substr( print_word2, 10, 27 );
1103
1104 return;
1105
1106 assign_label(10):
1107
1108 if print_mode = 1
1109 then do;
1110 call ioa_$ioa_stream (debug_output, "ralr changed from ^.3b to ^.3b",
1111 mc.regs.ralr, substr(print_word2, 34, 3));
1112 end;
1113
1114 mcp -> mc.regs.ralr = substr( print_word2, 34, 3 );
1115
1116 return;
1117
1118 assign_label(11):
1119
1120 work_ptr = addr( value );
1121
1122 if print_mode = 1
1123
1124 then do;
1125 call ioa_$ioa_stream (debug_output, "Old ppr");
1126 call print_ppr;
1127 end;
1128
1129 scup -> scu.ppr.psr = work_ptr -> its.segno;
1130 scup -> scu.ppr.prr = work_ptr -> its.ringno;
1131 scup -> scu.ppr.p = substr( value, 3,1 );
1132 scup -> scu.ilc = work_ptr -> its.offset;
1133
1134 if print_mode = 1
1135
1136 then do;
1137 call ioa_$ioa_stream (debug_output, "New ppr");
1138 call print_ppr;
1139 end;
1140
1141 return;
1142
1143 assign_label(12):
1144
1145 work_ptr = addr( value );
1146
1147 if print_mode = 1
1148
1149 then do;
1150 call ioa_$ioa_stream (debug_output, "Old tpr");
1151 call print_tpr;
1152 end;
1153
1154 scup -> scu.tpr.tsr = work_ptr -> its.segno;
1155 scup -> scu.tpr.trr = work_ptr -> its.ringno;
1156 scup -> scu.tpr_tbr = work_ptr -> its.bit_offset;
1157 scup -> scu.ca = work_ptr -> its.offset;
1158
1159 if print_mode = 1
1160
1161 then do;
1162 call ioa_$ioa_stream (debug_output, "New tpr");
1163 call print_tpr;
1164 end;
1165
1166 return;
1167
1168 assign_label(13):
1169
1170 if print_mode = 1
1171
1172 then do;
1173 call print_text_$format( addr( scup -> scu.even_inst), source_string);
1174 call ioa_$ioa_stream (debug_output, "Old even instruction: ^a", source_string);
1175 end;
1176
1177 scup -> scu.even_inst = print_word2;
1178
1179 if print_mode = 1
1180
1181 then do;
1182 call print_text_$format( addr( scup -> scu.even_inst), source_string);
1183 call ioa_$ioa_stream (debug_output, "New even instruction: ^a", source_string);
1184 end;
1185
1186 return;
1187
1188 assign_label(14):
1189
1190 if print_mode = 1
1191
1192 then do;
1193 call print_text_$format( addr( scup -> scu.odd_inst), source_string);
1194 call ioa_$ioa_stream (debug_output, "Old odd instruction: ^a", source_string);
1195 end;
1196
1197 scup -> scu.odd_inst = print_word2;
1198
1199 if print_mode = 1
1200
1201 then do;
1202 call print_text_$format( addr( scup -> scu.odd_inst), source_string);
1203 call ioa_$ioa_stream (debug_output, "New odd instruction: ^a", source_string);
1204 end;
1205
1206 return;
1207
1208 end db_regs;