1
2
3
4
5
6
7
8
9
10
11
12
13 prnter_: procedure ( line ) ;
14
15
16
17
18
19
20
21
22
23 declare line char (*) ;
24
25 declare ioa_ external entry options (variable);
26 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35));
27 dcl iox_$user_output ptr external;
28
29 dcl p1_macroerr_debug_sw static init ("0"b)bit (1);
30 dcl nl char (1) static options (constant) init ("
31 ");
32
33 declare eb_data_$abort_assembly external static label;
34 declare eb_data_$who_am_I external static char(12);
35 declare com_err_ external entry options (variable);
36
37 declare prlst_$prlst_ external entry (char(*)) ;
38
39 call prlst_$prlst_(line) ;
40
41 call ioa_(line) ;
42
43 return;
44
45 no_storage: entry ;
46
47 call com_err_(0, eb_data_$who_am_I, "list of available storage has been exhausted") ;
48
49 go to abort_it ;
50
51
52 phsmsg: entry ;
53
54
55 call com_err_(0,eb_data_$who_am_I, "Phase error while generating the object segment") ;
56
57 go to abort_it ;
58
59
60
61 no_end_card: entry ;
62
63 call com_err_(0,eb_data_$who_am_I, "End statement missing.") ;
64
65 go to abort_it ;
66
67 abort1: entry ;
68
69
70
71 abort_it: goto eb_data_$abort_assembly;
72
73 macro_error: entry (console_remark, listing_remark);
74
75 dcl (console_remark, listing_remark) char (*);
76
77 if tpass2 = 0 & ^p1_macroerr_debug_sw then return;
78
79 if console_remark ^= "" & tquietsw = 0 then do;
80 call iox_$put_chars (iox_$user_output, addr (console_remark), length (console_remark), (0));
81 call iox_$put_chars (iox_$user_output, addr (nl), 1, (0));
82 end;
83
84 if listing_remark ^= "" then call prlst_$prlst_ (listing_remark);
85 return;
86
87 debug_p1_macroerr: entry (sw);
88
89 dcl sw char (*);
90
91 if sw = "on" then p1_macroerr_debug_sw = "1"b;
92 else p1_macroerr_debug_sw = "0"b;
93 return;
94
95 general_abort: entry (abort_remark);
96
97 dcl abort_remark char (*);
98
99 call com_err_ (0, eb_data_$who_am_I, abort_remark);
100 call prlst_$prlst_ (abort_remark);
101 go to abort_it;
102
103
104
105 %include varcom;
106 %include alm_options;
107
108 end prnter_ ;