



		    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
