1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         *********************************************************** */
  8 %;                                                          /* Tape input procedure for backup system. */
  9 /* ******************************************************
 10    *                                                    *
 11    *                                                    *
 12    * Copyright (c) 1972 by Massachusetts Institute of   *
 13    * Technology and Honeywell Information Systems, Inc. *
 14    *                                                    *
 15    *                                                    *
 16    ****************************************************** */
 17 
 18 bk_input:                                                   /* Created February 1969, R C Daley. */
 19      procedure;                                             /* Modified 7 February 1970, R H Campbell. */
 20                                                             /* Modified 10/25/65 by S. Herbst */
 21                                                             /* changed to use tape_mult_
 22                                                                9/77 by Noel I. Morris */
 23                                                             /* Modified 11/9/77 by Steve Herbst */
 24 /* Changed to call command_query_ except for "20 unexplained errors" query 02/28/80 S. Herbst */
 25 /* Modified: 17 October 1980 by G. Palter to obey bk_ss_$preattached */
 26 /* Attach description changed from char(32) to char(168) to hold user comments 05/14/81 S. Herbst */
 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 ("");                      /* To reset tape label */
 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),             /* Backup logical record header */
 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; /* File system code. */
 86 
 87 /* ^L */
 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 /* ^L */
 98 
 99 input_init: entry (istat);                                  /* entry to initialize backup input procedure */
100 
101 dcl  istat fixed bin (35);                                  /* Error code (returned). */
102 
103           buffer = addr (line);                             /* Set up pointer to buffer for comments. */
104 
105           if bk_ss_$preattached
106           then do;                                          /* caller has already setup I/O switch */
107                mounted = "1"b;                              /* say it's moutned */
108                iocbp1 = bk_ss_$data_iocb;
109                istat = 0;
110           end;
111           else if held then istat = 0;                      /* -hold last time */
112           else do;
113                if mounted then call unmount;                /* unmount any previous tapes */
114                call mount (istat);                          /* mount first reload tape(s) */
115           end;
116           return;
117 
118 
119 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
120 
121 
122 rd_tape:  entry (lblptr, lblcnt, segptr, segcnt, rstat);    /* to get next backup record from tape */
123 
124 
125 dcl  lblptr pointer,                                        /* pointer to preamble area */
126      lblcnt fixed binary,                                   /* size of preamble (returned) */
127      segptr pointer,                                        /* pointer to segment area */
128      segcnt fixed binary,                                   /* length of segment if any (returned) */
129      rstat fixed bin (35);                                  /* status code (returned) */
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;                              /* Abort if no tape mounted. */
142                rstat = error_table_$dev_nt_assnd;
143                return;
144 
145           end;
146           buffer = addr (line);                             /* Set up pointer to buffer for comments. */
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;                    /*  must have not found rest of segment */
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;                             /* Check for tape reading error */
159                if code = error_table_$end_of_info then go to eor; /* check end of reel */
160                go to tsterr;                                /* check for further tsterrors */
161           end;
162 
163           if unspec (theader.compare) ^= unspec (header) then do;
164                if skipped = 0 then                          /* Is this the first time? */
165                     call backup_map_$on_line (addr (searching_for_header), length (searching_for_header));
166                skipped = skipped + 1;                       /* Count this physical record skipped. */
167                call iox_$get_chars (iocbp1, addr (theader), 896, nelemt, code);
168                if code = error_table_$end_of_info then go to eor; /* check end of reel */
169                if code ^= 0 then go to tsterr;              /* check for read error spacing */
170                go to getnext;                               /* try again to read header */
171           end;
172 
173           if skipped ^= 0 then do;                          /* Did we have to skip any records? */
174                call ioa_$rsnnl ("^d 256-word blocks skipped.", line, temp, skipped); /* Make up comment. */
175                call backup_map_$on_line (buffer, temp);     /* Type the comment. */
176                skipped = 0;                                 /* Clear the count. */
177 
178           end;
179           lblcnt = theader.hdrcnt;                          /* pick up preamble length in words */
180           segcnt = theader.segcnt;                          /* pick up segment length in words */
181           temp = theader.hdrcnt + 32 + 255;                 /* adjust to read preamble to end of physical record */
182           temp = temp - mod (temp, 256) - 32;               /* 32 words have already been read. */
183           call iox_$get_chars (iocbp1, lblptr, temp * 4, nelemt, code);
184 
185           if code = error_table_$end_of_info then go to eor; /* check end of reel */
186           if code ^= 0 then go to tsterr;
187           if req = header_only then return;
188                                                             /*  header has been read */
189 
190 
191 READ_SEG:
192           if segcnt > 0 then do;
193                temp = segcnt + 255;                         /* adjust to read segment to end of physical record */
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; /* check end of reel */
197                if code ^= 0 then go to tsterr;
198           end;
199           return;                                           /* exit to caller */
200 
201 eor:      call backup_map_$on_line (addr (end_of_reel_encountered), length (end_of_reel_encountered));
202           go to remount;                                    /* go to mount next tape if any */
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;                               /* go to mount next reel if any */
207           end;
208 
209 err:      call backup_map_$fs_error_line (code, "bk_input", "primary_reload_tape", "");
210                                                             /* We used to go to remount for code = */
211                                                             /* et_$improper_data_format also, but now */
212                                                             /* we fall thru and eventually query user. */
213                                                             /* It was found that usually the rest */
214                                                             /* of the tape was readable after all. */
215 
216           error_count = error_count + 1;                    /* bump error count */
217           if error_count > 20 then do;                      /* more than 20 successive  unexplained errors */
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;               /* try next tape */
226                error_count = 0;                             /* try 20 more times */
227           end;
228           go to getnext;                                    /* and try to find next record on this reel */
229 
230 
231 remount:  if bk_ss_$sub_entry then do;                      /* get next tape label from tape_entry */
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;                                   /* indicate normal termination */
246                return;
247           end;
248 next:     call unmount;                                     /* unmount current reel(s) */
249           error_count = 0;
250           call mount (rstat);                               /* mount next reel(s) if any */
251           if rstat ^= 0 then return;                        /* return if no more reels to load */
252           skipped = 0;                                      /* Reset count of records skipped. */
253           go to getnext;                                    /* otherwise, continue on new reel(s) */
254 
255 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
256 
257 input_finish: entry;                                        /* to terminate reload (by program) */
258           buffer = addr (line);                             /* Set up pointer to buffer for comments. */
259           if bk_ss_$preattached then;
260           else if mounted then
261                if ^bk_ss_$holdsw then call unmount;         /* unmount any reel(s) still mounted */
262                else if first_tape_label ^= tape_label then do; /* -hold with a multi-volume set */
263                     call unmount;                           /* dismount last tape */
264                     remount_first_tape = "1"b;              /* and mount the first */
265                     call mount (rstat);
266                     held = "1"b;
267                end;
268                else do;
269                     held = "1"b;                            /* -hold: don't unmount */
270                     call iox_$close (iocbp1, code);
271                     call iox_$open (iocbp1, Stream_input, "0"b, code);
272                end;                                         /* just rewind tape */
273           return;
274                                                             /* ^L */
275 mount:    procedure (mount_status);                         /* internal procedure to mount first or next reel(s) */
276 
277 dcl  mount_status fixed bin (35);                           /* Error code (returned). */
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;            /* get tape label from tape_entry */
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;                             /* default is small buffer */
301                if ^bk_ss_$debugsw then if (bk_ss_$myname = "reload") | (bk_ss_$myname = "iload") then do;
302                          buf_size = 4160;                   /* system reload so big buffer */
303                          tape_label = rtrim (tape_label) || ",sys";  /* we want to be a system process */
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;         /* reset */
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);                        /* set mounted switch */
323           end mount;
324 
325 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
326 
327 unmount:  procedure;                                        /* internal procedure to unmount current reel(s) */
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);   /* Reset label info in map header */
337           end unmount;
338      end bk_input;