1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56 status: st: procedure options (variable);
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96 dcl 1 opt,
97 (2 primary_name,
98 2 names,
99 2 type,
100 2 link_path,
101 2 unique_id,
102 2 dtu,
103 2 dtcm,
104 2 dtem,
105 2 dtd,
106 2 dtvd,
107 2 author,
108 2 bc_author,
109 2 logical_volume,
110 2 bit_count,
111 2 records_used,
112 2 current_length,
113 2 max_length,
114 2 mode,
115 2 access_class,
116 2 ring_brackets,
117 2 safety_switch,
118 2 copy_switch,
119 2 audit_switch,
120 2 ivds,
121 2 cvds,
122 2 usage_count,
123 2 damaged_switch,
124 2 synchronized_switch,
125 2 entry_bound
126 ) bit (1) unaligned,
127 2 dm_files_only,
128 (3 highest_ci,
129 3 concurrency_switch,
130 3 rollback_switch,
131 3 protected_switch
132 ) bit (1) unaligned;
133
134
135 dcl 1 explicit_opt like opt;
136
137 dcl 1 saved_options like opt;
138
139 dcl ALL_OPTIONS bit (33) aligned int static options (constant) init ((33)"1"b);
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
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)),
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,
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);
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,
210 2 all,
211 2 dates,
212 2 lengths
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);
227 dcl mode_bits (5) bit (1) unaligned;
228 dcl ring_brackets (8) fixed bin (3);
229
230
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
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
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);
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);
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
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
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
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
348
349 dcl (cleanup, linkage_error) condition;
350
351
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;
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;
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;
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;
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;
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
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
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
535
536 if ^dir_sw & ^link_sw & ^seg_sw then dir_sw, link_sw, seg_sw = "1"b;
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;
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;
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;
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
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;
587 if active_function & arg_count = 2 then go to AF_USAGE;
588 path_count = 1;
589 path_array.path_len (1) = 0;
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;
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);
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 ();
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;
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;
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 ();
677
678 if ^printed_something then
679 printed_something = printed_pathname;
680
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
702
703
704
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;
718
719
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;
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);
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;
761 else branch_status.mode = "01"b;
762 branch_status.ring_brackets (*) = "000111"b;
763 end;
764 else call ENTRY_ERROR (code, dn, en);
765
766
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 ;
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
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
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;
805 if chase & chased then do;
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;
819 go to STATUS;
820 end;
821 else if code = error_table_$noentry then
822 if chase then do;
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;
829
830 string (opt) = string (opt) & string (link_options);
831 if string (opt) = "0"b & switch_count = 0 then
832 call ENTRY_WRONG_TYPE ("a link");
833 end;
834
835 else do;
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;
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
852 if branch_status.type = directory_type & branch_status.bit_count = "0"b then opt.current_length = "0"b;
853 else opt.bit_count = "0"b;
854 else ;
855
856 if dm_file_sw | root_sw then msf = "0"b;
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;
863 unspec (opt.dm_files_only) = "0"b;
864
865
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
873
874 if ^active_function & ^one_item then do;
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
892
893 if opt.names | opt.primary_name then do;
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;
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;
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;
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
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
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);
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;
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;
1039
1040
1041
1042
1043
1044
1045 if root_sw then do;
1046 temp_clock = clock ();
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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
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;
1278 call PRINT_PATHNAME ();
1279 if dm_file_sw then string (mode_bits) = "0"b || substr (auto_dm_file_status.mode, 1, 4);
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
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;
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;
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;
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;
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
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;
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;
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;
1450
1451 if opt.safety_switch then do;
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;
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 ;
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;
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 ;
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;
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;
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;
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;
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
1621
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;
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
1665
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 ;
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;
1709 switch_list.name_index (k) = 0;
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
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
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
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
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
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,
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,
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,
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,
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),
1972 2 records_used init ("0"b),
1973 2 current_length init ("1"b),
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,
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,
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,
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,
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,
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,
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,
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,
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,
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;