1
2
3
4
5
6
7
8 %;
9
10
11
12
13
14
15
16
17
18 reload:
19 procedure;
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38 dcl (cold, complete, print_map, array) bit (1) init ("0"b);
39 dcl map_name char (64),
40 arg_array (20) char (32) aligned;
41
42 dcl (dir char (168),
43 ent char (32)) aligned,
44 rings (3) fixed bin (6),
45 error_table_$noarg ext fixed bin,
46 error_table_$namedup ext fixed bin;
47 dcl device char (8);
48 dcl mode char (0);
49 dcl tchar char (1) based;
50 dcl mname char (32);
51 dcl code fixed bin;
52 dcl (l, n) fixed bin;
53 dcl (ap, alp, sp) pointer;
54 dcl arg based char (n);
55 dcl error_table_$ionmat external fixed bin;
56 dcl date_name_ entry (char (*), char (*), char (*), char (*), fixed bin);
57 dcl backup_load entry;
58 dcl com_err_ entry options (variable),
59 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin),
60 cu_$arg_list_ptr entry (pointer),
61 bk_arg_reader_$reload_arg_reader entry (fixed bin, pointer, fixed bin),
62 bk_arg_reader_$array_arg_reader entry ((20) char (32) aligned, fixed bin),
63 dprint_ entry (char(*) aligned, char(*) aligned, ptr, fixed bin),
64 expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin),
65 hcs_$status_minf entry (char (*) aligned, char (*) aligned, fixed bin (1),
66 fixed bin, fixed bin (35), fixed bin),
67 hcs_$append_branchx entry (char (*) aligned, char (*) aligned, fixed bin (5), (3) fixed bin (6),
68 char (*) aligned, fixed bin (1), fixed bin (1), fixed bin (24), fixed bin),
69 hcs_$acl_add1 entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (5),
70 (3) fixed bin (6), fixed bin),
71 get_group_id_$tag_star returns (char (32) aligned),
72 cu_$level_get returns (fixed bin),
73 (ioa_, ioa_$rsnnl) entry options (variable),
74 ios_$attach entry (char (*), char (*), char (*), char (*), bit (72) aligned),
75 ios_$detach entry (char (*), char (*), char (*), bit (72) aligned),
76 ios_$get_at_entry_ entry (char (*), char (*), char (*), char (*), fixed bin),
77 unique_chars_ entry (bit (*) aligned) returns (char (15) aligned);
78
79 dcl (addr, max) builtin;
80
81 % include bk_ss_;
82
83 % include io_status;
84
85 % include dprint_arg;
86
87 dcl 1 dprint_defaults aligned,
88 2 version fixed bin init (9),
89 2 copies fixed bin init (1),
90 2 delete fixed bin init(0),
91 2 queue fixed bin init(-1),
92 2 pt_pch fixed bin init (1),
93 2 notify fixed bin init (0),
94 2 heading char (64) init (""),
95 2 output_module fixed bin init (1),
96 2 dest char (12) init (""),
97
98
99
100 2 carriage_control,
101 3 nep bit (1) unal init ("0"b),
102 3 single bit (1) unal init ("0"b),
103 3 non_edited bit (1) unal init ("0"b),
104 3 truncate bit (1) unal init ("0"b),
105 3 center_top_label bit (1) unal init ("0"b),
106 3 center_bottom_label bit (1) unal init ("0"b),
107 3 esc bit (1) unal init ("0"b),
108 3 no_separator bit (1) unal init ("0"b),
109 3 line_nbrs bit (1) unal init ("0"b),
110 3 padding bit (27) unal init ((27)"0"b),
111 2 pad (30) fixed bin init ((30)0),
112 2 forms char (8) init (""),
113 2 lmargin fixed bin init (0),
114 2 line_lth fixed bin init (-1),
115
116
117
118 2 class char(8) init (""),
119 2 page_lth fixed bin init (-1),
120
121
122
123 2 top_label char(136) init (""),
124 2 bottom_label char(136) init (""),
125
126
127
128 2 bit_count fixed bin (35) init (0),
129 2 form_name char (24) init (""),
130 2 destination char (24) init (""),
131 2 chan_stop_path char (168) init (""),
132
133
134
135 2 request_type char (24) unaligned init (""),
136 2 defer_until_process_termination fixed bin init (0),
137
138 2 forms_name char (64) unaligned init ("");
139
140 join_reload:
141 cold = ""b;
142 print_map = "1"b;
143 bk_ss_$myname = "reload";
144 go to squo;
145
146 reload_arg_array: entry (arg_array);
147 array = "1"b;
148 goto join_reload;
149
150 system_release: entry;
151 cold = "0"b;
152 print_map = "0"b;
153 bk_ss_$myname = "reload";
154 bk_ss_$ignore_dates = "1"b;
155 bk_ss_$dir_trim = "1"b;
156 go to squo;
157
158 iload: entry;
159 cold = "1"b;
160 print_map = "0"b;
161 bk_ss_$myname = "iload";
162 squo: bk_ss_$trimsw = "1"b;
163 complete = "1"b;
164 bk_ss_$quotasw = "1"b;
165 go to reset_control;
166
167 retrieve: entry;
168 cold, complete, print_map = ""b;
169 bk_ss_$quotasw = ""b;
170 bk_ss_$datesw = ""b;
171 bk_ss_$myname = "retrieve";
172 bk_ss_$trimsw = ""b;
173 reset_control:
174 bk_ss_$sub_entry = "0"b;
175 bk_ss_$pvname = "";
176 bk_ss_$pvsw = "0"b;
177 bk_ss_$rname = "";
178 bk_ss_$retrievesw = "0"b;
179 bk_ss_$rsize = 0;
180 start:
181 n = 1;
182
183 if ^complete then do;
184 call cu_$arg_ptr (1, ap, n, code);
185 if code ^= 0 then do;
186 call com_err_ (code, bk_ss_$myname, "Control file path required.");
187 go to ended;
188 end;
189
190 if ap -> tchar = "-" then do;
191 n = 1;
192 go to arg_reader;
193 end;
194 bk_ss_$rname = ap -> arg;
195 bk_ss_$retrievesw = "1"b;
196 bk_ss_$rsize = n;
197
198 n = 2;
199
200 end;
201
202 arg_reader:
203 bk_ss_$mapsw = "1"b;
204 if ^array then do;
205 call cu_$arg_list_ptr (alp);
206 call bk_arg_reader_$reload_arg_reader (n, alp, code);
207 end;
208 else call bk_arg_reader_$array_arg_reader (arg_array, code);
209 if code ^= 0 then if code ^= error_table_$noarg then go to ended;
210
211 if bk_ss_$myname = "retrieve"
212 then if bk_ss_$retrievesw
213 then call ioa_$rsnnl ("^a.retrieve.map", map_name, l, bk_ss_$rname);
214 else do;
215 call ioa_ ("No retrieval file argument given");
216 go to ended;
217 end;
218
219 else if bk_ss_$debugsw then do;
220 call date_name_ ("", "", "reload.map", mname, code);
221 if code ^= 0 then do;
222 call com_err_ (code, "reload", "Termination on error from date_name_");
223 go to ended;
224 end;
225 map_name = mname;
226 l = 32;
227 end;
228
229 else do;
230 if cold then do;
231 rings (1), rings (2), rings (3) = 7;
232 call hcs_$append_branchx (">", "reload_dir", 01011b, rings,
233 (get_group_id_$tag_star ()), 1, 0, 0, code);
234 if code ^= 0 then if code ^= error_table_$namedup then go to ended;
235 call hcs_$acl_add1 (">", "reload_dir", "*.SysDaemon.*", 01011b, rings, code);
236 if code ^= 0 then go to ended;
237 end;
238
239 call ioa_$rsnnl (">reload_dir>^a.reload.map", map_name, l, unique_chars_ (""b));
240 end;
241
242 rings (1), rings (2), rings (3) = max ((cu_$level_get ()), 4);
243
244 call expand_path_ (addr (map_name), l, addr (dir), addr (ent), code);
245 call hcs_$append_branchx (dir, ent, 01011b, rings, (get_group_id_$tag_star ()), 0, 0, 0, code);
246 if (code = 0) | (code = error_table_$namedup)
247 then call hcs_$acl_add1 (dir, ent, "*.SysDaemon.*", 01011b, rings, code);
248 sp = addr (status);
249 call ios_$attach ("map", "file_", map_name, "w", sp -> status_bits);
250 if status.code = error_table_$ionmat then do;
251 if print_map then do;
252 call ios_$get_at_entry_ ("map", device, map_name, mode, code);
253 if code = 0 then do;
254 if device ^= "file_" then
255 print_map = ""b;
256 end;
257 else do;
258 call com_err_ (code, bk_ss_$myname, "ios_$get_at_entry_ for map");
259 print_map = ""b;
260 end;
261 end;
262 end;
263 else if status.code ^= 0 then do;
264 call com_err_ (status.code, bk_ss_$myname, "ios_$attach for ^a", map_name);
265 go to ended;
266 end;
267
268 call backup_load ();
269
270 done: call ios_$detach ("map", "", "", sp -> status_bits);
271 if status.code ^= 0 then
272 call com_err_ (status.code, bk_ss_$myname, "ios_$detach for ^a", map_name);
273 if print_map & bk_ss_$dprintsw then do;
274 dpap = addr(dprint_arg_buf);
275 dprint_arg_buf = dprint_defaults;
276 dprint_arg.nep = "1"b;
277 dprint_arg_buf.queue = bk_ss_$dprint_queue;
278 if bk_ss_$dprint_destination_setsw then dprint_arg_buf.destination = bk_ss_$dprint_destination;
279 else dprint_arg_buf.destination = "BACKUP";
280 if bk_ss_$dprint_heading_setsw then dprint_arg_buf.heading = bk_ss_$dprint_heading;
281 else dprint_arg_buf.heading = "RELOAD MAP";
282 if bk_ss_$dprint_request_type_setsw then dprint_arg_buf.request_type = bk_ss_$dprint_request_type;
283 call hcs_$status_minf (dir, ent, 1, 0, dprint_arg_buf.bit_count, code);
284
285 call dprint_ ( dir, ent, dpap, code );
286 if code ^= 0
287 then call com_err_ ( code, bk_ss_$myname, "Unable to dprint map." );
288 end;
289
290 ended: bk_ss_$myname = "";
291 end reload;