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
37
38
39
40
41 ^L
42
43
44 bk_output:
45 procedure;
46
47 dcl uptr ptr;
48 dcl temp fixed bin,
49 code fixed bin (35),
50 attach_descrip char (168),
51 buffer pointer,
52 line character (132);
53
54
55 dcl answer char (64) aligned varying;
56 dcl error_rnt entry variable options (variable);
57 dcl requested char(32);
58 dcl comment char(32);
59 dcl volname char(32);
60 dcl volume_pool_path char(168);
61
62 dcl (primary_dump_tape, secondary_dump_tape)
63 static character (64),
64
65 (iocbp1, iocbp2) ptr static,
66 mounted static bit (1) initial (""b),
67
68 two_tapes bit (1) static,
69 blanks char (4) static init (""),
70
71 s character (1) static;
72
73
74 dcl 1 header static,
75 2 zz1 character (32) initial (" z z z z z z z z z z z z z z z z"),
76 2 english character (56)
77 initial ("This is the beginning of a backup logical record."),
78 2 zz2 character (32) initial (" z z z z z z z z z z z z z z z z"),
79 2 hdrcnt fixed binary,
80 2 segcnt fixed binary;
81
82 dcl end_of_tape_encountered static options (constant) char (24) initial ("End of tape encountered.");
83
84 declare parse_tape_reel_name_ entry (char (*), char (*)),
85 backup_map_$error_line entry options (variable),
86 backup_map_$fs_error_line entry (fixed bin (35), char (*), char (*), char (*)),
87 (
88 backup_map_$on_line,
89 backup_map_$tapes
90 ) entry (pointer, fixed binary);
91
92 %include iox_dcls;
93
94 dcl com_err_ entry options (variable);
95 dcl sub_err_ entry options (variable);
96 dcl command_query_ entry options (variable);
97 dcl ioa_ entry options (variable);
98 dcl ioa_$rsnnl entry options (variable);
99 dcl manage_volume_pool_$allocate entry (ptr, entry options (variable), char (*), char (*), char (*),
100 fixed bin (35));
101 dcl manage_volume_pool_$get_pool_path entry (ptr, entry, char(*), fixed bin(35));
102 dcl error_table_$action_not_performed
103 fixed bin (35) ext static,
104 error_table_$dev_nt_assnd fixed bin (35) ext static,
105 error_table_$device_end fixed bin (35) ext static;
106
107
108 dcl (addr, addrel, divide, length, min, null, mod, rtrim, unspec)
109 builtin;
110
111 %include query_info;
112
113 %include iox_modes;
114
115 %include bk_ss_;
116
117 %include backup_control;
118 ^L
119 output_init:
120 entry (ntapes, wstat);
121 dcl ntapes fixed bin;
122
123 if bk_ss_$no_output
124 then do;
125 wstat = 0;
126 go to exit;
127 end;
128
129 buffer = addr (line);
130 if bk_ss_$preattached
131 then do;
132 mounted = "1"b;
133 two_tapes = "0"b;
134 s = " ";
135 iocbp1 = bk_ss_$data_iocb;
136 wstat = 0;
137 end;
138 else if mounted
139 then wstat = 0;
140 else do;
141 if ntapes > 1 & ^bk_ss_$sub_entry
142 then do;
143 two_tapes = "1"b;
144 s = "s";
145 end;
146 else if ntapes = 1
147 then do;
148 two_tapes = ""b;
149 s = " ";
150 end;
151 call mount (wstat);
152 end;
153 if bk_ss_$mapsw
154 then
155 if wstat = 0
156 then do;
157 if two_tapes
158 then
159 call ioa_$rsnnl ("Primary tape label: ^a, secondary tape label: ^a.", line, temp,
160 primary_dump_tape, secondary_dump_tape);
161 else call ioa_$rsnnl ("Tape label: ^a.", line, temp, primary_dump_tape);
162 call backup_map_$tapes (buffer, temp);
163
164 end;
165 go to exit;
166
167
168
169 output_finish:
170 entry;
171
172 if bk_ss_$no_output
173 then go to exit;
174
175 buffer = addr (line);
176 if bk_ss_$preattached
177 then ;
178 else if bk_ss_$holdsw
179 then do;
180 call iox_$control (iocbp1, "error_count", addr (temp), code);
181 if code ^= 0
182 then do;
183 flush_error:
184 call backup_map_$fs_error_line (code, "bk_output", "", "");
185 unmo:
186 call unmount;
187 end;
188 if mounted
189 then if two_tapes
190 then do;
191 call iox_$control (iocbp2, "error_count", addr (temp), code);
192 if code ^= 0
193 then go to flush_error;
194 end;
195 end;
196 else call unmount;
197 go to exit;
198
199
200
201 wr_tape:
202 entry (lblptr, lblcnt, segptr, segcnt, wstat);
203
204 dcl lblptr pointer,
205 lblcnt fixed binary,
206
207 segptr pointer,
208 segcnt fixed binary,
209
210 wstat fixed bin (35);
211
212
213 uptr = segptr;
214 if bk_ss_$no_output
215 then do;
216 wstat = 0;
217 go to exit;
218 end;
219
220 if ^mounted
221 then do;
222 wstat = error_table_$dev_nt_assnd;
223 go to exit;
224 end;
225 wstat = 0;
226 buffer = addr (line);
227 header.hdrcnt = lblcnt;
228 header.segcnt = segcnt;
229 retry:
230 call wrout (addr (header), 32);
231 if code = error_table_$device_end
232 then go to enderr;
233 if code ^= 0
234 then go to tsterr;
235 temp = header.hdrcnt + 32 + 255;
236 temp = temp - mod (temp, 256) - 32;
237 call wrout (lblptr, temp);
238 if code = error_table_$device_end
239 then go to enderr;
240 if code ^= 0
241 then go to tsterr;
242 if header.segcnt > 0
243 then do;
244 temp = header.segcnt;
245 call wrbufout (uptr, temp);
246 if code = error_table_$device_end
247 then go to enderr;
248 if code ^= 0
249 then go to tsterr;
250 end;
251 exit:
252 return;
253 enderr:
254 call backup_map_$on_line (addr (end_of_tape_encountered), length (end_of_tape_encountered));
255 go to unm;
256 tsterr:
257 call backup_map_$fs_error_line (code, "bk_output", "", "");
258
259 unm:
260 if bk_ss_$preattached
261 then do;
262 wstat = code;
263 go to exit;
264 end;
265
266 call unmount;
267 call output_init (-1, wstat);
268 if wstat = 0
269 then go to retry;
270 go to exit;
271
272 query_for_tape:
273 procedure (type, label, Squit_the_dump);
274 dcl type character (*),
275
276 label character (64),
277
278 Squit_the_dump bit (1) aligned;
279
280 unspec (query_info) = "0"b;
281 query_info.version = query_info_version_4;
282 query_info.suppress_name_sw = "1"b;
283 query_info.question_iocbp, query_info.answer_iocbp = null;
284 call command_query_ (addr (query_info), answer, bk_ss_$myname, "Type ^a dump tape label:", type);
285 label = answer;
286
287 if label = "quit" | label = "q"
288 then Squit_the_dump = "1"b;
289
290 return;
291 end query_for_tape;
292
293
294
295 get_label:
296 procedure (type, label, Squit_the_dump);
297 dcl type character (*),
298
299 label character (64),
300
301 Squit_the_dump bit (1) aligned;
302
303
304 Squit_the_dump = "0"b;
305
306 code = 0;
307 if bk_ss_$sub_entry then
308 error_rnt = sub_err_;
309 else
310 error_rnt = com_err_;
311
312 if bk_ss_$volume_pool_ptr = null () then
313 call query_for_tape(type, label, Squit_the_dump);
314 else do;
315 requested = "*";
316 comment = bk_ss_$myname;
317 volname = "";
318 call manage_volume_pool_$get_pool_path(bk_ss_$volume_pool_ptr, error_rnt, volume_pool_path, code);
319 if code ^= 0 then
320 volume_pool_path = "[unknown]";
321
322 call manage_volume_pool_$allocate(bk_ss_$volume_pool_ptr, error_rnt, requested, comment, volname, code);
323 if code ^= 0 then do;
324 call error_rnt(code, "bk_output", "Unable to allocate tape from volume pool ^a", volume_pool_path);
325 call query_for_tape(type, label, Squit_the_dump);
326 end;
327 else
328 call ioa_ ("^a: Allocated tape ^a from volume pool ^a", bk_ss_$myname, volname, volume_pool_path);
329 label = volname;
330 end;
331
332 if ^Squit_the_dump then do;
333 if ^bk_ss_$debugsw
334 then
335 label = rtrim (label) || ",sys";
336 end;
337 return;
338 end get_label;
339
340
341
342 mount:
343 procedure (mount_status);
344 dcl mount_status fixed bin (35);
345 dcl Squit_the_dump bit (1) aligned;
346
347 mount_status = 0;
348 mounted = "0"b;
349 Squit_the_dump = "0"b;
350 iocbp1, iocbp2 = null;
351
352 do while (^mounted & ^Squit_the_dump);
353 if bk_ss_$sub_entry
354 then
355 call bk_ss_$control_ptr -> backup_control.tape_entry (primary_dump_tape);
356 else
357 call get_label ("primary", primary_dump_tape, Squit_the_dump);
358
359 call mount_tape (Squit_the_dump, iocbp1, "bk_output_1", primary_dump_tape, mount_status);
360 end;
361 if two_tapes & mounted & mount_status = 0
362 then do;
363 mounted = "0"b;
364 do while (^mounted & ^Squit_the_dump);
365 call get_label ("secondary", secondary_dump_tape, Squit_the_dump);
366
367 call mount_tape (Squit_the_dump, iocbp2, "bk_output_2", secondary_dump_tape, mount_status);
368 end;
369 end;
370 return;
371
372
373 mount_tape:
374 proc (Squit, Piocb, switch_name, tape_id, code);
375
376 dcl Squit bit (1) aligned,
377 Piocb ptr,
378 switch_name char (11),
379 tape_id char (64),
380 code fixed bin (35);
381
382 code = 0;
383
384 if Squit
385 then do;
386 code = error_table_$action_not_performed;
387 call backup_map_$error_line (code, "bk_output", "Aborted tape mount.");
388 if iocbp1 ^= null
389 then do;
390 call iox_$close (iocbp1, (0));
391 call iox_$detach_iocb (iocbp1, (0));
392 end;
393 return;
394 end;
395
396 call parse_tape_reel_name_ (tape_id, attach_descrip);
397 call iox_$attach_name (switch_name, Piocb, "tape_mult_ " || attach_descrip || " -write", null (), code);
398
399 if code ^= 0
400 then call backup_map_$fs_error_line (code, "bk_output", tape_id, "");
401 else do;
402 call iox_$open (Piocb, Stream_output, "0"b, code);
403 if code = 0
404 then mounted = "1"b;
405 else do;
406 call backup_map_$fs_error_line (code, "bk_output", tape_id, "");
407 code = 0;
408 call iox_$detach_iocb (Piocb, code);
409 if code ^= 0
410 then call backup_map_$fs_error_line (code, "bk_output", tape_id, "");
411 end;
412 end;
413 if code = 0
414 then call iox_$modes (Piocb, "async", (""), (0));
415
416 return;
417 end mount_tape;
418 end mount;
419
420
421
422 wrbufout:
423 proc (wrptr, wrcnt);
424 dcl wrptr ptr;
425 dcl wrcnt fixed bin;
426 dcl ttbuf (words_to_write) fixed bin (35) aligned based;
427 dcl zzbuf (1024) fixed bin (35) aligned based;
428 dcl xptr ptr;
429 dcl words_to_go fixed bin;
430 dcl words_to_write fixed bin;
431 dcl save_err_label label;
432 dcl EC fixed bin (35);
433
434
435 save_err_label = bk_ss_$err_label;
436 bk_ss_$err_label = wbo_clean;
437
438 words_to_go = wrcnt;
439 wbo_retry:
440 xptr = wrptr;
441 do while (words_to_go > 0);
442
443 words_to_write = min (1024, words_to_go);
444
445 if wrptr ^= bk_ss_$sp
446 then do;
447 if words_to_write ^= 1024
448 then
449 unspec (bk_ss_$sp -> zzbuf) = ""b;
450
451 bk_ss_$error = 9;
452 bk_ss_$sp -> ttbuf = xptr -> ttbuf;
453 bk_ss_$error = 0;
454 end;
455
456 words_to_write = 256 * divide (words_to_write + 255, 256, 17, 0);
457
458 call iox_$put_chars (iocbp1, bk_ss_$sp, words_to_write * 4, code);
459 if two_tapes & code = 0
460 then call iox_$put_chars (iocbp2, bk_ss_$sp, words_to_write * 4, code);
461 if code ^= 0
462 then go to wbo_ret;
463
464 xptr = addrel (xptr, words_to_write);
465 words_to_go = words_to_go - words_to_write;
466 end;
467
468 wbo_ret:
469 if ^bk_ss_$preattached & (code = 0)
470 then do;
471 call iox_$control (iocbp1, "error_count", addr (EC), code);
472
473 if two_tapes & code = 0
474 then call iox_$control (iocbp2, "error_count", addr (EC), code);
475 end;
476
477 bk_ss_$err_label = save_err_label;
478 return;
479
480 wbo_clean:
481 unspec (bk_ss_$sp -> zzbuf) = ""b;
482 wrptr = bk_ss_$sp;
483 bk_ss_$err_label = save_err_label;
484
485 go to wbo_retry;
486
487 end wrbufout;
488
489
490
491 wrout:
492 procedure (wrptr, wrcnt);
493 dcl wrptr pointer,
494 wrcnt fixed binary;
495
496 call iox_$put_chars (iocbp1, wrptr, wrcnt * 4, code);
497 if two_tapes
498 then if code = 0
499 then
500 call iox_$put_chars (iocbp2, wrptr, wrcnt * 4, code);
501
502 end wrout;
503
504
505
506 unmount:
507 procedure;
508 if ^mounted
509 then return;
510
511 call iox_$close (iocbp1, code);
512 if code ^= 0
513 then call backup_map_$fs_error_line (code, "bk_output", primary_dump_tape, "");
514 call iox_$detach_iocb (iocbp1, code);
515 if code ^= 0
516 then call backup_map_$fs_error_line (code, "bk_output", primary_dump_tape, "");
517 if two_tapes
518 then do;
519 call iox_$close (iocbp2, code);
520 if code ^= 0
521 then
522 call backup_map_$fs_error_line (code, "bk_output", secondary_dump_tape, "");
523 call iox_$detach_iocb (iocbp2, code);
524 if code ^= 0
525 then
526 call backup_map_$fs_error_line (code, "bk_output", secondary_dump_tape, "");
527 end;
528 call backup_map_$tapes (addr (blanks), 4);
529 mounted = "0"b;
530 iocbp1, iocbp2 = null;
531
532 end unmount;
533 end bk_output;