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 /* Modified June 1984 by Keith Loepere to use the new dc_find. */
 14 /* Modified by C. Hornig to no longer use system_free_seg */
 15 /* Modified May 1981 by C. Hornig to compress link pathnames */
 16 /* Modified Jul 79 by Greenberg for another oversize stack problem. */
 17 /* Modified Oct 1978 by B. Greenberg to fix oversize stack problem. */
 18 /* Modified May 1978 by T. Casey to fix bug in list_dir entry point when returning link authors */
 19 /* Modified 04/78 by G. Palter to fix bug when asking for links only */
 20 /* Modified 07/77 by THVV for bad_dir_ check */
 21 /* modified 06/77 by THVV to combine star and dc_pack */
 22 /* modified 04/77 by THVV to use system_free_seg better */
 23 /* modified 05/31/76 by R. Bratt to call find_$finished */
 24 /* modified 04/20/76 by R. Bratt to return partial  info if not mounted */
 25 /* modified Dec 75 by REM and TAC to add dir_list_ entry for NSS performance */
 26 /* Modified 4/75 for NSS by THVV */
 27 /* modified by Kobziar on 11-12-73 to drop setting of append bit on segs  */
 28 /* modified by Ackerman-Lewis on 12-03-74 to return correct count of names matching star name  */
 29 /* modified by Kobziar on 741203 to call new entry in access_mode */
 30 /* Modified 750117 by PG to eliminate $no_acc_ck entry & clean up program */
 31 
 32 
 33 /****^  HISTORY COMMENTS:
 34   1) change(86-08-18,JSLove), approve(86-08-18,MCR7518),
 35      audit(86-09-29,Parisek), install(86-10-02,MR12.0-1174):
 36      Changed to call check_star_name_ with control mask CHECK_STAR_IGNORE_ALL
 37      rather than check_star_name_$entry. This bypasses syntactic checks which
 38      ring zero is not responsible for enforcing.  Also changed to use named
 39      constants defined in check_star_name.incl.pl1.
 40   2) change(87-06-01,GDixon), approve(87-07-13,MCR7740),
 41      audit(87-07-24,Hartogs), install(87-08-04,MR12.1-1055):
 42       A) Modified to properly declare check_star_name_.
 43                                                    END HISTORY COMMENTS */
 44 
 45 
 46 /* format: style4,delnl,insnl,tree,ifthenstmt,indnoniterend */
 47 
 48 star_:
 49      procedure (a_dirname, a_star_name, a_pbl, a_areap, a_ecount, a_eptr, a_nptr, a_code);
 50 
 51 dcl  a_areap ptr parameter;
 52 dcl  a_bcount fixed bin parameter;
 53 dcl  a_bptr ptr parameter;                                  /* for dc_pack */
 54 dcl  a_code fixed bin (35) parameter;
 55 dcl  a_dirname char (*) parameter;
 56 dcl  a_ecount fixed bin parameter;
 57 dcl  a_eptr ptr parameter;
 58 dcl  a_lcount fixed bin parameter;
 59 dcl  a_lptr ptr parameter;                                  /* for dc_pack */
 60 dcl  a_nptr ptr parameter;
 61 dcl  a_pbl fixed bin (3) parameter;
 62 dcl  a_star_name char (*) parameter;
 63 dcl  dcpack_area area parameter;
 64 
 65 dcl  branch_count fixed bin;
 66 dcl  call_find_finish bit (1) aligned;
 67 dcl  code fixed bin (35);
 68 dcl  dc_pack bit (1) aligned;
 69 dcl  dirname char (168);
 70 dcl  eptr ptr;
 71 dcl  fast_listing bit (1) aligned;
 72 dcl  just_return_totals bit (1) aligned;
 73 dcl  locked bit (1) aligned;
 74 dcl  n_branches_match fixed bin;
 75 dcl  n_links_match fixed bin;
 76 dcl  need_vtoc bit (1) aligned;
 77 dcl  nptr ptr;
 78 dcl  number_of_entries fixed bin;
 79 dcl  pbl fixed bin (3);
 80 dcl  priv bit (1) aligned;
 81 dcl  return_link_path bit (1) aligned;
 82 dcl  saved_dir_change_pclock fixed bin (35);
 83 dcl  star_list_entry bit (1) aligned;
 84 dcl  star_name char (32);
 85 dcl  starname_type fixed bin (2);
 86 dcl  u_areap ptr;
 87 dcl  want_branches bit (1) aligned;
 88 dcl  want_links bit (1) aligned;
 89 dcl  vtoc_available bit (1) aligned;
 90 
 91 dcl  error_table_$argerr fixed bin (35) external;
 92 dcl  error_table_$nomatch fixed bin (35) external;
 93 dcl  error_table_$notalloc fixed bin (35) external;
 94 
 95 dcl  acc_name_$get entry (ptr, ptr);
 96 dcl  access_mode$effective entry (pointer, bit (36) aligned, bit (36) aligned, fixed bin (35));
 97 dcl  alloc_ external entry (fixed bin, pointer, pointer);
 98 dcl  check_star_name_ entry (char(*), bit(36), fixed bin(2), fixed bin(35));
 99 dcl  freen_ entry (pointer);
100 dcl  hash$search entry (ptr, ptr, ptr, fixed bin (35));
101 dcl  lock$dir_lock_read entry (ptr, fixed bin (35));
102 dcl  lock$dir_unlock entry (ptr);
103 dcl  match_star_name_ entry (char(*) aligned, char(*), fixed bin(35));
104 dcl  mountedp entry (bit (36) aligned) returns (fixed bin (35));
105 dcl  vtoc_attributes$get_info entry (bit (36) aligned, bit (36), fixed bin, ptr, fixed bin (35));
106 
107 dcl  (addr, addrel, binary, bit, divide, max, mod, null, rel, size, substr, unspec) builtin;
108 
109 dcl  (area, bad_dir_, seg_fault_error) condition;
110 %page;
111 /*
112    star_:
113    procedure (a_dirname, a_star_name, a_pbl, a_areap, a_ecount, a_eptr, a_nptr, a_code);
114 */
115 
116           dc_pack, priv, fast_listing, star_list_entry = "0"b;
117           go to common;
118 
119 star_priv:
120      entry (a_dirname, a_star_name, a_pbl, a_areap, a_ecount, a_eptr, a_nptr, a_code);
121 
122           dc_pack, fast_listing, star_list_entry = "0"b;
123           priv = "1"b;
124           go to common;
125 
126 list_dir:
127      entry (a_dirname, dcpack_area, a_bptr, a_bcount, a_lptr, a_lcount, a_code);
128 
129           priv, fast_listing, star_list_entry = "0"b;
130           dc_pack = "1"b;
131           go to common;
132 
133 list_dir_fast:
134      entry (a_dirname, dcpack_area, a_bptr, a_bcount, a_lptr, a_lcount, a_code);
135 
136           priv, star_list_entry = "0"b;
137           dc_pack, fast_listing = "1"b;
138           go to common;
139 
140 dir_list_:
141      entry (a_dirname, a_star_name, a_pbl, a_areap, a_bcount, a_lcount, a_eptr, a_nptr, a_code);
142 
143           dc_pack, priv = "0"b;
144           fast_listing, star_list_entry = "1"b;
145           go to common;
146 
147 list_:
148      entry (a_dirname, a_star_name, a_pbl, a_areap, a_bcount, a_lcount, a_eptr, a_nptr, a_code);
149 
150           dc_pack, priv, fast_listing = "0"b;
151           star_list_entry = "1"b;
152           go to common;
153 
154 list_priv:
155      entry (a_dirname, a_star_name, a_pbl, a_areap, a_bcount, a_lcount, a_eptr, a_nptr, a_code);
156 
157           dc_pack, fast_listing = "0"b;
158           priv, star_list_entry = "1"b;
159           go to common;
160 %page;
161 common:
162           code = 0;
163           want_branches, want_links, return_link_path, need_vtoc = "0"b;
164           call_find_finish, locked = "0"b;
165           dirname = a_dirname;
166 
167 /*              Make sure we always return consistent values.                   */
168 
169           n_branches_match, n_links_match = 0;
170           dc_branch_arrayp, dc_link_arrayp, eptr, nptr = null ();
171           code = 0;
172 
173 /* Analyze starname type */
174 
175           if dc_pack then do;
176                starname_type = STAR_TYPE_MATCHES_EVERYTHING;
177                want_branches, want_links = "1"b;
178                u_areap = addr (dcpack_area);
179                end;
180           else do;
181                star_name = a_star_name;
182                u_areap = a_areap;
183                pbl = a_pbl;
184                if pbl > 3 then do;                          /* pathname desired */
185                     return_link_path = "1"b;
186                     pbl = mod (pbl, 4);                     /* trim the pathname option */
187                     end;
188 
189                if /* case */ pbl = 1 then want_links = "1"b;
190                else if pbl = 2 then want_branches = "1"b;
191                else if pbl = 3 then want_branches, want_links = "1"b;
192                else do;
193                     code = error_table_$argerr;
194                     go to finish;
195                     end;
196 
197                call check_star_name_ (star_name, CHECK_STAR_IGNORE_ALL, starname_type, code);
198                if code ^= 0 then go to finish;
199                end;
200 
201 RESCAN_DIR:
202           eptr, nptr, dc_branch_arrayp, dc_link_arrayp = null ();
203           call_find_finish, locked = "0"b;
204 
205           if priv
206           then call dc_find$dir_read_priv (dirname, dp, code);
207           else call dc_find$dir_read (dirname, dp, code);
208           if code ^= 0 then go to finish;
209 
210           call_find_finish, locked = "1"b;
211 
212           if starname_type = STAR_TYPE_USE_PL1_COMPARE      /* Special case names with no * or ? */
213           then branch_count, number_of_entries = 1;         /* .. since at most one item can match */
214           else do;
215                branch_count = dir.seg_count + dir.dir_count;
216                number_of_entries = branch_count + dir.lcount;
217                end;
218 
219 
220           if u_areap = null () then do;                     /* Just wants totals */
221                if starname_type = STAR_TYPE_MATCHES_EVERYTHING then do;
222                     if want_branches then n_branches_match = branch_count;
223                     if want_links then n_links_match = dir.lcount;
224                     go to finish;
225                     end;
226                else just_return_totals = "1"b;              /* No vtoc needed, but must scan thru dir */
227                end;
228           else just_return_totals = "0"b;
229 
230           if ^fast_listing
231           then                                              /* Never need VTOC for fast list */
232                if dc_pack | (want_branches & star_list_entry & ^just_return_totals) then do;
233                     need_vtoc = "1"b;                       /* See if need any info from VTOC */
234                     code = mountedp (dir.sons_lvid);        /* volume may not be mounted */
235                     vtoc_available = (code = 0);            /* sorry, force fast list, N.B. code must stay set */
236                     end;
237 
238           call SCAN_DIR;                                    /* Internal proc does the two scans */
239 %page;
240 finish:
241           if call_find_finish then call dc_find$finished (dp, locked);
242 
243           if star_list_entry | dc_pack then do;             /* Copy values back to caller args */
244                a_bcount = n_branches_match;
245                a_lcount = n_links_match;
246                end;
247           else do;
248                a_ecount = n_branches_match + n_links_match;
249                end;
250 
251           if dc_pack then do;
252                a_bptr = dc_branch_arrayp;
253                a_lptr = dc_link_arrayp;
254                end;
255           else do;
256                a_eptr = eptr;
257                a_nptr = nptr;
258                end;
259 
260           a_code = code;
261           return;
262 %page;
263 SCAN_DIR:
264      procedure;
265 
266 dcl  alloc_size fixed bin;
267 dcl  ec fixed bin (35);
268 dcl  entry_list (number_of_entries) uns fixed bin (18);
269 dcl  entry_rel bit (18);
270 dcl  link_path_blocks fixed bin;
271 dcl  n_entries_in_list fixed bin;
272 dcl  n_names_match fixed bin;
273 dcl  name_rel bit (18);
274 dcl  total_names_seen fixed bin;
275 
276 dcl  u_narray (n_names_match + link_path_blocks) char (32) aligned based (nptr);
277 dcl  user_area area based (u_areap);
278 
279 
280           n_branches_match, n_links_match, total_names_seen = 0;
281           n_entries_in_list, n_names_match, link_path_blocks = 0;
282 
283           call MAKE_ENTRY_LIST;
284 
285           if n_links_match + n_branches_match = 0 then do;
286                if ^dc_pack then code = error_table_$nomatch;
287                go to done;
288                end;
289 
290           if just_return_totals then go to done;            /* If all we want is counts, we got them */
291 
292 /* Allocate room in user area for copying it out */
293 /* We have to unlock the dir first */
294 
295           saved_dir_change_pclock = dir.change_pclock;
296 
297           call lock$dir_unlock (dp);
298           locked = "0"b;
299 
300           on area go to set_no_alloc;
301 
302           if dc_pack then do;
303                dc_n_branches = max (branch_count, 1);
304                allocate dcpack_branch_array in (user_area);
305 
306                dc_n_links = max (n_links_match, 1);
307                allocate dcpack_link_array in (user_area);
308                allocate dcpack_grand_link_pathname_array in (user_area);
309                dc_grand_n_names = max (total_names_seen, 1);
310                allocate dcpack_grand_name_array in (user_area);
311 
312                end;
313 
314           else do;
315                if n_names_match + link_path_blocks > 0
316                then allocate u_narray in (user_area) set (nptr);
317                else nptr = null;
318 
319                if star_list_entry
320                then alloc_size = size (star_list_link) * n_links_match + size (star_list_branch) * n_branches_match;
321                else alloc_size = n_links_match + n_branches_match;
322                                                             /* size (entries) = 1 */
323                if alloc_size = 0
324                then eptr = null;
325                else do;
326                     on area go to free_nptr;
327                     call alloc_ (alloc_size, u_areap, eptr);/* entries */
328                     if eptr = null then go to free_nptr;
329                     end;
330                end;
331 
332 /* Now relock the dir */
333 
334           on seg_fault_error signal bad_dir_;
335           call lock$dir_lock_read (dp, code);
336           if code ^= 0 then go to finish;
337           locked = "1"b;
338           revert seg_fault_error;
339 
340           if dir.change_pclock ^= saved_dir_change_pclock then do;
341                if dc_pack then do;
342                     free dcpack_branch_array;
343                     free dcpack_link_array;
344                     free dcpack_grand_name_array;
345                     free dcpack_grand_link_pathname_array;
346                     end;
347                else do;
348                     free u_narray;
349                     if eptr ^= null () then call freen_ (eptr);
350                     end;
351                call dc_find$finished (dp, locked);
352                go to RESCAN_DIR;
353                end;
354 
355           call SORT_ENTRY_LIST;
356 
357           call RETURN_INFO;
358 
359           goto done;
360 
361 
362 free_nptr:
363           free u_narray in (user_area);
364 set_no_alloc:
365           code = error_table_$notalloc;
366 
367 done:
368           return;                                           /* normal exit from SCAN_DIR */
369 %page;
370 MAKE_ENTRY_LIST:
371           procedure;
372 
373 dcl  dir_nwords fixed bin (18);
374 dcl  entry_names_match_star fixed bin;
375 dcl  n_entries_seen fixed bin;
376 dcl  n_names_seen fixed bin;
377 
378 
379                dir_nwords = addrel (dp, dir.arearp) -> area.lu;
380 
381                if starname_type ^= STAR_TYPE_USE_PL1_COMPARE then do;
382                     n_entries_seen = 0;                     /* if there may be several entries */
383                     do entry_rel = dir.entryfrp repeat (entry.efrp) while (entry_rel ^= ""b);
384                          ep = addrel (dp, entry_rel);
385                          n_entries_seen = n_entries_seen + 1;
386                          if (n_entries_seen > number_of_entries) | (binary (entry_rel, 18) > dir_nwords)
387                          then signal bad_dir_;              /* check for loop */
388 
389 
390                          call CHECK_VALID_ENTRY;
391 
392                          if (entry.bs & want_branches) | (^entry.bs & want_links) then do;
393                                                             /* Type is correct */
394                               entry_names_match_star = 0;   /* Does a name match? */
395                               n_names_seen = 0;
396                               do name_rel = entry.name_frp repeat (np -> names.fp) while (name_rel ^= ""b);
397                                    np = addrel (dp, name_rel);
398                                    n_names_seen = n_names_seen + 1;
399                                    if (n_names_seen > entry.nnames)
400                                                             /* check for loop */
401                                         | (binary (name_rel, 18) > dir_nwords) | (np -> names.owner ^= entry.uid)
402                                         | (np -> names.type ^= NAME_TYPE) | (np -> names.entry_rp ^= entry_rel)
403                                    then signal bad_dir_;
404 
405 
406                                    if NAME_MATCHES () then do;
407                                         entry_names_match_star = entry_names_match_star + 1;
408                                                             /* This name will be listed */
409                                         n_names_match = n_names_match + 1;
410                                         end;
411                               end;
412 
413                               if entry_names_match_star > 0 then call TAKE_ENTRY;
414                               end;
415                     end;                                    /* end of loop on ep */
416                     end;
417 
418                else do;                                     /* STAR_TYPE_USE_PL1_COMPARE:  Return one or none */
419                     call hash$search (dp, addr (star_name), ep, ec);
420                     if ec = 0 then do;                      /* Special case for efficiency. use hash table */
421                          call CHECK_VALID_ENTRY;            /* Found the entry */
422                          n_names_match = 1;                 /* Found desired name */
423                          call TAKE_ENTRY;
424                          end;
425                     end;
426 
427                return;
428 
429 /* ---------------------------------------- */
430 
431 TAKE_ENTRY:
432                procedure;
433 
434                     n_entries_in_list = n_entries_in_list + 1;
435                     entry_list (n_entries_in_list) = binary (rel (ep), 18);
436                     total_names_seen = total_names_seen + n_names_seen;
437                     if ^entry.bs then do;                   /* link */
438                          n_links_match = n_links_match + 1;
439                          if return_link_path
440                          then link_path_blocks = link_path_blocks + divide (link.pathname_size + 31, 32, 17, 0);
441                          end;
442                     else n_branches_match = n_branches_match + 1;
443 
444                     return;
445 
446                end TAKE_ENTRY;
447 
448 /* ----------------------------------------------------- */
449 
450 CHECK_VALID_ENTRY:
451                procedure;
452 
453                     if entry.bs
454                     then if (entry.owner ^= dir.uid) | ((entry.type ^= SEG_TYPE) & (entry.type ^= DIR_TYPE))
455                          then signal bad_dir_;
456                          else ;
457                     else if (link.owner ^= dir.uid) | (link.type ^= LINK_TYPE) then signal bad_dir_;
458 
459                     return;
460 
461                end CHECK_VALID_ENTRY;
462 %page;
463 %include dir_allocation_area;
464 
465           end MAKE_ENTRY_LIST;
466 %page;
467 SORT_ENTRY_LIST:
468           procedure ();
469 
470 /* Someday, this should sort the entry list by rel(ep). */
471 
472                return;
473 
474           end SORT_ENTRY_LIST;
475 %page;
476 RETURN_INFO:
477           procedure;
478 
479 dcl  code fixed bin (35);
480 dcl  earrayx fixed bin;
481 dcl  exmode bit (36) aligned;
482 dcl  grand_larrayx fixed bin;
483 dcl  grand_narrayx fixed bin;
484 dcl  larrayx fixed bin;
485 dcl  link_author char (32) aligned;
486 dcl  mode bit (36) aligned;
487 dcl  narrayx fixed bin;
488 dcl  ret_mode bit (5) aligned;
489 dcl  1 sci aligned like based_sc_info;
490 dcl  tx fixed bin;
491 dcl  vtoc_code fixed bin (35);
492 
493                narrayx, larrayx, earrayx = 1;
494                grand_narrayx, grand_larrayx = 1;
495 
496                do tx = 1 to n_entries_in_list;
497                     ep = addrel (dp, entry_list (tx));
498 
499                     if entry.bs then do;
500                          call access_mode$effective (ep, mode, exmode, code);
501                          if entry.dirsw
502                          then ret_mode = "0"b || substr (exmode, 1, 1) || "1"b || substr (exmode, 2, 2);
503                          else ret_mode = "0"b || substr (mode, 1, 4);
504 
505                          if need_vtoc then do;
506                               unspec (sci) = ""b;           /* clear out old junk */
507                               vtoc_code = code;
508                               if vtoc_available then do;
509                                    call vtoc_attributes$get_info (entry.uid, entry.pvid, (entry.vtocx), addr (sci),
510                                         vtoc_code);
511                                    if ^dc_pack & (vtoc_code ^= 0) & (code = 0) then code = vtoc_code;
512                                    end;
513                               end;
514                          end;
515                     else call acc_name_$get (addr (link.author), addr (link_author));
516 
517                     if dc_pack
518                     then call RETURN_DCPACK_INFO;
519                     else call RETURN_STAR_INFO;
520                end;
521 
522                return;
523 %page;
524 
525 RETURN_DCPACK_INFO:
526                procedure;
527 
528 declare  first_name_relp bit (18);
529 
530 /* in this program earrayx goes up by 1 for each branch.
531    larrayx goes up by 1 for each link, and narrayx by 1 for each name on an entry (resets each time) */
532 
533                     if entry.bs then do;
534                          dc_branchp = addr (dcpack_branch_array (earrayx));
535                          earrayx = earrayx + 1;
536                          unspec (dcpack_branch) = ""b;
537                          dcpack_branch.vtoc_error = (vtoc_code ^= 0);
538                          dcpack_branch.uid = entry.uid;
539                          dcpack_branch.dtu = sci.dtu;
540                          dcpack_branch.dtm = sci.dtm;
541                          dcpack_branch.dtd = entry.dtd;
542                          dcpack_branch.dtem = entry.dtem;
543                          dcpack_branch.dirsw = entry.dirsw;
544                          dcpack_branch.optsw = entry.copysw;
545                          dcpack_branch.bc = bit (entry.bc, 24);
546                          dcpack_branch.cl = bit (divide (sci.csl, 1024, 9, 0), 9);
547                          dcpack_branch.ml = bit (divide (sci.msl, 1024, 9, 0), 9);
548                          dcpack_branch.nnames = entry.nnames;
549                          dcpack_branch.mode = ret_mode;
550 
551                          if entry.dirsw then do;
552                               dcpack_branch.rb1 = (3)"0"b || entry.ex_ring_brackets (1);
553                               dcpack_branch.rb2 = (3)"0"b || entry.ex_ring_brackets (2);
554                               dcpack_branch.rb3 = dcpack_branch.rb2;
555                               end;
556                          else do;
557                               dcpack_branch.rb1 = (3)"0"b || entry.ring_brackets (1);
558                               dcpack_branch.rb2 = (3)"0"b || entry.ring_brackets (2);
559                               dcpack_branch.rb3 = (3)"0"b || entry.ring_brackets (3);
560                               end;
561                          end;
562 
563                     else do;                                /* link */
564 
565                          dc_linkp = addr (dcpack_link_array (larrayx));
566                          larrayx = larrayx + 1;
567                          unspec (dcpack_link) = ""b;
568                          dcpack_link.uid = link.uid;
569                          dcpack_link.dtu = ""b;
570                          dcpack_link.dtem = link.dtem;
571                          dcpack_link.dtd = link.dtd;
572                          dcpack_link.nnames = link.nnames;
573                          dc_pnp = null ();
574                          if grand_larrayx > dc_n_links then signal bad_dir_;
575                          dc_pnp = addr (dcpack_grand_link_pathname_array (grand_larrayx));
576                          grand_larrayx = grand_larrayx + 1;
577                          dcpack_path.size = link.pathname_size;
578                          dcpack_path.name = link.pathname;
579                          dcpack_path.author = link_author;
580                          dcpack_link.pathnamerp = rel (dc_pnp);
581 
582                          end;                               /* links */
583 
584                     first_name_relp = rel (addr (dcpack_grand_name_array (grand_narrayx)));
585 
586                     do name_rel = entry.name_frp repeat (np -> names.fp) while (name_rel ^= ""b);
587 
588                          if grand_narrayx > dc_grand_n_names then signal bad_dir_;
589                          dc_namep = addr (dcpack_grand_name_array (grand_narrayx));
590                          grand_narrayx = grand_narrayx + 1;
591                          np = addrel (dp, name_rel);
592                          dcpack_ename.name = np -> names.name;
593                          dcpack_ename.size = 32;
594                     end;
595 
596                     if entry.bs
597                     then dcpack_branch.namerp = first_name_relp;
598                     else dcpack_link.namerp = first_name_relp;
599 
600 
601                     return;
602 
603                end RETURN_DCPACK_INFO;
604 %page;
605 RETURN_STAR_INFO:
606                procedure;
607 
608 dcl  full_pathname char (168) aligned based;
609 
610 /* In this program, earrayx is in WORDS not entries. It goes up a different amount
611    depending on whether(a) star_ was called, (b) star_list_ was called and it's a branch,
612    (c) star_list_ was called and it's a link. Also, narrayx goes up by 1 for each name
613    and 6 for each link path. */
614 
615                     esp = addrel (eptr, earrayx - 1);
616                     star_entry.nindex = narrayx;
617                     star_entry.nnames = 0;
618                     if entry.bs
619                     then if entry.dirsw
620                          then star_entry.type = "10"b;      /* dir */
621                          else star_entry.type = "01"b;      /* seg */
622                     else star_entry.type = "00"b;           /* link */
623 
624                     do name_rel = entry.name_frp repeat (np -> names.fp) while (name_rel ^= ""b);
625                          np = addrel (dp, name_rel);
626                          if NAME_MATCHES () then do;
627                               u_narray (narrayx) = np -> names.name;
628                               narrayx = narrayx + 1;
629                               star_entry.nnames = star_entry.nnames + 1;
630                               end;
631                     end;
632 
633                     if ^star_list_entry
634                     then earrayx = earrayx + size (star_entry);
635                     else do;
636                          if entry.bs then do;               /* branch */
637                               earrayx = earrayx + size (star_list_branch);
638                               if entry.dirsw then star_list_branch.master_dir = entry.master_dir;
639                               star_list_branch.mode = ret_mode;
640 
641                               if need_vtoc then do;
642                                    star_list_branch.dtm_or_dtem = sci.dtm;
643                                    star_list_branch.dtu = sci.dtu;
644                                    star_list_branch.rec_or_bc = sci.records;
645                                    end;
646                               else do;                      /* didn't access vtoce */
647                                    star_list_branch.dtu = ""b;
648                                    star_list_branch.dtm_or_dtem = entry.dtem;
649                                    star_list_branch.rec_or_bc = entry.bc;
650                                    end;
651                               end;
652 
653                          else do;                           /* link */
654                               earrayx = earrayx + size (star_list_link);
655                               if return_link_path then do;  /* copy path name */
656                                    star_list_link.pln = link.pathname_size;
657                                    substr (addr (u_narray (narrayx)) -> full_pathname, 1, link.pathname_size) =
658                                         link.pathname;
659                                    star_list_link.pindex = narrayx;
660                                    narrayx = narrayx + divide (link.pathname_size + 31, 32, 17, 0);
661                                    end;
662                               else do;
663                                    star_list_link.pln = 0;
664                                    star_list_link.pindex = 0;
665                                    end;
666 
667                               star_list_link.dtm = link.dtem;
668                               star_list_link.dtd = link.dtd;
669                               end;
670                          end;
671 
672                end RETURN_STAR_INFO;
673 
674           end RETURN_INFO;
675 %page;
676 NAME_MATCHES:
677           procedure returns (bit (1) aligned);
678 
679 dcl  code fixed bin (35);
680 
681                if starname_type = STAR_TYPE_MATCHES_EVERYTHING then return ("1"b);
682                call match_star_name_ (np -> names.name, star_name, code);
683                return (code = 0);
684 
685           end NAME_MATCHES;
686 
687      end SCAN_DIR;
688 %page;
689 %include check_star_name;
690 %page;
691 %include dc_find_dcls;
692 %page;
693 %include dcpack_info;
694 %page;
695 %include dir_entry;
696 %page;
697 %include dir_header;
698 %page;
699 %include dir_link;
700 %page;
701 %include dir_name;
702 %page;
703 %include fs_types;
704 %page;
705 %include quota_cell;
706 %page;
707 %include sc_info;
708 %page;
709 %include star_info;
710      end star_;