1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 bk_retrieve: proc;                                          /* extracted from backup_load */
 14 
 15 /* Modified 16 June 1970, R H Campbell. */
 16 /* Modified 21 October 1970, R. J. Feiertag */
 17 /* Modified 10 May 1971, R. A. Tilden */
 18 /* Modified 22 July 1974 RE Mullen */
 19 /* Modified 23 July 1975, R. Bratt to remove knowledge of pre 18-0 backup tape formats */
 20 /* Entry points check_structure and parse structure added 11/9/77 by Steve Herbst */
 21 /* -no_primary added 08/03/79 S. Herbst */
 22 /* Modified to avoid page boundary hardware bug 098; installed on MCR 4311 to fix errmsgs 02/05/80 S. Herbst */
 23 /* Hierarchy level restriction removed for reloading commands 07/18/80 S. Herbst */
 24 /* Changed not to cross-retrieve a segment in place of an existing directory 01/21/82 S. Herbst */
 25 /* Changed to retrieve an entire MSF without ">**" 02/05/82 S. Herbst */
 26 
 27 dcl (i, j, k, l, n, htype) fixed bin,                       /* temporary storage */
 28      path_name char (168),                                  /* Complete path name of entry. */
 29      old_dname char (168) init (""),                        /* Previous directory name. */
 30      code fixed bin (35);
 31 
 32 
 33 dcl  line char (300) static,                                /* Output line(s) buffer. */
 34      line_pointer ptr static,                               /* Pointer to line buffer. */
 35      hp ptr static,
 36      a_hp ptr;
 37 
 38 dcl  nl char (1) static;                                    /* Newline used in parsing retrieval control */
 39 
 40 dcl  rname char (168) aligned,                              /* Retrieval control input name, dirname */
 41      rdname char (168) static aligned,                      /* Retrieval control dirname */
 42      rename char (32) aligned static,                       /* ..entry name */
 43     (rsize, rbc) fixed bin;                                 /* size of rname, bit count of file */
 44 
 45 dcl (rptr, reqptr) ptr static;                              /* ptr to retrieval control (raw, parsed) */
 46 
 47 dcl (parsed, next, stop, terminate, reported, checked) fixed bin static;
 48 
 49 dcl  label_index fixed bin;
 50 
 51 dcl (rlines, rfin, rcomp,                                   /* no. requests, no. complete, no. unique */
 52      rcurr, ncurr) fixed bin static,                        /* current request, next newname */
 53      grt_count fixed bin;                                   /* number of >'s in a pathname */
 54 
 55 dcl  1 req based (reqptr) aligned,                          /* parsed request array */
 56      2 path_copy char (168),                                /* to avoid CMPC failure near page boundary, Bug 098 */
 57      2 opt (1000),                                          /* options for, status of, a request */
 58      3 (rename,                                             /* new name was provided */
 59      exact,                                                 /* load only this entity */
 60      synonym,                                               /* this entry is a synonym for the one specified by renamo */
 61      found,                                                 /* something by this name was found */
 62      finished,                                              /* request has been satisfied fully */
 63      spare) bit (1) unaligned,
 64      2 srch (1000),                                         /* data by which to retrieve */
 65      3 (len,                                                /* significant chars in search name */
 66      grt,                                                   /* number of >'s in search name */
 67      control_index,                                         /* index of backup_control entry for backup_load_ */
 68      renamo) fixed bin,                                     /* index of newname or of primary entry if a synonym */
 69      3 name char (168),                                     /* name to look for */
 70      2 newn (200),                                          /* name by which to reload */
 71      3 (ndlen, nelen, ngrt) fixed bin,                      /* lengths of next fields, number of ">"s in dname */
 72      3 ndname char (168);                                   /* new pathname */
 73 
 74 dcl (rscan (1000000) char (1), rmove char (1000000)) based, /* overlays for parsing */
 75      rset bit (6) based;                                    /* overlay for setting field of bits */
 76 
 77 dcl (error_table_$badcall, error_table_$bad_string,
 78      error_table_$smallarg, error_table_$badpath, error_table_$noentry,
 79      error_table_$no_dir, error_table_$no_s_permission,
 80      error_table_$moderr, error_table_$no_info,
 81      error_table_$arg_ignored, error_table_$segknown) external fixed bin (35);
 82 
 83 dcl (addr, baseptr, divide, fixed, index, length, reverse, rtrim, substr, unspec, verify) builtin;
 84 
 85 dcl  backup_map_$fs_error_line entry (fixed bin (35), char (*) aligned, char (*) aligned, char (*) aligned),
 86      backup_map_$on_line entry (ptr, fixed bin),
 87      backup_util$get_real_name entry (ptr, ptr, fixed bin, fixed bin (35)),
 88      expand_pathname_ entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35));
 89 
 90 dcl  hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)),
 91      hcs_$terminate_noname entry (ptr, fixed bin (35)),
 92      hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)),
 93      hcs_$initiate_count entry (char (*) aligned, char (*) aligned, char (*), fixed bin, fixed bin (2), ptr, fixed bin (35));
 94 
 95 dcl (com_err_, ioa_, ioa_$rsnnl) ext entry options (variable);
 96 
 97 /* ^L */
 98 
 99 %include bk_ss_;
100 %page;
101 %include backup_control;
102 %page;
103 %include backup_preamble_header;
104 %page;
105 %include backup_record_types;
106 
107 /* ^L */
108 
109 /* Check whether this tape record is to be reloaded by scanning retrieval request segment. */
110 
111 check_retrieval: entry (label_index);
112 
113           if rfin = rcomp then do;                          /* If all unique requests are fully satisfied */
114                call ioa_$rsnnl ("^a: all requests satisfied.", line, n, bk_ss_$myname);
115                call backup_map_$on_line (line_pointer, n);  /* inform the world of success */
116                label_index = stop;                          /* and terminate retrieval */
117                go to exit;
118           end;
119 
120           htype = hp -> h.record_type;
121           hp -> h.dlen = length (rtrim (hp -> h.dname));
122           path_name = substr (hp -> h.dname, 1, hp -> h.dlen) || ">"; /* prepare full name of tape record */
123           n = hp -> h.dlen + 1;                             /* set the length */
124           if hp -> h.elen ^= 0 then do;                     /* if there is an entry name, tack it on */
125                hp -> h.elen = length (rtrim (hp -> h.ename));
126                substr (path_name, n + 1) = substr (hp -> h.ename, 1, hp -> h.elen) || ">";
127                n = n + hp -> h.elen + 1;                    /* recompute length */
128           end;
129           if rcurr ^= 0 then do;                            /* if we are currently working on a subtree request */
130                i = rcurr;                                   /* set i in case of match */
131                req.path_copy = req.srch.name (i);
132                if substr (path_name, 1, req.srch.len (i)) = req.path_copy then
133                     go to match;                            /* first part of pathname matches */
134                if bk_ss_$onlysw & req.opt.found (i) then do; /* no longer matching, and wanted only first */
135                     req.opt.finished (i) = "1"b;            /* mark previous request completed */
136                     if req.opt.synonym (i) then req.opt.finished (req.srch.renamo (i)) = "1"b; /* and his twin */
137                     rfin = rfin + 1;                        /* number of fully completed increases */
138                end;
139           end;
140           do i = 1 to rlines;                               /* look for applicable request */
141                if i = rcurr then go to next_test;           /* skip possible request previously checked */
142                if req.opt.finished (i) then go to next_test; /* skip completed request */
143                if req.opt.exact (i) then do;                /* exact means don't load subtree */
144                     if n = req.srch.len (i) & substr (path_name, 1, n) = req.srch.name (i) then
145                          go to match;                       /* exactly the item requested */
146                end;
147                else do;
148                     req.path_copy = req.srch.name (i);
149                     if substr (path_name, 1, req.srch.len (i)) = req.path_copy then
150                          go to match;                       /* pathname matches */
151                end;
152 next_test: end;
153           rcurr = 0;                                        /* not working on anything */
154           label_index = next;                               /* don't process this tape record */
155           go to exit;
156 
157 match:    bk_ss_$retrieval_index = i;                       /* save; backup_load uses it */
158           if bk_ss_$sub_entry then bk_ss_$path_index = req.srch.control_index (i);
159           if htype ^= ndc_directory & htype ^= sec_dir then do;
160                req.opt.found (i) = "1"b;                    /* indicate something interesting encountered */
161                if req.opt.synonym (i) then req.opt.found (req.srch.renamo (i)) = "1"b; /* on twin too */
162                if bk_ss_$sub_entry then
163                     bk_ss_$control_ptr -> backup_control.found (bk_ss_$path_index) = "1"b;
164           end;
165           if bk_ss_$onlysw then do;                         /* special processing with -first option */
166                if req.opt.exact (i) then do;                /* if only exact match was wanted, this is it */
167                     if htype ^= ndc_directory & htype ^= sec_dir then do;
168                          req.opt.finished (i) = "1"b;       /* so mark it, and its brother if any */
169                          if req.opt.synonym (i) then req.opt.finished (req.srch.renamo (i)) = "1"b;
170                          rfin = rfin + 1;                   /* count number of requests complete */
171                     end;
172                end;
173                if rcurr ^= 0 then                           /* avoid OOB */
174                     if req.opt.finished (rcurr) then rcurr = 0; /*  we delayed resetting this so it could be used in loop */
175           end;
176           if ^req.opt.exact (i) then rcurr = i;             /* indicate we are currently interested in a subtree */
177           if req.opt.rename (i) then do;                    /* check whether to load it under its own name */
178                bk_ss_$cross_retrievesw = "1"b;
179                ncurr = req.srch.renamo (i);                 /* get index of new name */
180                if req.opt.synonym (i) then ncurr = req.srch.renamo (ncurr); /* indirect if necessary */
181                grt_count = req.srch.grt (i);
182                j = 0;                                       /* count of ">"s in tape dirname */
183                if req.newn.ndlen (ncurr) = 0 then do;       /* check whether replacing only entry name */
184                     if (htype = ndc_directory_list) then do;
185                          do i = 1 to hp -> h.dlen;          /* scan for entry name portion */
186                               if addr (hp -> h.dname) -> rscan (i) = ">" then do;
187                                    j = j + 1;               /* count subpath */
188                                    if j = grt_count then do;  /* found the place */
189                                         hp -> h.dname = substr (hp -> h.dname, 1, i) ||
190                                              substr (req.newn.ndname (ncurr), 1, req.newn.nelen (ncurr));
191                                         hp -> h.dlen = i + req.newn.nelen (ncurr);
192                                         go to renamed;      /* finished renaming */
193                                    end;
194                               end;
195                          end;
196                          go to renamed;
197                     end;
198                     hp -> h.ename = req.newn.ndname (ncurr); /* change name */
199                     hp -> h.elen = req.newn.nelen (ncurr);  /* and its length */
200                     go to renamed;                          /* go load it */
201                end;
202                if (htype = ndc_directory_list) then do;
203                     do i = 1 to hp -> h.dlen;               /* scan old dirname */
204                          if addr (hp -> h.dname) -> rscan (i) = ">" then do;
205                               j = j + 1;                    /* count partial path */
206                               if j = grt_count + 1 then do;  /* looking for one > beyond the old path */
207 partial:                           hp -> h.dname = substr (req.newn.ndname (ncurr), 1, req.newn.ndlen (ncurr))
208                                         || substr (hp -> h.dname, i, hp -> h.dlen - i + 1);
209                                    hp -> h.dlen = hp -> h.dlen - i + 1 + req.newn.ndlen (ncurr);
210                                    go to renamed;           /* partial path substituted */
211                               end;
212                          end;
213                     end;
214 dironly:            hp -> h.dlen = req.newn.ndlen (ncurr);  /* complete replacement */
215                     hp -> h.dname = substr (req.newn.ndname (ncurr), 1, hp -> h.dlen);
216                     go to renamed;
217                end;
218                do i = 1 to hp -> h.dlen;                    /* scan entire tape dirname */
219                     if addr (hp -> h.dname) -> rscan (i) = ">" then do; /* if it is end of partial path, count it */
220                          j = j + 1;                         /* increment total */
221                          if j = grt_count then do;          /* check whether this is size of dirname */
222                               k = index (substr (hp -> h.dname, i + 1), ">"); /* look for another one */
223                               if k = 0 then go to dironly;  /* if not, dirname only needs changing */
224                               i = i + k;                    /* replace this many levels of dirname */
225                               go to partial;                /* rename front end of path */
226                          end;
227                     end;
228                end;
229                hp -> h.dlen = req.newn.ndlen (ncurr) - req.newn.nelen (ncurr) - 1; /* replace both d- and e- names */
230                hp -> h.dname = substr (req.newn.ndname (ncurr), 1, hp -> h.dlen);
231                hp -> h.elen = req.newn.nelen (ncurr);
232                hp -> h.ename = substr (req.newn.ndname (ncurr), hp -> h.dlen + 2, hp -> h.elen);
233 renamed:  end;
234           else bk_ss_$cross_retrievesw = "0"b;
235           label_index = checked;                            /* reload (renamed) entity */
236           go to exit;
237 
238 
239 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
240 
241 
242 flag_msf: entry (A_index);
243 
244 dcl A_index fixed bin;
245 
246           rcurr = A_index;                                  /* doing a subtree (MSF) */
247 
248           req.opt.exact (A_index) = "0"b;                   /* retrieve the whole subtree */
249           if req.opt.synonym (A_index) then req.opt.exact (req.srch.renamo (A_index)) = "0"b;
250                                                             /* get the twin too in case it matters */
251           return;
252 
253 
254 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
255 
256 
257 /* Entry to parse the retrieval file and convert it into tabular form */
258 
259 parse_retrieval_control: entry (rname, rsize, a_hp, label_index);
260 
261           if bk_ss_$sub_entry then do;
262                call backup_map_$fs_error_line (error_table_$badcall, "bk_retrieve$parse_retrieval_control",
263                     "^/This entry point must be called via backup_load, reload or retrieve", "");
264                label_index = terminate;
265           end;
266           go to COMMON;
267 
268 parse_structure: entry (a_hp, label_index);
269 
270           if ^bk_ss_$sub_entry then do;
271                call backup_map_$fs_error_line (error_table_$badcall, "bk_retrieve$parse_structure",
272                     "^/This entry point must be called via backup_load_", "");
273                label_index = terminate;
274           end;
275 
276 COMMON:   hp = a_hp;                                        /* Copy argument into static and save */
277           unspec (nl) = "000001010"b;                       /* Newline character */
278           rfin, rlines = 0;                                 /* convert retrieval file to tabular form */
279           parsed = 1;                                       /* set up label index words */
280           next = 2;
281           stop = 3;
282           terminate = 4;
283           reported = 5;
284           checked = 6;
285           if ^bk_ss_$sub_entry then do;
286                line_pointer = addr (line);
287 
288                call expand_pathname_ (substr (rname, 1, rsize), rdname, rename, code);
289                if code ^= 0 then do;
290                     call com_err_ (code, bk_ss_$myname, rname);
291                     go to reported_exit;                    /* cannot proceed without legal pathname */
292                end;
293 
294                call hcs_$initiate_count (rdname, rename, "", rbc, 1, rptr, code);
295                if code ^= 0 & code ^= error_table_$segknown then do;
296                     call com_err_ (code, bk_ss_$myname, "^a>^a", rdname, rename);
297                     go to reported_exit;                    /* cannot proceed without instructions */
298                end;
299           end;
300 
301           call hcs_$make_seg ("", "retrieval_control", "", 01011b, reqptr, code);
302           if code ^= 0 & code ^= error_table_$segknown then do;
303                call com_err_ (code, bk_ss_$myname, "retrieval_control");
304 reported_exit: label_index = reported;                      /* cannot proceed without storage */
305                go to exit;
306           end;
307           call hcs_$truncate_seg (reqptr, 0, 0);            /* be sure it's zeroes */
308 
309           ncurr, rcurr, i = 1;                              /* new names, requests, character cursors */
310 
311           if bk_ss_$sub_entry then do;
312                rlines, rcomp = bk_ss_$control_ptr -> backup_control.request_count;
313                if rlines > 500 then go to parsed_enough;
314                do rcurr = 1 to rlines;
315                     line = bk_ss_$control_ptr -> backup_control.path (rcurr);
316                     if substr (line, 1, 1) ^= ">" then do;
317                          bk_ss_$control_ptr -> backup_control.status_code (rcurr) = error_table_$badpath;
318                          label_index = terminate;
319                          go to exit;
320                     end;
321                     req.srch.control_index (rcurr) = rcurr;  /* one req.srch per backup_control entry so far */
322                     req.srch.name (rcurr) = line;
323                     req.srch.len (rcurr) = length (line) + 1 - verify (reverse (line), " ");
324                     if bk_ss_$control_ptr -> backup_control.new_path (rcurr) ^= "" then do;    /* cross-retrieval */
325                          req.opt.rename (rcurr) = "1"b;
326                          req.srch.renamo (rcurr) = ncurr;
327                          j = 0;                             /* count >'s in search name */
328                          do k = 1 to req.srch.len (rcurr);
329                               if addr (req.srch.name (rcurr)) -> rscan (k) = ">" then j = j + 1;
330                          end;
331                          req.srch.grt (rcurr) = j;
332                          line = bk_ss_$control_ptr -> backup_control.new_path (rcurr);
333                          n = length (rtrim (line));
334                          bk_ss_$no_primary = bk_ss_$control_ptr -> backup_control.no_primary_sw (rcurr);
335                          j = 0;
336                          call count_grts;
337                          ncurr = ncurr + 1;
338                          n = req.srch.len (rcurr);
339                     end;
340                     else req.opt.rename (rcurr) = "0"b;
341                     req.opt.exact (rcurr) = "0"b;           /* load everything underneath specified entry */
342                end;
343           end;
344 
345           else do;
346                rbc = divide (rbc, 9, 17, 0);                /* compute number of characters to scan */
347                do while (i < rbc);                          /* scan the file one line at a time */
348                     if rlines > 500 then go to parsed_enough; /* maximum requests at one time */
349                     do j = i by 1 to rbc while (rptr -> rscan (j) ^= nl); /* isolate one request line */
350                     end;
351                     n = j - i;                              /* length without newline character */
352                     k = i;                                  /* save beginning of line index */
353                     i = j + 1;                              /* one past the newline */
354                     if n = 0 then go to parse_next;         /* ignore blank line */
355                     line = substr (rptr -> rmove, k, n);    /* extract line to facilitate further scanning */
356                     if substr (line, 1, 1) ^= ">" then do;  /* at least the lefthand side must be a pathname */
357                          call com_err_ (error_table_$badpath, bk_ss_$myname, "search arg of ^a", line);
358                          go to bad_p;
359                     end;
360                     j = index (line, "=");                  /* check for rename option */
361                     if j = 0 then do;                       /* renaming was not specified */
362                          req.opt.rename (rcurr) = ""b;      /* turn off the switch */
363                          req.srch.name (rcurr) = substr (line, 1, n); /* move in pathname to seek */
364                          req.srch.len (rcurr) = n;          /* and its length */
365                     end;
366                     else do;                                /* renaming was specified */
367                          if j = n then do;                  /* line ending in "=" is an error */
368                               call com_err_ (error_table_$bad_string, bk_ss_$myname, "no new name in ^a", line);
369                               go to bad_p;                  /* give up */
370                          end;
371                          req.opt.rename (rcurr) = "1"b;     /* so indicate */
372                          req.srch.name (rcurr) = substr (line, 1, j - 1); /* move search argument */
373                          req.srch.len (rcurr) = j - 1;      /* length of sought pathname */
374                          req.srch.renamo (rcurr) = ncurr;   /* location of new name */
375                          call count_grts;                   /* count ">"'s in pathname */
376                          ncurr = ncurr + 1;                 /* prepare for next renaming */
377                          n = j - 1;                         /* length ignoring righthand side */
378                     end;
379                     call see_stars;                         /* look for stars in search name */
380                     j = 0;                                  /* count >'s in search name */
381                     do k = 1 to req.srch.len (rcurr);
382                          if addr (req.srch.name (rcurr)) -> rscan (k) = ">" then j = j + 1;
383                     end;
384                     req.srch.grt (rcurr) = j;
385                     rcurr = rcurr + 1;                      /* next request */
386                     rlines = rlines + 1;
387 parse_next:    end;
388                call hcs_$terminate_noname (rptr, code);     /* ascii version no longer needed */
389                if code ^= 0 then
390                     call backup_map_$fs_error_line (code, "terminate_noname", rname, "");
391                rcomp = rlines;                              /* number of requests to fulfill first option */
392           end;
393           do i = 1 to rlines;                               /* see if abbreviations were typed and get fuller names */
394                if bk_ss_$sub_entry then
395                     bk_ss_$no_primary = bk_ss_$control_ptr -> backup_control.no_primary_sw (i);
396                if ^bk_ss_$no_primary then do;
397                     call backup_util$get_real_name
398                          (addr (req.srch.name (i)), addr (req.srch.name (rcurr)), req.srch.len (rcurr), code);
399                     if code > 1 & code ^= error_table_$noentry & code ^= error_table_$no_dir &
400                       code ^= error_table_$no_s_permission & code ^= error_table_$moderr &
401                       code ^= error_table_$no_info then do;
402                          bk_ss_$path_index = i;
403                          call backup_map_$fs_error_line (code, (bk_ss_$myname),
404                               "get_real_name for "||req.srch.name (i), "");
405                          go to bad_p;
406                     end;
407                     else if code = 1 then do;               /* another name was generated */
408                          req.opt (rcurr) = req.opt (i);
409                          req.opt.synonym (rcurr) = "1"b;    /* indicate duplicate entry */
410                          req.srch.renamo (rcurr) = i;       /* point out original request */
411                          req.srch.control_index (rcurr) = req.srch.control_index (i);
412                                                             /* index of backup_control entry for backup_load_ */
413                          req.srch.grt (rcurr) = req.srch.grt (i);  /* copy the original's > count */
414                          req.srch.name (rcurr) = substr (req.srch.name (rcurr), 1, req.srch.len (rcurr)) || ">";
415                          req.srch.len (rcurr) = req.srch.len (rcurr) + 1; /* ">" added for comparisons */
416                          rcurr = rcurr + 1;
417                          rlines = rlines + 1;
418                     end;
419                end;
420                else code = 0;
421                req.srch.name (i) = substr (req.srch.name (i), 1, req.srch.len (i)) || ">"; /* append ">" for comparisons */
422                req.srch.len (i) = req.srch.len (i) + 1;     /* adjust size */
423           end;
424           rcurr = 0;                                        /* indicate no "current" request */
425           label_index = parsed;                             /* proceed to load the tape */
426           go to exit;
427 
428 parsed_enough: call ioa_$rsnnl                              /* here if too many requests for request table */
429                ("^a: over 500 retrieval requests. Reload ended.", line, n, bk_ss_$myname);
430           call backup_map_$on_line (line_pointer, n);       /* print complaint */
431 bad_p:    call hcs_$terminate_noname (rptr, code);          /* get rid of useless parsed data */
432           code = error_table_$arg_ignored;
433           rlines = 0;                                       /* say we don't have any requests */
434           label_index = terminate;                          /* abort run */
435 
436           return;
437 
438 
439 count_grts: proc;
440 
441                req.newn.ngrt (ncurr) = 0;                   /* prepare to count ">"s */
442                if substr (line, j + 1, 1) = ">" then do;    /* see if dirname or entry name */
443                     req.newn.ndname (ncurr) = substr (line, j + 1, n - j); /* save new dirname */
444                     req.newn.ndlen (ncurr) = n - j;         /* ..and its length */
445                     if ^bk_ss_$no_primary then call backup_util$get_real_name  /* use primary pathname */
446                          (addr (req.newn.ndname (ncurr)), addr (req.newn.ndname (ncurr)), req.newn.ndlen (ncurr), code);
447                     else code = 0;
448                     do k = 1 to req.newn.ndlen (ncurr);     /* count its ">"s */
449                          if addr (req.newn.ndname (ncurr)) -> rscan (k) = ">" then do;
450                               req.newn.ngrt (ncurr) = req.newn.ngrt (ncurr) + 1;
451                               l = k;                        /* we need to know where the last one was */
452                          end;
453                     end;
454                     req.newn.nelen (ncurr) = req.newn.ndlen (ncurr) - l; /* split off and save entry name */
455                end;
456                else do;                                     /* store entry name */
457                     req.newn.ndlen (ncurr) = 0;             /* no dirname */
458                     req.newn.ndname (ncurr) = substr (line, j + 1, n - j);
459                     req.newn.nelen (ncurr) = n - j;
460                end;
461 
462           end count_grts;
463 
464 
465 see_stars: proc;
466 
467                if substr (req.srch.name (rcurr), n - 2, 3) = ">**" then do; /* hierarchy load is wanted */
468                     req.opt.exact (rcurr) = ""b;            /* don't want exact match only */
469                     substr (req.srch.name (rcurr), n - 2, 3) = ""; /* reset global indicator */
470                     req.srch.len (rcurr) = n - 3;           /* lower length */
471                     if req.opt.rename (rcurr) then do;      /* special rules for subtree renaming */
472                          l = 1;                             /* prepare to count ">"s in search name */
473                          do k = 2 to req.srch.len (rcurr);  /* to check that request is not to change hierarchy level */
474                               if addr (req.srch.name (rcurr)) -> rscan (k) = ">" then l = l + 1;
475                          end;
476                     end;
477                end;
478                else req.opt.exact (rcurr) = "1"b;           /* exact match is wanted */
479                req.opt.found (rcurr), req.opt.finished (rcurr), req.opt.synonym (rcurr) = ""b;
480 
481           end see_stars;
482 
483 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
484 
485 
486 /* Entry to prepare notification of what was accomplished */
487 
488 report_retrieval: entry;
489 
490 dcl  unsatisfied bit (1) aligned;
491 
492           if rlines = 0 then go to exit;
493           if bk_ss_$sub_entry then go to reportend;
494           call hcs_$initiate_count (rdname, rename, "", rbc, 1, rptr, code);
495           if code ^= 0 & code ^= error_table_$segknown then do; /* cannot report if we can't access request file */
496                call backup_map_$fs_error_line (code, "initiate", rdname, rename);
497                go to reportend;
498           end;
499           rbc = divide (rbc, 9, 17, 0);                     /* who knows if it changed? */
500           i, k = 1;                                         /* ascii index, request index */
501           unsatisfied = ""b;                                /* Flags first unsatisfied request */
502 
503 next_req: n = index (substr (rptr -> rmove, i, rbc), nl);   /* Look for next new line character */
504           if n ^= 0 then                                    /* Found one */
505                if ^req.opt (k).found then do;               /* Was this request satisfied? */
506                     if ^unsatisfied then do;                /* Was previous unsatisfied request found? */
507                          call ioa_ ("The following requests were not satisfied:"); /* NO! */
508                          unsatisfied = "1"b;                /* Mark unsatisfied request encountered */
509                     end;
510 
511                     call ioa_ ("^a^/   Search name: ^a",
512                          substr (rptr -> rmove, i, n-1),
513                          substr (req.srch (k).name, 1, req.srch (k).len));
514                end;
515 
516           i = i + n;                                        /* Increment index to continue scan of request file */
517           k = k + 1;                                        /* Increment parsed request index */
518 
519           if i < rbc then go to next_req;                   /* Continue if more input */
520 
521           call hcs_$terminate_noname (rptr, code);          /* get rid of ascii requests */
522 reportend: call hcs_$truncate_seg (reqptr, 0, code);        /* get rid of parsed requests */
523 exit:     return;
524      end;