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
26
27
28
29
30
31
32
33
34
35
36 pl1_print$varying: proc(var_string);
37
38
39
40 dcl var_string char(*) varying aligned;
41
42
43
44 dcl l_suff fixed bin,
45 arg_length fixed bin(21);
46
47
48
49 declare string char (261120) aligned based (pl1_stat_$list_ptr);
50
51
52
53 declare ( length, substr) builtin;
54
55
56
57 declare listing_overflow condition;
58
59
60
61 dcl ( pl1_stat_$list_ptr ptr,
62 pl1_stat_$max_list_size fixed bin(21),
63 pl1_stat_$char_pos fixed bin(21)) static external;
64
65
66
67 declare NL character(1) aligned static internal initial("
68 ");
69 ^L
70
71
72
73
74 l_suff=0;
75 go to l1;
76
77
78
79 pl1_print$varying_nl: entry(var_string);
80
81 l_suff=1;
82
83 l1: arg_length=length(var_string);
84
85 if arg_length + pl1_stat_$char_pos + l_suff > pl1_stat_$max_list_size
86 then signal condition(listing_overflow);
87
88 substr(string,pl1_stat_$char_pos,arg_length)=var_string;
89 goto done;
90
91
92
93 pl1_print$non_varying: entry(nv_string,size);
94
95 dcl nv_string char(*) aligned,
96 size fixed bin(35);
97
98 l_suff=0;
99 go to l2;
100
101
102
103 pl1_print$non_varying_nl: entry(nv_string,size);
104
105 l_suff=1;
106
107 l2: if size > 0
108 then arg_length=size;
109 else arg_length=length(nv_string);
110
111 if arg_length + pl1_stat_$char_pos + l_suff > pl1_stat_$max_list_size
112 then signal condition(listing_overflow);
113 substr(string,pl1_stat_$char_pos,arg_length)=nv_string;
114
115 done: pl1_stat_$char_pos=pl1_stat_$char_pos + arg_length;
116
117 if l_suff ^= 0
118 then do;
119 substr(string,pl1_stat_$char_pos,1) = NL;
120 pl1_stat_$char_pos = pl1_stat_$char_pos+1;
121 end;
122
123 return;
124 ^L
125
126
127 pl1_print$string_ptr: entry(pt,size);
128
129 dcl pt ptr;
130 dcl based_string char(size) aligned based(pt);
131
132 l_suff = 0;
133 goto l3;
134
135
136
137 pl1_print$string_ptr_nl: entry(pt,size);
138
139 l_suff = 1;
140
141 l3: arg_length = size;
142
143 if arg_length + pl1_stat_$char_pos + l_suff > pl1_stat_$max_list_size
144 then signal condition(listing_overflow);
145
146 substr(string,pl1_stat_$char_pos,arg_length)=based_string;
147
148 goto done;
149 ^L
150 pl1_print$for_lex:
151 entry (bv_source_ptr, bv_line_number, bv_line_start, bv_line_length, bv_suppress_line_numbers,
152 bv_line_begins_in_comment);
153
154
155
156 declare ( bv_source_ptr ptr,
157 bv_line_number fixed bin (14),
158 bv_line_start fixed bin (21),
159 bv_line_length fixed bin (21),
160 bv_suppress_line_numbers bit (1) aligned,
161 bv_line_begins_in_comment bit (1) aligned
162 ) parameter;
163
164
165
166 declare line_number_string picture "zzzzzzzz9";
167
168
169
170 declare pl1_stat_$source_seg fixed bin (8) external static;
171
172
173
174 declare SPACE_FOR_LINE_NUMBERS_PLUS_ONE_BLANK fixed bin internal static options (constant) init (10);
175
176
177
178
179
180
181
182
183
184
185
186 if pl1_stat_$char_pos + SPACE_FOR_LINE_NUMBERS_PLUS_ONE_BLANK
187 + bv_line_length >= pl1_stat_$max_list_size
188 then signal condition(listing_overflow);
189
190
191 if ^bv_suppress_line_numbers
192 then do;
193 line_number_string = bv_line_number;
194 substr (string, pl1_stat_$char_pos,
195 SPACE_FOR_LINE_NUMBERS_PLUS_ONE_BLANK) = line_number_string;
196
197 if pl1_stat_$source_seg > 0
198 then do;
199 line_number_string = pl1_stat_$source_seg;
200 substr (string, pl1_stat_$char_pos, 3) = substr (line_number_string, 7, 3);
201 end;
202
203 pl1_stat_$char_pos = pl1_stat_$char_pos + SPACE_FOR_LINE_NUMBERS_PLUS_ONE_BLANK;
204
205 if bv_line_begins_in_comment
206 then substr (string, pl1_stat_$char_pos - 1, 1) = "*";
207 end;
208
209 substr (string, pl1_stat_$char_pos, bv_line_length) = substr (bv_source_ptr -> based_string,
210 bv_line_start, bv_line_length);
211 pl1_stat_$char_pos = pl1_stat_$char_pos + bv_line_length;
212 return;
213 ^L
214
215
216 pl1_print$unaligned_nl: entry(unal_string,size);
217
218 dcl unal_string char(*) unaligned;
219
220 if size > 0
221 then arg_length = size;
222 else arg_length = length(unal_string);
223
224 if arg_length + pl1_stat_$char_pos >= pl1_stat_$max_list_size
225 then signal condition(listing_overflow);
226
227 substr(string,pl1_stat_$char_pos,arg_length) = unal_string;
228
229 l_suff = 1;
230 goto done;
231 end;