1
2
3
4
5
6
7
8 %;
9
10
11
12
13
14
15
16
17
18 bk_input:
19 procedure;
20
21
22
23
24
25
26
27
28 dcl (tape_label, first_tape_label) char (64) init ("");
29 dcl answer char (64) aligned varying;
30
31 dcl (temp, skipped, error_count) fixed binary,
32 nelemt fixed bin (22),
33 code fixed bin (35),
34 attach_descrip char (168),
35 line character (132),
36 yes_sw bit (1),
37 (buffer, tp) pointer;
38
39 dcl iocbp1 ptr static init (null ()),
40 (held, mounted, remount_first_tape) bit (1) static initial ("0"b),
41 blanks char (4) static init ("");
42
43 dcl buf_size fixed bin;
44 dcl tape_dim_data_$tdcm_buf_size fixed bin external;
45
46 dcl searching_for_header static character (21) initial ("Searching for header.");
47
48 dcl end_of_reel_encountered static character (24) initial ("End of reel encountered.");
49
50 dcl end_of_readable_data static character (21) initial ("End of readable data.");
51
52 dcl 1 header aligned static options (constant),
53 2 zz1 char (32) init (" z z z z z z z z z z z z z z z z"),
54 2 english char (56) init ("This is the beginning of a backup logical record."),
55 2 zz2 char (32) init (" z z z z z z z z z z z z z z z z");
56
57 dcl 1 theader aligned,
58 2 compare,
59 3 zz1 char (32),
60 3 english char (56),
61 3 zz2 char (32),
62 2 hdrcnt fixed bin,
63 2 segcnt fixed bin,
64 2 space (32: 255);
65
66 dcl (addr, length, mod, null, rtrim, substr, unspec) builtin;
67
68 dcl iox_$error_output ptr ext;
69 dcl iox_$user_input ptr ext;
70
71 dcl backup_map_$fs_error_line entry (fixed bin (35), char (*), char (168), char (32)),
72 (backup_map_$tapes, backup_map_$on_line) entry (pointer, fixed binary),
73 command_query_$yes_no entry options (variable),
74 (ioa_$rsnnl, ioa_$nnl, ioa_) entry options (variable),
75 command_query_ entry options (variable),
76 iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35)),
77 iox_$open entry (ptr, fixed bin, bit (1), fixed bin (35)),
78 iox_$close entry (ptr, fixed bin (35)),
79 iox_$detach_iocb entry (ptr, fixed bin (35)),
80 iox_$get_chars entry (ptr, ptr, fixed bin (22), fixed bin (22), fixed bin (35)),
81 iox_$get_line entry (ptr, ptr, fixed bin (22), fixed bin, fixed bin (35)),
82 parse_tape_reel_name_ entry (char (*), char (*));
83
84 dcl (error_table_$end_of_info, error_table_$improper_data_format,
85 error_table_$data_improperly_terminated, error_table_$dev_nt_assnd) ext fixed bin;
86
87
88
89 %include query_info;
90 %page;
91 %include iox_modes;
92 %page;
93 %include bk_ss_;
94 %page;
95 %include backup_control;
96
97
98
99 input_init: entry (istat);
100
101 dcl istat fixed bin (35);
102
103 buffer = addr (line);
104
105 if bk_ss_$preattached
106 then do;
107 mounted = "1"b;
108 iocbp1 = bk_ss_$data_iocb;
109 istat = 0;
110 end;
111 else if held then istat = 0;
112 else do;
113 if mounted then call unmount;
114 call mount (istat);
115 end;
116 return;
117
118
119
120
121
122 rd_tape: entry (lblptr, lblcnt, segptr, segcnt, rstat);
123
124
125 dcl lblptr pointer,
126 lblcnt fixed binary,
127 segptr pointer,
128 segcnt fixed binary,
129 rstat fixed bin (35);
130
131 dcl req fixed bin;
132 dcl header_only fixed bin int static init (1);
133 dcl segment_only fixed bin int static init (2);
134 dcl both fixed bin int static init (3);
135
136
137 if lblptr = null then req = segment_only;
138 else if segptr = null then req = header_only;
139 else req = both;
140
141 if ^mounted then do;
142 rstat = error_table_$dev_nt_assnd;
143 return;
144
145 end;
146 buffer = addr (line);
147 skipped, error_count, rstat = 0;
148 if req = segment_only then go to READ_SEG;
149
150 getnext:
151 if req = segment_only then do;
152 rstat = 2;
153 return;
154 end;
155
156 call iox_$get_chars (iocbp1, addr (theader), 128, nelemt, code);
157
158 if code ^= 0 then do;
159 if code = error_table_$end_of_info then go to eor;
160 go to tsterr;
161 end;
162
163 if unspec (theader.compare) ^= unspec (header) then do;
164 if skipped = 0 then
165 call backup_map_$on_line (addr (searching_for_header), length (searching_for_header));
166 skipped = skipped + 1;
167 call iox_$get_chars (iocbp1, addr (theader), 896, nelemt, code);
168 if code = error_table_$end_of_info then go to eor;
169 if code ^= 0 then go to tsterr;
170 go to getnext;
171 end;
172
173 if skipped ^= 0 then do;
174 call ioa_$rsnnl ("^d 256-word blocks skipped.", line, temp, skipped);
175 call backup_map_$on_line (buffer, temp);
176 skipped = 0;
177
178 end;
179 lblcnt = theader.hdrcnt;
180 segcnt = theader.segcnt;
181 temp = theader.hdrcnt + 32 + 255;
182 temp = temp - mod (temp, 256) - 32;
183 call iox_$get_chars (iocbp1, lblptr, temp * 4, nelemt, code);
184
185 if code = error_table_$end_of_info then go to eor;
186 if code ^= 0 then go to tsterr;
187 if req = header_only then return;
188
189
190
191 READ_SEG:
192 if segcnt > 0 then do;
193 temp = segcnt + 255;
194 temp = temp - mod (temp, 256);
195 call iox_$get_chars (iocbp1, segptr, temp * 4, nelemt, code);
196 if code = error_table_$end_of_info then go to eor;
197 if code ^= 0 then go to tsterr;
198 end;
199 return;
200
201 eor: call backup_map_$on_line (addr (end_of_reel_encountered), length (end_of_reel_encountered));
202 go to remount;
203
204 tsterr: if code = error_table_$data_improperly_terminated then do;
205 call backup_map_$on_line (addr (end_of_readable_data), length (end_of_readable_data));
206 go to remount;
207 end;
208
209 err: call backup_map_$fs_error_line (code, "bk_input", "primary_reload_tape", "");
210
211
212
213
214
215
216 error_count = error_count + 1;
217 if error_count > 20 then do;
218 call backup_map_$fs_error_line (code, bk_ss_$myname, "More than 20 unexplained errors", "");
219 call command_query_$yes_no (yes_sw, 0, bk_ss_$myname,
220 "20 unrecoverable I/O errors have occurred; the tape is probably unreadable.
221 Do you want to try further?",
222 "More than 20 unexplained errors.
223 Do you want to try for 20 more?");
224
225 if ^yes_sw then go to remount;
226 error_count = 0;
227 end;
228 go to getnext;
229
230
231 remount: if bk_ss_$sub_entry then do;
232 call bk_ss_$control_ptr -> backup_control.tape_entry (tape_label);
233 if tape_label = "" then go to no_more;
234 else go to next;
235 end;
236
237 unspec (query_info) = "0"b;
238 query_info.version = query_info_version_5;
239 query_info.yes_or_no_sw = "1"b;
240 query_info.question_iocbp, query_info.answer_iocbp = null;
241
242 call command_query_ (addr (query_info), answer, bk_ss_$myname,
243 "Are there any more tapes to be reloaded?");
244 if answer = "no" then do;
245 no_more: rstat = 1;
246 return;
247 end;
248 next: call unmount;
249 error_count = 0;
250 call mount (rstat);
251 if rstat ^= 0 then return;
252 skipped = 0;
253 go to getnext;
254
255
256
257 input_finish: entry;
258 buffer = addr (line);
259 if bk_ss_$preattached then;
260 else if mounted then
261 if ^bk_ss_$holdsw then call unmount;
262 else if first_tape_label ^= tape_label then do;
263 call unmount;
264 remount_first_tape = "1"b;
265 call mount (rstat);
266 held = "1"b;
267 end;
268 else do;
269 held = "1"b;
270 call iox_$close (iocbp1, code);
271 call iox_$open (iocbp1, Stream_input, "0"b, code);
272 end;
273 return;
274
275 mount: procedure (mount_status);
276
277 dcl mount_status fixed bin (35);
278
279 if remount_first_tape then do;
280 remount_first_tape = "0"b;
281 tape_label = first_tape_label;
282 end;
283 else do;
284 if bk_ss_$sub_entry then do;
285 if tape_label = "" then
286 call bk_ss_$control_ptr -> backup_control.tape_entry (tape_label);
287 end;
288 else do;
289 unspec (query_info) = "0"b;
290 query_info.version = query_info_version_5;
291 query_info.suppress_name_sw = "1"b;
292 query_info.question_iocbp, query_info.answer_iocbp = null;
293 call command_query_ (addr (query_info), answer, bk_ss_$myname,
294 "Input tape label:");
295 tape_label = answer;
296 end;
297 if first_tape_label = "" then first_tape_label = tape_label;
298 end;
299
300 buf_size = 2080;
301 if ^bk_ss_$debugsw then if (bk_ss_$myname = "reload") | (bk_ss_$myname = "iload") then do;
302 buf_size = 4160;
303 tape_label = rtrim (tape_label) || ",sys";
304 end;
305
306 tape_dim_data_$tdcm_buf_size = buf_size;
307 call parse_tape_reel_name_ (tape_label, attach_descrip);
308 call iox_$attach_ioname ("bk_input_1", iocbp1, "tape_mult_ " || attach_descrip, code);
309 if code ^= 0 then do;
310 call backup_map_$fs_error_line (code, "bk_input", "attach bk_input_1", "");
311 go to MOUNT_ERROR;
312 end;
313 call iox_$open (iocbp1, Stream_input, "0"b, code);
314 tape_dim_data_$tdcm_buf_size = 2080;
315 if code ^= 0 then
316 call backup_map_$fs_error_line (code, "bk_input", "open bk_input_1", "");
317 else do;
318 call ioa_$rsnnl ("Tape label: ^a.", line, temp, tape_label);
319 call backup_map_$tapes (buffer, temp);
320 end;
321 MOUNT_ERROR: mount_status = code;
322 mounted = (code = 0);
323 end mount;
324
325
326
327 unmount: procedure;
328 held = "0"b;
329 call iox_$close (iocbp1, code);
330 if code ^= 0 then
331 call backup_map_$fs_error_line (code, "bk_input", "close bk_input_1", "");
332 call iox_$detach_iocb (iocbp1, code);
333 if code ^= 0 then
334 call backup_map_$fs_error_line (code, "bk_input", "detach bk_input_1", "");
335 mounted = "0"b;
336 call backup_map_$tapes (addr (blanks), 4);
337 end unmount;
338 end bk_input;