1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1987                *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   6         *                                                         *
   7         *********************************************************** */
   8 
   9 
  10 
  11 
  12 /****^  HISTORY COMMENTS:
  13   1) change(87-02-17,TLNguyen), approve(87-02-17,MCR7622),
  14      audit(87-02-25,Gilcrease), install(87-03-23,MR12.1-1008):
  15      - Make "status" active function returns the current length when the
  16        "-length" control argument is specified.
  17      - Add the "-nonstandard_names" (-nsn) control argument to the status
  18        command or active function.
  19   2) change(87-02-24,TLNguyen), approve(87-02-24,MCR7620),
  20      audit(87-02-25,Gilcrease), install(87-03-23,MR12.1-1008):
  21      - Change "status" command to always display an appropriate error message
  22        if "-chase" control argument is specified and the entry is a null link.
  23      - Change "status" command to always skip printing an error message if the
  24        code received from "file_manager_$status" is "A transaction is currently
  25        in progress."
  26      - Change "status" to always display an error message if specified paths
  27        are directories, MSFs, DM files, and links and the "-synchronized_
  28        switch" is specified.
  29      - Change "status" to always call "msf_manager_$close" when it finishes for
  30        an MSF and to always call "cleanup" internal procedure when it finishes.
  31      - Change "status" to always not display a specified MSF's contents which
  32        appeared at the end of the error message.
  33   3) change(87-03-25,TLNguyen), approve(87-03-25,MCR7620),
  34      audit(87-03-25,Gilcrease), install(87-03-25,MR12.1-1015):
  35                PBF to last installation, status with no arguments ok now.
  36   4) change(87-09-04,TLNguyen), approve(87-09-04,PBF7620),
  37      audit(87-09-04,Farley), install(87-09-09,MR12.1-1099):
  38      status with MSFs and -all control argument work ok now.
  39   5) change(88-01-29,TLNguyen), approve(88-01-29,MCR7833),
  40      audit(88-02-02,Lippard), install(88-02-02,MR12.2-1020):
  41      Make status with -length work as documented when it is used as a command.
  42   6) change(88-05-12,Lippard), approve(88-05-02,MCR7881),
  43      audit(88-06-09,Fawcett), install(88-08-02,MR12.2-1074):
  44      Add -audit_switch, -asw.
  45   7) change(89-04-06,Vu), approve(89-04-06,MCR8096), audit(89-04-26,Lee),
  46      install(89-05-10,MR12.3-1040):
  47      status -switch SW_NAME yields bogus error for link and the date returned
  48      by status for the root does not use the user's default date/time format.
  49      Reformatted status.pl1
  50                                                    END HISTORY COMMENTS */
  51 
  52 
  53 
  54 /* format: style4,ifthenstmt,^indproc */
  55 
  56 status: st: procedure options (variable);
  57 
  58 /* WARNING: Some hcs_ entries are mis-declared with char (*) aligned */
  59 
  60 /* This command and active function returns selected
  61    attributes of storage system entries. */
  62 
  63 /* Written 5/20/76 by Steve Herbst */
  64 /* Control args -dr, -lk, -sm added and [st -nm] names quoted 09/28/79 S. Herbst */
  65 /* Changed to print damaged switch (if on) by default 03/19/80 S. Herbst */
  66 /* Fix dates reported for MSF's (most recent date of all components) 01/06/81 S. Herbst */
  67 /* Chasing fixed, -chase_if_possible added, -records_used -> -records 01/12/81 S. Herbst */
  68 /* Fixed bug in MSF processing 10/01/81 S. Herbst */
  69 /* fixed not to assume 168 char link pathname BIM 3/82 */
  70 /* Added printing of synchronized switch, J. Bongiovanni, September 1982 */
  71 /* Fixed to handle et_$vtoce_connection_fail like et_$logical_volume_not_connected 11/23/82 S. Herbst */
  72 /* Changed back again to treat VTOCE errors as errors, since no info can be trusted. 12/07/82 S. Herbst */
  73 /* Simple support for object_type_ 2/24/83 Jay Pattin */
  74 /* Added entry_bound, -switch, changed behavior of -all w/switches 6/2/83 Jay Pattin */
  75 /* 830924 object_type_ --> fs_util_, BIM */
  76 /* Modified 11/21/83 by C Spitzer. fix lots of bugs */
  77 /* Fixed to not free switch_list when switch_list_ptr is null, 1984.02.16, MAP */
  78 /* Modified 07/18/84 by Jim Lippard to only allocate names when they're
  79    asked for and to free them properly */
  80 /* Modified 84-09-17 by JAFalksen. Utilize date_time_$format("date_time",... */
  81 /* Modified 01/11/84 by C Spitzer. work on root (changes adapted by Steve Herbst) */
  82 /* Changed to work on DM files 10/23/84 Steve Herbst */
  83 /* Added extended entry type control args -select_entry_type, changed -force_no_type to -inase 11/20/84 M. Pandolf */
  84 /* Changed -no_(concurrency rollback)_sw to -(concurrency rollback)_sw 12/04/84 Steve Herbst */
  85 /* Fixed mode value for DM files 01/11/85 Steve Herbst */
  86 /* Modified 02/05/85 by M. Sharpe to implement -slet correctly and to complain
  87    about unsupported operation when type does not have ring brackets, extended
  88    mode, max length, etc. */
  89 /* Fixed to print DM file switches without a transaction in effect 02/26/85 Steve Herbst */
  90 
  91 
  92 /* DECLARATIONS */
  93 
  94 /* Options structure. Various settings for it are at the back of the listing. */
  95 
  96 dcl  1 opt,                                                 /* attributes to be requested */
  97        (2 primary_name,                                     /* -primary, -pri */
  98        2 names,                                             /* -name, -names, -nm */
  99        2 type,                                              /* -type, -tp */
 100        2 link_path,                                         /* -link_path, -lp */
 101        2 unique_id,                                         /* -unique_id, -uid */
 102        2 dtu,                                               /* -date_time_used, -dtu */
 103        2 dtcm,                                              /* -date_time_contents_modified, -dtcm */
 104        2 dtem,                                              /* -date_time_entry_modified, -dtem */
 105        2 dtd,                                               /* -date_time_dumped, -dtd */
 106        2 dtvd,                                              /* -date_time_volume_dumped, -dtvd */
 107        2 author,                                            /* -author, -at */
 108        2 bc_author,                                         /* -bc_author, -bca */
 109        2 logical_volume,                                    /* -logical_volume, -lv, -device, -dv */
 110        2 bit_count,                                         /* -bit_count, -bc */
 111        2 records_used,                                      /* -records, -rec */
 112        2 current_length,                                    /* -current_length, -cl */
 113        2 max_length,                                        /* -max_length, -ml */
 114        2 mode,                                              /* -mode, -md */
 115        2 access_class,                                      /* -access_class, -acc */
 116        2 ring_brackets,                                     /* -ring_brackets, -rb */
 117        2 safety_switch,                                     /* -safety_switch, -ssw */
 118        2 copy_switch,                                       /* -copy_switch, -csw */
 119        2 audit_switch,                                      /* -audit_switch, -asw */
 120        2 ivds,                                              /* -incr_volume_dump_switch, -ivds */
 121        2 cvds,                                              /* -comp_volume_dump_switch , -cvds */
 122        2 usage_count,                                       /* -usage_count, -use */
 123        2 damaged_switch,                                    /* -damaged_switch, -dsw */
 124        2 synchronized_switch,                               /* -synchronized_switch, -synch */
 125        2 entry_bound                                        /* -entry_bound, -eb */
 126        ) bit (1) unaligned,
 127        2 dm_files_only,
 128          (3 highest_ci,                                     /* -highest_control_interval, -hci */
 129          3 concurrency_switch,                              /* -concurrency_sw, -concsw */
 130          3 rollback_switch,                                 /* -rollback_sw, -rlbsw */
 131          3 protected_switch                                 /* -protected_sw, -psw */
 132          ) bit (1) unaligned;
 133 
 134 
 135 dcl  1 explicit_opt like opt;                               /* attributes explicitly requested */
 136 
 137 dcl  1 saved_options like opt;                              /* saved copy of opt */
 138 
 139 dcl  ALL_OPTIONS bit (33) aligned int static options (constant) init ((33)"1"b); /* for -all */
 140 
 141 dcl  LONG_OPTION (33) char (64) int static options (constant) init
 142           ("-primary", "-name", "-type", "-link_path", "-unique_id",
 143           "-date_time_used", "-date_time_contents_modified", "-date_time_entry_modified",
 144           "-date_time_dumped", "-date_time_volume_dumped", "-author", "-bc_author",
 145           "-logical_volume", "-bit_count", "-records", "-current_length", "-max_length",
 146           "-mode", "-access_class", "-ring_brackets", "-safety_switch", "-copy_switch",
 147           "-audit_switch", "-incr_volume_dump_switch", "-comp_volume_dump_switch", "-usage_count",
 148           "-damaged_switch", "-synchronized_switch", "-entry_bound",
 149                                                             /* (DM file options:) */
 150           "-highest_control_interval", "-concurrency_sw", "-rollback_sw", "-protected_sw");
 151 
 152 dcl  SHORT_OPTION (33) char (8) int static options (constant) init
 153           ("-pri", "-nm", "-tp", "-lp", "-uid",
 154           "-dtu", "-dtcm", "-dtem", "-dtd", "-dtvd", "-at", "-bca",
 155           "-lv", "-bc", "-rec", "-cl", "-ml",
 156           "-md", "-acc", "-rb", "-ssw", "-csw", "-asw",
 157           "-ivds", "-cvds", "-use",
 158           "-dsw", "-synch", "-eb",
 159           "-hci", "-concsw", "-rlbsw", "-psw");
 160 
 161 
 162 dcl  1 bks aligned like status_for_backup;
 163 
 164 dcl  1 link_status aligned based (addr (branch_status)),    /* status for link entries */
 165        2 type bit (2) unaligned,
 166        2 nnames bit (16) unaligned,
 167        2 nrp bit (18) unaligned,
 168        2 dtlm bit (36) unaligned,
 169        2 dtd bit (36) unaligned,
 170        2 pnl fixed bin (18) uns unaligned,
 171        2 pnrp bit (18) unaligned;
 172 
 173 dcl  1 msf_info aligned,                                    /* status for MSF components */
 174        2 type bit (2) unaligned,
 175        2 nnames bit (16) unaligned,
 176        2 names_offset bit (18) unaligned,
 177        2 dtcm bit (36) unaligned,
 178        2 dtu bit (36) unaligned,
 179        2 mode bit (5) unaligned,
 180        2 pad bit (13) unaligned,
 181        2 records fixed bin (17) unaligned,
 182        2 dtd bit (36) unaligned,
 183        2 dtem bit (36) unaligned,
 184        2 pad3 bit (36) unaligned,
 185        2 current_length fixed bin (11) unaligned,
 186        2 bit_count bit (24) unaligned,
 187        2 pad2 bit (18) unaligned,
 188        2 rbs (0:2) fixed bin (5) unaligned,
 189        2 pad4 bit (36) unaligned;
 190 
 191 dcl  branch_names (0:99) char (32) based (branch_names_ptr);/* names from hcs_$status_long */
 192 
 193 dcl  ROOT_NAMES (1) char (32) int static options (constant) init (">");
 194 
 195 dcl  1 si aligned like suffix_info;
 196 
 197 dcl  1 auto_dm_file_status aligned like dm_file_status;
 198 
 199 dcl  1 path_array (path_array_size) aligned based (path_array_ptr),
 200        2 path_ptr ptr,
 201        2 path_len fixed bin,
 202        2 nonstandard_names_flag bit (1) aligned;
 203 dcl  1 slet_path_array (slet_path_array_size) aligned based (slet_path_array_ptr) like path_array;
 204 dcl  1 path_array_space (25) like path_array;
 205 
 206 dcl  dates_array (5) bit (36);
 207 
 208 dcl  1 combined_options,
 209        (2 access,                                           /* -access */
 210        2 all,                                               /* -all */
 211        2 dates,                                             /* -date */
 212        2 lengths                                            /* -length */
 213        ) bit (1) unaligned;
 214 
 215 dcl  1 fs_entry_type aligned based (fs_entry_type_ptr),
 216        2 count fixed bin,
 217        2 suffix char (32) unaligned dim (fs_entry_type_count refer (fs_entry_type.count));
 218 
 219 dcl  1 fs_time_value aligned based,
 220        2 pad1 bit (20) unal,
 221        2 time bit (36) unal,
 222        2 pad2 bit (16) unal;
 223 
 224 dcl  temp_clock fixed bin (71);
 225 dcl  stime bit (36);
 226 dcl  switch_names (10) char (32);                           /* for -switch */
 227 dcl  mode_bits (5) bit (1) unaligned;
 228 dcl  ring_brackets (8) fixed bin (3);
 229 
 230 /* Constants */
 231 
 232 dcl  ME char (32) int static options (constant) init ("status");
 233 dcl  INITIALIZER_ID char (32) int static options (constant) init ("Initializer.SysDaemon.z");
 234 dcl  EXTENDED_type fixed bin int static options (constant) init (5);
 235 dcl  (CHASE init (1), NO_CHASE init (0)) fixed bin int static options (constant);
 236 
 237 /* Based */
 238 
 239 dcl  area area based (area_ptr);
 240 dcl  arg char (arg_len) based (arg_ptr);
 241 dcl  return_string char (return_len) varying based (return_ptr);
 242 dcl  slet_path char (slet_path_len) based (slet_path_ptr);
 243 dcl  target_path char (target_len) based (target_ptr);
 244 
 245 /* Automatic */
 246 
 247 dcl  slet_area area;
 248 
 249 dcl  date_string char (64) varying;
 250 dcl  mode_string char (36) varying;
 251 
 252 dcl  (class, temp_string) char (336);                       /* ASCII access class */
 253 dcl  (dn, msf_path, saved_dn, target_dn) char (168);
 254 dcl  (author_string, bc_author_string, comp_name, en, fs_type, fs_util_type) char (32);
 255 dcl  (lv_string, saved_en, star_en, target_en) char (32);
 256 dcl  type_string char (32);                                 /* avoid string size condition while compiling. */
 257 
 258 dcl  access_class bit (72) aligned;
 259 dcl  (exmodes, local_unique_id, modes) bit (36) aligned;
 260 dcl  (bc36, msf_dtcm, msf_dtd, msf_dtem, msf_dtu) bit (36);
 261 dcl  switch_mask bit (10) aligned;
 262 dcl  (active_function, chase, chase_if_possible, chased, dir_sw, dm_file_sw, interpret_as_standard_entry) bit (1) aligned;
 263 dcl  (link_sw, matched, msf, msf_error, one_item, printed_pathname, printed_something) bit (1) aligned;
 264 dcl  (root_sw, safety_switch, seg_sw, selecting_by_entry_type, star_sw) bit (1) aligned;
 265 
 266 dcl  (area_ptr, arg_ptr, branch_names_ptr, comp_ptr, fs_entry_type_ptr, msf_ptr) ptr;
 267 dcl  (path_array_ptr, return_ptr, slet_path_array_ptr, slet_path_ptr, target_ptr) ptr;
 268 
 269 dcl  status_chase fixed bin (1);
 270 dcl  entry_type fixed bin (3);
 271 dcl  (arg_count, arg_len, class_len, cvds, entry_type_index, extended_type_count, fs_entry_type_count, i, ivds) fixed bin;
 272 dcl  (j, k, kk, path_array_size, path_count, return_len, slet_path_array_size, slet_path_len) fixed bin;
 273 dcl  (switch_count, switch_length, target_len, total_length, total_records) fixed bin;
 274 dcl  max_length fixed bin (19);
 275 dcl  total_bit_count fixed bin (24);
 276 dcl  (bc35, code, usage_count) fixed bin (35);
 277 
 278 /* External */
 279 
 280 dcl  dm_error_$transaction_in_progress fixed bin (35) ext;
 281 dcl  error_table_$badopt fixed bin (35) ext;
 282 dcl  error_table_$inconsistent fixed bin (35) ext;
 283 dcl  error_table_$incorrect_access fixed bin (35) ext;
 284 dcl  error_table_$logical_volume_not_connected fixed bin (35) ext;
 285 dcl  error_table_$logical_volume_not_defined fixed bin (35) ext;
 286 dcl  error_table_$moderr fixed bin (35) ext;
 287 dcl  error_table_$no_s_permission fixed bin (35) ext;
 288 dcl  error_table_$noarg fixed bin (35) ext;
 289 dcl  error_table_$noentry fixed bin (35) ext;
 290 dcl  error_table_$nomatch fixed bin (35) ext;
 291 dcl  error_table_$not_act_fnc fixed bin (35) ext;
 292 dcl  error_table_$root fixed bin (35) ext;
 293 dcl  error_table_$segknown fixed bin (35) ext;
 294 dcl  error_table_$unsupported_operation fixed bin (35) ext;
 295 
 296 /* Entries */
 297 
 298 dcl  complain entry variable options (variable);
 299 
 300 dcl  active_fnc_err_ entry options (variable);
 301 dcl  check_star_name_$entry entry (char (*), fixed bin (35));
 302 dcl  com_err_ entry options (variable);
 303 dcl  convert_authorization_$to_string_short entry (bit (72) aligned, char (*), fixed bin (35));
 304 dcl  cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (35));
 305 dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
 306 dcl  expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35));
 307 dcl  expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
 308 dcl  get_group_id_ entry () returns (char (32));
 309 dcl  get_system_free_area_ entry returns (ptr);
 310 dcl  get_wdir_ entry returns (char (168));
 311 dcl  file_manager_$status entry (char (*), char (*), ptr, fixed bin (35));
 312 dcl  fs_util_$get_type entry (char (*), char (*), char (*), fixed bin (35));
 313 dcl  fs_util_$get_max_length entry (char (*), char (*), fixed bin (19), fixed bin (35));
 314 dcl  fs_util_$get_ring_brackets entry (char (*), char (*), (*) fixed bin (3), fixed bin (35));
 315 dcl  fs_util_$get_switch entry (char (*), char (*), char (*), bit (1) aligned, fixed bin (35));
 316 dcl  fs_util_$get_user_access_modes entry (char (*), char (*), char (*), fixed bin, bit (36) aligned,
 317           bit (36) aligned, fixed bin (35));
 318 dcl  fs_util_$list_switches_for_type entry (char (*), char (*), ptr, ptr, fixed bin (35));
 319 dcl  fs_util_$suffix_info_for_type entry (char (*), ptr, fixed bin (35));
 320 dcl  hcs_$get_access_class entry (char (*), char (*), bit (72) aligned, fixed bin (35));
 321 dcl  hcs_$get_dates entry (char (*), char (*), (5) bit (36), fixed bin (35));
 322 dcl  hcs_$get_author entry (char (*), char (*), fixed bin, char (*), fixed bin (35));
 323 dcl  hcs_$get_bc_author entry (char (*), char (*), char (*), fixed bin (35));
 324 dcl  hcs_$get_link_target entry (char (*), char (*), char (*), char (*), fixed bin (35));
 325 dcl  hcs_$get_max_length entry (char (*), char (*), fixed bin (19), fixed bin (35));
 326 dcl  hcs_$get_safety_sw entry (char (*), char (*), bit (1) aligned, fixed bin (35));
 327 dcl  hcs_$get_volume_dump_switches entry (char (*), char (*), fixed bin, fixed bin, fixed bin (35));
 328 dcl  hcs_$star_dir_list_ entry (char (*), char (*), fixed bin (3), ptr, fixed bin, fixed bin, ptr, ptr, fixed bin (35));
 329 dcl  hcs_$status_for_backup entry (char (*), char (*), ptr, fixed bin (35));
 330 dcl  hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35));
 331 dcl  ioa_ entry options (variable);
 332 dcl  ioa_$nnl entry options (variable);
 333 dcl  ioa_$rsnnl entry options (variable);
 334 dcl  mdc_$find_lvname entry (bit (36), char (*), fixed bin (35));
 335 dcl  mhcs_$get_seg_usage entry (char (*), char (*), fixed bin (35), fixed bin (35));
 336 dcl  msf_manager_$close entry (ptr);
 337 dcl  msf_manager_$get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35));
 338 dcl  msf_manager_$open entry (char (*), char (*), ptr, fixed bin (35));
 339 dcl  pathname_ entry (char (*), char (*)) returns (char (168));
 340 dcl  requote_string_ entry (char (*)) returns (char (*));
 341 
 342 /* Builtins */
 343 
 344 dcl  (addr, after, before, bin, binary, clock, convert, divide, fixed, hbound, index, null) builtin;
 345 dcl  (length, max, ptr, reverse, rtrim, string, substr, unspec, verify, empty) builtin;
 346 
 347 /* Conditions */
 348 
 349 dcl  (cleanup, linkage_error) condition;
 350 
 351 /* END OF DECLARATIONS */
 352 %page;
 353           call cu_$af_return_arg (arg_count, return_ptr, return_len, code);
 354           if code = error_table_$not_act_fnc then do;
 355                active_function = "0"b;
 356                complain = com_err_;
 357           end;
 358           else do;
 359                active_function = "1"b;
 360                complain = active_fnc_err_;
 361           end;
 362 
 363           code = 0;                                         /* must reset code to 0 */
 364           string (opt) = "0"b;
 365           string (combined_options) = "0"b;
 366           chase, chase_if_possible, dir_sw, dm_file_sw, interpret_as_standard_entry, link_sw, root_sw, seg_sw = "0"b;
 367           area_ptr = get_system_free_area_ ();
 368 
 369           path_array_ptr = addr (path_array_space);
 370           fs_entry_type_ptr, star_list_branch_ptr, star_list_names_ptr = null;
 371           selecting_by_entry_type = ""b;
 372 
 373           on cleanup call CLEAN_UP ();
 374 
 375           path_array_size = arg_count;
 376           if path_array_size > hbound (path_array_space, 1) then
 377                allocate path_array in (area) set (path_array_ptr);
 378 
 379           path_count, switch_count = 0;
 380           switch_length = 13;
 381 
 382           do i = 1 to arg_count;
 383 
 384                call cu_$arg_ptr (i, arg_ptr, arg_len, code);
 385 
 386                if substr (arg, 1, 1) ^= "-" then do;
 387                     path_count = path_count + 1;
 388                     path_array.path_ptr (path_count) = arg_ptr;
 389                     path_array.path_len (path_count) = arg_len;
 390                     path_array.nonstandard_names_flag (path_count) = "0"b;
 391                end;
 392 
 393                else if arg = "-working_dir" | arg = "-wd" then do;
 394                     path_count = path_count + 1;
 395                     path_array.path_len (path_count) = 0;   /* use expand_path_'s working dir feature */
 396                     path_array.nonstandard_names_flag (path_count) = "0"b;
 397                end;
 398 
 399                else if arg = "-chase" then chase = "1"b;
 400                else if arg = "-no_chase" then chase = "0"b;
 401                else if arg = "-chase_if_possible" | arg = "-cip" then chase_if_possible = "1"b;
 402                else if arg = "-no_chase_if_possible" | arg = "-ncip" then chase_if_possible = "0"b;
 403                else if arg = "-directory" | arg = "-dr" then dir_sw = "1"b;
 404                else if arg = "-link" | arg = "-lk" then link_sw = "1"b;
 405                else if arg = "-segment" | arg = "-sm" then seg_sw = "1"b;
 406                else if arg = "-switch" then do;
 407                     i = i + 1;
 408                     if i > arg_count then do;
 409                          call complain (error_table_$noarg, ME, "Following -switch.");
 410                          return;
 411                     end;
 412                     if switch_count = 10 then do;
 413                          call complain (0, ME, "Only 10 switch names allowed.");
 414                          return;
 415                     end;
 416                     call cu_$arg_ptr (i, arg_ptr, arg_len, code);
 417                     switch_count = switch_count + 1;
 418                     switch_names (switch_count) = arg;
 419                     switch_length = max (switch_length, arg_len);
 420                end;
 421 
 422                else do;
 423                     do j = hbound (LONG_OPTION, 1) by -1 to 1
 424                          while (arg ^= LONG_OPTION (j) & arg ^= SHORT_OPTION (j));
 425                     end;
 426                     if j ^= 0 then substr (string (opt), j, 1) = "1"b;
 427                     else if arg = "-device" | arg = "-dv" then opt.logical_volume = "1"b;
 428                     else if arg = "-entry_type" | arg = "-ettp" then opt.type = "1"b;
 429                     else if arg = "-interpret_as_extended_entry" | arg = "-inaee" then interpret_as_standard_entry = "0"b;
 430                     else if arg = "-interpret_as_standard_entry" | arg = "-inase" then interpret_as_standard_entry = "1"b;
 431                     else if arg = "-names" then opt.names = "1"b; /* synonym for -name and -nm */
 432                     else if arg = "-nonstandard_names" | arg = "-nsn" then do;
 433                          i = i + 1;
 434                          if i > arg_count then do;
 435                               call complain (error_table_$noarg, ME, "Need an argument for ^a.", arg);
 436                               return;
 437                          end;
 438                          call cu_$arg_ptr (i, arg_ptr, arg_len, code);
 439                          path_count = path_count + 1;
 440                          path_array.path_ptr (path_count) = arg_ptr;
 441                          path_array.path_len (path_count) = arg_len;
 442                          path_array.nonstandard_names_flag (path_count) = "1"b;
 443                     end;
 444                     else if arg = "-records_used" | arg = "-ru" then opt.records_used = "1"b; /* syn for -records */
 445                     else if arg = "-select_entry_type" | arg = "-slet" then do;
 446                          i = i + 1;
 447                          if i > arg_count then do;
 448                               call complain (error_table_$noarg, ME, "Following ^a", arg);
 449                               return;
 450                          end;
 451                          call cu_$arg_ptr (i, arg_ptr, arg_len, code);
 452                          call BUILD_ENTRY_TYPE_LIST (arg, fs_entry_type_ptr, selecting_by_entry_type);
 453                     end;
 454                     else if arg = "-length" | arg = "-lengths" | arg = "-ln" then lengths = "1"b;
 455                     else if active_function then do;        /* not any control arg acceptable to status af */
 456                          call complain (0, ME,
 457                               "Specified control argument is not implemented by this active function.   ^a", arg);
 458                          return;
 459                     end;
 460                     else if arg = "-access" | arg = "-ac" then access = "1"b;
 461                                                             /* -all, -a are undocumented synonyms of -long to be retained for compatibility. */
 462                     else if arg = "-all" | arg = "-a" | arg = "-long" | arg = "-lg" then all = "1"b;
 463                     else if arg = "-date" | arg = "-dt" then dates = "1"b;
 464                     else do;
 465                          call complain (error_table_$badopt, ME, "^a", arg);
 466                          return;
 467                     end;
 468                end;
 469           end;
 470 
 471 /* Adjust the environment for slet processing, if any requested */
 472 
 473           if selecting_by_entry_type then do;
 474 
 475                if link_sw | seg_sw | dir_sw then do;
 476                     call complain (error_table_$inconsistent, ME,
 477                          "-select_entry_type is an alternative to -directory, -segment, or -link.");
 478                     return;
 479                end;
 480                dir_sw, link_sw, seg_sw = "1"b;
 481 
 482                extended_type_count = 0;
 483                do entry_type_index = 1 to fs_entry_type.count;
 484                     if substr (fs_entry_type.suffix (entry_type_index), 1, 1) ^= "-" then
 485                          extended_type_count = extended_type_count + 1;
 486                end;
 487 
 488                if extended_type_count = fs_entry_type.count then slet_path_array_size = path_count * extended_type_count;
 489                else slet_path_array_size = path_count * (extended_type_count + 1);
 490 
 491                if slet_path_array_size > hbound (path_array_space, 1) then
 492                     allocate slet_path_array in (area) set (slet_path_array_ptr);
 493                else slet_path_array_ptr = addr (path_array_space);
 494 
 495                i = slet_path_array_size;
 496                do j = path_count by -1 to 1;
 497 
 498                     do entry_type_index = 1 to fs_entry_type.count;
 499                          if substr (fs_entry_type.suffix (entry_type_index), 1, 1) ^= "-" then do;
 500                               slet_path_len = path_array.path_len (j) + 1 +
 501                                    length (rtrim (fs_entry_type.suffix (entry_type_index)));
 502                               allocate slet_path in (slet_area) set (slet_path_ptr);
 503                               target_len = path_array.path_len (j);
 504                               if ^path_array.nonstandard_names_flag (j) then
 505                                    call expand_pathname_$add_suffix (path_array.path_ptr (j) -> target_path,
 506                                         fs_entry_type.suffix (entry_type_index), target_dn,
 507                                         slet_path_ptr -> slet_path, code);
 508                               else do;
 509                                    target_dn = get_wdir_ ();
 510                                    arg_len = path_array.path_len (j);
 511                                    arg_ptr = path_array.path_ptr (j);
 512                                    slet_path_ptr -> slet_path = arg;
 513                               end;
 514                               slet_path_array.path_ptr (i) = slet_path_ptr;
 515                               slet_path_array.path_len (i) = slet_path_len;
 516                               i = i - 1;
 517                          end;
 518                     end;
 519                     if fs_entry_type.count > extended_type_count then do;
 520                          slet_path_array.path_ptr (i) = path_array.path_ptr (j);
 521                          slet_path_array.path_len (i) = path_array.path_len (j);
 522                          i = i - 1;
 523                     end;
 524                end;
 525 
 526                if path_array_ptr ^= addr (path_array_space) then do;
 527                     free path_array in (area);
 528                     path_array_ptr = slet_path_array_ptr;
 529                end;
 530 
 531                path_count = slet_path_array_size;
 532           end;
 533 
 534 /* Set star selection variables */
 535 
 536           if ^dir_sw & ^link_sw & ^seg_sw then dir_sw, link_sw, seg_sw = "1"b; /* default */
 537 
 538           if ^link_sw then star_select_sw = star_BRANCHES_ONLY;
 539           else if ^dir_sw & ^seg_sw then star_select_sw = star_LINKS_ONLY;
 540           else star_select_sw = star_ALL_ENTRIES;
 541 
 542           k = 0;
 543           switch_mask = ""b;
 544           do i = 1 to switch_count;                         /* check for standards */
 545                if switch_names (i) = "damaged" then opt.damaged_switch = "1"b;
 546                else if switch_names (i) = "safety" then opt.safety_switch = "1"b;
 547                else if switch_names (i) = "copy" then opt.copy_switch = "1"b;
 548                else if switch_names (i) = "audit" then opt.audit_switch = "1"b;
 549                else if switch_names (i) = "synchronized" then opt.synchronized_switch = "1"b;
 550                else if switch_names (i) = "complete_volume_dump" then opt.cvds = "1"b;
 551                else if switch_names (i) = "incremental_volume_dump" then opt.ivds = "1"b;
 552                else substr (switch_mask, i, 1) = "1"b;
 553 
 554                if ^(substr (switch_mask, i, 1)) then k = k + 1; /* was a standard switch */
 555           end;
 556 
 557           explicit_opt = opt;
 558 
 559           if all then string (opt) = ALL_OPTIONS;
 560 
 561           if access then string (opt) = string (opt) | string (access_options);
 562           if dates then string (opt) = string (opt) | string (date_options);
 563           if lengths then do;
 564                if active_function then
 565                     string (opt) = string (opt) | string (active_function_length_options);
 566                else string (opt) = string (opt) | string (length_options);
 567           end;
 568           if switch_count = 0 & string (opt) = "0"b then
 569                if active_function then do;                  /* control arg must be supplied to active function */
 570 AF_USAGE:
 571                     call active_fnc_err_ (0, ME, "Usage:  [status path control_arg {-chase}]");
 572                     return;
 573                end;
 574                else unspec (opt) = unspec (default_options);
 575 
 576 /* Shorter output format if only one item of information is requested. */
 577 
 578           j = switch_count - k;
 579           do i = 1 to hbound (LONG_OPTION, 1);
 580                if substr (string (opt), i, 1) then j = j + 1;
 581           end;
 582           if j = 1 then one_item = "1"b;
 583           else if active_function & ^lengths then go to AF_USAGE;
 584           else one_item = "0"b;
 585 
 586           if path_count = 0 then do;                        /* assume working directory */
 587                if active_function & arg_count = 2 then go to AF_USAGE;
 588                path_count = 1;
 589                path_array.path_len (1) = 0;                 /* use expand_path_'s working dir feature */
 590                path_array.path_ptr (1) = null ();
 591           end;
 592           else if active_function & path_count > 1 then go to AF_USAGE;
 593 
 594           saved_options = opt;
 595 %page;
 596           printed_something = "0"b;                         /* haven't output anything yet */
 597 
 598           do i = 1 to path_count;
 599                if path_array.nonstandard_names_flag (i) then do;
 600                     dn = get_wdir_ ();
 601                     arg_len = path_array.path_len (i);
 602                     arg_ptr = path_array.path_ptr (i);
 603                     en = arg;
 604                end;
 605                else do;
 606                     call expand_path_ (path_array.path_ptr (i), path_array.path_len (i), addr (dn), addr (en), code);
 607                     if code ^= 0 then do;
 608                          arg_ptr = path_array.path_ptr (i);
 609                          arg_len = path_array.path_len (i);
 610                          call complain (code, ME, "^a", arg);
 611                          go to NEXT_PATH;
 612                     end;
 613                     if en ^= "" then call check_star_name_$entry (en, code); /* star convention? */
 614                end;
 615                if code = 0 then do;
 616                     star_sw = "0"b;
 617                     j, star_entry_count = 1;
 618                     printed_pathname = "0"b;
 619                     msf = "0"b;
 620                     msf_ptr = null ();
 621 
 622                     call ENTRY_STATUS ();                   /* do the work */
 623 
 624                     if msf then
 625                          if msf_ptr ^= null then call msf_manager_$close (msf_ptr);
 626                     if branch_names_ptr ^= null & ^root_sw then free branch_names in (area);
 627                end;
 628                else if code > 2 then do;                    /* invalid entry name */
 629                     arg_ptr = path_array.path_ptr (i);
 630                     arg_len = path_array.path_len (i);
 631                     call complain (code, ME, "^a", arg);
 632                     go to NEXT_PATH;
 633                end;
 634                else if active_function then do;
 635                     call active_fnc_err_ (0, ME, "Star convention is not allowed.");
 636 RETURN:
 637                     return;
 638                end;
 639                else
 640 star_loop:
 641                     begin;
 642                     star_sw = "1"b;
 643                     star_list_branch_ptr, star_list_names_ptr = null;
 644 
 645                     on condition (cleanup) call CLEAN_UP ();
 646 
 647                     call hcs_$star_dir_list_ (dn, en, star_select_sw, area_ptr, star_branch_count, star_link_count,
 648                          star_list_branch_ptr, star_list_names_ptr, code);
 649                     if code ^= 0 then do;
 650                          call complain (code, ME, "^a", pathname_ (dn, en));
 651                          go to NEXT_PATH;
 652                     end;
 653                     star_en = en;
 654                     matched = "0"b;
 655                     star_entry_count = star_branch_count + star_link_count;
 656                     do j = 1 to star_entry_count;
 657                          entry_type = star_dir_list_branch (j).type;
 658                          if entry_type = star_SEGMENT then do;
 659                               if ^seg_sw then go to NEXT_MATCH;
 660                          end;
 661                          else if entry_type = star_LINK then do;
 662                               if ^link_sw then go to NEXT_MATCH;
 663                          end;
 664                          else do;                           /* directory type: dir or MSF */
 665                               if star_dir_list_branch (j).bit_count = 0 then do;
 666                                    if ^dir_sw then go to NEXT_MATCH;
 667                               end;
 668                               else if ^seg_sw then go to NEXT_MATCH;
 669                          end;
 670                          matched = "1"b;
 671                          en = star_list_names (star_dir_list_branch (j).nindex);
 672                          printed_pathname = "0"b;
 673                          msf = "0"b;
 674                          msf_ptr = null ();
 675 
 676                          call ENTRY_STATUS ();              /* do the work */
 677 
 678                          if ^printed_something then         /* if we haven't output anything yet, */
 679                               printed_something = printed_pathname; /* then if we printed the pathname, */
 680                                                             /* well that's something */
 681 
 682                          if chased | msf_error then dn = saved_dn;
 683                          if msf then
 684                               if msf_ptr ^= null then call msf_manager_$close (msf_ptr);
 685                          if branch_names_ptr ^= null & ^root_sw then free branch_names in (area);
 686 NEXT_MATCH:
 687                     end;
 688                     if ^matched | (matched & ^printed_something) then
 689                          call complain (error_table_$nomatch, ME, "^a", pathname_ (dn, star_en));
 690                     call CLEAN_UP ();
 691                end star_loop;
 692 
 693 NEXT_PATH:
 694           end;
 695 STATUS_EXIT:
 696           call CLEAN_UP ();
 697           return;
 698 %page;
 699 ENTRY_STATUS: proc;
 700 
 701 /* This internal procedure returns the requested attributes of dn>en */
 702 /* It uses a number of global values declared in the external procedure. */
 703 /* It allocates branch names and sets branch_names_ptr. */
 704 /* For multisegment files, it turns on the flag msf. */
 705 
 706 dcl  max_switch_length fixed bin;
 707 dcl  not_mounted fixed bin (35);
 708 dcl  msf_mode bit (5) aligned;
 709 dcl  msf_rbs (0:2) fixed bin (5) unaligned;
 710 
 711           max_switch_length = switch_length;
 712           branch_status.number_names = "0"b;
 713           opt = saved_options;
 714           chased, dm_file_sw, msf_error, root_sw = "0"b;
 715           not_mounted = 0;
 716 
 717           status_chase = NO_CHASE;                          /* get info on entry */
 718 
 719 /* If it's a link, we'll be coming back here with status_chase = CHASE */
 720 
 721 STATUS:
 722           branch_status.names_rel_pointer = "0"b;
 723 
 724           if opt.names | opt.primary_name | opt.link_path then
 725                call hcs_$status_long (dn, en, status_chase, addr (branch_status), area_ptr, code);
 726           else call hcs_$status_long (dn, en, status_chase, addr (branch_status), null, code);
 727           branch_names_ptr = null;
 728 
 729           if branch_status.names_rel_pointer ^= "0"b then
 730                branch_names_ptr = ptr (area_ptr, branch_status.names_rel_pointer);
 731 
 732           on condition (cleanup) begin;
 733                if branch_names_ptr ^= null & ^root_sw then free branch_names in (area);
 734           end;
 735 
 736           if code ^= 0 then
 737                if code = error_table_$no_s_permission then do;
 738 NO_S:
 739                     string (opt) = string (opt) & string (no_s_options);
 740                     if string (opt) = "0"b then call ENTRY_ERROR (code, dn, en);
 741                end;
 742                else if code = error_table_$logical_volume_not_connected |
 743                     code = error_table_$logical_volume_not_defined then do;
 744                     not_mounted = code;
 745                     string (opt) = string (opt) & string (off_line_options);
 746                     if branch_status.number_names = "0"b then string (opt) = string (opt) & string (no_s_options);
 747                     if string (opt) = "0"b then call ENTRY_ERROR (code, dn, en);
 748                end;
 749                else if code = error_table_$root then do;    /* now it works on the root */
 750                     root_sw = "1"b;
 751                     string (opt) = string (opt) & string (root_options);
 752                     if string (opt) = "0"b then call ENTRY_WRONG_TYPE ("the root");
 753                     dn = ">";
 754                     en = "";
 755                     branch_names_ptr = addr (ROOT_NAMES);   /* fake hcs_$status info */
 756                     unspec (branch_status) = "0"b;
 757                     branch_status.type = directory_type;
 758                     branch_status.unique_id = (36)"1"b;
 759                     branch_status.number_names = "0001"b4;
 760                     if get_group_id_ () = INITIALIZER_ID then branch_status.mode = "01011"b; /* sma */
 761                     else branch_status.mode = "01"b;        /* s for everybody else */
 762                     branch_status.ring_brackets (*) = "000111"b; /* 7,7,7 */
 763                end;
 764                else call ENTRY_ERROR (code, dn, en);
 765 
 766 /* Check the fs type when we are -inase with -slet, and fake out status if wrong type */
 767 
 768           if selecting_by_entry_type then do;
 769                call fs_util_$get_type (dn, en, fs_type, code);
 770                if code ^= 0 then do;
 771                     call complain (code, ME, "Getting type of ^a", pathname_ (dn, en));
 772                     return;
 773                end;
 774                if ^ENTRY_TYPE_SELECTED (fs_type, fs_entry_type_ptr) then do;
 775                     matched = "1"b;
 776                     return;
 777                end;
 778                else if substr (fs_type, 1, 1) = "-" then ;  /* standard type, no faking necessary */
 779                else if star_sw then
 780                     if before (reverse (rtrim (en)), ".") ^= before (reverse (rtrim (star_en)), ".") then do;
 781                          matched = "1"b;
 782                          return;
 783                     end;
 784           end;
 785 
 786 /* See if the entry is a special type */
 787 
 788           entry_type = fixed (branch_status.type);
 789           msf = (entry_type = star_DIRECTORY & branch_status.bit_count ^= "0"b);
 790 
 791           if ^interpret_as_standard_entry & entry_type ^= star_LINK & ^root_sw then
 792                if msf | switch_count > 0 | (string (opt) & string (typed_options)) then do;
 793                     call fs_util_$get_type (dn, en, fs_util_type, code);
 794                     dm_file_sw = (code = 0 & fs_util_type = FS_OBJECT_TYPE_DM_FILE);
 795                     if code = 0 & substr (fs_util_type, 1, 1) ^= "-" then do;
 796                                                             /* for now, handle segs, dirs, DM files, and MSF's by hand */
 797                          entry_type = EXTENDED_type;
 798                          msf = "0"b;
 799                          si.version = SUFFIX_INFO_VERSION_1;
 800                          call fs_util_$suffix_info_for_type (fs_util_type, addr (si), (0));
 801                     end;
 802                end;
 803 
 804           if branch_status.type = link_type then do;        /* process link for -chase or -chase_if_possible */
 805                if chase & chased then do;                   /* null link */
 806                     call complain (0, ME, "Null link with -chase.  ^a", pathname_ (dn, en));
 807                     return;
 808                end;
 809                else if (chase_if_possible | chase) then
 810                     if ^chased then do;
 811                          call hcs_$get_link_target (dn, en, target_dn, target_en, code);
 812                          if code = 0 & dn ^= "" then do;
 813                               chased = "1"b;
 814                               saved_dn = dn;
 815                               saved_en = en;
 816                               dn = target_dn;
 817                               en = target_en;
 818                               status_chase = CHASE;         /* chase the link this time */
 819                               go to STATUS;                 /* go back to get link info */
 820                          end;
 821                          else if code = error_table_$noentry then
 822                               if chase then do;             /* null link */
 823                                    call complain (code, ME,
 824                                         "Target:  ^a.  Link to a null link with -chase.  Source:  ^a",
 825                                         pathname_ (target_dn, target_en), pathname_ (dn, en));
 826                                    return;
 827                               end;
 828                     end;                                    /* if ^chase */
 829 
 830                string (opt) = string (opt) & string (link_options);
 831                if string (opt) = "0"b & switch_count = 0 then /* no applicable control args */
 832                     call ENTRY_WRONG_TYPE ("a link");
 833           end;                                              /* if branch_status.type = link_type */
 834 
 835           else do;                                          /* non-link */
 836                if ^star_sw then
 837                     if branch_status.type = directory_type & ^dm_file_sw then do;
 838                          if (seg_sw | link_sw) & ^dir_sw then call ENTRY_WRONG_TYPE ("a directory");
 839                     end;
 840                     else if (link_sw | dir_sw) & ^seg_sw then
 841                          if dm_file_sw then call ENTRY_WRONG_TYPE ("a Data Management file");
 842                          else call ENTRY_WRONG_TYPE ("a segment");
 843 
 844                string (opt) = string (opt) & string (nonlink_options);
 845                if string (opt) = "0"b & switch_count = 0 then do; /* no applicable control args */
 846                     if ^star_sw then call ENTRY_WRONG_TYPE ("not a link");
 847                     return;
 848                end;
 849           end;
 850 
 851           if lengths & active_function then                 /* set up the return value for -length only when status acts as an active function */
 852                if branch_status.type = directory_type & branch_status.bit_count = "0"b then opt.current_length = "0"b; /* for directory type -- status active function returns bit count for -length */
 853                else opt.bit_count = "0"b;                   /* for other types -- status active function returns current length for -length */
 854           else ;
 855 
 856           if dm_file_sw | root_sw then msf = "0"b;          /* root's not, can't look inside a DM file */
 857 
 858           if dm_file_sw then do;
 859                string (opt) = string (opt) & string (dm_file_options);
 860                if string (opt) = "0"b & switch_count = 0 then call ENTRY_WRONG_TYPE ("a Data Management file");
 861           end;
 862           else do;                                          /* not DM file; make sure some control args apply */
 863                unspec (opt.dm_files_only) = "0"b;
 864 
 865 /**** vp: phx20203 ; case when string (opt) = "0"b and switch_count > 0 for a link ****/
 866                if string (opt) = "0"b then do;
 867                     if branch_status.type = link_type then call ENTRY_WRONG_TYPE ("a link");
 868                     else call ENTRY_WRONG_TYPE ("not a Data Management file");
 869                end;
 870           end;
 871 %page;
 872 /* Now we know we can proceed to print or return some info */
 873 
 874           if ^active_function & ^one_item then do;          /* multiple entries; print pathname */
 875                call PRINT_PATHNAME ();
 876                call ioa_ ("");
 877           end;
 878 
 879           if dm_file_sw then do;
 880                if (string (opt) & string (fm_status_options)) ^= "0"b then do;
 881                     unspec (auto_dm_file_status) = "0"b;
 882                     auto_dm_file_status.version = DM_FILE_STATUS_VERSION_1;
 883                     call file_manager_$status (dn, en, addr (auto_dm_file_status), code);
 884                     if code ^= 0 & code ^= dm_error_$transaction_in_progress then do;
 885                          call complain (code, ME, "^a", pathname_ (dn, en));
 886                          return;
 887                     end;
 888                end;
 889           end;
 890 %page;
 891 /* Format each item of status info */
 892 
 893           if opt.names | opt.primary_name then do;          /* -name or -primary */
 894                if active_function then do;
 895                     return_string = requote_string_ (rtrim (branch_names (0)));
 896                     if opt.names then
 897                          do k = 1 to bin (branch_status.number_names) - 1;
 898                          return_string = return_string || " " || requote_string_ (rtrim (branch_names (k)));
 899                     end;
 900                     return;
 901                end;
 902                call PRINT_PATHNAME ();
 903                if opt.names then do;
 904                     if one_item then call ioa_ ("^a", branch_names (0));
 905                     else call ioa_ ("names:^4x^a", branch_names (0));
 906                     do k = 1 to bin (branch_status.number_names) - 1;
 907                          if one_item then call ioa_ ("^a", branch_names (k));
 908                          else call ioa_ ("^10x^a", branch_names (k));
 909                     end;
 910                end;
 911                else if one_item then call ioa_ ("^a", branch_names (0));
 912                else call ioa_ ("primary name:^7x^a", branch_names (0));
 913           end;
 914 
 915           if opt.type then do;                              /* -type */
 916                if root_sw then type_string = "directory";
 917                else if dm_file_sw then type_string = "Data Management file";
 918                else if entry_type = EXTENDED_type then type_string = si.type_name;
 919                else if entry_type = star_LINK then type_string = "link";
 920                else if entry_type = star_SEGMENT then type_string = "segment";
 921                else if entry_type = star_DIRECTORY then
 922                     if branch_status.bit_count ^= "0"b then type_string = "multisegment file";
 923                     else if branch_status.mdir then type_string = "master directory";
 924                     else type_string = "directory";
 925 
 926                if active_function then do;
 927                     return_string = """" || rtrim (type_string) || """";
 928                     return;
 929                end;
 930                call PRINT_PATHNAME ();
 931                if one_item then call ioa_ ("^a", type_string);
 932                else call ioa_ ("type:^15x^a", type_string);
 933           end;
 934 
 935           if opt.link_path then do;                         /* -link_path */
 936                target_ptr = ptr (area_ptr, link_status.pnrp);
 937                target_len = link_status.pnl;
 938                if active_function then do;
 939                     return_string = rtrim (target_path);
 940                     return;
 941                end;
 942                call PRINT_PATHNAME ();
 943                if one_item then call ioa_ ("^a", target_ptr -> target_path);
 944                else call ioa_ ("links to:^11x^a", target_ptr -> target_path);
 945           end;
 946 
 947           if opt.unique_id then do;                         /* -unique_id */
 948                if dm_file_sw then local_unique_id = auto_dm_file_status.fm_unique_id;
 949                else local_unique_id = branch_status.unique_id;
 950                if active_function then do;
 951                     call ioa_$rsnnl ("^w", return_string, k, local_unique_id);
 952                     return;
 953                end;
 954                else do;
 955                     call PRINT_PATHNAME ();
 956                     if one_item then call ioa_ ("^w", local_unique_id);
 957                     else call ioa_ ("^[fm unique id:^7x^;unique id:^10x^]^w", dm_file_sw, local_unique_id);
 958                end;
 959           end;
 960 
 961 /* Get MSF information */
 962 
 963           if opt.dtu | opt.dtcm | opt.dtem | opt.dtd | opt.bit_count | opt.records_used | opt.current_length |
 964                opt.mode | opt.ring_brackets then do;
 965 
 966                call PRINT_PATHNAME ();
 967 
 968                if msf then
 969 get_msf_info:
 970                     begin;
 971                     on cleanup begin;
 972                          if msf_ptr ^= null then call msf_manager_$close (msf_ptr);
 973                     end;
 974 
 975                     call msf_manager_$open (dn, en, msf_ptr, code);
 976                     if msf_ptr = null then do;
 977                          call complain (code, ME, "Unable to open multisegment file ^a>^a", dn, en);
 978                          msf = "0"b;
 979                          return;
 980                     end;
 981 
 982                     msf_dtu, msf_dtcm, msf_dtem, msf_dtd = "0"b;
 983                     total_records = bin (branch_status.records, 17);
 984                     total_length = bin (branch_status.current_length, 11);
 985                     total_bit_count = 0;
 986                     msf_path = rtrim (dn) || ">" || en;
 987                                                             /* initialize in case no components */
 988                     msf_mode = branch_status.mode & "01010"b;
 989                     unspec (msf_rbs) = unspec (branch_status.ring_brackets);
 990 
 991                     do k = 0 by 1 while (code = 0);         /* look at all components */
 992                          call msf_manager_$get_ptr (msf_ptr, k, "0"b, comp_ptr, 0, code);
 993                          if code = 0 | code = error_table_$segknown then do;
 994                               comp_name = convert (comp_name, k);
 995                               comp_name = substr (comp_name, verify (comp_name, " "));
 996                               call hcs_$status_long (msf_path, comp_name, 1, addr (msf_info), null, code);
 997                               if code ^= 0 then
 998                                    if code = error_table_$no_s_permission then do;
 999                                         opt.ring_brackets = "0"b;
1000                                         if string (opt) = "0"b then do;
1001                                              saved_dn = dn;
1002                                              msf_error = "1"b;
1003                                              call ENTRY_ERROR (code, msf_path, comp_name);
1004                                         end;
1005                                    end;
1006                                    else do;
1007                                         call complain (code, ME, "^a>^a", msf_path, comp_name);
1008                                         return;
1009                                    end;
1010                               code = 0;
1011                               if fixed (msf_info.dtu) > fixed (msf_dtu) then msf_dtu = msf_info.dtu;
1012                               if fixed (msf_info.dtcm) > fixed (msf_dtcm) then msf_dtcm = msf_info.dtcm;
1013                               if fixed (msf_info.dtem) > fixed (msf_dtem) then msf_dtem = msf_info.dtem;
1014                               if fixed (msf_info.dtd) > fixed (msf_dtd) then msf_dtd = msf_info.dtd;
1015                               if k = 0 then do;             /* first component */
1016                                    msf_mode = msf_info.mode;
1017                                    unspec (msf_rbs) = unspec (msf_info.rbs);
1018                               end;
1019                               total_records = total_records + msf_info.records;
1020                               total_bit_count = total_bit_count + bin (msf_info.bit_count);
1021                               total_length = total_length + msf_info.current_length;
1022                          end;
1023                          else if code ^= error_table_$noentry then do;
1024                               opt.bit_count, opt.records_used, opt.current_length, opt.dtu, opt.dtcm,
1025                                    opt.dtem, opt.dtd, opt.mode, opt.ring_brackets = "0"b;
1026                               if string (opt) = "0"b then do;
1027                                    saved_dn = dn;
1028                                    msf_error = "1"b;
1029                                    comp_name = convert (comp_name, k);
1030                                    call ENTRY_ERROR (error_table_$moderr,
1031                                         dn, en);
1032                               end;
1033                          end;
1034                     end;
1035                end get_msf_info;
1036           end;
1037 
1038           if opt.dtu then do;                               /* -date_time_used */
1039 
1040 /**** vp: phx20897; convert the system clock to 36 bits then make use of
1041       the internal procedure CONVERT_DATE to convert a 36 bits clock time
1042       into an ASCII date string.  This will effectively check for active
1043       function as well.                                                  ****/
1044 
1045                if root_sw then do;
1046                     temp_clock = clock ();                  /* This conversion method was taken from date_time_.pl1 routine */
1047                     stime = addr (temp_clock) -> fs_time_value.time;
1048                     call CONVERT_DATE (stime);
1049                end;
1050                else if msf & msf_dtu ^= "0"b then call CONVERT_DATE (msf_dtu);
1051                else call CONVERT_DATE (branch_status.date_time_used);
1052                call PRINT_PATHNAME ();
1053                if one_item then call ioa_ ("^a", date_string);
1054                else if date_string ^= "ZERO" | explicit_opt.dtu then call ioa_ ("date used:^10x^a", date_string);
1055           end;
1056 
1057           if opt.dtcm then do;                              /* -date_time_contents_modified */
1058                if msf & msf_dtcm ^= "0"b then call CONVERT_DATE (msf_dtcm);
1059                else call CONVERT_DATE (branch_status.date_time_modified);
1060                call PRINT_PATHNAME ();
1061                if one_item then call ioa_ ("^a", date_string);
1062                else if date_string ^= "ZERO" | explicit_opt.dtcm then call ioa_ ("date modified:^6x^a", date_string);
1063           end;
1064 
1065           if opt.dtem then do;                              /* -date_time_entry_modified */
1066                call PRINT_PATHNAME ();
1067                if entry_type = star_LINK then do;
1068                     call CONVERT_DATE (link_status.dtlm);
1069                     if one_item then call ioa_ ("^a", date_string);
1070                     else if date_string ^= "ZERO" | explicit_opt.dtem then
1071                          call ioa_ ("date link modified: ^a", date_string);
1072                end;
1073                else do;
1074                     if msf & msf_dtem ^= "0"b then call CONVERT_DATE (msf_dtem);
1075                     else call CONVERT_DATE (branch_status.date_time_entry_modified);
1076                     if one_item then call ioa_ ("^a", date_string);
1077                     else if date_string ^= "ZERO" | explicit_opt.dtem then
1078                          call ioa_ ("branch modified:^4x^a", date_string);
1079                end;
1080           end;
1081 
1082           if opt.dtvd then do;                              /* -date_time_volume_dumped */
1083                call PRINT_PATHNAME ();
1084                if entry_type = star_LINK then do;
1085                     call hcs_$get_dates (dn, "", dates_array, code);
1086                     call CONVERT_DATE (dates_array (5));
1087                     if one_item then call ioa_ ("link dtvd: ^a", date_string);
1088                     else if date_string ^= "ZERO" | explicit_opt.dtd then
1089                          call ioa_ ("link volume dumped:^1x^a", date_string);
1090                end;
1091                else do;
1092                     call hcs_$get_dates (dn, en, dates_array, code);
1093                     call CONVERT_DATE (dates_array (5));
1094                     if one_item then call ioa_ ("dtvd: ^a", date_string);
1095                     else if date_string ^= "ZERO" | explicit_opt.dtd then
1096                          call ioa_ ("date volume dumped:^1x^a", date_string);
1097                end;
1098           end;
1099 
1100           if opt.dtd then do;                               /* -date_time_dumped */
1101                call PRINT_PATHNAME ();
1102                if entry_type = star_LINK then do;
1103                     call CONVERT_DATE (link_status.dtd);
1104                     if one_item then call ioa_ ("dtd: ^a", date_string);
1105                     else if date_string ^= "ZERO" | explicit_opt.dtd then
1106                          call ioa_ ("link dumped:^8x^a", date_string);
1107                end;
1108                else do;
1109                     if msf & msf_dtd ^= "0"b then call CONVERT_DATE (msf_dtd);
1110                     else call CONVERT_DATE (branch_status.date_time_dumped);
1111                     if one_item then call ioa_ ("br dtd: ^a", date_string);
1112                     else if date_string ^= "ZERO" | explicit_opt.dtd then
1113                          call ioa_ ("date branch dumped:^1x^a", date_string);
1114                end;
1115           end;
1116 
1117           if opt.author then do;                            /* -author */
1118                call PRINT_PATHNAME ();
1119                if root_sw then do;
1120                     author_string = INITIALIZER_ID;
1121                     code = 0;
1122                end;
1123                else call hcs_$get_author (dn, en, 0, author_string, code);
1124                if active_function then do;
1125                     if code = 0 then return_string = rtrim (author_string);
1126                     else call active_fnc_err_ (code, ME);
1127                     return;
1128                end;
1129                if code = 0 then do;
1130                     if one_item then call ioa_ ("^a", author_string);
1131                     else call ioa_ ("author:^13x^a", author_string);
1132                end;
1133                else if one_item then call complain (code, ME);
1134                else if explicit_opt.author then call complain (code, ME, "Unable to get author.");
1135           end;
1136 
1137           if opt.bc_author then do;                         /* -bc_author */
1138                call PRINT_PATHNAME ();
1139                if root_sw then do;
1140                     bc_author_string = INITIALIZER_ID;
1141                     code = 0;
1142                end;
1143                else call hcs_$get_bc_author (dn, en, bc_author_string, code);
1144                if active_function then do;
1145                     if code = 0 then return_string = rtrim (bc_author_string);
1146                     else call active_fnc_err_ (code, ME);
1147                     return;
1148                end;
1149                if code = 0 then do;
1150                     if one_item then call ioa_ ("^a", bc_author_string);
1151                     else if explicit_opt.bc_author | bc_author_string ^= author_string then
1152                          call ioa_ ("bit count author:^3x^a", bc_author_string);
1153                end;
1154                else if one_item then call complain (code, ME);
1155                else if explicit_opt.bc_author then call complain (code, ME, "Unable to get bit count author.");
1156           end;
1157 
1158           if opt.logical_volume then do;                    /* -logical_volume */
1159                call PRINT_PATHNAME ();
1160                if root_sw then do;
1161                     lv_string = "root";
1162                     code = 0;
1163                end;
1164                else call mdc_$find_lvname (branch_status.lvid, lv_string, code);
1165                if active_function then do;
1166                     if code = 0 then return_string = rtrim (lv_string);
1167                     else call active_fnc_err_ (code, ME);
1168                     return;
1169                end;
1170                else if code = 0 then do;
1171                     if one_item then call ioa_ ("^a", lv_string);
1172                     else if entry_type = star_SEGMENT then call ioa_ ("volume name:^8x^a", lv_string);
1173                     else call ioa_ ("sons volume:^8x^a", lv_string);
1174                end;
1175                else if one_item then call complain (code, ME);
1176                else if explicit_opt.logical_volume then call complain (code, ME, "Unable to get logical volume.");
1177           end;
1178 
1179           if opt.bit_count then do;                         /* -bit_count */
1180                call PRINT_PATHNAME ();
1181                if root_sw then bc35 = 0;
1182                else do;
1183                     bc36 = "0000"b3 || branch_status.bit_count;
1184                     unspec (bc35) = bc36;                   /* convert to fixed bin (35) */
1185                end;
1186                if msf then
1187                     if active_function then do;
1188                          call ioa_$rsnnl ("^d", return_string, k, total_bit_count);
1189                          return;
1190                     end;
1191                     else do;
1192                          call ioa_ ("number of components:^9x^d", k - 1);
1193                          if k - 1 ^= bin (branch_status.bit_count) then
1194                               call ioa_ ("msf indicator:^6x^d   (inconsistent with number of components)", bc35);
1195                          call ioa_ ("total bit count:^4x^d", total_bit_count);
1196                     end;
1197                else if active_function then do;
1198                     call ioa_$rsnnl ("^d", return_string, k, bc35);
1199                     return;
1200                end;
1201                else if one_item then call ioa_ ("^d", bc35);
1202                else call ioa_ ("bit count:^10x^d", bc35);
1203           end;
1204 
1205           if opt.records_used then do;                      /* -records_used */
1206                call PRINT_PATHNAME ();
1207                if msf then
1208                     if active_function then do;
1209                          call ioa_$rsnnl ("^d", return_string, k, total_records);
1210                          return;
1211                     end;
1212                     else do;
1213                          if one_item then call ioa_ ("^d", total_records);
1214                          else call ioa_ ("total records used:^x^d", total_records);
1215                     end;
1216                else if active_function then do;
1217                     call ioa_$rsnnl ("^d", return_string, k, fixed (branch_status.records, 18));
1218                     return;
1219                end;
1220                else do;
1221                     if one_item then call ioa_ ("^d", fixed (branch_status.records, 18));
1222                     else call ioa_ ("records used:^7x^d", fixed (branch_status.records, 18));
1223                end;
1224           end;
1225 
1226           if opt.current_length then do;                    /* -current_length */
1227                call PRINT_PATHNAME ();
1228                if msf then
1229                     if active_function then do;
1230                          call ioa_$rsnnl ("^d", return_string, k, total_length);
1231                          return;
1232                     end;
1233                     else do;
1234                          if one_item then call ioa_ ("^d", total_length);
1235                          else if explicit_opt.current_length | total_length ^= total_records then
1236                               call ioa_ ("total length:^7x^d", total_length);
1237                     end;
1238                else if active_function then do;
1239                     call ioa_$rsnnl ("^d", return_string, k, fixed (branch_status.current_length, 12));
1240                     return;
1241                end;
1242                else do;
1243                     if one_item then call ioa_ ("^d", fixed (branch_status.current_length, 12));
1244                     else if explicit_opt.current_length |
1245                          branch_status.current_length ^= substr (branch_status.records, 7, 12) then
1246                          call ioa_ ("current length:^5x^d", fixed (branch_status.current_length, 12));
1247                end;
1248           end;
1249 
1250           if opt.max_length then do;                        /* -max_length */
1251                call PRINT_PATHNAME ();
1252                if entry_type ^= star_DIRECTORY then do;
1253                     if msf then call hcs_$get_max_length (msf_path, "0", max_length, code);
1254                     else if entry_type = EXTENDED_type then call fs_util_$get_max_length (dn, en, max_length, code);
1255                     else call hcs_$get_max_length (dn, en, max_length, code);
1256                     if active_function then do;
1257                          if code = 0 then call ioa_$rsnnl ("^d", return_string, k, max_length);
1258                          else call active_fnc_err_ (code, ME);
1259                          return;
1260                     end;
1261                     if code = 0 then
1262                          if one_item then call ioa_ ("^d", max_length);
1263                          else call ioa_ ("max length:^9x^d", max_length);
1264                     else if code = error_table_$unsupported_operation & ^explicit_opt.max_length then ;
1265                                                             /* ignore if this type has no max length */
1266                     else if one_item then call complain (code, ME);
1267                     else if explicit_opt.max_length then call complain (code, ME, "Unable to get max length.");
1268                end;
1269                else if active_function then do;
1270                     call active_fnc_err_ (0, ME, "Unable to get the max length of a directory.  ^a>^a", dn, en);
1271                     return;
1272                end;
1273                else if explicit_opt.max_length then
1274                     call complain (0, ME, "Unable to get the max length of a directory.  ^a>^a", dn, en);
1275           end;
1276 
1277           if opt.mode then do;                              /* -mode */
1278                call PRINT_PATHNAME ();
1279                if dm_file_sw then string (mode_bits) = "0"b || substr (auto_dm_file_status.mode, 1, 4); /* prevent string size condition while compiling. */
1280                else if msf then string (mode_bits) = msf_mode;
1281                else string (mode_bits) = branch_status.mode;
1282                mode_string = "";
1283                if entry_type = EXTENDED_type then do;
1284                     call fs_util_$get_user_access_modes (dn, en, "", -1, modes, exmodes, code);
1285                     if code ^= 0 then
1286                          if code = error_table_$unsupported_operation & ^explicit_opt.mode then ;
1287                                                             /* ignore if this type has no extended mode */
1288                          else call complain (code, ME, "Unable to get extended mode.");
1289                     else do;
1290                          do k = 1 to length (rtrim (si.modes));
1291                               if substr (modes, k, 1) then mode_string = mode_string || substr (si.modes, k, 1);
1292                          end;
1293                     end;
1294                end;
1295                else if dm_file_sw | msf | entry_type = star_SEGMENT then do;
1296                     if mode_bits (2) then mode_string = "r";
1297                     if mode_bits (3) then mode_string = mode_string || "e";
1298                     if mode_bits (4) then mode_string = mode_string || "w";
1299                end;
1300                else do;                                     /* directory */
1301                     if mode_bits (2) then mode_string = "s";
1302                     if mode_bits (4) then mode_string = mode_string || "m";
1303                     if mode_bits (5) then mode_string = mode_string || "a";
1304                end;
1305                if code = 0 then do;
1306                     if mode_string = "" then mode_string = "null";
1307                     if active_function then do;
1308                          return_string = mode_string;
1309                          return;
1310                     end;
1311                     if one_item then call ioa_ ("^a", mode_string);
1312                     else call ioa_ ("mode:^15x^a", mode_string);
1313                end;
1314           end;
1315 
1316           if opt.access_class then do;                      /* -access_class */
1317                call PRINT_PATHNAME ();
1318                call hcs_$get_access_class (dn, en, access_class, code);
1319                if code = 0 then do;
1320                     call convert_authorization_$to_string_short (access_class, class, code);
1321                     if code ^= 0 then call complain (code, ME, "Unable to convert access class.");
1322                     else if active_function then do;
1323                          if class = "" then class = "system_low";
1324                          return_string = rtrim (class);
1325                          return;
1326                     end;
1327                     else if class ^= "" then do;            /* format access class in lines of 50 chars */
1328                          class_len = index (class, " ") - 1;
1329                          if class_len = -1 then class_len = 336;
1330                          k = 1;
1331                          if ^one_item then call ioa_$nnl ("access class:^7x");
1332                          do while ((class_len - k + 1) > 50);
1333                               temp_string = substr (class, k, 50);
1334                               kk = length (temp_string) + 1 - index (reverse (temp_string), ",");
1335                               call ioa_$nnl ("^a", substr (class, k, kk));
1336                               if ^one_item then call ioa_$nnl ("^/^20x");
1337                               k = k + kk;
1338                          end;
1339                          call ioa_ ("^a", substr (class, k));
1340                     end;
1341                     else if explicit_opt.access_class then
1342                          if one_item then call ioa_ ("system_low");
1343                          else call ioa_ ("access class:^7xsystem_low");
1344                end;
1345                else if active_function | explicit_opt.access_class then do;
1346                     call complain (code, ME, "Unable to get access class.");
1347                     return;
1348                end;
1349           end;
1350 
1351           if opt.ring_brackets then do;                     /* -ring_brackets */
1352                call PRINT_PATHNAME ();
1353                if entry_type = EXTENDED_type then do;
1354                     if si.num_ring_brackets = 0 then
1355                          if explicit_opt.ring_brackets then
1356                               call complain (0, ME, "The ^a object type does not support ring brackets.",
1357                                    si.type_name);
1358                          else ;
1359                     else do;
1360                          call fs_util_$get_ring_brackets (dn, en, ring_brackets, code);
1361                          if code ^= 0 then
1362                               if code = error_table_$unsupported_operation & ^explicit_opt.ring_brackets then ;
1363                                                             /* ignore if this type has no ring brackets */
1364                               else call complain (code, ME, "Unable to get ring brackets.");
1365                          else if active_function then call ioa_$rsnnl ("^v(^d ^)", return_string, k,
1366                                    si.num_ring_brackets, ring_brackets);
1367                          else call ioa_ ("^[ring brackets:^6x^]^v(^d, ^)^d", ^one_item,
1368                                    si.num_ring_brackets - 1, ring_brackets);
1369                     end;
1370                end;
1371                else if active_function then do;
1372                     if dm_file_sw then
1373                          call ioa_$rsnnl ("^d ^d", return_string, k, auto_dm_file_status.ring_brackets);
1374                     else if msf then call ioa_$rsnnl ("^d ^d ^d", return_string, k, msf_rbs);
1375                     else if entry_type ^= star_DIRECTORY then
1376                          call ioa_$rsnnl ("^d ^d ^d", return_string, k, fixed (branch_status.ring_brackets, 5));
1377                     else call ioa_$rsnnl ("^d ^d", return_string, k, fixed (branch_status.ring_brackets (0), 5),
1378                               fixed (branch_status.ring_brackets (1), 5));
1379                     return;
1380                end;
1381                else if dm_file_sw then
1382                     if one_item then call ioa_ ("^d, ^d", auto_dm_file_status.ring_brackets);
1383                     else call ioa_ ("extended ring brackets:^2x^d, ^d", auto_dm_file_status.ring_brackets);
1384                else if msf then
1385                     if one_item then call ioa_ ("^d, ^d, ^d", msf_rbs);
1386                     else call ioa_ ("ring brackets:^6x^d, ^d, ^d", msf_rbs);
1387                else if entry_type ^= star_DIRECTORY then
1388                     if one_item then call ioa_ ("^d, ^d, ^d", fixed (branch_status.ring_brackets, 5));
1389                     else call ioa_ ("ring brackets:^6x^d, ^d, ^d", fixed (branch_status.ring_brackets, 5));
1390                else if one_item then call ioa_ ("^d, ^d", fixed (branch_status.ring_brackets (0), 5),
1391                          fixed (branch_status.ring_brackets (1), 5));
1392                else call ioa_ ("ring brackets:^6x^d, ^d", fixed (branch_status.ring_brackets (0), 5),
1393                          fixed (branch_status.ring_brackets (1), 5));
1394           end;
1395 
1396           if opt.usage_count then do;                       /* -usage_count */
1397                call PRINT_PATHNAME ();
1398                if entry_type = star_DIRECTORY then
1399                     if explicit_opt.usage_count & ^star_sw then
1400                          call complain (0, ME, "Cannot determine the usage count of a directory.");
1401                     else ;
1402                else do;
1403                     usage_count = 0;
1404                     on linkage_error begin;
1405                          usage_count = -1;
1406                          go to flurp;
1407                     end;
1408                     call mhcs_$get_seg_usage (dn, en, usage_count, code);
1409 flurp:
1410                     revert linkage_error;
1411                     if usage_count < 0 then code = error_table_$incorrect_access;
1412                     if active_function then do;
1413                          if code = 0 then call ioa_$rsnnl ("^d", return_string, k, usage_count);
1414                          else call active_fnc_err_ (code, ME);
1415                          return;
1416                     end;
1417                     if code = 0 then
1418                          if one_item then call ioa_ ("^d", usage_count);
1419                          else call ioa_ ("usage count:^8x^d", usage_count);
1420                     else if explicit_opt.usage_count then
1421                          call complain (code, ME, "Unable to get usage count.");
1422                end;
1423           end;
1424 
1425           if entry_type = EXTENDED_type | dm_file_sw then do;
1426                call PRINT_PATHNAME ();
1427                switch_list_ptr = null ();
1428                on cleanup begin;
1429                     if switch_list_ptr ^= null ()
1430                     then free switch_list;
1431                end;
1432 
1433                call fs_util_$list_switches_for_type (fs_util_type, SWITCH_LIST_VERSION_1, area_ptr,
1434                     switch_list_ptr, code);
1435                if code = error_table_$unsupported_operation &
1436                     ^(explicit_opt.safety_switch | explicit_opt.ivds | explicit_opt.copy_switch | explicit_opt.audit_switch | explicit_opt.cvds |
1437                     explicit_opt.synchronized_switch | explicit_opt.damaged_switch | explicit_opt.concurrency_switch |
1438                     explicit_opt.rollback_switch | explicit_opt.protected_switch) then
1439                     goto SKIP_SWITCHES;                     /* WARNING, this ain't too modular */
1440                if code ^= 0 then do;
1441                     call complain (code, ME, "Listing switches.");
1442                     return;
1443                end;
1444                if all then do k = 1 to switch_list.switch_count;
1445                     max_switch_length = max (max_switch_length,
1446                          length (rtrim (switch_list.names (switch_list.name_index (k)))));
1447                end;
1448           end;
1449           max_switch_length = max_switch_length + 8;        /* " switch: " */
1450 
1451           if opt.safety_switch then do;                     /* -safety_switch */
1452                call PRINT_PATHNAME ();
1453                if entry_type = EXTENDED_type | dm_file_sw then call STATUS_SWITCH ("safety", explicit_opt.safety_switch);
1454                else do;
1455                     if root_sw then safety_switch = "0"b;
1456                     else call hcs_$get_safety_sw (dn, en, safety_switch, code);
1457                     call PRINT_SWITCH ("safety", explicit_opt.safety_switch, safety_switch, "0"b);
1458                end;
1459           end;
1460 
1461           if opt.ivds then do;                              /* -ivds */
1462                call PRINT_PATHNAME ();
1463                if entry_type = star_DIRECTORY & ^root_sw then
1464                     if explicit_opt.ivds then call ENTRY_WRONG_TYPE ("a directory");
1465                     else ;                                  /* not valid for dirs */
1466                else do;
1467                     if entry_type = EXTENDED_type | dm_file_sw then
1468                          call STATUS_SWITCH ("ivds", explicit_opt.ivds);
1469                     else do;
1470                          if root_sw then ivds = 1;
1471                          else call hcs_$get_volume_dump_switches (dn, en, ivds, cvds, code);
1472                          call PRINT_SWITCH ("ivds", explicit_opt.ivds, (ivds = -1), "1"b);
1473                     end;
1474                end;
1475           end;
1476 
1477           if opt.cvds then do;                              /* -cvds */
1478                call PRINT_PATHNAME ();
1479                if entry_type = star_DIRECTORY & ^root_sw then
1480                     if explicit_opt.cvds then call ENTRY_WRONG_TYPE ("a directory");
1481                     else ;                                  /* not valid for dirs */
1482                else do;
1483                     if entry_type = EXTENDED_type | dm_file_sw then call STATUS_SWITCH ("cvds", explicit_opt.cvds);
1484                     else do;
1485                          if root_sw then cvds = 1;
1486                          else call hcs_$get_volume_dump_switches (dn, en, ivds, cvds, code);
1487                          call PRINT_SWITCH ("cvds", explicit_opt.cvds, (cvds = -1), "1"b);
1488                     end;
1489                end;
1490           end;
1491 
1492           if opt.audit_switch then do;                      /* -audit_switch */
1493                call PRINT_PATHNAME ();
1494                if entry_type = EXTENDED_type | dm_file_sw then call STATUS_SWITCH ("audit", explicit_opt.audit_switch);
1495                else do;
1496                     bks.version = status_for_backup_version_2;
1497                     call hcs_$status_for_backup (dn, en, addr (bks), code);
1498                     call PRINT_SWITCH ("audit", explicit_opt.audit_switch, (bks.audit_flag), "0"b);
1499                end;
1500           end;
1501 
1502           if opt.copy_switch then do;                       /* -copy_switch */
1503                call PRINT_PATHNAME ();
1504                if entry_type = EXTENDED_type | dm_file_sw then call STATUS_SWITCH ("copy", explicit_opt.copy_switch);
1505                else do;
1506                     code = 0;
1507                     call PRINT_SWITCH ("copy", explicit_opt.copy_switch, (branch_status.copy_switch), "0"b);
1508                end;
1509           end;
1510 
1511           if opt.damaged_switch then do;                    /* -damaged_switch */
1512                call PRINT_PATHNAME ();
1513                if entry_type = EXTENDED_type | dm_file_sw then
1514                     call STATUS_SWITCH ("damaged", explicit_opt.damaged_switch);
1515                else do;
1516                     code = 0;
1517                     call PRINT_SWITCH ("damaged", explicit_opt.damaged_switch, (branch_status.damaged_switch), "0"b);
1518                end;
1519           end;
1520 
1521           if opt.synchronized_switch then do;               /* -synchronized_switch */
1522                call PRINT_PATHNAME ();
1523                if entry_type = EXTENDED_type | dm_file_sw then
1524                     call STATUS_SWITCH ("synchronized", explicit_opt.synchronized_switch);
1525                else do;
1526                     code = 0;
1527                     if fixed (branch_status.bit_count) = 0 & branch_status.type = directory_type then do;
1528                          if ^all then
1529                               call complain (0, ME, "Directories do not support the synch switch.  ^a.", pathname_ (dn, en));
1530                     end;
1531                     else call PRINT_SWITCH ("synchronized", explicit_opt.synchronized_switch,
1532                               (branch_status.synchronized_switch), "0"b);
1533                end;
1534           end;
1535 
1536           call PRINT_PATHNAME ();
1537           if entry_type = EXTENDED_type then do;
1538                if all then do;
1539                     do k = 1 to switch_list.switch_count;
1540                          if switch_list.name_index (k) > 0 then
1541                               call STATUS_SWITCH_QUICK ((switch_list.names (switch_list.name_index (k))), "0"b);
1542                     end;
1543                     do k = 1 to switch_count;
1544                          do kk = 1 to switch_list.switch_name_count;
1545                               if switch_names (k) = switch_list.names (kk) then go to FOUND;
1546                          end;
1547                          call complain (0, ME, "The ^a switch is not supported by ^a.", switch_names (k),
1548                               si.plural_name);
1549 FOUND:
1550                     end;
1551                end;
1552 
1553                else if switch_mask ^= "0"b then do kk = 1 to switch_count;
1554                     call STATUS_SWITCH (switch_names (kk), "1"b);
1555                end;
1556           end;
1557           else if switch_mask ^= "0"b then do k = 1 to switch_count;
1558                if substr (switch_mask, k, 1) then
1559                     call complain (0, ME, "Standard objects do not support the ^a switch.", switch_names (k));
1560           end;
1561 
1562 SKIP_SWITCHES:
1563           if opt.entry_bound then do;
1564                call PRINT_PATHNAME ();
1565                if entry_type ^= star_SEGMENT then
1566                     if explicit_opt.entry_bound then
1567                          call complain (0, ME, "The entry is not a gate.  ^a", pathname_ (dn, en));
1568                     else ;
1569                else do;
1570                     bks.version = status_for_backup_version_2;
1571                     call hcs_$status_for_backup (dn, en, addr (bks), code);
1572                     if code ^= 0 then call complain (code, ME, "Unable to obtain entrybound.");
1573                     else if ^bks.entrypt then
1574 NOT_GATE:
1575                          if explicit_opt.entry_bound then call complain (0, ME, "The entry is not a gate.");
1576                          else ;
1577                     else if active_function then call ioa_$rsnnl ("^d", return_string, k, fixed (bks.entrypt_bound));
1578                     else if one_item then call ioa_ ("^d", fixed (bks.entrypt_bound));
1579                     else call ioa_ ("entry bound:^8x^d", fixed (bks.entrypt_bound));
1580                end;
1581           end;
1582 
1583           if opt.highest_ci then do;
1584                call PRINT_PATHNAME ();
1585                if active_function then call ioa_$rsnnl ("^d", return_string, k, auto_dm_file_status.highest_ci);
1586                else if one_item then call ioa_ ("^d", auto_dm_file_status.highest_ci);
1587                else call ioa_ ("highest control interval:  ^d", auto_dm_file_status.highest_ci);
1588           end;
1589 
1590           if opt.concurrency_switch then do;
1591                call PRINT_PATHNAME ();
1592                call PRINT_SWITCH ("concurrency", explicit_opt.concurrency_switch,
1593                     ^auto_dm_file_status.no_concurrency_sw, "1"b);
1594           end;
1595 
1596           if opt.rollback_switch then do;
1597                call PRINT_PATHNAME ();
1598                call PRINT_SWITCH ("rollback", explicit_opt.rollback_switch,
1599                     ^auto_dm_file_status.no_rollback_sw, "1"b);
1600           end;
1601 
1602           if opt.protected_switch then do;
1603                call PRINT_PATHNAME ();
1604                call PRINT_SWITCH ("protected", explicit_opt.protected_switch,
1605                     (auto_dm_file_status.protected_sw), "1"b);
1606           end;
1607 
1608           if not_mounted ^= 0 & all & ^active_function then
1609                call complain (not_mounted, ME,
1610                     "Unable to determine: date used, date modified, date volume dumped, records used, max length or usage count.");
1611 
1612           if j = star_entry_count & ^active_function & ^one_item then call ioa_ ("");
1613           if (entry_type = EXTENDED_type) & (switch_list_ptr ^= null ()) then free switch_list;
1614 
1615 ENTRY_RETURN:
1616           return;
1617 %page;
1618 CONVERT_DATE: proc (date_time);
1619 
1620 /* This internal procedure converts a bit(36) clock time into an ASCII date string.
1621    If status was called as an active function, the string is returned. */
1622 
1623 dcl  date_time bit (36);
1624 dcl  date_time_$format entry (char (*), fixed bin (71), char (*), char (*)) returns (char (250) var);
1625 dcl  cv_fstime_ entry (bit (36) aligned) returns (fixed bin (71));
1626 
1627           if date_time = "0"b then date_string = "ZERO";
1628           else date_string = date_time_$format ("date_time", cv_fstime_ ((date_time)), "", "");
1629           if active_function then do;
1630                return_string = """" || rtrim (date_string) || """";
1631                go to ENTRY_RETURN;                          /* "status" active function must call normal cleanup handler before it finishes. */
1632           end;
1633 
1634      end CONVERT_DATE;
1635 %page;
1636 ENTRY_ERROR: proc (P_code, P_dn, P_en);
1637 
1638 dcl  P_code fixed bin (35);
1639 dcl  (P_dn, P_en) char (*);
1640 
1641           if active_function then do;
1642                if msf_ptr ^= null then
1643                     call msf_manager_$close (msf_ptr);
1644                call CLEAN_UP;
1645           end;
1646           call complain (P_code, ME, "^a", pathname_ (P_dn, P_en));
1647           go to ENTRY_RETURN;
1648 
1649      end ENTRY_ERROR;
1650 %page;
1651 ENTRY_WRONG_TYPE: proc (P_string);
1652 
1653 dcl  P_string char (*);
1654 
1655           if ^star_sw then
1656                call complain (0, ME, "^a is ^[the root^;^a^]. Control arguments given do not apply.",
1657                     pathname_ (dn, en), root_sw, P_string);
1658           go to ENTRY_RETURN;
1659 
1660      end ENTRY_WRONG_TYPE;
1661 %page;
1662 PRINT_PATHNAME: proc;
1663 
1664 /* This internal procedure merely prints out the pathname if it hasn't been
1665    printed yet. */
1666 
1667           if printed_pathname | active_function then return;
1668 
1669           if star_sw | (path_count > 1) then
1670                if one_item then call ioa_ ("^5x^a", pathname_ (dn, en));
1671                else call ioa_ ("^/^10x^a", pathname_ (dn, en));
1672           else ;                                            /* don't print header for only 1 path on command line */
1673 
1674           printed_pathname = "1"b;
1675           return;
1676 
1677      end PRINT_PATHNAME;
1678 %page;
1679 STATUS_SWITCH: proc (switch, explicit);
1680 
1681 dcl  switch char (*);
1682 dcl  temp_switch char (32);
1683 dcl  explicit bit (1) unaligned;
1684 dcl  default bit (1) aligned;
1685 dcl  value bit (1) aligned;
1686 dcl  x fixed bin;
1687 
1688           if switch = "cvds" then temp_switch = "complete_volume_dump";
1689           else if switch = "ivds" then temp_switch = "incremental_volume_dump";
1690           else temp_switch = switch;
1691 
1692           do k = 1 to switch_list.switch_count;
1693                do x = 0 to switch_list.name_count (k) - 1;
1694                     if switch_list.name_index (k) > 0 then
1695                          if switch = switch_list.names (switch_list.name_index (k) + x) then go to JOIN;
1696                end;
1697           end;
1698 
1699           if explicit then
1700                call complain (0, ME, "The ^a switch is not supported by ^a.", switch, si.plural_name);
1701 
1702           return;
1703 
1704 STATUS_SWITCH_QUICK: entry (switch, explicit);
1705 
1706           temp_switch = switch;
1707 JOIN:
1708           if switch_list.name_index (k) = 0 then return;    /* already printed */
1709           switch_list.name_index (k) = 0;                   /* so we don't come back */
1710           default = switch_list.default_value (k);
1711 
1712           call fs_util_$get_switch (dn, en, temp_switch, value, code);
1713           goto PRINT;
1714 
1715 PRINT_SWITCH: entry (switch, explicit, switch_value, default_value);
1716 
1717 dcl  switch_value bit (1) aligned;
1718 dcl  default_value bit (1) aligned;
1719 
1720           value = switch_value;
1721           default = default_value;
1722           code = 0;
1723 PRINT:
1724           if code ^= 0 then call complain (code, ME, "Unable to get ^a switch.", switch);
1725 
1726           if active_function then do;
1727                if value then return_string = "true";
1728                else return_string = "false";
1729                return;
1730           end;
1731           else if all | (value ^= default) then
1732                if one_item then call ioa_ ("^[on^;off^]", value);
1733                else call ioa_ ("^a switch:^vt^[on^;off^] (default^[ = ^[off^;on^]^])", switch, max_switch_length, value,
1734                          value ^= default, value);
1735           else if explicit then
1736                if one_item then call ioa_ ("^[on^;off^]", value);
1737                else call ioa_ ("^a switch:^vt^[on^;off^]", switch, max_switch_length, value);
1738 
1739           return;
1740 
1741      end STATUS_SWITCH;
1742 
1743      end ENTRY_STATUS;
1744 %page;
1745 BUILD_ENTRY_TYPE_LIST: proc (P_entry_type_list, P_fs_entry_type_ptr, P_slet_enabled_sw);
1746 
1747 dcl  P_entry_type_list char (*);
1748 dcl  P_fs_entry_type_ptr ptr;
1749 dcl  P_slet_enabled_sw bit (1) aligned;
1750 dcl  1 entry_type_info aligned like suffix_info;
1751 dcl  types char (types_len) based (types_ptr);
1752 dcl  types_len fixed bin (24);
1753 dcl  types_ptr ptr;
1754 dcl  this_type char (32);
1755 
1756 /* Copy the entry type list parameter into locally managed storage */
1757 
1758           types_ptr = null;
1759           on cleanup begin;
1760                if types_ptr ^= null then free types in (area);
1761           end;
1762 
1763           types_len = length (P_entry_type_list);
1764           allocate types set (types_ptr) in (area);
1765           types = P_entry_type_list;
1766 
1767 /* Count the number of entry types and allocate the entry type array */
1768 
1769           do fs_entry_type_count = 1
1770                repeat (fs_entry_type_count + 1)
1771                while (index (types, ",") ^= 0);
1772                types = after (types, ",");
1773           end;
1774 
1775           allocate fs_entry_type in (area) set (P_fs_entry_type_ptr);
1776 
1777           entry_type_info.version = SUFFIX_INFO_VERSION_1;
1778           P_fs_entry_type_ptr -> fs_entry_type.suffix (*) = "";
1779 
1780 /* For each potential entry type, validate it and add it to the structure */
1781 
1782           types = P_entry_type_list;
1783           entry_type_index = 1;
1784 
1785           do while (types ^= "");
1786 
1787                this_type = before (types, ",");
1788                if substr (this_type, 1, 1) ^= "-" then do;
1789                     if this_type = "link" then this_type = FS_OBJECT_TYPE_LINK;
1790                     else if this_type = "segment" then this_type = FS_OBJECT_TYPE_SEGMENT;
1791                     else if this_type = "directory" then this_type = FS_OBJECT_TYPE_DIRECTORY;
1792                     else if this_type = "multisegment_file" then this_type = FS_OBJECT_TYPE_MSF;
1793                     else if this_type = "data_management_file" then this_type = FS_OBJECT_TYPE_DM_FILE;
1794 
1795                     P_fs_entry_type_ptr -> fs_entry_type.suffix (entry_type_index) = this_type;
1796 
1797                     if this_type = FS_OBJECT_TYPE_LINK then entry_type_index = entry_type_index + 1;
1798                                                             /* fs_util_ does not handle links */
1799                     else do;
1800                          call fs_util_$suffix_info_for_type (this_type, addr (entry_type_info), code);
1801                          if code = 0 then entry_type_index = entry_type_index + 1;
1802                     end;
1803                end;
1804 
1805                types = after (types, ",");
1806           end;
1807 
1808 /* Free the types variable and set P_slet_enabled_sw */
1809 
1810           free types_ptr -> types in (area);
1811 
1812           P_fs_entry_type_ptr -> fs_entry_type.count = entry_type_index - 1;
1813           if P_fs_entry_type_ptr -> fs_entry_type.count > 0 then P_slet_enabled_sw = "1"b;
1814           else do;
1815                call complain (0, ME,
1816                     "^[None of the specified entry types is valid^;The specified entry type is not valid^]: ^a",
1817                     P_fs_entry_type_ptr -> fs_entry_type.count > 1, P_entry_type_list);
1818                go to STATUS_EXIT;
1819           end;
1820 
1821           return;
1822 
1823      end BUILD_ENTRY_TYPE_LIST;
1824 %page;
1825 ENTRY_TYPE_SELECTED: proc (P_fs_type, P_fs_entry_type_ptr) returns (bit (1) aligned);
1826 
1827 dcl  P_fs_type char (*);
1828 dcl  P_fs_entry_type_ptr ptr;
1829 dcl  entry_type_index fixed bin;
1830 
1831           do entry_type_index = 1 to P_fs_entry_type_ptr -> fs_entry_type.count;
1832                if P_fs_type = P_fs_entry_type_ptr -> fs_entry_type.suffix (entry_type_index) then return ("1"b);
1833           end;
1834 
1835           return ("0"b);
1836 
1837      end ENTRY_TYPE_SELECTED;
1838 %page;
1839 CLEAN_UP: proc;
1840 
1841           if star_list_names_ptr ^= null then free star_list_names in (area);
1842           if star_list_branch_ptr ^= null then free star_dir_list_branch in (area);
1843           if fs_entry_type_ptr ^= null then free fs_entry_type in (area);
1844           if path_array_ptr ^= null & path_array_ptr ^= addr (path_array_space) then free path_array in (area);
1845 
1846      end CLEAN_UP;
1847 %page;
1848 dcl  1 access_options int static,                           /* for -access */
1849 
1850        (2 primary_name init ("0"b),
1851        2 names init ("0"b),
1852        2 type init ("0"b),
1853        2 link_path init ("0"b),
1854        2 unique_id init ("0"b),
1855        2 dtu init ("0"b),
1856        2 dtcm init ("0"b),
1857        2 dtem init ("0"b),
1858        2 dtd init ("0"b),
1859        2 dtvd init ("0"b),
1860        2 author init ("0"b),
1861        2 bc_author init ("0"b),
1862        2 logical_volume init ("0"b),
1863        2 bit_count init ("0"b),
1864        2 records_used init ("0"b),
1865        2 current_length init ("0"b),
1866        2 max_length init ("0"b),
1867        2 mode init ("1"b),
1868        2 access_class init ("1"b),
1869        2 ring_brackets init ("1"b),
1870        2 safety_switch init ("1"b),
1871        2 copy_switch init ("0"b),
1872        2 audit_switch init ("0"b),
1873        2 ivds init ("0"b),
1874        2 cvds init ("0"b),
1875        2 usage_count init ("0"b),
1876        2 damaged_switch init ("0"b),
1877        2 synchronized_switch init ("0"b),
1878        2 entry_bound init ("0"b),
1879        2 highest_ci init ("0"b),
1880        2 concurrency_switch init ("0"b),
1881        2 rollback_switch init ("0"b),
1882        2 protected_switch init ("0"b)
1883        ) bit (1) unaligned;
1884 %page;
1885 dcl  1 date_options int static,                             /* for -date */
1886        (2 primary_name init ("0"b),
1887        2 names init ("0"b),
1888        2 type init ("0"b),
1889        2 link_path init ("0"b),
1890        2 unique_id init ("0"b),
1891        2 dtu init ("1"b),
1892        2 dtcm init ("1"b),
1893        2 dtem init ("1"b),
1894        2 dtd init ("1"b),
1895        2 dtvd init ("1"b),
1896        2 author init ("0"b),
1897        2 bc_author init ("0"b),
1898        2 logical_volume init ("0"b),
1899        2 bit_count init ("0"b),
1900        2 records_used init ("0"b),
1901        2 current_length init ("0"b),
1902        2 max_length init ("0"b),
1903        2 mode init ("0"b),
1904        2 access_class init ("0"b),
1905        2 ring_brackets init ("0"b),
1906        2 safety_switch init ("0"b),
1907        2 copy_switch init ("0"b),
1908        2 audit_switch init ("0"b),
1909        2 ivds init ("0"b),
1910        2 cvds init ("0"b),
1911        2 usage_count init ("0"b),
1912        2 damaged_switch init ("0"b),
1913        2 synchronized_switch init ("0"b),
1914        2 entry_bound init ("0"b),
1915        2 highest_ci init ("0"b),
1916        2 concurrency_switch init ("0"b),
1917        2 rollback_switch init ("0"b),
1918        2 protected_switch init ("0"b)
1919        ) bit (1) unaligned;
1920 %page;
1921 dcl  1 length_options int static,                           /* for -length */
1922        (2 primary_name init ("0"b),
1923        2 names init ("0"b),
1924        2 type init ("0"b),
1925        2 link_path init ("0"b),
1926        2 unique_id init ("0"b),
1927        2 dtu init ("0"b),
1928        2 dtcm init ("0"b),
1929        2 dtem init ("0"b),
1930        2 dtd init ("0"b),
1931        2 dtvd init ("0"b),
1932        2 author init ("0"b),
1933        2 bc_author init ("0"b),
1934        2 logical_volume init ("0"b),
1935        2 bit_count init ("1"b),
1936        2 records_used init ("1"b),
1937        2 current_length init ("1"b),
1938        2 max_length init ("1"b),
1939        2 mode init ("0"b),
1940        2 access_class init ("0"b),
1941        2 ring_brackets init ("0"b),
1942        2 safety_switch init ("0"b),
1943        2 copy_switch init ("0"b),
1944        2 audit_switch init ("0"b),
1945        2 ivds init ("0"b),
1946        2 cvds init ("0"b),
1947        2 usage_count init ("0"b),
1948        2 damaged_switch init ("0"b),
1949        2 synchronized_switch init ("0"b),
1950        2 entry_bound init ("0"b),
1951        2 highest_ci init ("0"b),
1952        2 concurrency_switch init ("0"b),
1953        2 rollback_switch init ("0"b),
1954        2 protected_sw init ("0"b)
1955        ) bit (1) unaligned;
1956 %page;
1957 dcl  1 active_function_length_options int static,           /* for -length */
1958        (2 primary_name init ("0"b),
1959        2 names init ("0"b),
1960        2 type init ("0"b),
1961        2 link_path init ("0"b),
1962        2 unique_id init ("0"b),
1963        2 dtu init ("0"b),
1964        2 dtcm init ("0"b),
1965        2 dtem init ("0"b),
1966        2 dtd init ("0"b),
1967        2 dtvd init ("0"b),
1968        2 author init ("0"b),
1969        2 bc_author init ("0"b),
1970        2 logical_volume init ("0"b),
1971        2 bit_count init ("1"b),                             /* for directory type only */
1972        2 records_used init ("0"b),
1973        2 current_length init ("1"b),                        /* for other types such as segment or MSF or DM file */
1974        2 max_length init ("0"b),
1975        2 mode init ("0"b),
1976        2 access_class init ("0"b),
1977        2 ring_brackets init ("0"b),
1978        2 safety_switch init ("0"b),
1979        2 copy_switch init ("0"b),
1980        2 audit_switch init ("0"b),
1981        2 ivds init ("0"b),
1982        2 cvds init ("0"b),
1983        2 usage_count init ("0"b),
1984        2 damaged_switch init ("0"b),
1985        2 synchronized_switch init ("0"b),
1986        2 entry_bound init ("0"b),
1987        2 highest_ci init ("0"b),
1988        2 concurrency_switch init ("0"b),
1989        2 rollback_switch init ("0"b),
1990        2 protected_sw init ("0"b)
1991        ) bit (1) unaligned;
1992 %page;
1993 dcl  1 default_options int static,                          /* no control arguments specified */
1994        (2 primary_name init ("0"b),
1995        2 names init ("1"b),
1996        2 type init ("1"b),
1997        2 link_path init ("1"b),
1998        2 unique_id init ("0"b),
1999        2 dtu init ("1"b),
2000        2 dtcm init ("1"b),
2001        2 dtem init ("1"b),
2002        2 dtd init ("0"b),
2003        2 dtvd init ("0"b),
2004        2 author init ("0"b),
2005        2 bc_author init ("0"b),
2006        2 logical_volume init ("0"b),
2007        2 bit_count init ("1"b),
2008        2 records_used init ("1"b),
2009        2 current_length init ("0"b),
2010        2 max_length init ("0"b),
2011        2 mode init ("1"b),
2012        2 access_class init ("0"b),
2013        2 ring_brackets init ("0"b),
2014        2 safety_switch init ("0"b),
2015        2 copy_switch init ("0"b),
2016        2 audit_switch init ("0"b),
2017        2 ivds init ("0"b),
2018        2 cvds init ("0"b),
2019        2 usage_count init ("0"b),
2020        2 damaged_switch init ("1"b),
2021        2 synchronized_switch init ("0"b),
2022        2 entry_bound init ("0"b),
2023        2 highest_ci init ("1"b),
2024        2 concurrency_switch init ("1"b),
2025        2 rollback_switch init ("1"b),
2026        2 protected_switch init ("1"b)
2027        ) bit (1) unaligned;
2028 %page;
2029 dcl  1 no_s_options int static,                             /* attributes available without s access */
2030        (2 primary_name init ("0"b),
2031        2 names init ("0"b),
2032        2 type init ("1"b),
2033        2 link_path init ("1"b),
2034        2 unique_id init ("1"b),
2035        2 dtu init ("1"b),
2036        2 dtcm init ("1"b),
2037        2 dtem init ("1"b),
2038        2 dtd init ("1"b),
2039        2 dtvd init ("1"b),
2040        2 author init ("1"b),
2041        2 bc_author init ("1"b),
2042        2 logical_volume init ("1"b),
2043        2 bit_count init ("1"b),
2044        2 records_used init ("1"b),
2045        2 current_length init ("1"b),
2046        2 max_length init ("1"b),
2047        2 mode init ("1"b),
2048        2 access_class init ("1"b),
2049        2 ring_brackets init ("1"b),
2050        2 safety_switch init ("1"b),
2051        2 copy_switch init ("1"b),
2052        2 audit_switch init ("1"b),
2053        2 ivds init ("1"b),
2054        2 cvds init ("1"b),
2055        2 usage_count init ("1"b),
2056        2 damaged_switch init ("1"b),
2057        2 synchronized_switch init ("1"b),
2058        2 entry_bound init ("1"b),
2059        2 highest_ci init ("1"b),
2060        2 concurrency_switch init ("1"b),
2061        2 rollback_switch init ("1"b),
2062        2 protected_switch init ("1"b)
2063        ) bit (1) unaligned;
2064 %page;
2065 dcl  1 off_line_options int static,                         /* attributes available without VTOC */
2066        (2 primary_name init ("1"b),
2067        2 names init ("1"b),
2068        2 type init ("1"b),
2069        2 link_path init ("1"b),
2070        2 unique_id init ("1"b),
2071        2 dtu init ("0"b),
2072        2 dtcm init ("0"b),
2073        2 dtem init ("1"b),
2074        2 dtd init ("1"b),
2075        2 dtvd init ("0"b),
2076        2 author init ("1"b),
2077        2 bc_author init ("1"b),
2078        2 logical_volume init ("1"b),
2079        2 bit_count init ("1"b),
2080        2 records_used init ("0"b),
2081        2 current_length init ("0"b),
2082        2 max_length init ("1"b),
2083        2 mode init ("1"b),
2084        2 access_class init ("1"b),
2085        2 ring_brackets init ("1"b),
2086        2 safety_switch init ("1"b),
2087        2 copy_switch init ("1"b),
2088        2 audit_switch init ("1"b),
2089        2 ivds init ("0"b),
2090        2 cvds init ("0"b),
2091        2 usage_count init ("0"b),
2092        2 damaged_switch init ("0"b),
2093        2 synchronized_switch init ("0"b),
2094        2 entry_bound init ("1"b),
2095        2 highest_ci init ("0"b),
2096        2 concurrency_switch init ("0"b),
2097        2 rollback_switch init ("0"b),
2098        2 protected_switch init ("0"b)
2099        ) bit (1) unaligned;
2100 %page;
2101 dcl  1 link_options int static,                             /* attributes valid for links */
2102        (2 primary_name init ("1"b),
2103        2 names init ("1"b),
2104        2 type init ("1"b),
2105        2 link_path init ("1"b),
2106        2 unique_id init ("0"b),
2107        2 dtu init ("0"b),
2108        2 dtcm init ("0"b),
2109        2 dtem init ("1"b),
2110        2 dtd init ("1"b),
2111        2 dtvd init ("1"b),
2112        2 author init ("1"b),
2113        2 bc_author init ("0"b),
2114        2 logical_volume init ("0"b),
2115        2 bit_count init ("0"b),
2116        2 records_used init ("0"b),
2117        2 current_length init ("0"b),
2118        2 max_length init ("0"b),
2119        2 mode init ("0"b),
2120        2 access_class init ("0"b),
2121        2 ring_brackets init ("0"b),
2122        2 safety_switch init ("0"b),
2123        2 copy_switch init ("0"b),
2124        2 audit_switch init ("0"b),
2125        2 ivds init ("0"b),
2126        2 cvds init ("0"b),
2127        2 usage_count init ("0"b),
2128        2 damaged_switch init ("0"b),
2129        2 synchronized_switch init ("0"b),
2130        2 entry_bound init ("0"b),
2131        2 highest_ci init ("0"b),
2132        2 concurrency_switch init ("0"b),
2133        2 rollback_switch init ("0"b),
2134        2 protected_switch init ("0"b)
2135        ) bit (1) unaligned;
2136 %page;
2137 dcl  1 nonlink_options int static,                          /* attributes valid for non-links */
2138        (2 primary_name init ("1"b),
2139        2 names init ("1"b),
2140        2 type init ("1"b),
2141        2 link_path init ("0"b),
2142        2 unique_id init ("1"b),
2143        2 dtu init ("1"b),
2144        2 dtcm init ("1"b),
2145        2 dtem init ("1"b),
2146        2 dtd init ("1"b),
2147        2 dtvd init ("1"b),
2148        2 author init ("1"b),
2149        2 bc_author init ("1"b),
2150        2 logical_volume init ("1"b),
2151        2 bit_count init ("1"b),
2152        2 records_used init ("1"b),
2153        2 current_length init ("1"b),
2154        2 max_length init ("1"b),
2155        2 mode init ("1"b),
2156        2 access_class init ("1"b),
2157        2 ring_brackets init ("1"b),
2158        2 safety_switch init ("1"b),
2159        2 copy_switch init ("1"b),
2160        2 audit_switch init ("1"b),
2161        2 ivds init ("1"b),
2162        2 cvds init ("1"b),
2163        2 usage_count init ("1"b),
2164        2 damaged_switch init ("1"b),
2165        2 synchronized_switch init ("1"b),
2166        2 entry_bound init ("1"b),
2167        2 highest_ci init ("1"b),
2168        2 concurrency_switch init ("1"b),
2169        2 rollback_switch init ("1"b),
2170        2 protected_switch init ("1"b)
2171        ) bit (1) unaligned;
2172 %page;
2173 dcl  1 dm_file_options int static,                          /* attributes valid for DM files */
2174        (2 primary_name init ("1"b),
2175        2 names init ("1"b),
2176        2 type init ("1"b),
2177        2 link_path init ("0"b),
2178        2 unique_id init ("1"b),
2179        2 dtu init ("1"b),
2180        2 dtcm init ("1"b),
2181        2 dtem init ("1"b),
2182        2 dtd init ("1"b),
2183        2 dtvd init ("1"b),
2184        2 author init ("1"b),
2185        2 bc_author init ("0"b),
2186        2 logical_volume init ("1"b),
2187        2 bit_count init ("0"b),
2188        2 records_used init ("1"b),
2189        2 current_length init ("1"b),
2190        2 max_length init ("1"b),
2191        2 mode init ("1"b),
2192        2 access_class init ("1"b),
2193        2 ring_brackets init ("1"b),
2194        2 safety_switch init ("0"b),
2195        2 copy_switch init ("0"b),
2196        2 audit_switch init ("0"b),
2197        2 ivds init ("0"b),
2198        2 cvds init ("0"b),
2199        2 usage_count init ("0"b),
2200        2 damaged_switch init ("0"b),
2201        2 synchronized_switch init ("0"b),
2202        2 entry_bound init ("0"b),
2203        2 highest_ci init ("1"b),
2204        2 concurrency_switch init ("1"b),
2205        2 rollback_switch init ("1"b),
2206        2 protected_switch init ("1"b)
2207        ) bit (1) unaligned;
2208 %page;
2209 dcl  1 fm_status_options int static,                        /* DM file attr's requiring file_manager_$status */
2210        (2 primary_name init ("0"b),
2211        2 names init ("0"b),
2212        2 type init ("0"b),
2213        2 link_path init ("0"b),
2214        2 unique_id init ("1"b),
2215        2 dtu init ("0"b),
2216        2 dtcm init ("0"b),
2217        2 dtem init ("0"b),
2218        2 dtd init ("0"b),
2219        2 dtvd init ("0"b),
2220        2 author init ("0"b),
2221        2 bc_author init ("0"b),
2222        2 logical_volume init ("0"b),
2223        2 bit_count init ("0"b),
2224        2 records_used init ("0"b),
2225        2 current_length init ("0"b),
2226        2 max_length init ("0"b),
2227        2 mode init ("1"b),
2228        2 access_class init ("0"b),
2229        2 ring_brackets init ("1"b),
2230        2 safety_switch init ("0"b),
2231        2 copy_switch init ("0"b),
2232        2 audit_switch init ("0"b),
2233        2 ivds init ("0"b),
2234        2 cvds init ("0"b),
2235        2 usage_count init ("0"b),
2236        2 damaged_switch init ("0"b),
2237        2 synchronized_switch init ("0"b),
2238        2 entry_bound init ("0"b),
2239        2 highest_ci init ("1"b),
2240        2 concurrency_switch init ("1"b),
2241        2 rollback_switch init ("1"b),
2242        2 protected_switch init ("1"b)
2243        ) bit (1) unaligned;
2244 %page;
2245 dcl  1 root_options int static,                             /* attributes available for the root */
2246        (2 primary_name init ("1"b),
2247        2 names init ("1"b),
2248        2 type init ("1"b),
2249        2 link_path init ("0"b),
2250        2 unique_id init ("1"b),
2251        2 dtu init ("1"b),
2252        2 dtcm init ("0"b),
2253        2 dtem init ("0"b),
2254        2 dtd init ("0"b),
2255        2 dtvd init ("0"b),
2256        2 author init ("1"b),
2257        2 bc_author init ("1"b),
2258        2 logical_volume init ("1"b),
2259        2 bit_count init ("1"b),
2260        2 records_used init ("0"b),
2261        2 current_length init ("0"b),
2262        2 max_length init ("0"b),
2263        2 mode init ("1"b),
2264        2 access_class init ("0"b),
2265        2 ring_brackets init ("1"b),
2266        2 safety_switch init ("1"b),
2267        2 copy_switch init ("0"b),
2268        2 audit_switch init ("0"b),
2269        2 ivds init ("0"b),
2270        2 cvds init ("0"b),
2271        2 usage_count init ("0"b),
2272        2 damaged_switch init ("1"b),
2273        2 synchronized_switch init ("0"b),
2274        2 entry_bound init ("0"b),
2275        2 highest_ci init ("0"b),
2276        2 concurrency_switch init ("0"b),
2277        2 rollback_switch init ("0"b),
2278        2 protected_switch init ("0"b)
2279        ) bit (1) unaligned;
2280 %page;
2281 dcl  1 typed_options int static,                            /* attributes that must come from fs_util_ */
2282        (2 primary_name init ("0"b),
2283        2 names init ("0"b),
2284        2 type init ("1"b),
2285        2 link_path init ("0"b),
2286        2 unique_id init ("0"b),
2287        2 dtu init ("0"b),
2288        2 dtcm init ("0"b),
2289        2 dtem init ("0"b),
2290        2 dtd init ("0"b),
2291        2 dtvd init ("0"b),
2292        2 author init ("0"b),
2293        2 bc_author init ("0"b),
2294        2 logical_volume init ("0"b),
2295        2 bit_count init ("0"b),
2296        2 records_used init ("0"b),
2297        2 current_length init ("0"b),
2298        2 max_length init ("1"b),
2299        2 mode init ("1"b),
2300        2 access_class init ("0"b),
2301        2 ring_brackets init ("1"b),
2302        2 safety_switch init ("1"b),
2303        2 copy_switch init ("1"b),
2304        2 audit_switch init ("1"b),
2305        2 ivds init ("1"b),
2306        2 cvds init ("1"b),
2307        2 usage_count init ("0"b),
2308        2 damaged_switch init ("1"b),
2309        2 synchronized_switch init ("1"b),
2310        2 entry_bound init ("0"b),
2311        2 highest_ci init ("1"b),
2312        2 concurrency_switch init ("1"b),
2313        2 no_rollback_sw init ("1"b),
2314        2 protected_switch init ("1"b)
2315        ) bit (1) unaligned;
2316 %page;
2317 %include branch_status;
2318 %page;
2319 %include copy_flags;
2320 %page;
2321 %include dm_file_status;
2322 %page;
2323 %include star_structures;
2324 %page;
2325 %include status_for_backup;
2326 %page;
2327 %include suffix_info;
2328 
2329 
2330      end status;