COMPILATION LISTING OF SEGMENT switch_on Compiled by: Multics PL/I Compiler, Release 30, of February 16, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 08/23/88 0814.4 mst Tue Options: optimize map 1 /****^ ************************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1983 * 6* * * 7* * Copyright, (C) Massachusetts Institute of Technology, 1983 * 8* * * 9* ************************************************************** */ 10 11 12 /****^ HISTORY COMMENTS: 13* 1) change(86-11-11,Lippard), approve(86-12-08,MCR7589), 14* audit(87-02-16,Farley), install(87-03-23,MR12.1-1009): 15* Modified to allow damaged switch for directories. 16* 2) change(87-08-21,TLNguyen), approve(87-08-21,MCR7556), 17* audit(87-09-01,Lippard), install(87-12-07,MR12.2-1009): 18* a. Change the switch_on to return an error message to the user when 19* it fails to determine the type of a specified non-existent entry. 20* 21* b. Change the switch_on to set a specified support switch name on 22* for a specified existing extended entry type such as forum. 23* 3) change(88-05-12,Lippard), approve(88-05-02,MCR7881), 24* audit(88-06-16,Fawcett), install(88-08-02,MR12.2-1074): 25* Changed to allow setting of audit_switch. 26* 4) change(88-08-16,TLNguyen), approve(88-08-16,MCR7921), 27* audit(88-08-17,Parisek), install(88-08-23,MR12.2-1091): 28* Prevents an infinitive loop when one of the specified existent paths is a 29* Multisegment-file (MSF). 30* END HISTORY COMMENTS */ 31 32 33 /* format: style2,idind30,indcomtxt */ 34 switch_on: 35 swn: 36 procedure options (variable); 37 38 /**** 39* Syntax: switch_on name paths {-chase/-no_chase} 40* switch_off name paths {-chase/-no_chase} 41* 42* Turns on or off the named switch (safety, copy, no_complete_volume_dump, etc.) for the 43* specified pathnames. The star convention is allowed in paths. 44* 45* For an MSF, the switches of the MSF dir (when possible) and those of all the non-link components are set. */ 46 47 /* Written 06/18/80 by S. Herbst */ 48 /* Fixed to see links with starname only if -chase 11/17/80 S. Herbst */ 49 /* Modified September 1982, J. Bongiovanni, for synchronized switch */ 50 /* Added -name 10/26/82 S. Herbst */ 51 /* Modified 2/20/83 Jay Pattin for object_type_ */ 52 /* Modified 830927 BIM for object_type_ --> fs_util_ */ 53 /* Fixed to detect "Entry not found" 12/13/83 S. Herbst */ 54 /* Fixed to not blow out trying to find obj map of null seg, 1984.08.26, MAP */ 55 /* 850206 MSharpe to replace -fcnt with -inase/inaee */ 56 /* 850226 MSharpe to give better error messages when invalid switch names 57* are given in conjunction with starnames */ 58 59 /* Constants */ 60 61 dcl long_key (8) char (32) int static options (constant) 62 init ("copy", "damaged", "complete_volume_dump", 63 "incremental_volume_dump", "perprocess_static", "safety", "synchronized","audit"); 64 65 dcl short_key (8) char (32) int static options (constant) 66 init ("cp", "dm", "cvd", "ivd", "pps", "sf", "synch", "ad"); 67 68 dcl long_long_key (8) char (32) int static options (constant) 69 init ("copy_switch", "damaged_switch", "complete_volume_dump_switch", 70 "incremental_volume_dump_switch", "perprocess_static_switch", 71 "safety_switch", "synchronized_switch","audit_switch"); 72 73 dcl short_long_key (8) char (32) int static options (constant) 74 init ("csw", "dsw", "cvds", "ivds", "ppsw", "ssw", "synsw","asw"); 75 76 dcl DIR_ALLOWED bit (8) aligned static options (constant) init ("01000101"b); 77 78 dcl (UNKNOWN_KEY, GENERAL_SET) fixed bin int static options (constant) init (9); 79 80 dcl NO_CHASE fixed bin (1) int static options (constant) init (0); 81 82 dcl BRANCHES_ONLY fixed bin int static options (constant) init (2); 83 dcl BRANCHES_AND_LINKS fixed bin int static options (constant) init (3); 84 85 dcl ( 86 LINK_TYPE init (0), 87 SEG_TYPE init (1), 88 DIR_TYPE init (2), 89 MSF_TYPE init (3), 90 EXTENDED_TYPE init (4) 91 ) fixed bin static options (constant); 92 93 94 /* Based */ 95 96 dcl arg char (arg_len) based (arg_ptr); 97 98 dcl 1 entries (entries_count) aligned based (entries_ptr), 99 2 type fixed bin (2) unaligned unsigned, 100 2 nnames fixed bin (15) unaligned, 101 2 nindex fixed bin (17) unaligned; 102 103 dcl names (99 /* arbitrary */) char (32) aligned based (names_ptr); 104 105 106 /* Automatic */ 107 108 dcl (dn, target_dn) char (168); 109 dcl (en, key_name, me, star_en, target_en) 110 char (32); 111 112 dcl (chase_arg_given_sw, chase_sw, force_no_type_sw, got_key, got_path, name_sw, some_sw, star_sw, 113 switch_value) bit (1) aligned; 114 115 dcl area area based (area_ptr); 116 117 dcl (area_ptr, arg_ptr, entries_ptr, names_ptr) 118 ptr; 119 120 dcl (arg_count, arg_len, entries_count, i, j, key_index, star_type, type) 121 fixed bin; 122 dcl code fixed bin (35); 123 124 dcl error_table_$argerr fixed bin (35) ext; 125 dcl error_table_$badopt fixed bin (35) ext; 126 dcl error_table_$incorrect_access fixed bin (35) ext; 127 dcl error_table_$moderr fixed bin (35) ext; 128 dcl error_table_$no_dir fixed bin (35) ext; 129 dcl error_table_$no_s_permission fixed bin (35) ext; 130 dcl error_table_$nomatch fixed bin (35) ext; 131 dcl error_table_$not_a_branch fixed bin (35) ext; 132 dcl error_table_$root fixed bin (35) ext; 133 134 dcl ( 135 com_err_, 136 com_err_$suppress_name 137 ) entry options (variable); 138 dcl check_star_name_$entry entry (char (*), fixed bin (35)); 139 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 140 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 141 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 142 dcl get_group_id_ entry returns (char (32)); 143 dcl get_system_free_area_ entry returns (ptr); 144 dcl get_wdir_ entry returns (char (168)); 145 dcl hcs_$add_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); 146 dcl hcs_$delete_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); 147 dcl hcs_$get_link_target entry (char (*), char (*), char (*), char (*), fixed bin (35)); 148 dcl hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, 149 fixed bin (35)); 150 dcl hcs_$list_acl entry (char (*), char (*), ptr, ptr, ptr, fixed bin, fixed bin (35)); 151 dcl hcs_$set_copysw entry (char (*), char (*), fixed bin (1), fixed bin (35)); 152 dcl hcs_$set_damaged_sw entry (char (*), char (*), bit (1), fixed bin (35)); 153 dcl hcs_$set_safety_sw entry (char (*), char (*), bit (1), fixed bin (35)); 154 dcl hcs_$set_synchronized_sw entry (char (*), char (*), bit (1) aligned, fixed bin (35)); 155 dcl hcs_$set_volume_dump_switches entry (char (*), char (*), fixed bin, fixed bin, fixed bin (35)); 156 dcl hcs_$star_ entry (char (*), char (*), fixed bin, ptr, fixed bin, ptr, ptr, 157 fixed bin (35)); 158 dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin, fixed bin (24), 159 fixed bin (35)); 160 dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); 161 dcl fs_util_$set_switch entry (char (*), char (*), char (*), bit (1) aligned, fixed bin (35)); 162 dcl fs_util_$get_type entry (character (*), character (*), character (*), fixed binary (35)); 163 dcl pathname_ entry (char (*), char (*)) returns (char (168)); 164 dcl system_privilege_$set_entry_audit_switch 165 entry (char (*), char (*), bit (1), fixed bin (35)); 166 167 dcl (addr, addrel, divide, fixed, hbound, index, null, rtrim, substr) 168 builtin; 169 170 dcl test_linkage_entry entry variable options (variable); 171 172 173 dcl cleanup condition; 174 dcl linkage_error condition; 175 176 me = "switch_on"; 177 switch_value = "1"b; 178 go to COMMON; 179 180 switch_off: 181 swf: 182 entry; 183 184 me = "switch_off"; 185 switch_value = "0"b; 186 187 COMMON: 188 call cu_$arg_count (arg_count, code); 189 if code ^= 0 190 then do; 191 call com_err_ (code, me); 192 return; 193 end; 194 195 /* Read control args */ 196 197 chase_sw, chase_arg_given_sw, force_no_type_sw = "0"b; 198 199 do i = 1 to arg_count; 200 201 call cu_$arg_ptr (i, arg_ptr, arg_len, code); 202 203 if substr (arg, 1, 1) = "-" 204 then if arg = "-chase" 205 then chase_sw, chase_arg_given_sw = "1"b; 206 else if arg = "-no_chase" 207 then do; 208 chase_sw = "0"b; 209 chase_arg_given_sw = "1"b; 210 end; 211 212 else if arg = "-interpret_as_standard_entry" | arg = "-inase" 213 then force_no_type_sw = "1"b; 214 215 else if arg = "-interpret_as_extended_entry" | arg = "-inaee" 216 then force_no_type_sw = "0"b; 217 218 else if arg = "-name" | arg = "-nm" 219 then do; /* skip following arg */ 220 i = i + 1; 221 if i > arg_count 222 then do; 223 call com_err_ (0, me, "No value specified for -name"); 224 return; 225 end; 226 end; 227 else do; 228 call com_err_ (error_table_$badopt, me, "^a", arg); 229 return; 230 end; 231 end; 232 233 /* Read and process other args */ 234 235 got_key, got_path, name_sw = "0"b; 236 area_ptr, entries_ptr, names_ptr = null; 237 on cleanup call clean_up; 238 239 do i = 1 to arg_count; 240 241 call cu_$arg_ptr (i, arg_ptr, arg_len, code); 242 243 if arg = "-name" | arg = "-nm" 244 then name_sw = "1"b; 245 else if index (arg, "-") ^= 1 246 then if ^got_key 247 then do; 248 key_name = arg; 249 do j = hbound (long_key, 1) by -1 to 1 while (long_key (j) ^= key_name); 250 end; 251 if j = 0 252 then do; 253 do j = hbound (short_key, 1) by -1 to 1 while (short_key (j) ^= key_name); 254 end; 255 if j = 0 256 then do; 257 do j = hbound (long_long_key, 1) by -1 to 1 258 while (long_long_key (j) ^= key_name); 259 end; 260 if j = 0 261 then do; 262 do j = hbound (short_long_key, 1) by -1 to 1 263 while (short_long_key (j) ^= key_name); 264 end; 265 if j = 0 266 then if force_no_type_sw 267 then do; 268 call com_err_ (0, me, 269 "Invalid switch name: ^a", key_name); 270 goto RETURN; 271 end; 272 else j = UNKNOWN_KEY; 273 /* MAY BE EXTENDED OBJECT */ 274 end; 275 end; 276 end; 277 key_index = j; 278 got_key = "1"b; 279 name_sw = "0"b; 280 end; 281 282 else do; 283 284 got_path = "1"b; 285 286 if name_sw 287 then do; 288 name_sw = "0"b; 289 dn = get_wdir_ (); 290 en = arg; 291 go to LITERAL_NAME; 292 end; 293 294 call expand_pathname_ (arg, dn, en, code); 295 if code ^= 0 296 then do; 297 call com_err_ (code, me, "^a", arg); 298 return; 299 end; 300 301 if dn = ">" & en = "" 302 then do; 303 call com_err_ (error_table_$root, me, "^a", arg); 304 go to NEXT_ARG; 305 end; 306 307 call check_star_name_$entry (en, code); 308 if code = 0 309 then do; 310 LITERAL_NAME: 311 star_sw = "0"b; 312 313 type = get_type (dn, en); 314 /* no stars */ 315 316 if type = LINK_TYPE 317 then if chase_arg_given_sw & ^chase_sw 318 then call com_err_ (error_table_$not_a_branch, me, "^a", pathname_ (dn, en)); 319 320 else do; /* default: chase if not stars */ 321 322 call resolve_link (dn, en, target_dn, target_en, type, code); 323 324 if code = 0 325 then call set_one (target_dn, target_en, type, key_index, 326 switch_value, code); 327 else call com_err_ (code, me, "Chasing link ^a", 328 pathname_ (target_dn, target_en)); 329 330 end; 331 332 else call set_one (dn, en, type, key_index, switch_value, code); 333 end; 334 335 else if code > 2 336 then do; /* bad syntax in starname */ 337 call com_err_ (code, me, "^a", arg); 338 return; 339 end; 340 341 else do; 342 star_sw = "1"b; 343 star_en = en; 344 345 if area_ptr = null 346 then area_ptr = get_system_free_area_ (); 347 348 entries_ptr, names_ptr = null; 349 350 if chase_sw 351 then star_type = BRANCHES_AND_LINKS; 352 else star_type = BRANCHES_ONLY; 353 354 some_sw = "0"b; 355 356 call hcs_$star_ (dn, en, star_type, area_ptr, entries_count, entries_ptr, 357 names_ptr, code); 358 if code ^= 0 359 then do; 360 call com_err_ (code, me, "^a", pathname_ (dn, en)); 361 go to NEXT_ARG; 362 end; 363 364 else do j = 1 to entries_count; 365 366 type = entries_ptr -> entries (j).type; 367 if type = SEG_TYPE | type = DIR_TYPE 368 then do; /* not a link */ 369 370 target_dn = dn; 371 target_en = 372 names_ptr -> names (entries_ptr -> entries (j).nindex); 373 374 BRANCH: 375 type = get_type (target_dn, target_en); 376 /* MSF?, EXTENDED? */ 377 378 if (type ^= EXTENDED_TYPE) & key_index = UNKNOWN_KEY 379 then ; 380 else do; 381 call set_one (target_dn, target_en, type, key_index, 382 switch_value, code); 383 384 if code ^= 0 385 then if code = error_table_$no_s_permission 386 | code = error_table_$incorrect_access 387 | code = error_table_$no_dir 388 then go to NEXT_ARG; 389 end; 390 end; 391 392 else if chase_sw 393 then do; /* link */ 394 395 en = names_ptr -> names (entries_ptr -> entries (j).nindex); 396 397 call resolve_link (dn, en, target_dn, target_en, type, code); 398 399 if code = 0 400 then go to BRANCH; 401 else if key_index = UNKNOWN_KEY 402 then ; 403 /* Quiet! Wasn't meant for this one anyway */ 404 else call com_err_ (code, me, "Chasing link ^a", 405 pathname_ (dn, en)); 406 end; 407 end; 408 409 if star_sw & ^some_sw 410 then if key_index = UNKNOWN_KEY 411 then call com_err_ (0, me, "Invalid switch name: ^a", key_name); 412 else call com_err_ (error_table_$nomatch, me, "^a", pathname_ (dn, star_en)); 413 414 NEXT_ARG: 415 call clean_up; 416 end; 417 end; 418 end; 419 420 if ^got_path 421 then do; 422 call com_err_$suppress_name (0, me, "Usage: ^a keyword paths {-control_args}", me); 423 return; 424 end; 425 426 RETURN: 427 call clean_up; 428 429 return; 430 431 get_type: 432 proc (P_dn, P_en) returns (fixed bin); 433 434 /* Decides whether an entry is a segment, directory, or MSF */ 435 436 dcl (P_dn, P_en) char (*); 437 dcl type fixed bin; 438 dcl bit_count fixed bin (24); 439 dcl fs_util_type char (32); 440 441 code = 0; /* make get_type happy */ 442 fs_util_type = ""; 443 444 if ^force_no_type_sw 445 then do; 446 call fs_util_$get_type (P_dn, P_en, fs_util_type, code); 447 448 if code = 0 & ((substr (fs_util_type, 1, 1) ^= "-") | (fs_util_type = FS_OBJECT_TYPE_DM_FILE)) 449 then return (EXTENDED_TYPE); /* extended object or DM files,i.e., non-hcs */ 450 else if code ^= 0 451 then do; 452 call com_err_ (code, me, "^a", pathname_ (P_dn, P_en)); 453 goto RETURN; 454 end; 455 else; 456 end; 457 458 call hcs_$status_minf (P_dn, P_en, NO_CHASE, type, bit_count, code); 459 if code ^= 0 & code ^= error_table_$no_s_permission 460 then do; 461 if key_index = UNKNOWN_KEY 462 then call com_err_ (0, me, "Invalid switch name: ^a.", key_name); 463 else call com_err_ (code, me, "^a", pathname_ (P_dn, P_en)); 464 go to RETURN; 465 end; 466 467 if type = DIR_TYPE & bit_count > 0 468 then return (MSF_TYPE); 469 else return (type); 470 1 1 /* BEGIN INCLUDE FILE: suffix_info.incl.pl1 */ 1 2 /* format: style3,indcomtxt,idind30 */ 1 3 /**** Jay Pattin 2/13/83 1 4* M. Pandolf 1984.11.30 to set FS_OBJECT_TYPE_MSF to -multisegment_file 1 5* 1 6* The include file copy_flags.incl.pl1 must be included in any program using this include file. 1 7* 1 8* This structure is returned by the suffix_XXX_$suffix_info subroutines */ 1 9 1 10 declare suffix_info_ptr ptr; 1 11 1 12 declare 1 suffix_info aligned based (suffix_info_ptr), 1 13 2 version char (8), 1 14 2 type char (32) unaligned, 1 15 2 type_name char (32) unaligned, /* Singular name of the object type, e.g. "mailbox" */ 1 16 2 plural_name char (32) unaligned, /* Plural of above, e.g. "mailboxes" */ 1 17 2 flags unaligned, 1 18 3 standard_object bit (1) unaligned, /* ON if not an extended object (no suffix_XXX_) */ 1 19 3 extended_acl bit (1) unaligned, /* ON if uses extended ACLs, off if regular ACLs */ 1 20 3 has_switches bit (1) unaligned, /* ON if supports switches for objects */ 1 21 3 mbz1 bit (33) unaligned, 1 22 2 modes char (36), /* correspondence between bits and chars for extended modes */ 1 23 2 max_mode_len fixed bin, /* maximum number of modes on an object */ 1 24 2 num_ring_brackets fixed bin, /* number of ring brackets on object */ 1 25 2 copy_flags like copy_flags, /* See copy_flags.incl.pl1 */ 1 26 2 info_pathname char (168) unaligned; 1 27 /* pathname of info segment containing more info */ 1 28 1 29 declare SUFFIX_INFO_VERSION_1 char (8) static options (constant) init ("SUFFIX01"); 1 30 1 31 /* This information is returned by the suffix_XXX_$list_switches subroutines */ 1 32 1 33 declare switch_list_ptr ptr, 1 34 alloc_switch_count fixed bin, 1 35 alloc_switch_name_count fixed bin; 1 36 1 37 declare 1 switch_list aligned based (switch_list_ptr), 1 38 2 version char (8), /* SWITCH_LIST_VERSION_1 */ 1 39 2 switch_count fixed bin, /* total number of switches */ 1 40 2 switch_name_count fixed bin, /* total number of names */ 1 41 2 switches (alloc_switch_count refer (switch_list.switch_count)), 1 42 3 name_index fixed bin, /* index of first name for this switch */ 1 43 3 name_count fixed bin, /* number of names for this switch */ 1 44 3 default_value bit (1) aligned, /* default setting for this switch */ 1 45 3 mbz1 bit (36) aligned, /* reserved for future use */ 1 46 2 names (alloc_switch_name_count refer (switch_list.switch_name_count)) char (32); 1 47 1 48 declare SWITCH_LIST_VERSION_1 char (8) static options (constant) init ("SWLIST01"); 1 49 1 50 declare ( 1 51 FS_OBJECT_TYPE_SEGMENT init ("-segment"), 1 52 FS_OBJECT_TYPE_DIRECTORY init ("-directory"), 1 53 FS_OBJECT_TYPE_MSF init ("-multisegment_file"), 1 54 FS_OBJECT_TYPE_DM_FILE init ("-dm_file"), 1 55 FS_OBJECT_TYPE_LINK init ("-link") 1 56 ) char (32) unaligned int static options (constant); 1 57 1 58 /* END INCLUDE FILE: suffix_info.incl.pl1 */ 471 2 1 /* BEGIN INCLUDE FILE: copy_flags.incl.pl1 */ 2 2 2 3 /* Flags for attributes that should/may be copied by the copy_ subroutine. This include file is 2 4* required by suffix_info.incl.pl1 and copy_options.incl.pl1 2 5* 2 6* Jay Pattin 6/23/83 */ 2 7 2 8 declare 1 copy_flags aligned based, /* ON means that this attribute may be copied by copy_ */ 2 9 2 names bit (1) unaligned, 2 10 2 acl bit (1) unaligned, 2 11 2 ring_brackets bit (1) unaligned, 2 12 2 max_length bit (1) unaligned, 2 13 2 copy_switch bit (1) unaligned, 2 14 2 safety_switch bit (1) unaligned, 2 15 2 dumper_switches bit (1) unaligned, 2 16 2 entry_bound bit (1) unaligned, /* only for vanilla object segments */ 2 17 2 extend bit (1) unaligned, /* copy_ may append to end of existing object */ 2 18 2 update bit (1) unaligned, /* copy_ may replace contents of existing object */ 2 19 2 mbz bit (26) unaligned; 2 20 2 21 /* END INCLUDE FILE: copy_flags.incl.pl1 */ 472 473 end get_type; 474 475 resolve_link: 476 proc (P_dn, P_en, P_target_dn, P_target_en, P_type, P_code); 477 478 /* Chases a link and gets the type of the target */ 479 480 dcl (P_dn, P_en, P_target_dn, P_target_en) 481 char (*); 482 dcl P_type fixed bin; 483 dcl P_code fixed bin (35); 484 485 call hcs_$get_link_target (P_dn, P_en, P_target_dn, P_target_en, P_code); 486 if P_code ^= 0 487 then return; 488 489 P_type = get_type (P_target_dn, P_target_en); 490 491 end resolve_link; 492 493 set_one: 494 proc (P_dn, P_en, P_type, P_key_index, P_switch_value, P_code); 495 496 /* Sets the switch of one segment by calling the appropriate routine */ 497 498 dcl (P_dn, P_en) char (*); 499 dcl P_switch_value bit (1) aligned; 500 dcl (P_key_index, P_type) fixed bin; 501 dcl P_code fixed bin (35); 502 503 dcl (entries_ptr, names_ptr) ptr; 504 dcl entries_count fixed bin; 505 dcl code fixed bin (35); 506 507 dcl msf_path char (168); 508 dcl component_name char (32); 509 dcl msf_component_index fixed bin; /* local */ 510 511 code = 0; /* must initialize to avoid it was previously contained garbage */ 512 513 if P_type = MSF_TYPE 514 then do; /* first set the switch on all the components */ 515 516 if long_key (P_key_index) = "perprocess_static" 517 then do; 518 call com_err_ (0, me, "Operation not allowed on MSF's. ^a", pathname_ (P_dn, P_en)); 519 return; 520 end; 521 522 msf_path = P_dn; 523 if msf_path ^= ">" 524 then msf_path = rtrim (msf_path) || ">"; 525 msf_path = rtrim (msf_path) || P_en; 526 527 if area_ptr = null 528 then area_ptr = get_system_free_area_ (); 529 entries_ptr, names_ptr = null; 530 531 on cleanup call msf_cleanup; 532 533 call hcs_$star_ (msf_path, "**", BRANCHES_ONLY, area_ptr, entries_count, entries_ptr, names_ptr, code); 534 535 if code = 0 & entries_count > 0 536 then do; 537 do msf_component_index = 1 to entries_count; 538 component_name = names_ptr -> names (entries_ptr -> entries (msf_component_index).nindex); 539 540 call set_whichever (msf_path, component_name, (entries_ptr -> entries (msf_component_index).type), 541 P_key_index, P_switch_value); 542 end; 543 544 call msf_cleanup; 545 end; 546 end; 547 548 if P_type ^= MSF_TYPE | substr (DIR_ALLOWED, P_key_index, 1) 549 then call set_whichever (P_dn, P_en, P_type, P_key_index, P_switch_value); 550 551 return; 552 553 msf_cleanup: 554 proc; 555 556 if entries_ptr ^= null 557 then free entries_ptr -> entries in (area); 558 if names_ptr ^= null 559 then free names_ptr -> names in (area); 560 561 end msf_cleanup; 562 563 564 end set_one; 565 566 set_whichever: 567 proc (P_dn, P_en, P_type, P_key_index, P_switch_value); 568 569 /* Calls the appropriate entry point to set a switch */ 570 571 dcl (P_dn, P_en) char (*); 572 dcl (P_type, P_key_index) fixed bin; 573 dcl P_switch_value bit (1) aligned; 574 dcl code fixed bin (35); 575 576 dcl (ncvd_value, nivd_value) fixed bin; 577 578 code = 0; /* must initialize to avoid it was previously contained an unexpected value */ 579 580 if P_type = EXTENDED_TYPE 581 then goto SET (GENERAL_SET); 582 583 if P_type = DIR_TYPE & ^substr (DIR_ALLOWED, P_key_index, 1) 584 then do; 585 if ^star_sw 586 then call com_err_ (0, me, "Directories do not support the ^a switch. ^a.", key_name, 587 pathname_ (P_dn, P_en)); 588 return; 589 end; 590 591 go to SET (P_key_index); 592 593 SET (1): /* copy switch */ 594 some_sw = "1"b; 595 call hcs_$set_copysw (P_dn, P_en, fixed (P_switch_value, 1), code); 596 if code ^= 0 597 then call com_err_ (code, me, "^a", pathname_ (P_dn, P_en)); 598 return; 599 600 601 SET (2): /* damaged_switch */ 602 some_sw = "1"b; 603 call hcs_$set_damaged_sw (P_dn, P_en, (P_switch_value), code); 604 if code ^= 0 605 then call com_err_ (code, me, "^a", pathname_ (P_dn, P_en)); 606 return; 607 608 SET (3): /* complete_volume_dump switch */ 609 some_sw = "1"b; /* use NOT of user's arg "complete_volume_dump_switch" */ 610 if P_switch_value 611 then ncvd_value = -1; 612 else ncvd_value = 1; 613 call hcs_$set_volume_dump_switches (P_dn, P_en, 0, ncvd_value, code); 614 if code ^= 0 615 then call com_err_ (code, me, "^a", pathname_ (P_dn, P_en)); 616 return; 617 618 SET (4): /* incremental_volume_dump switch */ 619 some_sw = "1"b; /* use NOT of user's arg "incremental_volume_dump_switch" */ 620 if P_switch_value 621 then nivd_value = -1; 622 else nivd_value = 1; 623 call hcs_$set_volume_dump_switches (P_dn, P_en, nivd_value, 0, code); 624 if code ^= 0 625 then call com_err_ (code, me, "^a", pathname_ (P_dn, P_en)); 626 627 return; 628 629 SET (5): /* perprocess_static switch */ 630 some_sw = "1"b; 631 call set_perprocess (P_dn, P_en, P_switch_value, code); 632 return; 633 634 SET (6): /* safety switch */ 635 some_sw = "1"b; 636 call hcs_$set_safety_sw (P_dn, P_en, (P_switch_value), code); 637 if code ^= 0 638 then call com_err_ (code, me, "^a", pathname_ (P_dn, P_en)); 639 return; 640 641 SET (7): /* synchronized switch */ 642 some_sw = "1"b; 643 call hcs_$set_synchronized_sw (P_dn, P_en, (P_switch_value), code); 644 if code ^= 0 645 then call com_err_ (code, me, "^a", pathname_ (P_dn, P_en)); 646 return; 647 648 SET (8): /* entry audit switch */ 649 some_sw = "1"b; 650 on linkage_error begin; 651 call com_err_ (error_table_$moderr, me, "system_privilege_"); 652 goto no_sys_priv; 653 end; 654 test_linkage_entry = system_privilege_$set_entry_audit_switch; 655 call system_privilege_$set_entry_audit_switch (P_dn, P_en, (P_switch_value), code); 656 if code ^= 0 657 then call com_err_ (code, me, "^a", pathname_ (P_dn, P_en)); 658 659 no_sys_priv: 660 661 return; 662 SET (9): /* unknown keyname, only allowed for extended objects */ 663 if type ^= EXTENDED_TYPE 664 then do; 665 if ^star_sw 666 then call com_err_ (0, me, "Invalid switch name: ^a.", key_name); 667 return; 668 end; 669 670 if key_index = UNKNOWN_KEY /* users specified a switch name for a specified extended entry */ 671 then call fs_util_$set_switch (P_dn, P_en, key_name, P_switch_value, code); 672 else call fs_util_$set_switch (P_dn, P_en, long_key (key_index), P_switch_value, code); 673 674 if code ^= 0 675 then do; 676 677 if code = error_table_$argerr 678 679 then if star_sw & P_key_index = UNKNOWN_KEY 680 then return; /* we don't support this switch; if nobody else does, 681* the Invalid switch error will be printed at the end */ 682 else call com_err_ (code, me, "^/This object does not support the ^a switch. ^a", key_name, 683 pathname_ (P_dn, P_en)); /* must display error code value to users */ 684 685 else call com_err_ (code, me, "^[Res^;S^]etting ^a switch on ^a.", ^P_switch_value, key_name, 686 pathname_ (P_dn, P_en)); 687 end; 688 689 some_sw = "1"b; 690 return; 691 692 end set_whichever; 693 694 set_perprocess: 695 proc (P_dn, P_en, P_switch_value, P_code); 696 697 /* Sets the perprocess_static switch of an object segment, which is in the segment itself */ 698 699 dcl (P_dn, P_en) char (*); 700 dcl P_switch_value bit (1) aligned; 701 dcl P_code fixed bin (35); 702 3 1 /* BEGIN INCLUDE FILE ... object_map.incl.pl1 */ 3 2 /* coded February 8, 1972 by Michael J. Spier */ 3 3 /* Last modified on 05/20/72 at 13:29:38 by R F Mabee. */ 3 4 /* Made to agree with Spier's document on 20 May 1972 by R F Mabee. */ 3 5 /* modified on 6 May 1972 by R F Mabee to add map_ptr at end of object map. */ 3 6 /* modified May, 1972 by M. Weaver */ 3 7 /* modified 5/75 by E. Wiatrowski and 6/75 by M. Weaver */ 3 8 /* modified 5/77 by M. Weaver to add perprocess_static bit */ 3 9 3 10 declare 1 object_map aligned based, /* Structure describing standard object map */ 3 11 3 12 2 decl_vers fixed bin, /* Version number of current structure format */ 3 13 2 identifier char (8) aligned, /* Must be the constant "obj_map" */ 3 14 2 text_offset bit (18) unaligned, /* Offset relative to base of object segment of base of text section */ 3 15 2 text_length bit (18) unaligned, /* Length in words of text section */ 3 16 2 definition_offset bit (18) unaligned, /* Offset relative to base of object seg of base of definition section */ 3 17 2 definition_length bit (18) unaligned, /* Length in words of definition section */ 3 18 2 linkage_offset bit (18) unaligned, /* Offset relative to base of object seg of base of linkage section */ 3 19 2 linkage_length bit (18) unaligned, /* Length in words of linkage section */ 3 20 2 static_offset bit (18) unaligned, /* Offset relative to base of obj seg of static section */ 3 21 2 static_length bit (18) unaligned, /* Length in words of static section */ 3 22 2 symbol_offset bit (18) unaligned, /* Offset relative to base of object seg of base of symbol section */ 3 23 2 symbol_length bit (18) unaligned, /* Length in words of symbol section */ 3 24 2 break_map_offset bit (18) unaligned, /* Offset relative to base of object seg of base of break map */ 3 25 2 break_map_length bit (18) unaligned, /* Length in words of break map */ 3 26 2 entry_bound bit (18) unaligned, /* Offset in text of last gate entry */ 3 27 2 text_link_offset bit (18) unaligned, /* Offset of first text-embedded link */ 3 28 2 format aligned, /* Word containing bit flags about object type */ 3 29 3 bound bit (1) unaligned, /* On if segment is bound */ 3 30 3 relocatable bit (1) unaligned, /* On if segment has relocation info in its first symbol block */ 3 31 3 procedure bit (1) unaligned, /* On if segment is an executable object program */ 3 32 3 standard bit (1) unaligned, /* On if segment is in standard format (more than just standard map) */ 3 33 3 separate_static bit(1) unaligned, /* On if static is a separate section from linkage */ 3 34 3 links_in_text bit (1) unaligned, /* On if there are text-embedded links */ 3 35 3 perprocess_static bit (1) unaligned, /* On if static is not to be per run unit */ 3 36 3 unused bit (29) unaligned; /* Reserved */ 3 37 3 38 declare map_ptr bit(18) aligned based; /* Last word of the segment. It points to the base of the object map. */ 3 39 3 40 declare object_map_version_2 fixed bin static init(2); 3 41 3 42 /* END INCLUDE FILE ... object_map.incl.pl1 */ 703 704 705 dcl 1 segment_acl (1) aligned,/* to force access to Person.Project.a */ 706 2 access_name char (32), 707 2 mode bit (36), 708 2 pad bit (36), 709 2 status_code fixed bin (35); 710 711 dcl saved_mode bit (36); 712 dcl delete_acl_sw bit (1); 713 dcl (last_word_ptr, object_map_ptr, seg_ptr) 714 ptr; 715 dcl object_map_index fixed bin; 716 dcl word_count fixed bin (18); 717 dcl bit_count fixed bin (24); 718 dcl code fixed bin (35); 719 720 seg_ptr = null; 721 delete_acl_sw = "0"b; 722 723 on cleanup call sp_cleanup; 724 725 call hcs_$initiate_count (P_dn, P_en, "", bit_count, 0, seg_ptr, P_code); 726 if seg_ptr = null 727 then do; 728 call com_err_ (code, me, "^a", pathname_ (P_dn, P_en)); 729 return; 730 end; 731 732 if bit_count = 0 733 then do; 734 BAD_OBJECT: 735 if ^star_sw 736 then call com_err_ (0, me, "Obsolete or non-object segment ^a", pathname_ (P_dn, P_en)); 737 P_code = 0; 738 go to SP_RETURN; 739 end; 740 741 word_count = divide (bit_count + 35, 36, 18, 0); 742 last_word_ptr = addrel (seg_ptr, word_count - 1); 743 744 object_map_index = fixed (last_word_ptr -> map_ptr, 18); 745 if object_map_index <= 0 | object_map_index > word_count 746 then go to BAD_OBJECT; 747 748 object_map_ptr = addrel (seg_ptr, last_word_ptr -> map_ptr); 749 if object_map_ptr -> object_map.identifier ^= "obj_map " 750 then go to BAD_OBJECT; 751 752 if object_map_ptr -> object_map.decl_vers ^= 2 753 then go to BAD_OBJECT; /* obsolete version */ 754 755 /* Force write access if necessary */ 756 757 segment_acl (1).access_name = get_group_id_ (); /* Person.Project.a */ 758 759 call hcs_$list_acl (P_dn, P_en, null, null, addr (segment_acl), 1, P_code); 760 if P_code ^= 0 761 then do; 762 call com_err_ (P_code, me, "^a", pathname_ (P_dn, P_en)); 763 go to SP_RETURN; 764 end; 765 766 if segment_acl (1).status_code ^= 0 767 then delete_acl_sw = "1"b; /* no such previous ACL term */ 768 else do; 769 delete_acl_sw = "0"b; /* have to restore previous access */ 770 saved_mode = segment_acl (1).mode; 771 end; 772 773 segment_acl (1).mode = "101"b; /* set rw */ 774 775 call hcs_$add_acl_entries (P_dn, P_en, addr (segment_acl), 1, P_code); 776 if P_code ^= 0 777 then do; 778 call com_err_ (P_code, me, "^a", pathname_ (P_dn, P_en)); 779 go to SP_RETURN; 780 end; 781 782 on cleanup 783 begin; 784 call restore_acl; 785 call sp_cleanup; 786 end; 787 788 object_map_ptr -> object_map.format.perprocess_static = P_switch_value; 789 790 call restore_acl; 791 792 SP_RETURN: 793 call sp_cleanup; 794 795 return; 796 797 798 restore_acl: 799 proc; 800 801 if delete_acl_sw 802 then call hcs_$delete_acl_entries (P_dn, P_en, addr (segment_acl), 1, code); 803 else do; 804 segment_acl (1).mode = saved_mode; /* restore previous access */ 805 call hcs_$add_acl_entries (P_dn, P_en, addr (segment_acl), 1, code); 806 end; 807 808 end restore_acl; 809 810 811 sp_cleanup: 812 proc; 813 814 if seg_ptr ^= null 815 then call hcs_$terminate_noname (seg_ptr, code); 816 817 end sp_cleanup; 818 819 end set_perprocess; 820 821 /* SAVED FOR LATER SHAPING UP 822* set_soos: proc (P_dn, P_en, P_switch_value, P_code); 823* 824* /* Turns soos on, or tests for consistent AIM attributes and turns soos off 825* 826* dcl (P_dn, P_en) char (*); 827* dcl P_switch_value bit (1); 828* dcl P_code fixed bin (35); 829* 830* dcl (code, old_dir_priv, old_soos_priv) fixed bin (35); 831* 832* on linkage_error begin; 833* call com_err_ (error_table_$moderr, me, "system_privilege_."); 834* go to RETURN; 835* end; 836* 837* if P_switch_value = "1"b then call system_privilege_$soos_on (P_dn, P_en, P_code); 838* 839* else do; 840* 841* old_dir_priv, old_soos_priv = 1; /* don't restore privileges unless set 842* 843* on cleanup call clean_up_privs; 844* 845* call system_privilege_$dir_priv_on (old_dir_priv); /* ensure necessary privileges 846* call system_privilege_$soos_priv_on (old_soos_priv); 847* 848* call system_privilege_$check_mode_reset (P_dn, P_en, P_code); 849* /* this entry point only succeeds if the branch's 850* AIM attributes are consistent 851* if P_code ^= 0 then call com_err_ (P_code, me, "^a", pathname_ (P_dn, P_en)); 852* end; 853* 854* 855* clean_up_privs: proc; 856* 857* if old_dir_priv = 0 then call system_privilege_$dir_priv_off (code); 858* if old_soos_priv = 0 then call system_privilege_$soos_priv_off (code); 859* 860* end clean_up_privs; 861* 862* 863* end set_soos; 864**/ 865 866 clean_up: 867 proc; 868 869 if area_ptr = null 870 then return; 871 if entries_ptr ^= null 872 then free entries in (area); 873 if names_ptr ^= null 874 then free names in (area); 875 return; 876 877 end clean_up; 878 879 880 end switch_on; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 08/23/88 0814.4 switch_on.pl1 >spec>install>1091>switch_on.pl1 471 1 03/05/85 1807.3 suffix_info.incl.pl1 >ldd>include>suffix_info.incl.pl1 472 2 10/14/83 1606.7 copy_flags.incl.pl1 >ldd>include>copy_flags.incl.pl1 703 3 08/05/77 1022.5 object_map.incl.pl1 >ldd>include>object_map.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. BRANCHES_AND_LINKS constant fixed bin(17,0) initial dcl 83 ref 350 BRANCHES_ONLY 000435 constant fixed bin(17,0) initial dcl 82 set ref 352 533* DIR_ALLOWED 006716 constant bit(8) initial dcl 76 ref 548 583 DIR_TYPE constant fixed bin(17,0) initial dcl 85 ref 367 467 583 EXTENDED_TYPE constant fixed bin(17,0) initial dcl 85 ref 378 448 580 662 FS_OBJECT_TYPE_DM_FILE 000011 constant char(32) initial packed unaligned dcl 1-50 ref 448 GENERAL_SET constant fixed bin(17,0) initial dcl 78 ref 580 LINK_TYPE constant fixed bin(17,0) initial dcl 85 ref 316 MSF_TYPE constant fixed bin(17,0) initial dcl 85 ref 467 513 548 NO_CHASE 000450 constant fixed bin(1,0) initial dcl 80 set ref 458* P_code parameter fixed bin(35,0) dcl 501 in procedure "set_one" ref 493 P_code parameter fixed bin(35,0) dcl 701 in procedure "set_perprocess" set ref 694 725* 737* 759* 760 762* 775* 776 778* P_code parameter fixed bin(35,0) dcl 483 in procedure "resolve_link" set ref 475 485* 486 P_dn parameter char packed unaligned dcl 571 in procedure "set_whichever" set ref 566 585* 585* 595* 596* 596* 603* 604* 604* 613* 614* 614* 623* 624* 624* 631* 636* 637* 637* 643* 644* 644* 655* 656* 656* 670* 672* 682* 682* 685* 685* P_dn parameter char packed unaligned dcl 436 in procedure "get_type" set ref 431 446* 452* 452* 458* 463* 463* P_dn parameter char packed unaligned dcl 480 in procedure "resolve_link" set ref 475 485* P_dn parameter char packed unaligned dcl 699 in procedure "set_perprocess" set ref 694 725* 728* 728* 734* 734* 759* 762* 762* 775* 778* 778* 801* 805* P_dn parameter char packed unaligned dcl 498 in procedure "set_one" set ref 493 518* 518* 522 548* P_en parameter char packed unaligned dcl 480 in procedure "resolve_link" set ref 475 485* P_en parameter char packed unaligned dcl 436 in procedure "get_type" set ref 431 446* 452* 452* 458* 463* 463* P_en parameter char packed unaligned dcl 699 in procedure "set_perprocess" set ref 694 725* 728* 728* 734* 734* 759* 762* 762* 775* 778* 778* 801* 805* P_en parameter char packed unaligned dcl 498 in procedure "set_one" set ref 493 518* 518* 525 548* P_en parameter char packed unaligned dcl 571 in procedure "set_whichever" set ref 566 585* 585* 595* 596* 596* 603* 604* 604* 613* 614* 614* 623* 624* 624* 631* 636* 637* 637* 643* 644* 644* 655* 656* 656* 670* 672* 682* 682* 685* 685* P_key_index parameter fixed bin(17,0) dcl 572 in procedure "set_whichever" ref 566 583 591 677 P_key_index parameter fixed bin(17,0) dcl 500 in procedure "set_one" set ref 493 516 540* 548 548* P_switch_value parameter bit(1) dcl 499 in procedure "set_one" set ref 493 540* 548* P_switch_value parameter bit(1) dcl 573 in procedure "set_whichever" set ref 566 595 595 603 610 620 631* 636 643 655 670* 672* 685 P_switch_value parameter bit(1) dcl 700 in procedure "set_perprocess" ref 694 788 P_target_dn parameter char packed unaligned dcl 480 set ref 475 485* 489* P_target_en parameter char packed unaligned dcl 480 set ref 475 485* 489* P_type parameter fixed bin(17,0) dcl 500 in procedure "set_one" set ref 493 513 548 548* P_type parameter fixed bin(17,0) dcl 482 in procedure "resolve_link" set ref 475 489* P_type parameter fixed bin(17,0) dcl 572 in procedure "set_whichever" ref 566 580 583 SEG_TYPE constant fixed bin(17,0) initial dcl 85 ref 367 UNKNOWN_KEY constant fixed bin(17,0) initial dcl 78 ref 272 378 401 409 461 670 677 access_name 000100 automatic char(32) array level 2 dcl 705 set ref 757* addr builtin function dcl 167 ref 759 759 775 775 801 801 805 805 addrel builtin function dcl 167 ref 742 748 area based area(1024) dcl 115 ref 556 558 871 873 area_ptr 000306 automatic pointer dcl 117 set ref 236* 345 345* 356* 527 527* 533* 556 558 869 871 873 arg based char packed unaligned dcl 96 set ref 203 203 206 212 212 215 215 218 218 228* 243 243 245 248 290 294* 297* 303* 337* arg_count 000316 automatic fixed bin(17,0) dcl 120 set ref 187* 199 221 239 arg_len 000317 automatic fixed bin(17,0) dcl 120 set ref 201* 203 203 206 212 212 215 215 218 218 228 228 241* 243 243 245 248 290 294 294 297 297 303 303 337 337 arg_ptr 000310 automatic pointer dcl 117 set ref 201* 203 203 206 212 212 215 215 218 218 228 241* 243 243 245 248 290 294 297 303 337 bit_count 000126 automatic fixed bin(24,0) dcl 717 in procedure "set_perprocess" set ref 725* 732 741 bit_count 000355 automatic fixed bin(24,0) dcl 438 in procedure "get_type" set ref 458* 467 chase_arg_given_sw 000274 automatic bit(1) dcl 112 set ref 197* 203* 209* 316 chase_sw 000275 automatic bit(1) dcl 112 set ref 197* 203* 208* 316 350 392 check_star_name_$entry 000036 constant entry external dcl 138 ref 307 cleanup 000334 stack reference condition dcl 173 ref 237 531 723 782 code 000127 automatic fixed bin(35,0) dcl 718 in procedure "set_perprocess" set ref 728* 801* 805* 814* code 000100 automatic fixed bin(35,0) dcl 574 in procedure "set_whichever" set ref 578* 595* 596 596* 603* 604 604* 613* 614 614* 623* 624 624* 631* 636* 637 637* 643* 644 644* 655* 656 656* 670* 672* 674 677 682* 685* code 000105 automatic fixed bin(35,0) dcl 505 in procedure "set_one" set ref 511* 533* 535 code 000326 automatic fixed bin(35,0) dcl 122 in procedure "swn" set ref 187* 189 191* 201* 241* 294* 295 297* 307* 308 322* 324 324* 327* 332* 335 337* 356* 358 360* 381* 384 384 384 384 397* 399 404* 441* 446* 448 450 452* 458* 459 459 463* com_err_ 000032 constant entry external dcl 134 ref 191 223 228 268 297 303 316 327 337 360 404 409 412 452 461 463 518 585 596 604 614 624 637 644 651 656 665 682 685 728 734 762 778 com_err_$suppress_name 000034 constant entry external dcl 134 ref 422 component_name 000160 automatic char(32) packed unaligned dcl 508 set ref 538* 540* copy_flags based structure level 1 dcl 2-8 cu_$arg_count 000040 constant entry external dcl 139 ref 187 cu_$arg_ptr 000042 constant entry external dcl 140 ref 201 241 decl_vers based fixed bin(17,0) level 2 dcl 3-10 ref 752 delete_acl_sw 000114 automatic bit(1) packed unaligned dcl 712 set ref 721* 766* 769* 801 divide builtin function dcl 167 ref 741 dn 000100 automatic char(168) packed unaligned dcl 108 set ref 289* 294* 301 313* 316* 316* 322* 332* 356* 360* 360* 370 397* 404* 404* 412* 412* en 000224 automatic char(32) packed unaligned dcl 109 set ref 290* 294* 301 307* 313* 316* 316* 322* 332* 343 356* 360* 360* 395* 397* 404* 404* entries based structure array level 1 dcl 98 ref 556 871 entries_count 000104 automatic fixed bin(17,0) dcl 504 in procedure "set_one" set ref 533* 535 537 entries_count 000320 automatic fixed bin(17,0) dcl 120 in procedure "swn" set ref 356* 364 556 871 entries_ptr 000100 automatic pointer dcl 503 in procedure "set_one" set ref 529* 533* 538 540 556 556 entries_ptr 000312 automatic pointer dcl 117 in procedure "swn" set ref 236* 348* 356* 366 371 395 871 871 error_table_$argerr 000010 external static fixed bin(35,0) dcl 124 ref 677 error_table_$badopt 000012 external static fixed bin(35,0) dcl 125 set ref 228* error_table_$incorrect_access 000014 external static fixed bin(35,0) dcl 126 ref 384 error_table_$moderr 000016 external static fixed bin(35,0) dcl 127 set ref 651* error_table_$no_dir 000020 external static fixed bin(35,0) dcl 128 ref 384 error_table_$no_s_permission 000022 external static fixed bin(35,0) dcl 129 ref 384 459 error_table_$nomatch 000024 external static fixed bin(35,0) dcl 130 set ref 412* error_table_$not_a_branch 000026 external static fixed bin(35,0) dcl 131 set ref 316* error_table_$root 000030 external static fixed bin(35,0) dcl 132 set ref 303* expand_pathname_ 000044 constant entry external dcl 141 ref 294 fixed builtin function dcl 167 ref 595 595 744 force_no_type_sw 000276 automatic bit(1) dcl 112 set ref 197* 212* 215* 265 444 format 12 based structure level 2 dcl 3-10 fs_util_$get_type 000110 constant entry external dcl 162 ref 446 fs_util_$set_switch 000106 constant entry external dcl 161 ref 670 672 fs_util_type 000356 automatic char(32) packed unaligned dcl 439 set ref 442* 446* 448 448 get_group_id_ 000046 constant entry external dcl 142 ref 757 get_system_free_area_ 000050 constant entry external dcl 143 ref 345 527 get_wdir_ 000052 constant entry external dcl 144 ref 289 got_key 000277 automatic bit(1) dcl 112 set ref 235* 245 278* got_path 000300 automatic bit(1) dcl 112 set ref 235* 284* 420 hbound builtin function dcl 167 ref 249 253 257 262 hcs_$add_acl_entries 000054 constant entry external dcl 145 ref 775 805 hcs_$delete_acl_entries 000056 constant entry external dcl 146 ref 801 hcs_$get_link_target 000060 constant entry external dcl 147 ref 485 hcs_$initiate_count 000062 constant entry external dcl 148 ref 725 hcs_$list_acl 000064 constant entry external dcl 150 ref 759 hcs_$set_copysw 000066 constant entry external dcl 151 ref 595 hcs_$set_damaged_sw 000070 constant entry external dcl 152 ref 603 hcs_$set_safety_sw 000072 constant entry external dcl 153 ref 636 hcs_$set_synchronized_sw 000074 constant entry external dcl 154 ref 643 hcs_$set_volume_dump_switches 000076 constant entry external dcl 155 ref 613 623 hcs_$star_ 000100 constant entry external dcl 156 ref 356 533 hcs_$status_minf 000102 constant entry external dcl 158 ref 458 hcs_$terminate_noname 000104 constant entry external dcl 160 ref 814 i 000321 automatic fixed bin(17,0) dcl 120 set ref 199* 201* 220* 220 221* 239* 241* identifier 1 based char(8) level 2 dcl 3-10 ref 749 index builtin function dcl 167 ref 245 j 000322 automatic fixed bin(17,0) dcl 120 set ref 249* 249* 251 253* 253* 255 257* 257* 260 262* 262* 265 272* 277 364* 366 371 395* key_index 000323 automatic fixed bin(17,0) dcl 120 set ref 277* 324* 332* 378 381* 401 409 461 670 672 key_name 000234 automatic char(32) packed unaligned dcl 109 set ref 248* 249 253 257 262 268* 409* 461* 585* 665* 670* 682* 685* last_word_ptr 000116 automatic pointer dcl 713 set ref 742* 744 748 linkage_error 000000 stack reference condition dcl 174 ref 650 long_key 000321 constant char(32) initial array packed unaligned dcl 61 set ref 249 249 516 672* long_long_key 000121 constant char(32) initial array packed unaligned dcl 68 ref 257 257 map_ptr based bit(18) dcl 3-38 ref 744 748 me 000244 automatic char(32) packed unaligned dcl 109 set ref 176* 184* 191* 223* 228* 268* 297* 303* 316* 327* 337* 360* 404* 409* 412* 422* 422* 452* 461* 463* 518* 585* 596* 604* 614* 624* 637* 644* 651* 656* 665* 682* 685* 728* 734* 762* 778* mode 10 000100 automatic bit(36) array level 2 dcl 705 set ref 770 773* 804* msf_component_index 000170 automatic fixed bin(17,0) dcl 509 set ref 537* 538 540* msf_path 000106 automatic char(168) packed unaligned dcl 507 set ref 522* 523 523* 523 525* 525 533* 540* name_sw 000301 automatic bit(1) dcl 112 set ref 235* 243* 279* 286 288* names based char(32) array dcl 103 ref 371 395 538 558 873 names_ptr 000314 automatic pointer dcl 117 in procedure "swn" set ref 236* 348* 356* 371 395 873 873 names_ptr 000102 automatic pointer dcl 503 in procedure "set_one" set ref 529* 533* 538 558 558 ncvd_value 000101 automatic fixed bin(17,0) dcl 576 set ref 610* 612* 613* nindex 0(18) based fixed bin(17,0) array level 2 packed packed unaligned dcl 98 ref 371 395 538 nivd_value 000102 automatic fixed bin(17,0) dcl 576 set ref 620* 622* 623* null builtin function dcl 167 ref 236 345 348 527 529 556 558 720 726 759 759 759 759 814 869 871 873 object_map based structure level 1 dcl 3-10 object_map_index 000124 automatic fixed bin(17,0) dcl 715 set ref 744* 745 745 object_map_ptr 000120 automatic pointer dcl 713 set ref 748* 749 752 788 pathname_ 000112 constant entry external dcl 163 ref 316 316 327 327 360 360 404 404 412 412 452 452 463 463 518 518 585 585 596 596 604 604 614 614 624 624 637 637 644 644 656 656 682 682 685 685 728 728 734 734 762 762 778 778 perprocess_static 12(06) based bit(1) level 3 packed packed unaligned dcl 3-10 set ref 788* rtrim builtin function dcl 167 ref 523 525 saved_mode 000113 automatic bit(36) packed unaligned dcl 711 set ref 770* 804 seg_ptr 000122 automatic pointer dcl 713 set ref 720* 725* 726 742 748 814 814* segment_acl 000100 automatic structure array level 1 dcl 705 set ref 759 759 775 775 801 801 805 805 short_key 000221 constant char(32) initial array packed unaligned dcl 65 ref 253 253 short_long_key 000021 constant char(32) initial array packed unaligned dcl 73 ref 262 262 some_sw 000302 automatic bit(1) dcl 112 set ref 354* 409 593* 601* 608* 618* 629* 634* 641* 648* 689* star_en 000254 automatic char(32) packed unaligned dcl 109 set ref 343* 412* 412* star_sw 000303 automatic bit(1) dcl 112 set ref 310* 342* 409 585 665 677 734 star_type 000324 automatic fixed bin(17,0) dcl 120 set ref 350* 352* 356* status_code 12 000100 automatic fixed bin(35,0) array level 2 dcl 705 set ref 766 substr builtin function dcl 167 ref 203 448 548 583 switch_value 000304 automatic bit(1) dcl 112 set ref 177* 185* 324* 332* 381* system_privilege_$set_entry_audit_switch 000114 constant entry external dcl 164 ref 654 655 target_dn 000152 automatic char(168) packed unaligned dcl 108 set ref 322* 324* 327* 327* 370* 374* 381* 397* target_en 000264 automatic char(32) packed unaligned dcl 109 set ref 322* 324* 327* 327* 371* 374* 381* 397* test_linkage_entry 000330 automatic entry variable dcl 170 set ref 654* type based fixed bin(2,0) array level 2 in structure "entries" packed packed unsigned unaligned dcl 98 in procedure "swn" ref 366 540 type 000354 automatic fixed bin(17,0) dcl 437 in procedure "get_type" set ref 458* 467 469 type 000325 automatic fixed bin(17,0) dcl 120 in procedure "swn" set ref 313* 316 322* 324* 332* 366* 367 367 374* 378 381* 397* 662 word_count 000125 automatic fixed bin(18,0) dcl 716 set ref 741* 742 745 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. FS_OBJECT_TYPE_DIRECTORY internal static char(32) initial packed unaligned dcl 1-50 FS_OBJECT_TYPE_LINK internal static char(32) initial packed unaligned dcl 1-50 FS_OBJECT_TYPE_MSF internal static char(32) initial packed unaligned dcl 1-50 FS_OBJECT_TYPE_SEGMENT internal static char(32) initial packed unaligned dcl 1-50 SUFFIX_INFO_VERSION_1 internal static char(8) initial packed unaligned dcl 1-29 SWITCH_LIST_VERSION_1 internal static char(8) initial packed unaligned dcl 1-48 alloc_switch_count automatic fixed bin(17,0) dcl 1-33 alloc_switch_name_count automatic fixed bin(17,0) dcl 1-33 object_map_version_2 internal static fixed bin(17,0) initial dcl 3-40 suffix_info based structure level 1 dcl 1-12 suffix_info_ptr automatic pointer dcl 1-10 switch_list based structure level 1 dcl 1-37 switch_list_ptr automatic pointer dcl 1-33 NAMES DECLARED BY EXPLICIT CONTEXT. BAD_OBJECT 005765 constant label dcl 734 ref 745 749 752 BRANCH 002324 constant label dcl 374 ref 399 COMMON 000732 constant label dcl 187 ref 178 LITERAL_NAME 001631 constant label dcl 310 ref 291 NEXT_ARG 002614 constant label dcl 414 ref 304 361 384 RETURN 002655 constant label dcl 426 ref 270 453 464 SET 000000 constant label array(9) dcl 593 ref 580 591 SP_RETURN 006433 constant label dcl 792 ref 738 763 779 clean_up 006576 constant entry internal dcl 866 ref 237 414 426 get_type 002662 constant entry internal dcl 431 ref 313 374 489 msf_cleanup 003773 constant entry internal dcl 553 ref 531 544 no_sys_priv 005260 constant label dcl 659 ref 652 resolve_link 003216 constant entry internal dcl 475 ref 322 397 restore_acl 006441 constant entry internal dcl 798 ref 784 790 set_one 003330 constant entry internal dcl 493 ref 324 332 381 set_perprocess 005572 constant entry internal dcl 694 ref 631 set_whichever 004020 constant entry internal dcl 566 ref 540 548 sp_cleanup 006552 constant entry internal dcl 811 ref 723 785 792 swf 000712 constant entry external dcl 180 switch_off 000721 constant entry external dcl 180 switch_on 000676 constant entry external dcl 34 swn 000667 constant entry external dcl 34 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 7470 7606 6721 7500 Length 10176 6721 116 354 546 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME swn 436 external procedure is an external procedure. on unit on line 237 64 on unit get_type internal procedure shares stack frame of external procedure swn. resolve_link internal procedure shares stack frame of external procedure swn. set_one 218 internal procedure enables or reverts conditions. on unit on line 531 64 on unit msf_cleanup 64 internal procedure is called by several nonquick procedures. set_whichever 194 internal procedure enables or reverts conditions. on unit on line 650 84 on unit set_perprocess 208 internal procedure enables or reverts conditions. on unit on line 723 64 on unit on unit on line 782 64 on unit restore_acl 90 internal procedure is called by several nonquick procedures. sp_cleanup 70 internal procedure is called by several nonquick procedures. clean_up 64 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME set_one 000100 entries_ptr set_one 000102 names_ptr set_one 000104 entries_count set_one 000105 code set_one 000106 msf_path set_one 000160 component_name set_one 000170 msf_component_index set_one set_perprocess 000100 segment_acl set_perprocess 000113 saved_mode set_perprocess 000114 delete_acl_sw set_perprocess 000116 last_word_ptr set_perprocess 000120 object_map_ptr set_perprocess 000122 seg_ptr set_perprocess 000124 object_map_index set_perprocess 000125 word_count set_perprocess 000126 bit_count set_perprocess 000127 code set_perprocess set_whichever 000100 code set_whichever 000101 ncvd_value set_whichever 000102 nivd_value set_whichever swn 000100 dn swn 000152 target_dn swn 000224 en swn 000234 key_name swn 000244 me swn 000254 star_en swn 000264 target_en swn 000274 chase_arg_given_sw swn 000275 chase_sw swn 000276 force_no_type_sw swn 000277 got_key swn 000300 got_path swn 000301 name_sw swn 000302 some_sw swn 000303 star_sw swn 000304 switch_value swn 000306 area_ptr swn 000310 arg_ptr swn 000312 entries_ptr swn 000314 names_ptr swn 000316 arg_count swn 000317 arg_len swn 000320 entries_count swn 000321 i swn 000322 j swn 000323 key_index swn 000324 star_type swn 000325 type swn 000326 code swn 000330 test_linkage_entry swn 000354 type get_type 000355 bit_count get_type 000356 fs_util_type get_type THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return_mac tra_ext_1 enable_op shorten_stack ext_entry int_entry int_entry_desc op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. check_star_name_$entry com_err_ com_err_$suppress_name cu_$arg_count cu_$arg_ptr expand_pathname_ fs_util_$get_type fs_util_$set_switch get_group_id_ get_system_free_area_ get_wdir_ hcs_$add_acl_entries hcs_$delete_acl_entries hcs_$get_link_target hcs_$initiate_count hcs_$list_acl hcs_$set_copysw hcs_$set_damaged_sw hcs_$set_safety_sw hcs_$set_synchronized_sw hcs_$set_volume_dump_switches hcs_$star_ hcs_$status_minf hcs_$terminate_noname pathname_ system_privilege_$set_entry_audit_switch THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$argerr error_table_$badopt error_table_$incorrect_access error_table_$moderr error_table_$no_dir error_table_$no_s_permission error_table_$nomatch error_table_$not_a_branch error_table_$root LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 34 000666 176 000703 177 000706 178 000710 180 000711 184 000726 185 000731 187 000732 189 000743 191 000745 192 000762 197 000763 199 000766 201 000775 203 001012 206 001030 208 001034 209 001035 210 001037 212 001040 215 001053 218 001065 220 001075 221 001076 223 001101 224 001126 226 001127 228 001130 229 001162 231 001163 235 001165 236 001170 237 001174 239 001216 241 001225 243 001242 245 001257 248 001273 249 001276 250 001311 251 001314 253 001316 254 001331 255 001334 257 001336 259 001351 260 001354 262 001356 264 001371 265 001374 268 001400 270 001430 272 001431 277 001433 278 001434 279 001436 280 001437 284 001440 286 001442 288 001444 289 001445 290 001454 291 001461 294 001462 295 001512 297 001514 298 001546 301 001547 303 001557 304 001611 307 001612 308 001627 310 001631 313 001632 316 001635 322 001713 324 001716 327 001754 330 002027 332 002030 333 002063 335 002064 337 002066 338 002120 342 002121 343 002123 345 002126 348 002141 350 002144 352 002151 354 002153 356 002154 358 002216 360 002220 361 002267 364 002270 366 002277 367 002303 370 002307 371 002312 374 002324 378 002327 381 002336 384 002371 390 002402 392 002403 395 002405 397 002417 399 002422 401 002424 404 002430 407 002503 409 002505 412 002545 414 002614 418 002620 420 002622 422 002624 423 002654 426 002655 429 002661 431 002662 441 002700 442 002701 444 002704 446 002706 448 002735 450 002753 452 002755 453 003027 458 003030 459 003067 461 003074 463 003127 464 003200 467 003201 469 003212 475 003216 485 003246 486 003301 489 003305 491 003326 493 003327 511 003350 513 003351 516 003355 518 003364 519 003436 522 003437 523 003444 525 003476 527 003531 529 003545 531 003550 533 003572 535 003637 537 003643 538 003651 540 003663 542 003720 544 003722 548 003726 551 003771 553 003772 556 004000 558 004007 561 004016 566 004017 578 004040 580 004041 583 004047 585 004057 588 004137 591 004140 593 004142 595 004145 596 004174 598 004251 601 004252 603 004255 604 004304 606 004361 608 004362 610 004365 612 004373 613 004375 614 004425 616 004502 618 004503 620 004506 622 004514 623 004516 624 004546 627 004623 629 004624 631 004627 632 004654 634 004655 636 004660 637 004707 639 004764 641 004765 643 004770 644 005017 646 005074 648 005075 650 005100 651 005114 652 005141 654 005144 655 005152 656 005203 659 005260 662 005261 665 005265 667 005316 670 005317 672 005353 674 005404 677 005406 682 005420 685 005477 689 005565 690 005570 694 005571 720 005612 721 005614 723 005615 725 005637 726 005703 728 005707 729 005762 732 005763 734 005765 737 006045 738 006047 741 006050 742 006053 744 006057 745 006062 748 006066 749 006072 752 006076 757 006101 759 006113 760 006163 762 006166 763 006241 766 006242 769 006247 770 006250 773 006252 775 006254 776 006312 778 006315 779 006370 782 006371 784 006405 785 006412 786 006417 788 006420 790 006427 792 006433 795 006437 798 006440 801 006446 804 006510 805 006512 808 006550 811 006551 814 006557 817 006574 866 006575 869 006603 871 006610 873 006616 875 006625 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved