init_branches.pl1 11/11/89 1139.1r w 11/11/89 0800.0 209070 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ init_branches: procedure; /* init_branches is called during system initialization to create directories and branches for all segments already loaded. The AST entries for these segments are linked to the AST entries of their parents and the newly created branches. Last Modified: (Date and Reason) 12/27/84 by Keith Loepere for pdd dir_quota. 10/19/84 by Keith Loepere to set soos on old >sl1. 6/2/82 by J. Bongiovanni to remove restriction of >sl1 to RPV, save UID of >sl1 and >pdd in active_hardcore_data 3/82 BIM to unalign strings in call to asd_ 3/82 CAH for salvaging of dirs and recreating >sl1 04/22/81, WOS, for ADP SDWs 04/19/81, W. Olin Sibert, to stop maintaining aste.ic May 1978 by T. Casey to set initial quota of >pdd to largest possible value. 6/23/76 by B. Greenberg for reverse-deciduous >online_salvager_output 2/24/76 by R. Bratt to set per-process-sw in >pdd 4/24/75, 11/4/75 by B. Greenberg for NSS 741115 by PG to add name sl1 to >system_library_1. 740821 by PG to remove status permission on >pdd and >pdd>!zzzzzzzbBBBBBB to *.*.* 03/74 by Greenberg to remove hardcore gate kludge in favor of a real mechanism. 02/74 by E Stone to set the max length of segments created during system initialization. 10/73 by Steve Webber to add KLUDGE for hardcore gate entry bounds. 09/03/71 by Richard H. Gumpertz for page multi-level USAGE: call init_branches; DOCUMENTED IN: AN70 */ dcl (ntp, segp, pastep) ptr, relp bit (18) aligned, write_lock bit (36) aligned, (fi, i, pddq) fixed bin, ustr char (15), (code, ercode) fixed bin (35), ename char (32), next_astep ptr, rb (3) fixed bin (3), correct_max_length fixed bin (9), pds$process_group_id char (32) aligned ext, pds$ ext, dseg$ (0:4095) fixed bin (71) external static, ( slt$, name_table$ ) fixed bin ext; dcl 1 sdwi aligned like sdw_info automatic; dcl zzBB char (15) static options (constant) init ("!zzzzzzzbBBBBBB"); /* From Heb., "Directory of Flies" */ dcl No_daemon bit (1) aligned static options (constant) init ("1"b); /* Don't put *.SysDaemon on ACL */ /* Name of Initializer's Pdir */ dcl ( error_table_$noentry, error_table_$namedup ) fixed bin (35) external static, active_hardcore_data$sl1_uid bit (36) aligned ext, active_hardcore_data$pdd_uid bit (36) aligned ext, active_hardcore_data$pdir_quota fixed bin ext, active_hardcore_data$pdir_dir_quota fixed bin ext; dcl pvt$rlv_needs_salv bit (1) aligned external; dcl 1 dir_acl (2) aligned like directory_acl_entry; dcl 1 del_acl (1) aligned like delete_acl_entry; dcl 1 branch aligned like status_branch; dcl update_vtoce entry (ptr), thread$out ext entry (ptr, bit (18)), search_ast$hash_in entry (ptr), quota$dqset entry (char (*), fixed bin, fixed bin (35)), quota$dqmove entry (char (*), char (*), fixed bin, fixed bin (35)), quota$qset entry (char (*), fixed bin, fixed bin (35)), quota$qmove entry (char (*), char (*), fixed bin, fixed bin (35)), get_ptrs_$given_segno ext entry (fixed bin (18)) returns (ptr), sum$getbranch_root_my entry (ptr, bit (36) aligned, ptr, fixed bin (35)), asd_$del_sentries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)), asd_$replace_dall entry (char (*), char (*), ptr, fixed bin, bit (1) aligned, fixed bin (35)), unique_chars_ entry (bit (*)) returns (char (15)), append$branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin (3), char (*), fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35)), sdw_util_$dissect entry (pointer, pointer), syserr entry options (variable), syserr$error_code entry options (variable), (addr, baseno, binary, bin, bit, divide, fixed, max, null, ptr, rel, rtrim) builtin, lock$dir_unlock ext entry (ptr), chname$cfile entry (char (*), char (*), char (*), char (*), fixed bin (35)), get_ptrs_$given_astep entry (ptr, fixed bin (71)), initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35)), make_branches entry (ptr, ptr, fixed bin (24), ptr, (3) fixed bin (3), bit (3), fixed bin (35)), set$max_length_path entry (char (*), char (*), fixed bin (19), fixed bin (35)), status_$long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)), terminate_$teseg entry (ptr, fixed bin, fixed bin (35)); dcl salvager$dir_salv_boot entry (char (*)); /* Rename the previous instance of process_dir_dir. This allows the old one to be deleted without regard to name conflicts, and gives the Initializer a clean slate in the new zzBB. */ ustr = unique_chars_ (""b); /* Make up some stuff */ call chname$cfile (">", "process_dir_dir", "process_dir_dir", "process_dir_dir." || ustr, code); /* rename long name */ if (code ^= 0) & (code ^= error_table_$noentry) then call syserr$error_code (CRASH, code, "init_branches: renaming process_dir_dir:"); call chname$cfile (">", "pdd", "pdd", "pdd." || ustr, code); /* drop the short name if there */ if (code ^= 0) & (code ^= error_table_$noentry) then call syserr$error_code (CRASH, code, "init_branches: renaming old pdd:"); rb (*) = 7; dir_acl (1).access_name = pds$process_group_id; dir_acl (1).mode = SMA_ACCESS; /* sma for initializer */ /* Make a new process_dir_dir */ call append$branchx (">", "process_dir_dir", SMA_ACCESS_BIN, rb, (pds$process_group_id), 1, 0, 0, code); if code ^= 0 then call syserr$error_code (CRASH, code, "init_branches: unable to make process_dir_dir:"); call chname$cfile (">", "process_dir_dir", "", "pdd", ercode); /* add name pdd to process_dir_dir */ if ercode ^= 0 then call syserr$error_code (ANNOUNCE, ercode, "init_branches: couldn't add name pdd to process_dir_dir:"); /* now force on per-process-sw */ call initiate (">", "process_dir_dir", "", 0, 1, dp, code); if code ^= 0 then call syserr$error_code (CRASH, code, "init_branches: unable to initiate >pdd:"); dp -> dir.per_process_sw = "1"b; /* yeh, i know i dont have it locked */ active_hardcore_data$pdd_uid = dp -> dir.uid; pddq = 131071; /* give >pdd largest possible quota (2**17-1), to start with; answering service must keep track of it, and set it back up higher if it is in danger of running out because of lots of processes */ call quota$qset (">process_dir_dir", pddq, code); /* give PDD quota (makes it terminal) */ if code ^= 0 then call syserr$error_code (ANNOUNCE, code, "init_branches: couldn't set quota on >pdd to ^d ", pddq); call quota$dqset (">process_dir_dir", pddq, code);/* give PDD quota (makes it terminal) */ if code ^= 0 then call syserr$error_code (ANNOUNCE, code, "init_branches: couldn't set dir quota on >pdd to ^d ", pddq); /* Create >system_library_1 */ ename = ""; /* name to set soos on */ call chname$cfile (">", "system_library_1", "system_library_1", "system_library_1." || ustr, code); /* rename the old one */ if code = 0 then ename = "system_library_1." || ustr; else if code ^= error_table_$noentry then call syserr$error_code (CRASH, code, "init_branches: Renaming >system_library_1."); call chname$cfile (">", "sl1", "sl1", "sl1." || ustr, code); if code = 0 then ename = "sl1." || ustr; else if code ^= error_table_$noentry then call syserr$error_code (CRASH, code, "init_branches: Renaming >sl1."); if ename ^= "" then do; call dc_find$obj_status_write_priv (">", ename, DC_FIND_NO_CHASE, FS_OBJ_SOOS_MOD, ep, code); if code ^= 0 then call syserr$error_code (CRASH, code, "init_branches: Setting security_oosw for old >system_library_1."); ep -> entry.security_oosw = "1"b; call dc_find$finished (ptr (ep, 0), DC_FIND_UNLOCK_DIR); end; call append$branchx (">", "system_library_1", SMA_ACCESS_BIN, rb, (pds$process_group_id), 1, 0, 0, code); if code ^= 0 then call syserr$error_code (CRASH, code, "init_branches: unable to make >system_library_1:"); /* give everyone access to >system_library_1 */ dir_acl (2).access_name = "*.*.*"; dir_acl (2).mode = S_ACCESS; /* s to all */ call asd_$replace_dall (">", "system_library_1", addr (dir_acl), 2, No_daemon, ercode); if ercode ^= 0 then call syserr$error_code (ANNOUNCE, ercode, "init_branches: error in replacing acl of >sl1."); /* Add name "sl1" to "system_library_1" */ call chname$cfile (">", "system_library_1", "", "sl1", ercode); if ercode ^= 0 then call syserr$error_code (ANNOUNCE, ercode, "init_branches: couldn't add name sl1 to system_library_1:"); /* Save off the unique ID of >sl1 */ call initiate (">", "sl1", "", 0, 1, dp, code); if code ^= 0 then call syserr$error_code (CRASH, code, "init_branches: unable to initiate >sl1"); active_hardcore_data$sl1_uid = dp -> dir.uid; /* Create a branch for every segment in the SLT which needs one */ sltp = addr (slt$); /* Pointer to the SLT. */ ntp = addr (name_table$); /* Pointer to names segment. */ sstp = addr (sst_seg$); /* Pointer to SST. */ write_lock = "1"b; /* directories will be locked for write */ do fi = 0 to 3; /* loop through all AST lists */ relp = sstp -> sst.ausedp (fi); /* Rel. pointer to start of circular list. */ if relp ^= "0"b then do; /* Do for all segs. on the list. */ astep = ptr (sstp, relp); /* Pointer to first entry. */ back: next_astep = ptr (astep, aste.fp); /* I might just unthread this one */ if astep -> aste.usedf & /* if entry is free skip it */ astep -> aste.hc_sdw then do; /* We only want prodigy of make_sdw */ i = fixed (astep -> aste.strp, 18); /* segno left for us by make_sdw */ astep -> aste.strp = ""b;/* zero strp field so that legitimate trailers can be made */ sltep = addr (sltp -> slt.seg (i)); /* Pointer to SLT entry. */ /* Here we mask off the P bit, since append is not interested. */ call create_branch (ptr (ntp, sltep -> slte.path_ptr), ptr (ntp, sltep -> slte.names_ptr), sltep, bit (sltep -> slte.access, 3), segp, correct_max_length); /* Call to set up segment. */ call sum$getbranch_root_my (segp, write_lock, ep, ercode); /* get pointer to directory */ if ercode ^= 0 then call syserr$error_code (CRASH, ercode, "init_branches: getting dir entry pointer:"); dp = ptr (ep, 0); /* Generate pointer to directory. */ pastep = get_ptrs_$given_segno (fixed (baseno (dp), 18)); /* Get parent astep */ if pastep = null then call syserr (CRASH, "init_branches: Mysterious directory deactivation "); astep -> aste.par_astep = rel (pastep); /* Thread active to father */ astep -> aste.infl = pastep -> aste.infp; /* thread into inferior list */ pastep -> aste.infp = rel (astep); /* ditto */ /* it is ok to touch the parent dir here - we have assured its activity via the ic field and infl thread */ astep -> aste.per_process = ep -> entry.per_process_sw; /* Set per-process sw */ astep -> aste.msl = bit (correct_max_length, 9); /* take what i_b$b left */ astep -> aste.uid = ep -> entry.uid; /* Get uid into aste, so that segfault can find it. */ call thread$out (astep, sst.ausedp (fixed (aste.ptsi, 2))); /* No need to have him threaded. */ call search_ast$hash_in (astep); /* Make aste locatable */ astep -> aste.vtocx = ep -> entry.vtocx; /* Set up for update_vtoce */ call sdw_util_$dissect (addr (dseg$ (i)), addr (sdwi)); /* Set entrypoint bound, etc. */ ep -> entrypt_sw = (sdwi.gate_entry_bound > 0); if sdwi.gate_entry_bound > 0 then ep -> entrypt_bound = bit (binary (sdwi.gate_entry_bound - 1, 14), 14); else ep -> entrypt_bound = ""b; nm_astep = astep; /* update sstnt */ temp_entry_name = (addr (ep -> entry.primary_name) -> names.name); %include make_sstnt_entry; call update_vtoce (astep); /* Update the vtoc, get seg ctl working here */ call lock$dir_unlock (dp); /* Unlock the directory now. */ call terminate_$teseg (segp, 0, ercode); /* remove seg. from KST. */ if ercode ^= 0 then call syserr$error_code (CRASH, ercode, "init_branches: error from terminate_:"); end; astep = next_astep; /* Bump ptr to next AST */ if rel (astep) ^= relp then go to back; /* Go back for more. */ end; end; /* Now find the ASTE for >pdd, and turn on aste.per_process, so that activate can turn it on for sons activated off of that. */ astep = get_ptrs_$given_segno (fixed (baseno (addr (pds$)), 18)); /* I K_N_O_W_ that pds is in >pdd>zzz... */ astep = ptr (sstp, astep -> aste.par_astep); /* Now this is >pdd>!zzz..... */ astep -> aste.per_process = "1"b; /* activate won't do this for me */ ptr (sstp, astep -> aste.par_astep) -> aste.per_process = "1"b; /* do this for >pdd */ do astep = ptr (sstp, astep -> aste.infp) /* Walk the sons of zzzzzbBBBBB */ repeat ptr (sstp, astep -> aste.infl) while (astep ^= sstp); astep -> aste.per_process = "1"b; end; call set_ml ("slt"); /* special case setting max length of slt and name table */ call set_ml ("name_table"); /* since the lengths in their SLTEs are not accurate */ call quota$qmove (">process_dir_dir", zzBB, active_hardcore_data$pdir_quota, code); if code ^= 0 then call syserr$error_code (ANNOUNCE, code, "init_branches: quotas for pdir:"); call quota$dqmove (">process_dir_dir", zzBB, active_hardcore_data$pdir_dir_quota, code); if code ^= 0 then call syserr$error_code (ANNOUNCE, code, "init_branches: dir quotas for pdir:"); call asd_$replace_dall (">", "process_dir_dir", addr (dir_acl), 1, No_daemon, ercode); if ercode ^= 0 then call syserr$error_code (ANNOUNCE, ercode, "init_branches: replacing >pdd acl:"); /* Give Initializer access to its own process directory. */ call asd_$replace_dall (">process_dir_dir", zzBB, addr (dir_acl), 1, No_daemon, ercode); if ercode ^= 0 then call syserr$error_code (ANNOUNCE, ercode, "init_branches: replacing acl of >pdd for Initializer:"); /* create >dumps and set access */ rb (1), rb (2), rb (3) = 7; call append$branchx (">", "dumps", A_ACCESS_BIN, rb, "*.*.*", 1, 0, 0, code); if code ^= 0 then if code ^= error_table_$namedup then call syserr$error_code (BEEP, code, "init_branches: unable to append dumps directory."); else if pvt$rlv_needs_salv then call salvager$dir_salv_boot (">dumps"); return; /* Internal Procedure to set the max length based on the current length */ set_ml: proc (entry_name); dcl entry_name char (*); call status_$long (">system_library_1", entry_name, 0, addr (branch), (null), ercode); if ercode ^= 0 then call syserr$error_code (CRASH, ercode, "init_branches: From status_$long."); call set$max_length_path (">system_library_1", entry_name, branch.current_length * 1024, ercode); if ercode ^= 0 then call syserr$error_code (CRASH, ercode, "init_branches: From set$max_length: "); end set_ml; branch: entry (a_dirp, a_namep, a_sltep, a_access, a_segp); dcl (a_dirp, a_namep, a_sltep, a_segp) pointer; dcl a_access bit (3); call create_branch (a_dirp, a_namep, a_sltep, a_access, a_segp, (0)); /* max length unneeded for callers of this */ return; /* Subroutine to create and makeknown a branch */ /* USAGE: call init_branches$branch (dirp, namep, sltep, access, segp); 1) dirp ptr --- pointer the the directory name of the segment's parent 2) namep ptr --- pointer to the name of the segment 3) sltep ptr --- pointer to an SLT entry for the segment 4) access bit (3) --- an access field for the segment's SDW 5) segp ptr --- pointer to the segment (output) */ create_branch: procedure (pp, a_np, slep, access, sp, ml_to_return); /* Entry to append and makeknown a seg. */ dcl (pp, a_np, slep, sp) ptr, access bit (3); dcl rb (3) fixed bin (3); dcl pname char (168); dcl ename char (32); dcl bc fixed bin (24); dcl max_length fixed bin (19); dcl ml_to_return fixed bin (9); rb (1) = fixed (slep -> slte.ringbrack (1), 6); /* Copy ring brackets into fixed array. */ rb (2) = fixed (slep -> slte.ringbrack (2), 6); rb (3) = fixed (slep -> slte.ringbrack (3), 6); pname = pp -> path.name; /* PL/1 may be smarter than you think. */ ename = a_np -> segnam.names (1).name; /* Put name on even boundary */ if slep -> slte.acl_provided then aclp = addr (pp -> path.acls); else aclp = null; /* Generate pointer to ACL structure if present. */ bc = fixed (slep -> slte.bit_count, 24); call make_branches (pp, a_np, bc, aclp, rb, access, 0); /* If no acl was specified on the header/slte, then there is an acl like: rw *.SysDaemon.* mode-from-slte *.*.* So we delete the SysDaemon acl. */ if aclp = null then do; /* remove *.SysDaemon.* entry if acl was not replaced */ del_acl (1).access_name = "*.SysDaemon.*"; /* this acl is placed when the branch is created */ aclp = addr (del_acl); call asd_$del_sentries (pname, ename, aclp, 1, ercode); if ercode ^= 0 then call syserr$error_code (ANNOUNCE, ercode, "init_branches: $branch From asd_$del_sentries: "); end; call initiate (pname, ename, "", 0, 1, sp, ercode); if sp = null then call syserr$error_code (CRASH, ercode, "init_branches: error from initiate. "); max_length = max (divide (divide (bc + 35, 36, 19, 0) + 1023, 1024, 9, 0), fixed (slep -> slte.cur_length, 9), fixed (slep -> slte.max_length, 9)); /* Calculate max length */ if max_length = 0 then max_length = 4; /* As a last resort. */ call set$max_length_path (pname, ename, max_length * 1024, ercode); /* Prevent the segment from growing more than it should. */ if ercode ^= 0 then call syserr$error_code (CRASH, ercode, "init_branches: error from set$max_length "); ml_to_return = max_length; return; end create_branch; %page; %include acl_structures; %page; %include access_mode_values; %page; %include aste; %page; %include dc_find_dcls; %page; %include dir_entry; %page; %include dir_name; %page; %include dir_header; %page; %include fs_obj_access_codes; %page; %include sdw_info; %page; %include slt; %page; %include slte; %page; %include sst; %page; %include sstnt; %page; %include status_structures; %page; %include syserr_constants; %page; /* BEGIN MESSAGE DOCUMENTATION Message: init_branches: $branch From asd_: ERRORMESSAGE S: $info T: $init M: $err Initialization continues. A: $notify Message: init_branches: From set$max_length: ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: init_branches: From status_$long: ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: init_branches: Mysterious directory deactivation S: $crash T: $init M: $err A: $recover Message: init_branches: couldn't add name pdd to process_dir_dir: ERRORMESSAGE S: $info T: $init M: $err Initialization continues. Certain application programs may fail to work. A: $notify Message: init_branches: couldn't add name sl1 to system_library_1: ERRORMESSAGE S: $info T: $init M: $err Initialization continues. Certain application programs may fail to work. A: $notify Message: init_branches: couldn't set {dir}quota on >pdd to XXXX: ERRORMESSAGE S: $info T: $init M: $err Initialization continues. The answering service may encounter trouble in creating processes. A: $notify Message: init_branches: deleting old pdd: ERRORMESSAGE S: $crash T: $init M: The name pdd could not be removed from >pdd. $err A: $recover Message: init_branches: error from initiate. ERRORMESSAGE S: $crash T: $init M: A deciduous segment could not be made known. $err A: $recover Message: init_branches: error from terminate_: ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: init_branches: error from set$max_length ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: init_branches: error in adding acl of dumps: ERRORMESSAGE S: $info T: $init M: $err Initialization continues. The copy_fdump command may fail. The online salvager may fail to make stack and directory copies in >dumps. A: $notify Message: init_branches: error in replacing acl of >sl1. ERRORMESSAGE S: $info T: $init M: $err Initialization continues. User and daemon processes may malfunction. A: $notify Message: init_branches: getting dir entry pointer: ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: init_branches: {dir}quotas for pdir: ERRORMESSAGE S: $info T: $init M: $err Initialization continues. A: $notify Message: init_branches: renaming old pdd: ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: init_branches: renaming process_dir_dir: ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: init_branches: replacing >pdd acl: ERRORMESSAGE S: $info T: $init M: $err Initialization continues. A: $notify Message: init_branches: replacing acl of >pdd for Initializer: ERRORMESSAGE S: $info T: $init M: $err Initialization continues. A: $notify Message: init_branches: unable to append dumps directory. ERRORMESSAGE S: $beep T: $init M: $err Initialization continues. A: $notify Message: init_branches: unable to initiate >DIRNAME: ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: init_branches: unable to make >system_library_1: ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: init_branches: unable to make process_dir_dir: ERRORMESSAGE S: $crash T: $init M: $err A: $recover END MESSAGE DOCUMENTATION */ end init_branches;  load_system.pl1 11/11/89 1139.1rew 11/11/89 0801.1 72972 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-06-05,GJohnson), approve(86-06-05,MCR7387), audit(86-06-10,Martinson), install(86-07-11,MR12.0-1091): Correct error message documentation. END HISTORY COMMENTS */ /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */ /* LOAD_SYSTEM - Load Collection 3 from Multics System Tape. */ /* to v2pl1, RE Mullen, Nov 73 */ /* last modified 3/76 by N. I. Morris & S. H. Webber for new reconfig */ /* broken acl manipulations fixed BIM 3/82 */ /* Modified October 1983 by Keith Loepere for warm boot from disk. */ /* Modified January 1985 by Keith Loepere to set entry bounds on gates. */ load_system: procedure; /* Variables */ dcl access bit (3); dcl bitcount fixed bin (24); dcl count fixed bin (18); dcl cp ptr; dcl 1 cw aligned, /* Control word. */ ( 2 type fixed bin (18) uns, 2 count fixed bin (18) uns) unaligned; dcl 1 del_acl (1) aligned like delete_acl_entry; dcl dir_name char (168); dcl entry_bound fixed bin (14); dcl entryname char (32); dcl ercode fixed bin (35); dcl header_area (1000) fixed bin (35); dcl hp ptr; dcl lastword ptr; dcl mapword fixed bin (18); dcl must_delete_acl bit (1) aligned; dcl must_set_acl bit (1) aligned; dcl object_map_ptr ptr; dcl old_mode bit (36); dcl 1 seg_acl_struc aligned, 2 version fixed bin, 2 count fixed bin, 2 seg_acl (1) aligned like segment_acl_entry; dcl segp ptr; dcl wordcount fixed bin (18); /* Based */ dcl just_reference fixed bin (35) based; /* Misc */ dcl (addr, addrel, bit, divide, fixed, null, size, substr) builtin; /* External */ dcl pds$process_group_id ext static char (32) aligned; /* Entries */ dcl asd_$add_sentries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); dcl asd_$del_sentries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); dcl asd_$r_list_sall entry (char (*), char (*), ptr, ptr, fixed bin (35)); dcl disk_reader entry (ptr, fixed bin (18)); dcl init_branches$branch entry (ptr, ptr, ptr, bit (3), ptr); dcl set$entry_bound_ptr entry (ptr, fixed bin (14), fixed bin (35)); dcl syserr entry options (variable); dcl syserr$error_code entry options (variable); %page; hp = addr (header_area); /* Pointer to header area in stack. */ cp = addr (cw); /* Pointer to control word. */ seg_acl_struc.version = ACL_VERSION_1; seg_acl_struc.count = 1; seg_acl_struc.seg_acl (1).access_name = pds$process_group_id; loop: call disk_reader (cp, 1); /* Read in next control word from disk. */ if cw.type = 2 then do; /* Check for collection mark. */ call disk_reader (cp, 1); /* It is, get it out of the way. */ return; /* End of collection..quit. */ end; if cw.type ^= 0 then call syserr (CRASH, "load_system: illegal type in mst source"); count = cw.count; /* Copy count of header. */ if count > 1000 then call syserr (CRASH, "load_system: illegal header length in mst source"); call disk_reader (hp, count); /* Suck in the header. */ namep = addrel (hp, size (slte)); /* Set ptr to names */ pathp = addrel (namep, namep -> segnam.count * 9 + 1); /* ptr to path name */ access = bit (hp -> slte.access, 3); /* Set access from header, mask off P bit */ bitcount = hp -> slte_uns.bit_count; call init_branches$branch (pathp, namep, hp, access, segp); /* Go set up branch. */ dir_name = pathp -> path.name; entryname = namep -> segnam.names (1).name; must_set_acl, must_delete_acl = "0"b; old_mode = ""b; call asd_$r_list_sall (dir_name, entryname, null (), addr (seg_acl_struc), ercode); if ercode ^= 0 then call syserr$error_code (CRASH, ercode, "load_system: error from asd_$r_list_sall on ^a>^a.", dir_name, entryname); if seg_acl_struc.seg_acl (1).status_code = 0 then if ^substr (seg_acl_struc.seg_acl (1).mode, 3, 1) then do; /* no w */ must_set_acl = "1"b; must_delete_acl = "0"b; old_mode = seg_acl_struc.seg_acl (1).mode; end; else must_set_acl, must_delete_acl = "0"b; /* already have w */ else must_set_acl, must_delete_acl = "1"b; if must_set_acl then do; seg_acl_struc.seg_acl (1).mode = RW_ACCESS; call asd_$add_sentries (dir_name, entryname, addr (seg_acl_struc.seg_acl), 1, ercode); if ercode ^= 0 then asd_error: call syserr$error_code (CRASH, ercode, "load_system: error from asd_$add_sentries on ^a>^a.", dir_name, entryname); end; call disk_reader (cp, 1); /* Get next control word for seg. */ if cw.type ^= 1 then call syserr (CRASH, "load_system: illegal type in mst source"); call disk_reader (segp, (cw.count)); /* Suck in the segment. */ /* Find entry bound in object map; see if entry bound should be set. */ if bitcount = 0 then go to no_entry_bound; wordcount = divide (bitcount + 35, 36, 18, 0); lastword = addrel (segp, wordcount - 1); mapword = fixed (lastword -> map_ptr, 18); /* will want to see if value is in reasonable range */ if mapword <= 0 then go to no_entry_bound; /* last word won't point to new format map */ if mapword >= wordcount then go to no_entry_bound; object_map_ptr = addrel (segp, lastword -> map_ptr); /* get ptr to map */ if object_map_ptr -> object_map.identifier ^= "obj_map " then goto no_entry_bound; if object_map_ptr -> object_map.decl_vers ^= 2 then go to no_entry_bound; entry_bound = fixed (object_map_ptr -> object_map.entry_bound, 18); if entry_bound > 0 then do; call set$entry_bound_ptr (segp, entry_bound, ercode); if ercode ^= 0 then call syserr$error_code (CRASH, ercode, "load_system: error from set$entry_bound_ptr for ^a>^a.", dir_name, entryname); end; no_entry_bound: if must_set_acl & ^must_delete_acl then do; /* must_restore_acl ... */ seg_acl_struc.seg_acl (1).mode = old_mode; call asd_$add_sentries (dir_name, entryname, addr (seg_acl_struc.seg_acl), 1, ercode); if ercode ^= 0 then go to asd_error; end; if must_delete_acl then do; del_acl (1).access_name = pds$process_group_id; call asd_$del_sentries (dir_name, entryname, addr (del_acl), 1, ercode); if ercode ^= 0 then call syserr$error_code (CRASH, ercode, "load_system: error from asd_$delete_sentries for ^a>^a.", dir_name, entryname); end; ercode = segp -> just_reference; /* make it active again */ ercode = 0; go to loop; %page; %include access_mode_values; %page; %include acl_structures; %page; %include object_map; %page; %include slt; %page; %include slte; %page; %include syserr_constants; %page; /* BEGIN MESSAGE DOCUMENTATION Message: load_system: illegal type in mst source S: $crash T: $init M: $err A: $recover $boot_tape Message: load_system: error from asd_$add_sentries The system could not remove the write access it had set to load the contents of a segment from the mst source. S: $crash T: $init M: $err A: $recover $boot_tape Message: load_system: illegal header length in mst source S: $crash T: $init M: $err A: $recover $boot_tape Message: load_system: illegal type in mst source S: $crash T: $init M: $err A: $recover $boot_tape Message: load_system: error from set$entry_bound_ptr S: $crash T: $init M: $err A: $recover $boot_tape END MESSAGE DOCUMENTATION */ end;  make_branches.pl1 11/11/89 1139.1r w 11/11/89 0801.1 70776 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ make_branches: proc (pathp, namep, bitcnt, aclp, rb, access, dirsw); /* Modified 741115 by PG to turn off safety switch before trying to delete branch. */ /* Modified 751104 by BSG for NSS: to trek around deleting stuff on non-RPV volume */ /* Modified 3/82 BIM acl cleanup */ dcl bitcnt fixed bin (24), (pnl, pcnt, i, j) fixed bin (17), ercode fixed bin (35), (rb (3), nrb (3)) fixed bin (6), access bit (3), dirsw fixed bin (1), mode fixed bin (5); dcl 1 seg_access_string unaligned, 2 zero1 bit (1) unaligned, 2 rew bit (3) unaligned, 2 zero2 bit (1) unaligned; dcl 1 dir_access_string unaligned, 2 zero1 bit (1) unaligned, 2 s bit (1) unaligned, 2 zero2 bit (1) unaligned, 2 m bit (1) unaligned, 2 a bit (1) unaligned; dcl 1 dir_access_bit_string unaligned, 2 s bit (1) unaligned, 2 m bit (1) unaligned, 2 a bit (1) unaligned; dcl (error_table_$namedup, error_table_$noaccess) fixed bin (35) external; dcl error_table_$pvid_not_found fixed bin (35) external; dcl 1 nename aligned, /* name structure for recursive call */ 2 count fixed bin (17), 2 names, 3 size fixed, 3 name char (32) unaligned; dcl (addr, null, substr) builtin; dcl asd_$replace_sall entry (char (*), char (*), ptr, fixed bin, bit (1) aligned, fixed bin (35)), append$branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin (6), char (*), fixed bin (1), fixed bin, fixed bin (24), fixed bin (35)), chname$cfile entry (char (*), char (*), char (*), char (*), fixed bin (35)), delentry$dfile entry (char (*), char (*), fixed bin (35)), set$safety_sw_path entry (char (*), char (*), bit (1), fixed bin (35)), syserr ext entry options (variable), syserr$error_code entry options (variable), unique_chars_ entry (bit (*)) returns (char (15)); %include slt; %include access_mode_values; /* program */ if dirsw = 0 /* segment */ then do; unspec (seg_access_string) = ""b; seg_access_string.rew = access; mode = bin (string (seg_access_string), 5); end; else do; unspec (dir_access_string) = ""b; string (dir_access_bit_string) = access; dir_access_string = dir_access_bit_string, by name; mode = bin (string (dir_access_string), 5); end; rpt: pnl = pathp -> path.size; /* Grab length of pathname. */ call append$branchx (pathp -> path.name, namep -> segnam.names (1).name, mode, rb, "*.*.*", dirsw, 0, bitcnt, ercode); /* Try to append. */ if ercode ^= 0 then do; /* Check for errors. */ if ercode = error_table_$namedup then do; /* Name dup. */ call delete (pathp -> path.name, namep -> segnam.names (1).name); /* Go delete. */ go to rpt; /* Try again. */ end; else if ercode = error_table_$noaccess then do; /* See if dir. does not exist. */ do i = pnl to 1 by -1 while (substr (pathp -> path.name, i, 1) ^= ">"); end; if i = 1 then if substr (pathp -> path.name, 1, 1) ^= ">" then call syserr (1, "make_branches: bad path name ^a", pathp -> path.name); else pcnt = 1; else pcnt = i - 1; nename.names.name = substr (pathp -> path.name, i + 1, pnl - i); nrb (1), nrb (2), nrb (3) = 5; nename.count = 1; pathp -> path.size = pcnt; /* This KLUDGE is worthy of Charles Garman. */ call make_branches (pathp, addr (nename), 0, aclp, nrb, SMA_ACCESS, 1); pathp -> path.size = pnl; /* However, it was perpetrated by NIM. */ go to rpt; end; call syserr$error_code (1, ercode, "make_branches: error from append on ^a>^a:", pathp -> path.name, namep -> segnam.names (1).name); end; if aclp ^= null then do; /* must append an acl to the branch */ call asd_$replace_sall (pathp -> path.name, namep -> segnam.names (1).name, addr (aclp -> acls.acl), aclp -> acls.count, "1"b, ercode); if ercode ^= 0 then call syserr$error_code (1, ercode, "make_branches: error from asd_$replace_sall on ^a>^a:", pathp -> path.name, namep -> segnam.names (1).name); end; do j = 2 to namep -> segnam.count; /* Add all other names. */ repeat: call chname$cfile (pathp -> path.name, namep -> segnam.names (1).name, "", namep -> segnam.names (j).name, ercode); /* Add a name. */ if ercode ^= 0 then do; if ercode = error_table_$namedup then do; call delete (pathp -> path.name, namep -> segnam.names (j).name); go to repeat; /* Try again. */ end; call syserr$error_code (1, ercode, "make_branches: error from chname on ^a>^a:", pathp -> path.name, namep -> segnam.names (1).name); end; end; return; delete: entry (pathname, entryname); /* Entry to delete something. */ dcl (pathname, entryname) char (*); dcl newname char (32); dcl ustr char (15); call set$safety_sw_path (pathname, entryname, "0"b /* OFF */, ercode); if ercode ^= 0 then if ercode = error_table_$pvid_not_found then go to nopv; /* online inst */ else call syserr$error_code (1, ercode, "make_branches: delete: could not turn ^a>^a safety switch off:", pathname, entryname); call delentry$dfile (pathname, entryname, ercode); if ercode ^= 0 then if ercode = error_table_$pvid_not_found then do; nopv: ustr = unique_chars_ ("0"b); /* Make up new name */ newname = ustr || entryname; call syserr (0, "make_branches: delete: renaming ^a to ^a in ^a", entryname, newname, pathname); call chname$cfile (pathname, entryname, entryname, newname, ercode); if ercode ^= 0 then call syserr$error_code (1, ercode, "make_branches: delete: failed to rename"); end; else call syserr$error_code (1, ercode, "make_branches: could not delete ^a>^a:", pathname, entryname); return; /* BEGIN MESSAGE DOCUMENTATION Message: make_branches: bad path name PATH S: $crash T: $init M: $err A: $recover $boot_tape Message: make_branches: error from append on PATH: ERROR_MESSAGE S: $crash T: $init M: $err A: $recover $boot_tape Message: make_branches: error from chname on PATH: ERROR_MESSAGE S: $crash T: $init M: $err A: $recover $boot_tape Message: make_branches: error from asd_$replace_sall on PATH: ERROR_MESSAGE S: $crash T: $init M: $err A: $recover $boot_tape Message: make_branches: delete: could not turn PATH safety switch off: ERROR_MESSAGE S: $crash T: $init M: $err A: $recover $boot_tape Message: make_branches: delete: renaming NAME to UNIQUE in DIRNAME S: $info T: $init M: A segment which is being loaded from the system tape encountered a previous copy on a physical volume which is not now mounted. The old version of the segment is being renamed so that the new copy can be loaded. A: $note The system programmers will want to delete the unique-named segment. Message: make_branches: delete: failed to rename S: $crash T: $init M: $err A: $recover $boot_tape Message: make_branches: could not delete PATH: ERROR_MESSAGE S: $crash T: $init M: $err A: $recover $boot_tape END MESSAGE DOCUMENTATION */ end make_branches; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- 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