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 Note
27
28
29
30 prlst_: procedure(remark);
31 dcl remark char(*);
32 dcl (length, substr) builtin;
33 dcl (strstart, strlen, strmaxlen) fixed bin(21);
34 dcl listing_segment char(strlen) based(list);
35 dcl ec fixed bin(35);
36
37 dcl eb_data_$list_component fixed bin external;
38 dcl eb_data_$listing_max_length fixed bin(19) external;
39 dcl eb_data_$who_am_I char(12) external;
40 dcl error_table_$segknown fixed bin(35) external;
41 dcl utils_$abort external entry;
42 dcl com_err_ entry options(variable);
43 dcl msf_manager_$get_ptr entry(ptr, fixed bin, bit(1), ptr, fixed bin(24), fixed bin(35));
44 dcl NL char(1) int static options(constant) init("
45 ");
46
47 %include segnfo;
48
49 %include lstcom;
50
51 %include alm_options;
52
53 if tnolst ^= 0 then return;
54 strstart = lstlen + 1;
55 strlen = length(remark) + 1;
56 strmaxlen = 4*eb_data_$listing_max_length - lstlen;
57 if strlen > strmaxlen then do;
58 lstlen = lstlen + strmaxlen;
59 substr(listing_segment, strstart, strmaxlen) = substr(remark, 1, strmaxlen);
60 call new_list_seg;
61 lstlen = strlen - strmaxlen;
62 substr(listing_segment, 1, lstlen) = substr(remark || NL, strmaxlen+1, lstlen);
63 return;
64 end;
65 lstlen = lstlen + strlen;
66 substr(listing_segment, strstart, strlen) = remark || NL;
67 return;
68
69 new_list_seg: entry;
70 eb_data_$list_component = eb_data_$list_component + 1;
71 call msf_manager_$get_ptr(eb_data_$segnfo.list_fcb, eb_data_$list_component, "1"b, eb_data_$segnfo.list, 0, ec);
72 eb_data_$segnfo.lstlen = 0;
73 if ec ^= 0 then if ec ^= error_table_$segknown then do;
74 if tquietsw ^= 1 then call com_err_(ec, eb_data_$who_am_I, "Listing segment.");
75 call utils_$abort;
76 end;
77 end prlst_;