



		    create_vtoce.pl1                11/11/89  1129.9r w 11/11/89  0851.5      164484



/****^  ***********************************************************
        *                                                         *
        * 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.      *
        *                                                         *
        *********************************************************** */


/*
   create_vtoce (branchp, pvid, vtocx, code)


   FUNCTION -

   This procedure creates a vtoc entry for the segment whose branch is  pointed  to
   by  the input argument (branchp). It returns the uid of physical volume in which
   the vtoc entry was created (pvid) and the vtoc index (vtocx) of this vtoc entry.

   If the operation is successful the code returned is zero. If it fails, then  one
   possible returned value is error_table_$log_vol_full.      In this case, no vtoc
   entry was created and pvid=0, vtocx = -1.

   The logical volume assigned to the vtoc entry is defined as follows: if the vtoc
   entry is for a directory, the logical volume is the system logical volume, where
   all  directories  reside;  if the vtoc entry is for a non directory segment, the
   logical volume is specified in the header of the parent directory.


   IMPLEMENTATION -

   The parent directory is supposed to be locked before this procedure  is  called.
   Also the branch is supposed to be initialized.

   The  physical  volume where the vtoc entry is created is the first member of the
   logical volume which is not full. The file map is initialized with zeros.

   MODIFIED BY *

   03/10/75	Andre Bensoussan for the new storage system.
   08/11/75 Bernard Greenberg - most-space allocation algorithm.
   10/01/75 RE Mullen - optimize filemap nulling.
   10/21/75 by Greenberg for allocation by recs available, seg mover.
   02/06/76 by Greenberg for dynamic demounter.
   02/18/76 by Richard Bratt for LVT
   03/22/76 by Larry Johnson to set master_dir switch in vtoce, and to call uid_path_util for uid pathname
   06/76 by D.Vinograd to update volume dumper bit map when creating new vtoce.
   09/27/76 by RE Mullen for (cycling | pro-rata) PV selection to reduce io contention
   29 Jan 79 by D. Spector to allocate vtoces for deciduous segments on the RPV
   10/03/79 by J. A. Bush to copy terminal quota info  when copying vtoce for segment_mover
   01/09/80 by Mike Grady to fix try_cycle bug for inop devices and speed up fm nuller code
   03/22/81 by J. Bongiovanni for bug fix
            for volume being salvaged, avoid per-process creation on saturated units
   06/24/81 by J. Bongiovanni for random selection of PV within LV, weighted
            by fraction of space left
   03/06/82 by J. Bongiovanni to eliminate vtoce.infqcnt, for new PVTE, and for
            optimize parameter for segmove
   06/02/82 by J. Bongiovanni to set vtoce.perm_flags.per_bootload
   83-12-06 by BIM to correctly check LV access class and audit violations.
   84-12-05 by EJ Sharpe to use access_audit_ instead of protection_audit_
   85-04-01 by Keith Loepere for access_audit_check_ep_.
*/


create_vtoce : procedure (branchp, pvid, vtocx, code);


dcl  branchp ptr;					/* Input  - ptr to the branch */
dcl  pvid bit (36);					/* Output - uid of the phys. vol. where vtoc entry is created */
dcl  vtocx fixed bin (17);				/* Output - index of the vtoc entry that was created */
dcl  code fixed bin (35);				/* Output - error code */

/* Arguments for segmove entry */

dcl  corout_pvtx fixed bin;				/* Input/Output - next pvtx to be tried */
dcl  a_skip_pvtx fixed bin;
dcl  skip_pvtx fixed bin;				/* Input - original segment pvtx */
dcl  a_nreq fixed bin;				/* Input - required number of records */
dcl  a_optimize bit (1) aligned;			/* Input - optimize allocation of PV */

dcl (i, pvtx, msl) fixed bin (17);
dcl  first_pvtx fixed bin (17);
dcl  nreq fixed bin (17);
dcl (mover, looped, looping, try_cycle, held) bit (1);
dcl  1 event_flags aligned like audit_event_flags;
dcl  force_rpv bit (1);
dcl  optimizing bit (1);
dcl  lvid bit (36);
dcl  queue_length fixed bin;
dcl (working_sum, random_number, sum_fract_empty) fixed bin (35, 18);
dcl  n_pvs fixed bin;
dcl  pv_found bit (1);
dcl  pv_alloc_x fixed bin;
dcl  1 pv_alloc (MAX_PV_PER_LV) aligned,
     2 pvtx fixed bin,
     2 fract_empty fixed bin (35, 18);

dcl  vtoc_buffer (96) fixed bin (71);
dcl 1 local_vtoce like vtoce aligned based (addr (vtoc_buffer));
dcl  based_class_range (2) bit (72) aligned based;

dcl  access_operations_$fs_obj_create bit (36) aligned ext;
dcl  sys_info$initialization_state fixed bin ext;
dcl  sst$cycle_pv_allocation fixed bin (35) external;
dcl  pvt$root_lvid bit (36) aligned external;
dcl  error_table_$log_vol_full ext fixed bin (35);
dcl  error_table_$pvid_not_found ext fixed bin (35);
dcl  error_table_$ai_restricted ext fixed bin (35);
dcl  sys_info$default_max_length ext fixed bin (19);
dcl  sys_info$default_dir_max_length ext fixed bin (19);
dcl  active_hardcore_data$sl1_uid bit (36) aligned external;

dcl  access_audit_check_ep_$self entry (bit (36) aligned, bit (36) aligned, ptr) returns (bit (1));
dcl  access_audit_$log_entry_ptr entry options (variable);
dcl  display_access_class_$range entry ((2) bit(72) aligned) returns(char(32) aligned);
dcl  vtoc_man$alloc_and_put_vtoce entry (bit (36) aligned, fixed bin (17), ptr, fixed bin (35)) returns (fixed bin);
dcl  logical_volume_manager$lvtep entry (bit (36) aligned, ptr, fixed bin (35));
dcl  clock_ entry returns (fixed bin (52));
dcl  level$get entry () returns (fixed bin);
dcl  read_allowed_ entry (bit(72) aligned, bit(72) aligned) returns(bit(1) aligned);
dcl  write_allowed_ entry (bit(72) aligned, bit(72) aligned) returns(bit(1) aligned);
dcl  get_pvtx$hold_pvtx entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl  get_pvtx$release_pvtx entry (bit (36) aligned, fixed bin);
dcl  dbm_man$set_incr entry (fixed bin, fixed bin, fixed bin (35));
dcl  uid_path_util$get entry (ptr, dim (0:15) bit (36) aligned, fixed bin (35));
dcl  disk_control$queue_length_given_pvtx entry entry (fixed bin, fixed bin);

dcl  (addr, bit, clock, divide, fixed, high9, mod, multiply, null, ptr, rel, string, unspec) builtin;
	     

dcl  fm_nullifier char (256*2) aligned based (fmn_ptr);
dcl  fmn_ptr ptr;
dcl  uid_path (0:15) bit (36) aligned;

dcl  MAXQ_FOR_PDIR_CYCLE fixed bin int static options (constant) init (7);	/* number disk queue entries for saturation*/
dcl  MAX_PV_PER_LV fixed bin int static options (constant) init (32); /* maximum number of physical volumes on an LV*/
dcl  MODULUS fixed bin int static options (constant) init (1024);	/* for generating random number from clock*/
	     
	     

/* PREPARE A LOCAL COPY OF THE VTOCE USING THE BRANCH INFORMATION */

	mover = "0"b;				/* entry switch */
	skip_pvtx = 0;
	nreq = 0;
	optimizing = "1"b;
join:	code = 0;
	vtocep = addr (local_vtoce);
	ep = branchp;
	dp = ptr (ep, 0);

	if entry.dirsw then msl = divide (sys_info$default_dir_max_length, 1024, 17, 0);
	else msl = divide (sys_info$default_max_length, 1024, 17, 0);

	unspec (local_vtoce) = "0"b;
	local_vtoce.uid = entry.uid;
	local_vtoce.msl = bit (fixed (msl, 9));
	local_vtoce.dirsw = entry.dirsw;
	local_vtoce.primary_name = addr (entry.primary_name) -> names.name;
	local_vtoce.time_created = bit (clock_ (), 52);
	local_vtoce.dtu = local_vtoce.time_created;
	local_vtoce.dtm = local_vtoce.dtu;
	local_vtoce.par_pvid = dir.pvid;
	local_vtoce.par_vtocx = dir.vtocx;
	local_vtoce.per_process = entry.per_process_sw;
	local_vtoce.branch_rp = rel (ep);
	local_vtoce.access_class = entry.access_class;
	local_vtoce.master_dir = entry.master_dir;
	if dp -> dir.uid = active_hardcore_data$sl1_uid	/* parent is current >sl1 */
	     then local_vtoce.perm_flags.per_bootload = "1"b;
	if mover then				/* if called from segment_mover */
	     if tq_infop ^= null then			/* and we need to copy term quota attributes */
		do i = 0 to 1;			/* do it like this for efficiency */
		local_vtoce.trp (i) = tq_info.trp (i);	/* copy pertinent data */
		local_vtoce.trp_time (i) = tq_info.tup (i);
		local_vtoce.received (i) = tq_info.received (i);
	     end;

/* Fill the filemap with appropriate null addresses.  This is done using a */
/* based overlay in order to generate efficient code.  We are simulating */
/* do i = 0 to 255; local_vtoce.fm(i) = create_vtoce_null_addr; end; */
/* which is about 2500% slower. fm (0) MUST BE DOUBLE WORD ALIGNED */

	fmn_ptr = addr (local_vtoce.fm (0));		/* get ptr to base of filemap */
	fm_nullifier = high9(256*2);			/* set whole string - 256 bit (18)'s to */
						/* all one bits, done with single mlr */

/* GET THE UID_PATH OF THE PARENT FROM THE KST AND STORE IT IN THE VTOCE - THE UID_PATH IS AN ARRAY OF 16 ENTRIES
   NUMBERED FROM 0 TO 15 - ANY DIRECTORY WHICH IS IN THE PATH OF THE PARENT AND WHOSE TREE DEPTH IS i HAS ITS UID RECORDED
   IN UID_PATH(i)  - ANY ELEMENT OF THE UID_PATH THAT DOES NOT HOLD A UID HAS THE VALUE ZERO. */


	force_rpv = (dir.tree_depth = 0)		/* set for level 1 creations to go on rpv */
	     | dir.force_rpv			/* Better be on RLV ! */
	     | sys_info$initialization_state < 3;	/* make_sdw carefully placed deciduous
						   segments on the RPV. If we are creating segments
						   during collection 2, make sure the vtoce is allocated
						   on the RPV */

	call uid_path_util$get (dp, uid_path, code);	/* get uid path of parent */
	if code ^= 0 then return;
	local_vtoce.uid_path = uid_path;


/* If per process and not constrained attempt to cycle through PV's */

	try_cycle = ^mover & ^force_rpv 
	     & (dir.per_process_sw | sst$cycle_pv_allocation ^= 0);

/* DETERMINE IN WHICH LOGICAL VOLUME THE VTOCE IS TO BE CREATED. */

	if entry.dirsw = "0"b then lvid = dir.sons_lvid;
	else lvid = pvt$root_lvid;


restart:	call logical_volume_manager$lvtep ((lvid), lvtep, code);
	if code ^= 0 then return;
	if ^(read_allowed_ (entry.access_class, lvte.access_class.min) &
	     write_allowed_ (entry.access_class, lvte.access_class.max))
	then do;		
	     pvid = "0"b;
	     vtocx = -1;
	     code = error_table_$ai_restricted;
	     string(event_flags) = ""b;
	     if access_audit_check_ep_$self (string (event_flags), access_operations_$fs_obj_create, ep) then
		call access_audit_$log_entry_ptr ("create_vtoce", level$get(), string(event_flags),
		access_operations_$fs_obj_create, ep, code, null(), 0,
		"entry class range outside LV (^a LVID ^w)",
		display_access_class_$range (addr(lvte.access_class)->based_class_range), lvte.lvid);
	     return;
	end;

/* ALLOCATE A VTOCE ON SOME PV WITH A FREE VTOCE.  ALGORITHM:
   Satisfy segment_mover or force_rpv constraints if any.
   Else if per_process then try to cycle among the PV's. (always spread heavy I/O segments)
      Skip any PV whose disk queue is larger than MAXQ_FOR_PDIR_CYCLE, as this
      indicates local saturation in this cycle.
   Else place randomly (biased by fraction of space left on each PV).

   This algorithm attempts to gracefully handle the cases where some
   PV's are either empty (newly added?) or larger than others.
   It used to happen that if one PV was 2x larger, it would fill
   halfway before anything was placed on the others.
   It used to be that if one PV was by far the emptiest, then
   it would obtain all per-process segments thus creating an
   I/O bottleneck. --REM */


          pvt_arrayp = addr (pvt$array);
retry:
	held = "0"b;
	if try_cycle then do;			/* attempt to use cycle_pvtx */
	     try_cycle = "0"b;			/* don't do this more than once per creation */

	     looped, looping = "0"b;			/* not yet passed head of list */
	     pvtx = lvte.cycle_pvtx;			/* See if cycle has reasonable value */
	     if pvtx = 0 then looped = "1"b;		/* not good, reset and note */
	     else do;				/* maybe good */
		pvtep = addr (pvt_array (pvtx));	/* examine in detail */
		if pvte.lvid ^= lvid then looped = "1"b; /* not good, reset and note */
	     end;
	     if looped then pvtx, lvte.cycle_pvtx = lvte.pvtex; /* do the reset of cycle */
						/* Now pvtx and cycle_pvtx as good as can be, LV_wise */

	     do while (^looping);			/* dont loop forever if cant cycle */
		pvtep = addr (pvt_array (pvtx));
		call disk_control$queue_length_given_pvtx (pvtx, queue_length);
		if ^pvte.vacating
		& ^pvte.device_inoperative		/* bad idea if down */
		& pvte.n_free_vtoce > 0
		& pvte.nleft > 32 then do;		/* cycle not to cause immediate segmoves */
		     if dir.per_process_sw
			& queue_length>MAXQ_FOR_PDIR_CYCLE /* drive looks saturated		*/
			then do;			/* meter these				*/
			if pvte.skip_queue_count=262143    /* dont want overflow of meter		*/
			     then pvte.skip_queue_count = 0;
			else pvte.skip_queue_count = pvte.skip_queue_count + 1;
		     end;
		     else do;
			lvte.cycle_pvtx = pvte.brother_pvtx; /* leave cycle at next, may be Zero */
			pvid = pvte.pvid;
			go to got;
		     end;
		end;
		pvtx = pvte.brother_pvtx;	/* chase to next */
		if pvtx = 0 then do;		/* must wrap around */
		     if looped then looping = "1"b; /* wrap around only once */
		     else do;
			looped = "1"b;		/* note this first time */
			pvtx = lvte.pvtex;
		     end;
		end;
	     end;
	end;					/* end of try_cycle code */

	n_pvs = 0;
	sum_fract_empty = 0;
	pvtx = -1;

	if mover 
	then if corout_pvtx = 0
	     then first_pvtx = lvte.pvtex;		/* initialize */
	     else do;
		first_pvtx = pvt_array (corout_pvtx).brother_pvtx; /* pick up where we left off */
		corout_pvtx = 0;			/* reinitialize coroutine hack if scan is restarted */
	     end;
	else first_pvtx = lvte.pvtex;

	do i = first_pvtx repeat (pvte.brother_pvtx) while (i ^= 0);
	     pvtep = addr (pvt_array (i));
	     if pvte.lvid ^= lvid then go to restart;	/* LVT must have changed during scan */
	     if (^force_rpv | pvte.rpv)		/* Want to use rpv? */
	     then if pvte.n_free_vtoce > 0 & ^pvte.vacating /* Must be space for 1 new seg */
		then if (^mover | (pvte.nleft > nreq) & (i ^= skip_pvtx)) /* If moving, need nreq, not orig PV */
		     & ^pvte.device_inoperative	/* bad idea if down */
		     then do;
			if ^optimizing then do;	/* not trying to optimize			*/
			     pvtx = i;
			     goto got;
			end;
			else do;
			     n_pvs = n_pvs + 1;
			     pv_alloc (n_pvs).pvtx = i;
			     pv_alloc (n_pvs).fract_empty
				= divide (pvte.nleft, pvte.totrec, 35, 18);
			     sum_fract_empty = sum_fract_empty
				+ pv_alloc (n_pvs).fract_empty;
			end;
		     end;
	end;

/* Select a physical volume randomly biased by the fraction of space
   left on each physical volume.  The random number used is a modulus
   of the current clock.  This algorithm has the effect (for a reasonable
   number of segment creations) of cycling among physical volumes which
   are balanced in space used.  As a physical volume's space becomes
   exhausted (relative to other physical volumes in the same logical
   volume), it becomes progressively less favored for segment creation.				*/
	
	if n_pvs > 0 then do;
	     random_number = divide (multiply (mod (clock (), MODULUS), sum_fract_empty, 35, 18),
		MODULUS, 35, 18);			/* between 0 and sum_fract_empty		*/
	     working_sum = 0;
	     pv_found = "0"b;
	     do pv_alloc_x = 1 repeat pv_alloc_x + 1 
		while (^pv_found & pv_alloc_x < n_pvs);
		working_sum = working_sum + pv_alloc (pv_alloc_x).fract_empty;
		if working_sum >= random_number then do;
		     pv_found = "1"b;
		     pvtx = pv_alloc (pv_alloc_x).pvtx;
		end;
	     end;
	     if ^pv_found then pvtx = pv_alloc (n_pvs).pvtx;
	end;
	     
	

	if pvtx = -1 then
	     do ;
no_room:	     vtocx = -1;
	     pvid = "0"b;
	     code = error_table_$log_vol_full;
	     return;
	end;

got:	pvtep = addr (pvt_array (pvtx));
	if pvte.lvid ^= lvid then go to retry;
	pvid = pvte.pvid;
	

	call get_pvtx$hold_pvtx ((pvid), pvtx, code);
	if code ^= 0 then goto not_there;
	held = "1"b;

	vtocx = vtoc_man$alloc_and_put_vtoce ((pvid), pvtx, addr (local_vtoce), code);
	if code ^= 0 then do;
not_there:
	     vtocx = -1;
	     if held then call get_pvtx$release_pvtx ((pvid), pvtx);
	     pvid = "0"b;
	     return;
	end;
	if vtocx = -1 then do;			/* lost in window. There must be a better volume,
						   or LV is full, and we will find this out. */
	     if held then call get_pvtx$release_pvtx ((pvid), pvtx);
	     goto retry;
	end;
	call dbm_man$set_incr (pvtx, vtocx, code);

	call get_pvtx$release_pvtx ((pvid), pvtx);

	if mover then corout_pvtx = pvtx;		/* Start there next */
	return;

/*  */

/* create_vtoce$createv_for_segmove

   This entry is used to try to find a home for a segment which
   cannot allocate for a pendant page fault. segment_mover calls this
   entry maintaining the variable corout_pvtx for us. This enables us to
   scan the PVT. a_nreq is a minimum record requirement on a potential
   trial volume */


createv_for_segmove: entry (branchp, pvid, vtocx, code,	/* as regular */
	     corout_pvtx,				/* control state/pvtx answer */
	     a_skip_pvtx,				/* original pvtx, do not use */
	     a_nreq,				/* number or records needed */
	     tq_infop,				/* ptr to tq_info structure (null if no term quota) */
	     a_optimize);				/* ON => optimize allocation of PV */


	skip_pvtx = a_skip_pvtx;
	nreq = a_nreq;				/* copy args */
	mover = "1"b;				/* entry switch */
	optimizing = a_optimize;
	go to join;
%page; %include backup_static_variables;
%page; %include dir_entry;
%page; %include dir_header;
%page; %include dir_name;
%page; %include lvt;
%page; %include null_addresses;
%page; %include pvte;
%page; %include tq_info;
%page; %include vtoce;
%page; %include access_audit_eventflags;
%page;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   AUDIT (create_vtoce): DENIED creation of file system object ADDED_INFO entry class range outside LV (CLASS_RANGE lvid LVID)

   S:	$access_audit

   T:	$run

   M:	The specified user attempted to create a segment whose access class
	is outside the range accepted by the logical volume.

   A:	$inform_ssa

   END MESSAGE DOCUMENTATION */

     end create_vtoce;




		    delete_vtoce.pl1                11/11/89  1129.9rew 11/11/89  0851.5       80055



/****^  ******************************************************
        *                                                    *
        * Copyright, (C) Honeywell Bull Inc., 1987           *
        *                                                    *
        * Copyright (c) 1987 by Massachusetts Institute of   *
        * Technology and Honeywell Information Systems, Inc. *
        *                                                    *
        * Copyright (c) 1972 by Massachusetts Institute of   *
        * Technology and Honeywell Information Systems, Inc. *
        *                                                    *
        ****************************************************** */

/*
   delete_vtoce (branchp, code)


   FUNCTION -

   This procedure deletes the vtoc entry of the segment whose branch is pointed  to
   by the input argument "branchp". It performs the following system functions:
   -  Disconnect  the  page table (if any) of the segment from any sdw that may be
   pointing to it.
   - Free all disk, bulk store and core addresses occupied by the  pages  of  that
   segment.
   - Free the vtoc entry for that segment.
   -  If  the  segment  is  a directory which received some quota from its parent,
   return this quota to the parent.


   IMPLEMENTATION -

   This procedure is called only by delentry.  It  assumes  the  following  initial
   conditions:
   -  The directory in which the branch resides is locked for writing on behalf of the current
   process.
   - All items of the branch pointed to by "branchp" are valid.
   - All conditions required to delete the segment have already been checked.
   - If the segment to be deleted is a directory, it is locked on  behalf  of  the
   current process.


   MODIFICATIONS -

   03/27/75	Andre Bensoussan.
   07/29/77	Greenberg, for TPP update.
   09/17/82	J. Bongiovanni to optimize by reducing work done under
   AST Lock
   10/26/82	J. Bongiovanni, for fm_damaged
   05/30/83	E. N. Kittlitz search_ast$check, setfaults$if_active pvid, vtocx args

*/


/* format: style4 */
%page;
delete_vtoce: procedure (branchp, code);


dcl  branchp ptr;					/* Input  - branch pointer */
dcl  code fixed bin (35);				/* Output - error code */

dcl  uid bit (36) aligned;
dcl  pvid bit (36) aligned;
dcl  (i, pvtx, vtocx) fixed bin (17);
dcl  n_deposit_pages fixed bin;
dcl  1 local_aste aligned like aste;
dcl  1 local_vtoce aligned like vtoce;
dcl  deposit_list (0:255) bit (22) aligned;
dcl  pageno_list (0:255) fixed bin aligned;

dcl  null builtin;

dcl  error_table_$vtoce_connection_fail external fixed bin (35);
dcl  sst$checksum_filemap fixed bin (35) external;

dcl  lock$lock_ast entry;
dcl  lock$unlock_ast entry;
dcl  search_ast$check entry (bit (36) aligned, bit (36) aligned, fixed bin, fixed bin (35)) returns (ptr);
dcl  setfaults$if_active entry (bit (36) aligned, bit (36) aligned, fixed bin, bit (1) aligned);
dcl  quotaw$mq entry (ptr, ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl  vtoc_man$await_vtoce entry (bit (36) aligned, fixed bin, fixed bin, fixed bin (35));
dcl  vtoc_man$free_vtoce entry (bit (36) aligned, fixed bin, fixed bin, fixed bin (35));
dcl  get_pvtx entry (bit (36), fixed bin (35)) returns (fixed bin);
dcl  get_pvtx$hold_pvtx entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl  get_pvtx$release_pvtx entry (bit (36) aligned, fixed bin);
dcl  activate entry (ptr, fixed bin (35)) returns (ptr);
dcl  deactivate$for_delete entry (ptr, fixed bin (35));
dcl  pc$get_file_map entry (ptr, ptr, ptr, fixed bin, ptr, ptr);
dcl  pc$deposit_list entry (fixed bin, fixed bin, ptr, fixed bin, ptr);
dcl  truncate_vtoce$truncate_vtoce_delete entry (ptr, fixed bin (35));
dcl  syserr$error_code entry options (variable);

dcl  (error_table_$mylock, error_table_$root) fixed bin (35) external;

%page;
	code = 0;
	ep = branchp;

	uid = entry.uid;
	pvid = entry.pvid;
	pvtx = get_pvtx (entry.pvid, code); if code ^= 0 then return;
	vtocx = entry.vtocx;


	call get_pvtx$hold_pvtx (pvid, pvtx, code);
	if code ^= 0 then return;
	call setfaults$if_active (uid, pvid, vtocx, "0"b);

	call truncate_vtoce$truncate_vtoce_delete (ep, code);
	if code ^= 0 then if code = error_table_$vtoce_connection_fail then do;
		code = 0;				/* delete the branch only */
		go to release;
	     end;
	     else go to release;

	if entry.dirsw then call RETURN_QUOTA;

	n_deposit_pages = 0;

	call lock$lock_ast;

	astep = search_ast$check (uid, pvid, vtocx, (0)); /* don't worry about double uid */
	if astep ^= null then do;
	     if aste.dius then do;			/* volume dumper is using this */
		call lock$unlock_ast;
		astep = activate (ep, code);
		if code ^= 0 then go to release;
	     end;
	     call pc$get_file_map (astep, addr (local_aste), addr (local_vtoce.fm), n_deposit_pages,
		addr (deposit_list), addr (pageno_list));
	     if aste.fm_damaged & (sst$checksum_filemap ^= 0)
	     then n_deposit_pages = 0;
	     call deactivate$for_delete (astep, code);
	end;

	if code = 0 then
	     call vtoc_man$free_vtoce (pvid, pvtx, vtocx, code);

	call lock$unlock_ast;
	if code ^= 0 then go to release;

	if n_deposit_pages > 0 then do;
	     call vtoc_man$await_vtoce (pvid, pvtx, vtocx, code);
	     if code = 0 then
		call pc$deposit_list (pvtx, n_deposit_pages, addr (deposit_list),
		     vtocx, addr (pageno_list));
	end;

release:
	call get_pvtx$release_pvtx (pvid, pvtx);

	return;



RETURN_QUOTA: procedure;

dcl  qsw bit (1) init ("0"b);
dcl  local_tpp (0:1) fixed bin (71) aligned;
dcl  fixedoverflow condition;
dcl  par_pvid bit (36) aligned;
dcl  par_pvtx fixed bin;
dcl  pep ptr;
dcl  par_vtocx fixed bin (17);
dcl  sumcode fixed bin (35);
dcl  READ_LOCK bit (36) options (constant) static init ("000000000000"b3) aligned;


dcl  sum$getbranch_root_my entry (ptr, bit (36) aligned, ptr, fixed bin (35));
dcl  lock$dir_unlock entry (ptr);
dcl  (vtoc_man$get_vtoce, vtoc_man$put_vtoce) entry (bit (36) aligned, fixed bin, fixed bin, bit (3), ptr,
	fixed bin (35));

dcl  1 local_vtoce like vtoce aligned;

	astep = activate (ep, code); if code ^= 0 then return; /* Locks the AST and leaves it locked */

	do i = 0 to 1;
	     if (i = 0 & aste.tqsw (i) & ^aste.master_dir) |
		(i = 1 & aste.tqsw (i)) then
		do;
		qsw = "1"b;
		call quotaw$mq (ptr (astep, astep -> aste.par_astep), astep, -aste.quota (i),
		     bit (fixed (i, 1), 1), code);
		if code ^= 0 then call syserr$error_code (4, code,
			"delete_vtoce: from quotaw, pvid ^w, vtocx ^o", pvid, vtocx);
	     end;
	end;

	call lock$unlock_ast;

	if ^qsw then return;

/*	UPDATE TPP TO THE SUPERIOR */

	call vtoc_man$get_vtoce (pvid, pvtx, vtocx, "100"b, addr (local_vtoce), code);
	if code ^= 0 then return;

	local_tpp = local_vtoce.trp;
	if local_tpp (0) = 0 & local_tpp (1) = 0 then return;


	dp = ptr (ep, 0);				/* We're deleting >a>b>c>d. dp -> >a>b>c */
	call sum$getbranch_root_my (dp, READ_LOCK, pep, sumcode);
						/* This locking of parent's parent is to prevent seg move on parent. */

	if sumcode = 0 | sumcode = error_table_$root | sumcode = error_table_$mylock then do;
	     par_pvid = dir.pvid;
	     par_vtocx = dir.vtocx;
	end;
	else do;
	     code = sumcode;
	     go to tploss;
	end;

	call lock$lock_ast;				/* must protect VTOCE */

	par_pvtx = get_pvtx ((par_pvid), code);
	if code ^= 0 then go to tpploss1;
						/* Shouldn't happen, RLV better be mounted. */
	call vtoc_man$get_vtoce (par_pvid, par_pvtx, par_vtocx, "100"b, addr (local_vtoce), code);
	if code ^= 0 then go to tpploss1;

	on fixedoverflow go to tpploss1;
	local_vtoce.trp = local_vtoce.trp + local_tpp;
	revert fixedoverflow;

	call vtoc_man$put_vtoce (par_pvid, par_pvtx, par_vtocx, "100"b, addr (local_vtoce), code);
tpploss1:
	call lock$unlock_ast;
tploss:
	if sumcode = 0 then call lock$dir_unlock (ptr (pep, 0));

	if code ^= 0 then call syserr$error_code (4, code,
		"delete_vtoce: cannot add time/page product (^d ^d) to pvid ^w vtocx ^o uid ^w.",
		local_tpp, par_pvid, par_vtocx, dir.uid);

	return;

     end RETURN_QUOTA;

/* format: off */
%page; %include aste;
%page; %include dir_header;
%page; %include dir_entry;
%page; %include vtoce;

/* format: on */
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   delete_vtoce: from quotaw, pvid PPP. vtocx VVV ERRORMESSAGE

   S: $log

   T: $run

   M: While deleting a directory which had a quota
   account, a quota handling  problem usually record
   quota overflow, was encountered.

   A: $ignore

   Message:
   delete_vtoce: cannot add time/page product (SEGTPP DIRTPP)
   to pvid PPP vtocx VVV uid UUU ERRORMESSAGE

   S: $log

   T: $run

   M: During the deletion of a directory which had
   a quota account, a difficulty was encountered in
   reflecting its time/page product upward. SEGTPP and
   DIRTPP are the time/page product for segments and directories,
   respectively.

   A: $notify_sa

   END MESSAGE DOCUMENTATION */
     end delete_vtoce;




		    priv_delete_vtoce.pl1           11/11/89  1129.9rew 11/11/89  0851.5       80460



/****^  ******************************************************
        *                                                    *
        * Copyright, (C) Honeywell Bull Inc., 1987           *
        *                                                    *
        * Copyright (c) 1987 by Massachusetts Institute of   *
        * Technology and Honeywell Information Systems, Inc. *
        *                                                    *
        * Copyright (c) 1972 by Massachusetts Institute of   *
        * Technology and Honeywell Information Systems, Inc. *
        *                                                    *
        ****************************************************** */

/* format: style4 */
priv_delete_vtoce: procedure (a_uid, a_pvid, a_vtocx, a_code);

/* priv_delete_vtoce: a program to quietly and mysteriously induce a connection
   failure.  Intended to be used on a VTOCE for which it has been determined that
   no branch exists.  Several gullibility checks are applied. The only case that
   this program cannot protect itself against is the case of a wrong UID pathname
   for an existant segment.

   The priv_delete_vtoce$clear entry is used to get rid of a VTOCE completely--
   it writes zeros into it. This is used when it is necessary to eliminate a damaged
   VTOCE without regard to its possible contents.

   In the normal priv_delete_vtoce case, pages are freed, but quotas are not updated.
   In the $clear case, the vtoce is simply zeroed, without even freeing pages.
   However, normal volume salvage can be expected to pick them up next time. Neither
   of these entries will permit a VTOCE which appears to be active to be deleted.

   Bernard Greenberg   06/02/74
   Modified 06/02/81, W. Olin Sibert, to not lock directory for damaged VTOCE
   Modified 9 August 1981 WOS, to add priv_delete_vtoce$clear
   Modified January 82 BIM, for write lock for exclusive dir lock.
   Modified March 1982, J. Bongiovanni, to fix bug in find_aste and to cleanup locks
   Modified September 1982, J. Bongiovanni, to validate the moribund VTOCE before
   deleting it
   Modified August 1983, E. N. Kittlitz, set uid in clear case
*/

dcl  a_uid bit (36) aligned parameter;
dcl  a_pvid bit (36) aligned parameter;
dcl  a_vtocx fixed bin parameter;
dcl  a_code fixed bin parameter;

dcl  uid bit (36) aligned;
dcl  par_uid bit (36) aligned;
dcl  pvid bit (36) aligned;
dcl  code fixed bin (35);
dcl  pvtx fixed bin;
dcl  i fixed bin;
dcl  vtocx fixed bin;
dcl  clear_sw bit (1) aligned;

dcl  1 local_entry like entry aligned automatic;
dcl  1 local_dir like dir aligned automatic;
dcl  1 local_vtoce like vtoce aligned automatic;

dcl  sst$astap pointer external static;
dcl  sst$astsize fixed bin external static;
dcl  sst$pts (0:3) fixed bin external static;
dcl  1 sst$level (0:3) external static aligned,
       2 ausedp bit (18) unaligned,
       2 no_aste fixed bin (18) unsigned unaligned;

dcl  error_table_$vtoce_connection_fail fixed bin (35) external static;
dcl  error_table_$illegal_deactivation fixed bin (35) external static;
dcl  error_table_$invalid_vtoce fixed bin (35) external static;

dcl  delete_vtoce entry (pointer, fixed bin (35));
dcl  get_pvtx entry (bit (36) aligned, fixed bin (35)) returns (fixed bin);
dcl  lock$dir_lock_write entry (pointer, fixed bin (35));
dcl  lock$lock_ast entry ();
dcl  lock$unlock_ast entry ();
dcl  lock$dir_unlock_given_uid entry (bit (36) aligned);
dcl  search_ast entry (bit (36) aligned) returns (ptr);
dcl  syserr$error_code entry options (variable);
dcl  vtoc_man$free_vtoce entry (bit (36) aligned, fixed bin, fixed bin, fixed bin (35));
dcl  vtoc_man$get_vtoce entry (bit (36) aligned, fixed bin, fixed bin, bit (3), pointer, fixed bin (35));

dcl  (addr, addrel, binary, dim, fixed, null, unspec) builtin;

%page;

	clear_sw = "0"b;
	uid = a_uid;
	goto COMMON;


priv_delete_vtoce$clear: entry (a_pvid, a_vtocx, a_code);

	clear_sw = "1"b;
	uid = ""b;				/* don't have a UID yet */
	goto COMMON;


COMMON:	pvid = a_pvid;				/* Copy parameters, zero code */
	vtocx = a_vtocx;
	code = 0;
	par_uid = ""b;				/* Means parent not locked */

	pvtx = get_pvtx (pvid, code);			/* Try to get the pvtx */
	if code ^= 0 then go to finale;		/* Already off line. Lose */

	vtocep = addr (local_vtoce);
	dp = addr (local_dir);
	ep = addr (local_entry);			/* Set up local copy and fraud branch. */

	call vtoc_man$get_vtoce (pvid, pvtx, vtocx, "101"b, vtocep, code);
	if code ^= 0 then go to finale;		/* Some other lossage, could be demount, i/o err. */

	if (vtoce.uid ^= uid) & (^clear_sw) then do;	/* Only check if not simply clearing */
	     code = error_table_$vtoce_connection_fail;	/* Gone already */
	     go to finale;
	end;
	if clear_sw then uid = vtoce.uid;		/* why not use this? */

%page;

	if clear_sw then goto BAD_PARENT;		/* Don't bother trying if just clearing */

	if vtoce.uid_path (0) ^= "777777777777"b3 then goto BAD_PARENT; /* Can't be locked: UID path is bogus */

	do i = 15 to 0 by -1 while (vtoce.uid_path (i) = "0"b);
	end;					/* Get parent UID */

	par_uid = vtoce.uid_path (i);
	if par_uid = ""b then goto BAD_PARENT;		/* UID pathname is bad */

	unspec (dir) = "0"b;			/* Clear the fraudulent dir */
	dir.uid = par_uid;

	call lock$dir_lock_write (dp, code);		/*  Lock the UID in the dirlock table */
	if code ^= 0 then call syserr$error_code (CRASH, code, "priv_delete_vtoce: failed to lock ^w ", par_uid);

BAD_PARENT:
	call lock$lock_ast;				/* Check if active */

	call vtoc_man$get_vtoce (pvid, pvtx, vtocx, "101"b, vtocep, code);
	if code ^= 0 then go to unlock_ast_finale;	/* funny thing.. */

	if (vtoce.uid ^= uid) & (^clear_sw) then do;	/* Again, skip check */
	     code = error_table_$vtoce_connection_fail;
	     go to unlock_ast_finale;			/* gone in window */
	end;

	if find_aste (pvtx, vtocx) ^= null () then do;	/* Active, refuse to do this. */
	     code = error_table_$illegal_deactivation;
	     go to unlock_ast_finale;
	end;

	if (search_ast (uid) ^= null ()) & (^clear_sw) then do; /* UID in VTOCE is bad for sure */
	     code = error_table_$invalid_vtoce;
	     goto unlock_ast_finale;
	end;

%page;

	if clear_sw then do;			/* If clearing, just write (and await) */

	     call vtoc_man$free_vtoce (pvid, pvtx, vtocx, code); /* Let vtoc_man do the work */
	     if code ^= 0 then go to unlock_ast_finale;	/* funny thing.. */

	     call lock$unlock_ast ();			/* Unlock AST only after finished */
	end;

	else do;					/* In normal case, unlock AST immediately, since we have */
	     call lock$unlock_ast ();			/* parent locked, and it can't be activated while that */
						/* situation prevails */

	     if fixed (vtoce.records) > fixed (vtoce.csl) /* Validate the VTOCE a bit */
		| fixed (vtoce.csl) > fixed (vtoce.msl)
		| fixed (vtoce.msl) > dim (vtoce.fm, 1)
	     then do;
		code = error_table_$invalid_vtoce;
		goto finale;
	     end;

	     unspec (entry) = ""b;
	     entry.owner = "777777777770"b3;		/* No owner, until this field set right */
	     entry.pvid = pvid;			/* Inhibit quota grubbing-- */
	     entry.uid = uid;			/* This UID is special-cased by delete_vtoce */
	     entry.vtocx = vtocx;

	     call delete_vtoce (ep, code);		/* Now delete the vtoce */
	end;

finale:	if par_uid ^= ""b then			/* If there was a parent, then */
	     call lock$dir_unlock_given_uid (par_uid);	/* Unlock it */

	a_code = code;
	return;

unlock_ast_finale:
	call lock$unlock_ast;
	goto finale;

%page;

find_aste: proc (P_pvtx, P_vtocx) returns (pointer);

/* This procedure is used to look for an ASTE which claims to own a particular VTOC entry.
   It is used instead of search_ast because it is possible that there is some damage present,
   which might cause the UID to be completely bogus, and not be properly picked up by
   search_ast. It simply looks through all the pools looking for the proper pvtx/vtocx pair.
*/

dcl  P_pvtx fixed bin parameter;
dcl  P_vtocx fixed bin parameter;

dcl  pool_idx fixed bin;
dcl  aste_idx fixed bin;
dcl  my_astep pointer;


	my_astep = sst$astap;

	do pool_idx = 0 to 3;			/* Walk through all pools, rather than trusting search_ast */
	     do aste_idx = 1 to sst$level (pool_idx).no_aste;
		if (my_astep -> aste.vtocx = P_vtocx) then
		     if (my_astep -> aste.pvtx = P_pvtx) then
			return (my_astep);		/* This is it */

		my_astep = addrel (my_astep, binary (sst$pts (pool_idx) + sst$astsize, 18));
	     end;
	end;

	return (null ());				/* Didn't find it */

     end find_aste;

/* format: off */

%page; %include aste;
%page; %include dir_entry;
%page; %include dir_header;
%page; %include syserr_constants;
%page; %include vtoce;
%page;
/* format: on */

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   priv_delete_vtoce: failed to lock WWWWWW ERROR_MESSAGE

   S: $crash

   T: $run

   M: An attempt to lock a directory has failed.
   $err

   A: $recover
   $boot_tape

   END MESSAGE DOCUMENTATION */

     end priv_delete_vtoce;




		    truncate_vtoce.pl1              11/11/89  1129.9rew 11/11/89  0851.5      111123



/****^  ***********************************************************
        *                                                         *
        * 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.      *
        *                                                         *
        *********************************************************** */



/* format: style4 */
truncate_vtoce: proc (branchp, first_page, code);


/* FUNCTION -

   This procedure truncates the segment whose branch is pointed  to  by  the  input
   argument  "branchp",  from  the  page  number  defined  by  the  input  argument
   "first_page". The current length of the segment becomes equal  to  "first_page".
   All core and disk records occupied by the truncated portion of the segment
   are  freed.  In  addition,  the quota used information of the parents, up to the
   appropriate terminal quota directory, are updated to reflect the fact that  they
   , are not responsible any longer for those pages that have been freed.

   If  code  = 0 upon return, the operation was successful. Otherwise the operation
   failed at some point because of a system error.

   The parent directory is supposed to be locked before this procedure  is  called.


   IMPLEMENTATION -

   If the segment is active, the truncation takes place in the ASTE. The VTOCE will
   automatically  be updated at deactivation or any time the procedure update_vtoce
   is called.

   If the segment is not active, the truncation takes place directly in the  VTOCE.
   Since  the  parent  is  locked  and  the  segment  is  not active, it is safe to
   manipulate the VTOCE. However, updating the used count of the  parents  will  be
   done  on the ASTE's of the parent, after having forced them to the active state.



   MODIFIED BY :

   04/29/75  A. Bensoussan - Written for the new storage system.
   05/76	By Greenberg for await_vtoce,  06/76 for hphcs_$delete_vtoce.
   06/76 D.Vinograd - added entry hold which does not release pvtx .
   07/76 D. Vinograd modified to set volume dumper bit map so that truncated/deleted vtoces are dumped
   06/08/81 by J. Bongiovanni to set vtoce.records to 0 if truncating to 0
   07/10/82 by J. Bongiovanni to read entire VTOCE
   08/18/82 by J. Bongiovanni for new pc$deposit_list calling sequence
   10/26/82 by J. Bongiovanni to reset fm_damaged if truncating to 0, fix grandparent locking
   830430 BIM to make check of pvtx and vtocx against branch.
   83-08-06 by E. N. Kittlitz to do pvtx/vtocx check using search_ast$check.
   84-12-20 by Keith Loepere to count dirs pages against own quota.
   85-01-10 by Keith Loepere for covert channel detection.
   85-01-21 by Keith Loepere to add dtm setting and detection.
*/

%page;

dcl  branchp ptr;
dcl  code fixed bin (35);
dcl  first_page fixed bin (17);

dcl  csl fixed bin;
dcl  deleting bit (1) init ("0"b);
dcl  1 deposit aligned,
       2 list (256) bit (22) aligned;
dcl  dir_must_be_unlocked bit (1);
dcl  event_count fixed bin;
dcl  first fixed bin;
dcl  hold bit (1) init ("0"b);
dcl  i fixed bin;
dcl  1 local_vtoce like vtoce aligned;
dcl  multi_class bit (1) aligned;
dcl  n fixed bin;
dcl  normal bit (1) aligned;
dcl  page_count fixed bin;
dcl  pageno_list (256) fixed bin aligned;
dcl  par_astep ptr;
dcl  par_dp ptr;
dcl  par_ep ptr;
dcl  par_pvid bit (36) aligned;
dcl  par_uid bit (36) aligned;
dcl  par_vtocx fixed bin;
dcl  pvid bit (36) aligned;
dcl  pvtx fixed bin;
dcl  uid bit (36) aligned;
dcl  vtocx fixed bin;

dcl  error_table_$mylock fixed bin (35) external;
dcl  error_table_$vtoce_connection_fail fixed bin (35) external;
dcl  pds$throttle_segment_state_changes bit (1) aligned external;
dcl  sst$checksum_filemap fixed bin (35) external;

dcl  activate entry (ptr, fixed bin (35)) returns (ptr);
dcl  dbm_man$set_incr entry (fixed bin, fixed bin, fixed bin (35));
dcl  filemap_checksum_ entry (ptr, fixed bin, bit (36) aligned);
dcl  get_pvtx entry (bit (36) aligned, fixed bin (35)) returns (fixed bin);
dcl  get_pvtx$hold_pvtx entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl  get_pvtx$release_pvtx entry (bit (36) aligned, fixed bin);
dcl  limit_covert_channel entry (fixed bin);
dcl  lock$dir_unlock entry (ptr);
dcl  lock$lock_ast entry;
dcl  lock$unlock_ast entry;
dcl  pc$deposit_list entry (fixed bin, fixed bin, ptr, fixed bin, ptr);
dcl  pc$truncate entry (ptr, fixed bin);
dcl  pc$updates entry (ptr);
dcl  quotaw$cu entry (ptr, fixed bin, bit (1), fixed bin, fixed bin (35));
dcl  search_ast$check entry (bit (36) aligned, bit (36) aligned, fixed bin, fixed bin (35)) returns (ptr);
dcl  sum$getbranch_root_my entry (ptr, bit (1), ptr, fixed bin (35));
dcl  syserr entry options (variable);
dcl  vtoc_man$await_vtoce entry (bit (36) aligned, fixed bin, fixed bin, fixed bin (35));
dcl  vtoc_man$get_vtoce entry (bit (36) aligned, fixed bin, fixed bin, bit (3), ptr, fixed bin (35));
dcl  vtoc_man$put_vtoce entry (bit (36) aligned, fixed bin, fixed bin, bit (3), ptr, fixed bin (35));

dcl  (addr, bit, clock, fixed, min, null, ptr, substr) builtin;

%page;
	first = first_page;
	go to join;
hold: entry (branchp, first_page, code);
	first = first_page;
	hold = "1"b;
	goto join;
truncate_vtoce_delete: entry (branchp, code);
	deleting = "1"b;
	first = 0;
join:

/* INITIALIZE POINTERS AND VARIABLES */

	normal = ^(deleting | hold);
	ep = branchp;
	code = 0;

	uid = entry.uid;
	pvid = entry.pvid;
	pvtx = get_pvtx (pvid, code); if code ^= 0 then return;
	vtocx = entry.vtocx;
	multi_class = entry.multiple_class;
	event_count = 0;

/* IF THE SEGMENT IS ACTIVE, CALL UPON PAGE CONTROL TO DO ALL THE WORK */

	call lock$lock_ast;

	astep = search_ast$check (uid, pvid, vtocx, (0)); /* ignore double-uid error for now */

	if astep ^= null then do;			/* aste really matches */
	     if aste.hc_sdw then call syserr (CRASH, "truncate_vtoce: attempt to destroy hc_sdw seg astep ^p", astep);
	     csl = fixed (aste.csl);
	     call pc$truncate (astep, first);
	     if first = 0 then do;			/* was truncate to zero length? */
		if aste.damaged then aste.fmchanged = "1"b; /* force update_vtoce if reset it */
		aste.damaged = "0"b;		/* user wanted zeroes: he's got them */
		aste.fm_damaged = "0"b;		/* any filemap damage got better */
	     end;
	     call lock$unlock_ast;
	     if ^deleting & hold then call get_pvtx$hold_pvtx (pvid, pvtx, code);
	     go to covert_test;
	end;

	call lock$unlock_ast;


/* THE SEGMENT IS NOT ACTIVE - THEREFORE THE OPERATION HAS TO BE DONE ON THE VTOCE. */
/* NOTE THAT ANOTHER SEGMENT WITH THE SAME UID MIGHT BE ACTIVE, BUT WE DON'T CARE. */

	vtocep = addr (local_vtoce);

	call vtoc_man$get_vtoce (pvid, pvtx, vtocx, "111"b, vtocep, code);
	if code ^= 0 then return;

	if uid ^= vtoce.uid then do;
	     code = error_table_$vtoce_connection_fail;
	     return;
	end;

	csl = fixed (vtoce.csl);

	if ^deleting then call get_pvtx$hold_pvtx (pvid, pvtx, code);
	if code ^= 0 then return;			/* Got demounted if return */


/* PERFORM THE TRUNCATION ON THE VTOCE AND WRITE IT BACK IN THE DISK -
   DO NOT DEPOSIT ANY DISK ADDRESSES YET, BUT REMEMBER THEM */

	n = 0;
	do i = first to csl - 1;
	     if substr (vtoce.fm (i), 1, 1) = "0"b then do;
		n = n + 1;
		deposit.list (n) = vtoce.fm (i);
		pageno_list (n) = i;
		vtoce.fm (i) = truncate_vtoce_null_addr;
	     end;
	end;

	if vtoce.fm_damaged & (sst$checksum_filemap ^= 0)
	then n = 0;				/* don't deposit potentially bogus addresses */

	vtoce.csl = bit (fixed (min (first, csl), 9), 9);
	if first = 0 then do;
	     vtoce.records = "0"b;
	     vtoce.damaged = "0"b;
	     vtoce.fm_damaged = "0"b;
	end;
	else vtoce.records = bit (fixed (fixed (vtoce.records, 9) - n, 9), 9); /* #@!*%! */

	if sst$checksum_filemap = 0 then do;
	     vtoce.fm_damaged = "0"b;
	     vtoce.fm_checksum_valid = "0"b;
	     vtoce.fm_checksum = ""b;
	end;
	else do;
	     vtoce.fm_checksum_valid = "1"b;
	     call filemap_checksum_ (addr (vtoce.fm), fixed (vtoce.csl, 9), vtoce.fm_checksum);
	end;

	if vtoce.dirsw then
	     if ^vtoce.deciduous then
		vtoce.used (1) = vtoce.used (1) - n;	/* update dir quota */

/* Set dtu, dtcm.
   This setting can be a covert channel event (external to page control's
   detection of dtu/dtm setting).  If the object is multi-class, then it sits
   in a lower class dir and this dtu setting is lower class visible.  The dtm
   is always lower class visible, since it propogates up the hierarchy. */

	if normal then do;
	     vtoce.dtm, vtoce.dtu = bit (fixed (clock (), 52), 52);
	     if multi_class then event_count = 2;
	     else event_count = 1;
	end;

	call vtoc_man$put_vtoce ("0"b, pvtx, vtocx, "111"b, vtocep, code);
	if code ^= 0 then go to release;

	if deleting | (^deleting & ^vtoce.per_process & ^vtoce.deciduous) then
	     call dbm_man$set_incr (pvtx, vtocx, code);


/* IF THERE ARE ANY DISK ADDRESSES TO BE DEPOSITED, DO IT NOW - AND ALSO UPDATE THE USED COUNT
   IN ASTE's OF SUPERIOR DIRECTORIES AFTER HAVING FORCED THEM TO BE ACTIVE */

	if n = 0 then go to release;

	if ^vtoce.deciduous then do;			/* Cannot free deciduous space (hc part) */
	     call vtoc_man$await_vtoce ("0"b, pvtx, vtocx, code);
	     if code ^= 0 then go to release;
	     call pc$deposit_list (pvtx, (n), addr (deposit.list), vtocx, addr (pageno_list));
	end;

release:
	if normal then call get_pvtx$release_pvtx (pvid, pvtx); /* Free volume for demount */


	if entry.owner = "111111111111111111111111111111111000"b then return;
						/* No quota handling if hphcs_$delv */

	dp = ptr (ep, 0);
	par_uid = dir.uid;
	par_pvid = dir.pvid;
	par_vtocx = dir.vtocx;
	dir_must_be_unlocked = "0"b;

	call lock$lock_ast;

	par_astep = search_ast$check (par_uid, par_pvid, par_vtocx, code);
	if code ^= 0 then do;			/* can't activate it, so punt */
	     call lock$unlock_ast;
	     return;
	end;

	if par_astep = null then do;
	     call lock$unlock_ast;

	     call sum$getbranch_root_my (dp, "0"b, par_ep, code);

	     if code = 0 then dir_must_be_unlocked = "1"b;
	     else if code = error_table_$mylock then code = 0; else return;

	     par_dp = ptr (par_ep, 0);
	     par_astep = activate (par_ep, code);

	     if code ^= 0 then do;
		if dir_must_be_unlocked then call lock$dir_unlock (par_dp);
		return;
	     end;
	end;

	if ^vtoce.deciduous then do;
	     if vtoce.dirsw then
		if vtoce.received (1) = 0 then	/* non-terminal dir - give back quota to terminal cell */
		     call quotaw$cu (par_astep, (-n), "1"b, 0, code);
		else ;				/* deleting dir merely zeroes its own terminal quota */
	     else call quotaw$cu (par_astep, (-n), "0"b, 0, code);
	     if normal then call pc$updates (par_astep); /* let dumper know to come */
	end;
	call lock$unlock_ast;

	if dir_must_be_unlocked then call lock$dir_unlock (par_dp);
%page;
covert_test:
	if ^normal then return;

/* see if the truncation of these pages can transmit some data */

	if ^pds$throttle_segment_state_changes then return; /* uninteresting */
	if multi_class then do;			/* only multi-class segment attributes count towards covert channels */

/* The changing of records used is a covert channel relevant event.  The number
   of events depends on how many pages were truncated. */

	     csl = csl - first;
	     if csl > 0 then do;
		page_count = 1;
		do event_count = event_count repeat event_count + 1 while (page_count <= csl);
		     page_count = page_count * 2;	/* this finds log2(csl), sort of */
		end;
	     end;
	end;

	if event_count > 0 then call limit_covert_channel (event_count);
	return;

/* format: off */

%page; %include aste;
%page; %include dir_entry;
%page; %include dir_header;
%page; %include null_addresses;
%page; %include syserr_constants;
%page; %include vtoce;
%page;
/* format: on */

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   truncate_vtoce: attempt to destroy hc_sdw seg astep PPP

   S: $crash

   T: $run

   M: An attempt has been made to truncate
   a supervisor segment.
   The AST entry is located at PPP.
   $err

   A: $recover

   END MESSAGE DOCUMENTATION */

     end truncate_vtoce;




		    update_vtoce.pl1                11/11/89  1129.9r w 11/11/89  0851.5       88092



/****^  ***********************************************************
        *                                                         *
        * 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.      *
        *                                                         *
        *********************************************************** */



/*
   update_vtoce        (astep)
   update_vtoce$deact  (astep, code)





   FUNCTION -

   The procedure "update_vtoce" updates the vtoce using the aste pointed to by  the
   input  argument  "astep".  The  aste  can  be  regarded  as  being  some form of
   associative memory for almost all the vtoce items.  Therefore,  any  vtoce  item
   that  has  been  copied from the vtoce into the aste at activation time, must be
   copied back from the aste into the vtoce at update vtoce time, if the  value  of
   this  item  is  different  in  the  vtoce  and the aste. These items include the
   maximum segment length (msl), the current segment length (csl),  the  number  of
   disk  records  (records)  occupied by the segment, the date and time segment was
   used (dtu), the date and time the segment was modified (dtm) and  the  file  map
   (fm).  For  directories,  these  items,  in  addition, include all quota related
   information.

   The AST is supposed to be locked before calling "update_vtoce" and unlocked upon
   return. The procedure "update_vtoce" does not concern  itself  with  this  lock.
   When  it  is  obvious  that  no race condition can occur (initializer, emergency
   shutdown), this procedure may be called without locking the AST.

   The Page Table Lock however is not supposed  to  be  locked  (and  must  not  be
   locked) before calling this procedure.

   Update_vtoce  is  called  each  time  a segment is being deactivated. It is also
   called for segments which are not being deactivated,  in  order  to  update  the
   vtoce on the disk, if they have been active for a long time.


   IMPLEMENTATION -

   Basically   the   logic   of   "update_vtoce"   is  very  simple.   First,  call
   pc$get_file_map in order to get a  snapshot  of  the  aste  with  the  fm.  Then
   determine,  from  the aste, the pvtx and the vtocx of the vtoce, read the vtoce,
   update it with the items returned by pc$get_file_map, and write it back  on  the
   disk. At last, deposit the list of disk addresses that may have been returned by
   pc$get_file_map.   Although  this  simple  implementation  is  correct, it would
   probably be very expensive in terms of I/O requests since the 
   vtoce would be read and written each time. 

   The simple implementation is optimized as follows. A set of criteria are used
   to determine whether it is necessary to read the VTOCE. If it is not, part
   1 is written to disk (note that this can happen only for a segment whose
   file map fits into part 1). If it is necessary to read the VTOCE, the entire
   VTOCE is read and written back.
   





   MODIFIED BY:

        /84   Benson Margulies - to purge users of sst.incl
   10/01/82   J. Bongiovanni - synchronized switch, filemap checksum
   8/18/82    J. Bongiovanni - new pc$get_file_map, pc$deposit_list calling
			 sequence
   7/10/82    J. Bongiovanni - to simplify the optimization by reading the
		           entire VTOCE if it is necessary to read it at all
   3/18/82    J. Bongiovanni - to return an error code if called for a hardcore  segment
   10/10/77   B. Greenberg - update_vtoce$deact to take code, & implications thereof.
   Modified by D.Vinograd 6/76 to update volume dumper bit map so tha modified objects are dumped
   04/23/75   A. Bensoussan - wrote the first version for the new storage system to
   replace updateb.

*/





update_vtoce: procedure (a_astep);
	dsw = "0"b;
	go to join;

deact: entry (a_astep, a_code);
	dsw = "1"b;
join:

	dcl     a_astep		 ptr;


	dcl     1 local_vtoce	 like vtoce aligned;
	dcl     1 local_aste	 like aste aligned;

	dcl     (pvtx, vtocx)	 fixed bin (17);
	dcl     dsw		 bit (1);
	dcl     code		 fixed bin (35);
	dcl     a_code		 fixed bin (35);
	dcl     (n, i, pts, max)	 fixed bin (17);
	dcl     deposit_list	 (0:255) bit (22) aligned;
	dcl     pageno_list		 (0:255) fixed bin aligned;
	dcl     1 saved_fm		 aligned,
		2 fm		 (0:255) bit (18) unaligned;

	dcl     curtime		 bit (36) aligned;
	dcl     dt		 fixed bin (35);
	dcl     read_vtoce		 bit (1) aligned;
	dcl     parts_write		 bit (3);

	dcl     ALL_PARTS		 bit (3) int static options (constant) init ("111"b);
	dcl     PART_ONE		 bit (3) int static options (constant) init ("100"b);

	dcl     vtoc_man$get_vtoce	 entry (bit (36) aligned, fixed bin, fixed bin, bit (3), ptr, fixed bin (35));
	dcl     vtoc_man$put_vtoce	 entry (bit (36) aligned, fixed bin, fixed bin, bit (3), ptr, fixed bin (35));
	dcl     vtoc_man$await_vtoce	 entry (bit (36) aligned, fixed bin, fixed bin, fixed bin (35));
	dcl     pc$get_file_map	 entry (ptr, ptr, ptr, fixed bin, ptr, ptr);
	dcl     pc$deposit_list	 entry (fixed bin, fixed bin, ptr, fixed bin, ptr);
	dcl     filemap_checksum_	 entry (ptr, fixed bin, bit (36) aligned);

	dcl     (addr, bin, bit, clock, fixed, unspec) builtin;

	dcl     sst$checksum_filemap	 fixed bin (35) external;
	dcl     sst$pts		 (0:3) fixed bin (35) external static;

	dcl     error_table_$hardcore_sdw fixed bin (35) external;


/*	% include vtoce;		see at the end.	*/
/*	% include aste;		see at the end.	*/
/*	% include null_addresses;	see at the end.	*/

/* INITIALIZE POINTERS */

	n = 0;					/* For error recovery */
	astep = a_astep;
	if aste.hc_sdw then do;			/* Meaningless to update VTOCE for this type of segment */
		if dsw then a_code = error_table_$hardcore_sdw;
		return;
	     end;
	vtocep = addr (local_vtoce);
	pvtx = fixed (aste.pvtx); if pvtx <= 0 then return;
	vtocx = aste.vtocx;
	pts = sst$pts (fixed (aste.ptsi));

	read_vtoce = "0"b;

/* DETERMINE WHETHER IT IS NECESSARY TO READ THE VTOCE */

	if aste.dirsw & (aste.tqsw (0) | aste.tqsw (1))
	then read_vtoce = "1"b;
	if pts > 96 & aste.fmchanged
	then read_vtoce = "1"b;

	if read_vtoce then do;
		call vtoc_man$get_vtoce ("0"b, pvtx, vtocx, ALL_PARTS, vtocep, code);
		if code ^= 0 then go to serious_problem;
	     end;


/* GET A SNAPSHOT OF THE ASTE AND THE FILE MAP */

	if ^read_vtoce
	then unspec (vtoce) = ""b;

	call pc$get_file_map (astep, addr (local_aste), addr (vtoce.fm), n, addr (deposit_list), addr (pageno_list));
	if aste.fm_damaged & (sst$checksum_filemap ^= 0) then n = 0; /* Don't deposit if file map suspect */

	astep = addr (local_aste);

/* CHECK FOR RACE (FILE MAP UPDATED SINCE WE CHECKED) */

	if ^read_vtoce & aste.fmchanged & (pts > 96)
	then do;
		read_vtoce = "1"b;
		unspec (saved_fm.fm) = unspec (vtoce.fm);
		call vtoc_man$get_vtoce ("0"b, pvtx, vtocx, ALL_PARTS, vtocep, code);
		if code ^= 0 then goto serious_problem;
		unspec (vtoce.fm) = unspec (saved_fm.fm);
	     end;



/* UPDATE THE VTOCE IN LOCAL STORAGE */

	curtime = bit (bin (clock (), 52), 52);

	vtoce.uid = aste.uid;
	vtoce.msl = aste.msl;
	vtoce.csl = aste.csl;
	vtoce.records = aste.records;

	vtoce.dtu = aste.dtu;
	vtoce.dtm = aste.dtm;

	vtoce.nqsw = aste.nqsw;
	vtoce.deciduous = aste.hc_sdw;
	vtoce.per_process = aste.per_process;
	vtoce.damaged = aste.damaged;
	vtoce.fm_damaged = aste.fm_damaged;
	vtoce.synchronized = aste.synchronized;
	vtoce.dnzp = aste.dnzp;
	vtoce.gtpd = aste.gtpd;
	vtoce.nid = aste.nid;
	vtoce.dirsw = aste.dirsw;




	if aste.dirsw then
	     do;
		vtoce.master_dir = aste.master_dir;
		do i = 0, 1;
		     vtoce.used (i) = aste.used (i);
		     vtoce.quota (i) = aste.quota (i);
		     if aste.tqsw (i) then
			do;
			     dt = fixed (curtime, 36) - fixed (vtoce.trp_time (i), 36);
			     vtoce.trp (i) = vtoce.trp (i) + fixed (aste.used (i) * dt * .65536e-1 + .5e0, 71);
			     vtoce.trp_time (i) = curtime;
			end;
		end;
	     end;
	else seg_vtoce.usage = seg_aste.usage;		/* segments have pf count instead of quota */


/* DETERMINE THE PARTS TO BE WRITTEN AND WRITE THE VTOCE */

	if read_vtoce then do;
		parts_write = ALL_PARTS;
		max = 255;
	     end;
	else do;
		parts_write = PART_ONE;
		max = 95;
	     end;

	do i = pts to max; vtoce.fm (i) = update_vtoce_null_addr; end;

	if sst$checksum_filemap = 0 then do;
		vtoce.fm_checksum_valid = "0"b;
		vtoce.fm_checksum = ""b;
	     end;
	else if read_vtoce | (pts <= 96) then do;
		vtoce.fm_checksum_valid = "1"b;
		call filemap_checksum_ (addr (vtoce.fm), fixed (vtoce.csl, 9), vtoce.fm_checksum);
	     end;

	call vtoc_man$put_vtoce ("0"b, pvtx, vtocx, parts_write, vtocep, code);
	if code ^= 0 then go to serious_problem;


/* IF THERE ARE ANY DISK ADDRESSES TO BE DEPOSITED, THEN DO IT */

	if n > 0 then do;
		call vtoc_man$await_vtoce ("0"b, pvtx, vtocx, code);
		if code ^= 0 then go to serious_problem;
		call pc$deposit_list (pvtx, n, addr (deposit_list), vtocx, addr (pageno_list));
	     end;


/* RESET THE ASTE.FMCHANGED1 FLAG FOR PAGE CONTROL IF NECESSARY */

	if aste.fmchanged then a_astep -> aste.fmchanged1 = "0"b;

	if dsw then a_code = 0;
	return;

serious_problem:
	if dsw then a_code = code;
	a_astep -> aste.fmchanged = "1"b;		/* Cause trickle to do it */
	if n > 0
	then addr (pvt$array) -> pvt_array (aste.pvtx).vol_trouble_count
		= addr (pvt$array) -> pvt_array (aste.pvtx).vol_trouble_count + 1; /* Couldn't deposit */
	return;

%include vtoce;
%include pvte;
%include aste;
%include null_addresses;

     end update_vtoce;




		    vtoc_man.pl1                    11/11/89  1129.9r w 11/11/89  0851.5      363708



/****^  ***********************************************************
        *                                                         *
        * 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.      *
        *                                                         *
        *********************************************************** */


/*
			  vtoc_man$get_vtoce
				$read_ahead_vtoce
				$put_vtoce
				$alloc_and_put_vtoce
				$free_vtoce
				$free_vtoce_for_scavenge
				$cleanup_pv
				$stabilize
				$crawlout
	
	The specification of each function is given with the entry point declaration.
	
	Modified by :
	08/14/75	Andre Bensoussan - Written for the new storage system.
	06/02/76 by Bernard Greenberg for non-fatal write errors (hot buffers).
	06/07/76 by Bernard Greenberg for vtoc_man$stabilize.
	09/17/76 by R. Bratt to add per-process meters.
	03/12/80 by J. A. Bush to fix "out of buffers" bug
	04/16/81 by J. Bongiovanni to recover on crawlout with vtoc buffer lock ,
                   bug in cleanup_pv (vtoce 4 trashing), validate vtoc index
          03/08/82 by J. Bongiovanni for new PVTE and stocks
	07/07/82 by J. Bongiovanni - rewritten for new buffer strategy
	         (almost always read entire VTOCE, do write in 1 I/O).
          07/26/82 by J. Bongiovanni to add free_vtoce_for_scavenge and
	         read_ahead_vtoce
          11/06/82 by J. Bongiovanni to add pseudo-clock for scavenger race
	09/20/83 by E. N. Kittlitz to implement the former's last request: clear pad when writing
	01/17/84 by Jeffrey I. Schiller to requeue I/O for "hot" buffers.
	*/


/****^  HISTORY COMMENTS:
  1) change(86-01-16,Fawcett), approve(86-04-11,MCR7383),
     audit(86-06-02,GDixon), install(86-07-17,MR12.0-1097):
     Add support for 512_WORD_IO devices, (one vtoce per sector), and add
     software RAR.
                                                   END HISTORY COMMENTS */


/* format: style3 */
vtoc_man$get_vtoce:
     proc (Pvid, Pvtx, Vtocx, Parts, Copy_Vtocep, Code);

/*  Parameter  */

dcl	Copy_Vtocep	ptr;			/* Pointer to copy of VTOCE to be written or read into */
dcl	Code		fixed bin (35);		/* Status code */
dcl	Parts		bit (3);			/* Mask of parts of interest */
dcl	Pvid		bit (36) aligned;		/* Physical Volume ID */
dcl	Pvtx		fixed bin;		/* PVTE index */
dcl	Vtocx		fixed bin;		/* VTOCE index on volume */

/*  Automatic  */

dcl	bufx		fixed bin;
dcl	code		fixed bin (35);
dcl	dev_type		fixed bin;
dcl	hot_buffer_tried	bit (1);
dcl	1 local_vtoce_buffer
			aligned like vtoce_buffer;
dcl	old_pseudo_clock	fixed bin (35);
dcl	p99		pic "99";
dcl	parts		bit (3) aligned;
dcl	parts_to_write	bit (3) aligned;
dcl	pvid		bit (36) aligned;
dcl	pvtx		fixed bin;
dcl	return_vtocx	fixed bin;
dcl	sector_read_required
			bit (1) aligned;
dcl	vtocx		fixed bin;
dcl	wait_event	bit (36) aligned;

/*  Static  */

dcl	ALL_PARTS		bit (3) aligned int static options (constant) init ("111"b);
dcl	CORE_OFFSET	(0:7) fixed bin int static options (constant) init (0, 128, 64, 64, 0, 0, 0, 0);
dcl	MAX_PSEUDO_CLOCK	fixed bin (35) int static options (constant) init (1000000);
dcl	MAX_STEPS		fixed bin int static options (constant) init (10000);
dcl	SECTOR_OFFSET	(0:7) fixed bin int static options (constant) init (0, 2, 1, 1, 0, 0, 0, 0);
dcl	SECTORS_TO_WRITE	(0:7) fixed bin int static options (constant) init (0, 1, 1, 2, 1, 0, 2, 3);
dcl	VALID_WRITE	(0:7) bit (1) aligned int static options (constant)
			init ("0"b, "1"b, "1"b, "1"b, "1"b, "0"b, "1"b, "1"b);

/*  Based  */

dcl	1 Copy_Vtoce	aligned like vtoce_buffer based (Copy_Vtocep);

/*  External  */

dcl	error_table_$invalid_pvtx
			fixed bin (35) external;
dcl	error_table_$invalid_vtocx
			fixed bin (35) external;
dcl	error_table_$pvid_not_found
			fixed bin (35) external;
dcl	error_table_$vtoc_io_err
			fixed bin (35) external;
dcl	error_table_$vtoce_free
			fixed bin (35) external;
dcl	pds$processid	bit (36) aligned external;
dcl	pds$process_group_id
			char (32) aligned external;
dcl	pds$vtoc_reads	fixed bin (35) external;
dcl	pds$vtoc_writes	fixed bin (35) external;
dcl	pvt$n_entries	fixed bin external;

/*  Entry  */

dcl	dctl$read_sectors	entry (fixed bin, fixed bin (24), bit (18) aligned, fixed bin, fixed bin);
dcl	dctl$write_sectors	entry (fixed bin, fixed bin (24), bit (18) aligned, fixed bin, fixed bin);
dcl	disk_run		entry;
dcl	lock$lock_fast	entry (ptr);
dcl	lock$unlock_fast	entry (ptr);
dcl	pxss$addevent	entry (bit (36) aligned);
dcl	pxss$delevent	entry (bit (36) aligned);
dcl	pxss$wait		entry;
dcl	syserr		entry options (variable);
dcl	vtoc_search$hash_in entry (ptr);
dcl	vtoc_search$hash_out
			entry (ptr);
dcl	vtoc_search$search	entry (fixed bin, fixed bin, ptr);
dcl	vtoce_stock_man$check_in_use
			entry (ptr, fixed bin, fixed bin (35));
dcl	vtoce_stock_man$get_free_vtoce
			entry (ptr, fixed bin);
dcl	vtoce_stock_man$return_if_not_free
			entry (ptr, fixed bin, fixed bin (35));
dcl	vtoce_stock_man$return_free_vtoce
			entry (ptr, fixed bin);

/*  Builtin  */

dcl	addr		builtin;
dcl	bin		builtin;
dcl	bit		builtin;
dcl	convert		builtin;
dcl	divide		builtin;
dcl	mod		builtin;
dcl	null		builtin;
dcl	ptr		builtin;
dcl	rel		builtin;
dcl	size		builtin;
dcl	substr		builtin;
dcl	unspec		builtin;
%page;
/*        GET_VTOCE

	FUNCTION - This procedure copies the  vtoc  entry  defined  by  the
	input  arguments  (pvtx,vtocx)  into  the  caller's area pointed to by
	(copy_vtocep). The argument (parts) specifies  what  portions  of  the
	vtoc  entry is to be copied. The 64-word portion number i of the vtoce
	is copied into the user area only  if  bit  number  i  is  ON  in  the
	argument  parts.  Three  error  code may be returned: pvid_not_found,
	vtoc_io_err, or invalid_vtocx. */

	pvid = Pvid;
	pvtx = Pvtx;
	vtocx = Vtocx;
	parts = Parts;
	Code = 0;

	call SETUP_LOCK (pvtx, code);
	if code ^= 0
	then goto GET_VTOCE_RETURNS;

	call VALIDATE_VTOCX (vtocx, code);
	if code ^= 0
	then goto GET_VTOCE_RETURNS;


	call READ (pvtx, vtocx, parts, vtoc_buf_descp, vtoc_bufp, sector_read_required, code);
	if code ^= 0
	then goto GET_VTOCE_RETURNS;

	unspec (local_vtoce_buffer) = unspec (vtoce_buffer);

GET_VTOCE_RETURNS:
	call UNLOCK;
	vtoc_buffer.meters.call_get = vtoc_buffer.meters.call_get + 1;

	if code = 0
	then call COPY_PARTS (parts, addr (local_vtoce_buffer), Copy_Vtocep);

	Code = code;

	return;
%page;
/*        READ_AHEAD_VTOCE -

	FUNCTION - This procedure initiates a read to a specified VTOC entry,
	unless the VTOC entry is already in a VTOC buffer. It is similar to
	get_vtoce, except that it does not wait, and it returns no data
	to the caller. It is intended for routines which scan the VTOC
	sequentially (or in any predetermined order), to overlap VTOC I/O
	with processing. Three error codes may be returned: pvid_not_found,
	vtoc_io_err, or invalid_vtocx. */

read_ahead_vtoce:
     entry (Pvid, Pvtx, Vtocx, Parts, Code);

	pvid = Pvid;
	pvtx = Pvtx;
	vtocx = Vtocx;
	parts = Parts;
	Code = 0;

	call SETUP_LOCK (pvtx, code);
	if code ^= 0
	then goto READ_AHEAD_VTOCE_RETURNS;

	call VALIDATE_VTOCX (vtocx, code);
	if code ^= 0
	then goto READ_AHEAD_VTOCE_RETURNS;

	call READ_AHEAD (pvtx, vtocx, parts, vtoc_buf_descp, vtoc_bufp, sector_read_required, code);

READ_AHEAD_VTOCE_RETURNS:
	call UNLOCK;


	Code = code;

	return;


%page;
/*        PUT_VTOCE -

	FUNCTION - This procedure copies the vtoc  entry  from  the  user's
	area  located at (copy_vtocep) into the real vtoc entry defined by the
	(pvtx,vtocx) pair. The argument (parts) specifies what portions of the
	user's area is to be copied into the  real  vtoc  entry.  The  64-word
	portion  number  i  of  the user's vtoce is copied into the real vtoce
	only if bit number i is ON in the input argument parts. Three error
	codes may be returned: pvid_not_found, vtoc_io_err, or invalid_vtocx. */

put_vtoce:
     entry (Pvid, Pvtx, Vtocx, Parts, Copy_Vtocep, Code);

	pvid = Pvid;
	pvtx = Pvtx;
	vtocx = Vtocx;
	parts = Parts;
	Code = 0;
	sector_read_required = "0"b;
	parts_to_write = parts;
	call COPY_PARTS (parts, Copy_Vtocep, addr (local_vtoce_buffer));
						/* Avoid segfault with buffers locked */

	call SETUP_LOCK (pvtx, code);
	if code ^= 0
	then goto PUT_VTOCE_RETURNS;

	call VALIDATE_VTOCX (vtocx, code);
	if code ^= 0
	then goto PUT_VTOCE_RETURNS;

	vtoc_buffer.unsafe_pvtx = pvtx;		/* Update in progress */
	if (SECTORS_PER_VTOCE (pvte.device_type) = 1) & (parts ^= ALL_PARTS)
	then do;					/* 512_word sector device and not all parts */
		call READ (pvtx, vtocx, ALL_PARTS, vtoc_buf_descp, vtoc_bufp, sector_read_required, code);
		if code ^= 0
		then goto PUT_VTOCE_RETURNS;
		parts_to_write = ALL_PARTS;
	     end;

	else call GET_BUFFER (pvtx, vtocx, vtoc_buf_descp, vtoc_bufp, code);
						/* Get a buffer, wait until not out-of-service */
	if code ^= 0
	then goto PUT_VTOCE_RETURNS;
	call CLEAR_PAD (addr (local_vtoce_buffer), parts);/* No dirty bits */
	call COPY_PARTS (parts, addr (local_vtoce_buffer), vtoc_bufp);
						/* Update the buffer */

	call WRITE (parts_to_write, vtoc_buf_descp);	/* Write it out */
	if sector_read_required
	then vtoc_buffer.meters.soft_rar = vtoc_buffer.meters.soft_rar + 1;
PUT_VTOCE_RETURNS:
	vtoc_buffer.unsafe_pvtx = 0;
	call UNLOCK;
	vtoc_buffer.meters.call_put = vtoc_buffer.meters.call_put + 1;
	Code = code;
	return;
%page;
/*        ALLOC_AND_PUT_VTOCE -

	FUNCTION - This procedure removes a vtoc entry from the  free  pool
	for  the  physical volume defined by (pvtx), initializes the allocated
	VTOC entry with the data for the segment being created and returns the
	VTOC index of that entry. If there is no more free VTOC entry  in  the
	specified  physical  volume, it returns the value (-1). Three error code
	may be returned: pvid_not_found, vtoc_io_err, or invalid_vtocx. Whenever
	a  non  zero code is returned, the returned vtoc index is (-1). */

alloc_and_put_vtoce:
     entry (Pvid, Pvtx, Copy_Vtocep, Code) returns (fixed bin (17));

	pvid = Pvid;
	pvtx = Pvtx;
	Code = 0;
	return_vtocx = -1;

	unspec (local_vtoce_buffer) = unspec (Copy_Vtoce);/* Avoid segfaults with buffers locked */

	call SETUP_LOCK (pvtx, code);
	if code ^= 0
	then goto ALLOC_PUT_RETURNS;

RETRY_ALLOC:
	old_pseudo_clock = vtoc_buffer.scavenger_free_p_clock;

	call vtoce_stock_man$get_free_vtoce (pvtep, vtocx);
	if vtocx = -1
	then goto ALLOC_PUT_RETURNS;			/* None left */

	call VALIDATE_VTOCX (vtocx, code);		/* Make sure a valid index */
	if code ^= 0
	then do;
		call SET_VOL_TROUBLE (pvtep, vtocx, "Invalid free");
		goto RETRY_ALLOC;			/* Might win */
	     end;

	call READ (pvtx, vtocx, ALL_PARTS, vtoc_buf_descp, vtoc_bufp, sector_read_required, code);
	if code ^= 0
	then goto ALLOC_PUT_RETURNS;
	vtocep = vtoc_bufp;
	if vtoce.uid ^= ""b
	then do;
		call SET_VOL_TROUBLE (pvtep, vtocx, "UID ^= 0 in free VTOCE");
		goto RETRY_ALLOC;
	     end;

	if vtoc_buffer.scavenger_free_p_clock ^= old_pseudo_clock
	then do;					/* Scavenger has freed a VTOCE - better make sure it isn't this one */
		vtoc_buffer.meters.scavenger_free_checks = vtoc_buffer.meters.scavenger_free_checks + 1;
		call vtoce_stock_man$check_in_use (pvtep, vtocx, code);
		if code ^= 0
		then do;				/* Lost race */
			vtoc_buffer.meters.scavenger_free_losses = vtoc_buffer.meters.scavenger_free_losses + 1;
			goto RETRY_ALLOC;
		     end;
	     end;

	vtoc_buffer.unsafe_pvtx = pvtx;		/* Update in progress */

	call CLEAR_PAD (addr (local_vtoce_buffer), ALL_PARTS);
						/* wash the naughty bits */
	unspec (vtoce_buffer) = unspec (local_vtoce_buffer);
	call WRITE (ALL_PARTS, vtoc_buf_descp);

	return_vtocx = vtocx;

ALLOC_PUT_RETURNS:
	vtoc_buffer.unsafe_pvtx = 0;
	call UNLOCK;
	vtoc_buffer.meters.call_alloc = vtoc_buffer.meters.call_alloc + 1;

	Code = code;
	return (return_vtocx);
%page;
/*        FREE_VTOCE -

	FUNCTION - This procedure zeros the vtoc entry defined by the input
	arguments (pvtx,vtocx). Then it adds that vtoc entry in the free  pool
	for  the  physical  volume  defined  by  (pvtx). Three error codes may be
	returned: pvid_not_found, vtoc_io_err, or invalid_vtocx. */

free_vtoce:
     entry (Pvid, Pvtx, Vtocx, Code);

	pvid = Pvid;
	pvtx = Pvtx;
	vtocx = Vtocx;
	Code = 0;

	call SETUP_LOCK (pvtx, code);
	if code ^= 0
	then goto FREE_VTOCE_RETURNS;

	call VALIDATE_VTOCX (vtocx, code);
	if code ^= 0
	then goto FREE_VTOCE_RETURNS;

	call GET_BUFFER (pvtx, vtocx, vtoc_buf_descp, vtoc_bufp, code);
						/* Get a buffer, wait for not out-of-service */
	if code ^= 0
	then goto FREE_VTOCE_RETURNS;

	unspec (vtoce_buffer.parts) = ""b;		/* Mark it free - the whole thing */
	call WRITE (ALL_PARTS, vtoc_buf_descp);

	call vtoce_stock_man$return_free_vtoce (pvtep, vtocx);
						/* Return it to the stock */

FREE_VTOCE_RETURNS:
	call UNLOCK;
	vtoc_buffer.meters.call_free = vtoc_buffer.meters.call_free + 1;

	Code = code;
	return;
%page;
/*        FREE_VTOCE_FOR_SCAVENGE -

          FUNCTION - frees a VTOCE that the volume scavenger thinks is lost
	(free but not in map). Under appropriate locks, it checks that the
	VTOCE is still free. It calls a special entry in vtoce_stock_man
	that frees it only if it is not already free. Four error codes may
	be returned: pvid_not_found, vtoc_io_err, invalid_vtocx, or 
	vtoce_free.

	There is a race here, but it is safe. The VTOCE being freed could
	be in allocation, with the allocating process waiting for the
	read to complete. If we see the read completing before the
	allocating process, we will think that the VTOCE is free and
	mark it as such in the map. This is safe, since the VTOCE will
	never be allocated with a non-zero UID.

	On the other hand, it is annoying, since it causes spurious volume
	inconsistencies. The race is avoided by using a pseudo-clock, which
	is incremented under the VTOC Buffer Lock each time we free a
	VTOCE for the scavenger. VTOCE allocation checks the value of this
	pseudo-clock when it is given a vtocx and after the VTOCE read
	completes. If it has changed, it makes sure that the vtocx is
	in-use.
*/

free_vtoce_for_scavenge:
     entry (Pvid, Pvtx, Vtocx, Code);


	pvid = Pvid;
	pvtx = Pvtx;
	vtocx = Vtocx;
	Code = 0;

	call SETUP_LOCK (pvtx, code);
	if code ^= 0
	then goto FREE_FOR_SCAVENGE_RETURNS;

	call VALIDATE_VTOCX (vtocx, code);
	if code ^= 0
	then goto FREE_FOR_SCAVENGE_RETURNS;

	call READ (pvtx, vtocx, ALL_PARTS, vtoc_buf_descp, vtoc_bufp, sector_read_required, code);
	if code ^= 0
	then goto FREE_FOR_SCAVENGE_RETURNS;

	vtocep = vtoc_bufp;
	if vtoce.uid ^= ""b
	then do;
		code = error_table_$vtoce_free;	/* Someone else did it */
		goto FREE_FOR_SCAVENGE_RETURNS;
	     end;

	unspec (vtoce) = ""b;
	call WRITE (ALL_PARTS, vtoc_buf_descp);

	call vtoce_stock_man$return_if_not_free (pvtep, vtocx, code);

	vtoc_buffer.scavenger_free_p_clock = vtoc_buffer.scavenger_free_p_clock + 1;
	if vtoc_buffer.scavenger_free_p_clock > MAX_PSEUDO_CLOCK
	then vtoc_buffer.scavenger_free_p_clock = 0;

FREE_FOR_SCAVENGE_RETURNS:
	call UNLOCK;

	Code = code;
	return;


%page;
/*        AWAIT_VTOCE -

	FUNCTION - This procedure is called by  programs which  update vtoces
	and subsequently deposit addresses. It awaits all  pendant I/O on a sel-
	ected vtoce, so that the addresses  to  be  deposited will not be avail-
	able for  reassignment until it is  known that  they no longer appear in
	the old vtoce. This is solely for unrecoverable disk failures. The error
	codes which may be returned are pvid_not_found, vtoc_io_err, and invalid_vtocx. */

await_vtoce:
     entry (Pvid, Pvtx, Vtocx, Code);

	pvid = Pvid;
	pvtx = Pvtx;
	vtocx = Vtocx;
	Code = 0;

	call SETUP_LOCK (pvtx, code);
	if code ^= 0
	then goto AWAIT_RETURNS;

	call VALIDATE_VTOCX (vtocx, code);
	if code ^= 0
	then goto AWAIT_RETURNS;

RETRY_AWAIT:
	call vtoc_search$search (pvtx, vtocx, vtoc_buf_descp);
						/* See if the VTOCE still has a buffer */
	if vtoc_buf_descp = null ()
	then goto AWAIT_RETURNS;			/* No - easy case */

	if vtoc_buf_desc.os
	then do;
		call WAIT (vtoc_buf_descp, code);	/* Wait until not out-of-service */
		if code ^= 0
		then goto AWAIT_RETURNS;		/* Might have disappeared */
		goto RETRY_AWAIT;
	     end;

	if vtoc_buf_desc.write_sw & vtoc_buf_desc.err	/* Hot buffer */
	then code = error_table_$vtoc_io_err;

AWAIT_RETURNS:
	call UNLOCK;
	vtoc_buffer.meters.call_await = vtoc_buffer.meters.call_await + 1;

	Code = code;
	return;
%page;
/*        CLEANUP_PV - 

	FUNCTION - Guarantees that the physical volume supplied does not have 
	any portion of its VTOC in the vtoc_buffers. If it does, and nothing can be
	done about it (hot buffer, hard I/O error), the volume inconsistency
	count is increased. */

cleanup_pv:
     entry (Pvtx, Code);

	pvid = ""b;
	pvtx = Pvtx;
	vtocx = -1;
	Code = 0;

	call SETUP_LOCK (pvtx, code);			/* Will get non-zero code during demount */

	do bufx = 1 to vtoc_buffer.n_bufs;		/* Requeue writes on hot buffers */
	     vtoc_buf_descp = addr (vtoc_buf_desc_array (bufx));
	     if vtoc_buf_desc.pvtx = pvtx & vtoc_buf_desc.used = "1"b /* This volume, Buffer in use */
		& vtoc_buf_desc.err & vtoc_buf_desc.write_sw & ^vtoc_buf_desc.os
						/* Hot buffer */
	     then call WRITE ((vtoc_buf_desc.parts_used), vtoc_buf_descp);
	end;

	do bufx = 1 to vtoc_buffer.n_bufs;		/* Wait for all out-of-service */
	     vtoc_buf_descp = addr (vtoc_buf_desc_array (bufx));
	     do while (vtoc_buf_desc.pvtx = pvtx & vtoc_buf_desc.used /* This volume, Buffer in use */
		& vtoc_buf_desc.os);		/* Out-of-service */
		call WAIT (vtoc_buf_descp, code);
	     end;
	end;

	code = 0;
	do bufx = 1 to vtoc_buffer.n_bufs;		/* Flush buffers, abandon hot buffers */
	     vtoc_buf_descp = addr (vtoc_buf_desc_array (bufx));
	     if vtoc_buf_desc.pvtx = pvtx & vtoc_buf_desc.used
						/* This volume, Buffer in use */
	     then do;
		     if vtoc_buf_desc.os
		     then call syserr (CRASH, "vtoc_man: Buffer out-of-service during cleanup");
		     if vtoc_buf_desc.write_sw & vtoc_buf_desc.err
						/* Hot buffer */
		     then do;
			     call SET_VOL_TROUBLE (pvtep, (vtoc_buf_desc.vtocx),
				"Hot buffer abandoned during cleanup");
			     code = error_table_$vtoc_io_err;
			end;
		     call FLUSH_BUFFER (vtoc_buf_descp);
		end;
	end;

	call UNLOCK;

	Code = code;
	return;
%page;
/*        STABILIZE - 

	FUNCTION - This entry is called only during emergency shutdown. It
	makes the vtoc_buffer consistent so that shutdown can succeed. This
	process includes busting the lock, rethreading all buffers into
	the hash table, abandoning in-progress reads, and setting in-progress
	writes to "hot". */

stabilize:
     entry;

	pvid = ""b;
	pvtx = -1;
	vtocx = -1;

	vtoc_buffer_segp = addr (vtoc_buffer_seg$);
	vtoc_buffer.lock.processid = ""b;		/* Bust the lock */

	call SETUP_LOCK (pvtx, code);

	call RETHREAD;

	do bufx = 1 to vtoc_buffer.n_bufs;
	     vtoc_buf_descp = addr (vtoc_buf_desc_array (bufx));
	     if vtoc_buf_desc.used & vtoc_buf_desc.os	/* Buffer in use, I/O in progress */
	     then if vtoc_buf_desc.write_sw
		then do;				/* Write */
			vtoc_buf_desc.err = "1"b;	/* Make hot */
			vtoc_buf_desc.os = "0"b;
		     end;
		else call FLUSH_BUFFER (vtoc_buf_descp);
	end;

	call UNLOCK;

	return;
%page;
/*        CRAWLOUT -

	FUNCTION - This entry is called only by verify_lock when it has
	found the vtoc buffer lock held by the process.  It checks for
	inconsistent buffer states and corrects them (specifically, 
	out-of-service but no I/O queued).  Before doing this, it waits
	for the associated event, to cover the case where the I/O
	was queued successfully, but the crawlout occurred afterwards.
	If the I/O was not queued successfully, the wait will end
	via notify-time-out.  If a physical volume is
	potentially inconsistent ("unsafe"), the volume inconsistency
	count is increased. Note that the vtoc buffer lock is left locked
	on exit - verify_lock busts it for us. */

crawlout:
     entry;


	vtoc_buffer_segp = addr (vtoc_buffer_seg$);
	vtoc_buf_desc_arrayp = ptr (vtoc_buffer_segp, vtoc_buffer.buf_desc_offset);
	vtoc_buf_arrayp = ptr (vtoc_buffer_segp, vtoc_buffer.buf_offset);
	pvt_arrayp = addr (pvt$array);

	if vtoc_buffer.lock.processid ^= pds$processid
	then return;				/* Invalid call */

	call RETHREAD;				/* May be inconsistent */

	if vtoc_buffer.unsafe_pvtx ^= 0
	then do;					/* Update in progress */
		pvtep = addr (pvt_array (vtoc_buffer.unsafe_pvtx));
		call SET_VOL_TROUBLE (pvtep, -1, "Update in progress on crawlout by " || pds$process_group_id);
	     end;

	do bufx = 1 to vtoc_buffer.n_bufs;		/* Look for inconsistent buffers */
	     vtoc_buf_descp = addr (vtoc_buf_desc_array (bufx));
	     if vtoc_buf_desc.used & vtoc_buf_desc.os & ^vtoc_buf_desc.ioq
						/* buffer in use, out-of-service, not queued */
	     then do;
		     pvtx = vtoc_buf_desc.pvtx;
		     vtocx = vtoc_buf_desc.vtocx;
		     wait_event = bit (bin (vtoc_buffer.wait_event_constant + vtoc_buf_desc.wait_index, 36), 36);
		     call pxss$addevent (wait_event);
		     call lock$unlock_fast (addr (vtoc_buffer.lock));
		     call pxss$wait;		/* Wait 1 NTO interval */
		     call lock$lock_fast (addr (vtoc_buffer.lock));
		     if vtoc_buf_desc.used & vtoc_buf_desc.os
			& ^vtoc_buf_desc.ioq /* Buffer in use, out-of-service, not queued */
			& vtoc_buf_desc.pvtx = pvtx & vtoc_buf_desc.vtocx = vtocx
						/* Still the same one */
		     then do;
			     pvtep = addr (pvt_array (pvtx));
			     if vtoc_buf_desc.write_sw
			     then do;		/* Write */
				     call syserr (LOG,
					"vtoc_man: write I/O recovered on crawlout by ^a for ^a_^a^a vtocx ^o",
					pds$process_group_id, pvte.devname,
					convert (p99, pvte.logical_area_number), pvte.sv_name, vtocx);
				     vtoc_buf_desc.os = "0"b;
				     call WRITE ((vtoc_buf_desc.parts_used), vtoc_buf_descp);
				end;
			     else do;		/* Read */
				     call syserr (LOG,
					"vtoc_man: read reset on crawlout by ^a for ^a_^a^a vtocx ^o",
					pds$process_group_id, pvte.devname,
					convert (p99, pvte.logical_area_number), pvte.sv_name, vtocx);
				     call FLUSH_BUFFER (vtoc_buf_descp);
				end;
			end;
		end;
	end;


	return;
%page;
/*	CLEAR_PAD - clears pad fields in the vtoce prior to copying to buffer for write. */

CLEAR_PAD:
     proc (Clear_ptr, Parts);

dcl	Clear_ptr		ptr;
dcl	Parts		bit (3) aligned;

dcl	1 Clear_vtoce	aligned like vtoce based (Clear_ptr);

	if (Parts & "100"b)
	then do;
		Clear_vtoce.pad_free_vtoce_chain = ""b;
		Clear_vtoce.pad2 = ""b;
		Clear_vtoce.pad3 = ""b;
		Clear_vtoce.pad4 = ""b;
	     end;
	if (Parts & "001"b)
	then do;
		unspec (Clear_vtoce.pad6) = ""b;
		Clear_vtoce.pad7 = ""b;
		Clear_vtoce.pad8 = ""b;
		Clear_vtoce.pad9 = ""b;
	     end;

     end CLEAR_PAD;
%page;
/*        COPY_PARTS - copies VTOCE parts between two buffers as specified
	by a mask.
*/

COPY_PARTS:
     proc (Parts, From_ptr, To_ptr);

dcl	Parts		bit (3) aligned;
dcl	From_ptr		ptr;
dcl	To_ptr		ptr;

dcl	partsx		fixed bin;

dcl	1 From_Vtoce_Buffer aligned like vtoce_buffer based (From_ptr);
dcl	1 To_Vtoce_Buffer	aligned like vtoce_buffer based (To_ptr);

	do partsx = 1 to N_PARTS_PER_VTOCE;
	     if substr (Parts, partsx, 1) = "1"b
	     then unspec (To_Vtoce_Buffer.parts (partsx)) = unspec (From_Vtoce_Buffer.parts (partsx));
	end;

     end COPY_PARTS;
%page;
/*        Routines to compute parameters needed by disk control

	CORE   - computes the absolute memory address

	RECORD - computes the Multics record number

	SECTOR - computes the sector within record
*/

CORE:
     proc (Vtoc_buf_descp) returns (fixed bin (24));

dcl	Vtoc_buf_descp	ptr;
dcl	1 Vtoc_buf_desc	aligned like vtoc_buf_desc based (Vtoc_buf_descp);

	return (vtoc_buffer.abs_addr + bin (Vtoc_buf_desc.buf_rel));

     end CORE;



RECORD:
     proc (Vtoc_buf_descp) returns (bit (18) aligned);

dcl	Vtoc_buf_descp	ptr;
dcl	1 Vtoc_buf_desc	aligned like vtoc_buf_desc based (Vtoc_buf_descp);

	return (bit (bin (VTOC_ORIGIN + divide (Vtoc_buf_desc.vtocx, VTOCES_PER_RECORD (dev_type), 17), 18), 18));

     end RECORD;


SECTOR:
     proc (Vtoc_buf_descp) returns (fixed bin (17));

dcl	Vtoc_buf_descp	ptr;
dcl	1 Vtoc_buf_desc	aligned like vtoc_buf_desc based (Vtoc_buf_descp);


	return (mod (Vtoc_buf_desc.vtocx, VTOCES_PER_RECORD (dev_type)) * SECTORS_PER_VTOCE (dev_type));

     end SECTOR;


%page;
/*        SET_VOL_TROUBLE - increments the count of volume inconsistencies
	and logs a message into syserr.
*/

SET_VOL_TROUBLE:
     proc (Pvtep, Vtocx, Msg);

dcl	Pvtep		ptr;
dcl	Vtocx		fixed bin;
dcl	Msg		char (*);

dcl	1 Pvte		aligned like pvte based (Pvtep);

	Pvte.vol_trouble_count = Pvte.vol_trouble_count + 1;

	call syserr (LOG, "vtoc_man: ^a ^[vtocx ^o ^;^1s^]on ^a_^a^a", Msg, (Vtocx ^= -1), Vtocx, Pvte.devname,
	     convert (p99, Pvte.logical_area_number), Pvte.sv_name);

     end SET_VOL_TROUBLE;
%page;
/*        RETHREAD - procedure to walk the vtoc_buffer linearly and
	thread all in-use buffers into the hash table. This is called
	if damage is suspected.
*/

RETHREAD:
     proc;

	unspec (vtoc_buffer.hash_table) = ""b;		/* Clear out the old hash table */

	do bufx = 1 to vtoc_buffer.n_bufs;
	     vtoc_buf_descp = addr (vtoc_buf_desc_array (bufx));
	     if vtoc_buf_desc.used
	     then call vtoc_search$hash_in (vtoc_buf_descp);
	end;

     end RETHREAD;
%page;
/*        FLUSH_BUFFER - procedure to clear a buffer descriptor and thread
	it out of the hash table.
*/

FLUSH_BUFFER:
     proc (Vtoc_buf_descp);

dcl	Vtoc_buf_descp	ptr;
dcl	1 Vtoc_buf_desc	aligned like vtoc_buf_desc based (Vtoc_buf_descp);

	call vtoc_search$hash_out (Vtoc_buf_descp);

	vtoc_buffer.search_index =
	     divide (bin (rel (Vtoc_buf_descp)) - bin (rel (vtoc_buf_desc_arrayp)), size (vtoc_buf_desc), 17) + 1;
						/* Set to look at this one first */

	unspec (Vtoc_buf_desc) = ""b;


     end FLUSH_BUFFER;
%page;
/*        GET_BUFFER - procedure to find a buffer given a pvtx and vtocx.
	If the VTOCE so defined already has a buffer, it is returned.
	Otherwise, one is allocated. This routine does not return until
	the buffer is not out-of-service.
	
	GET_BUFFER_NOWAIT - identical to GET_BUFFER, except that it does
	not wait for the buffer to be not out-of-service.
*/

GET_BUFFER:
     proc (Pvtx, Vtocx, Vtoc_buf_descp, Vtoc_bufp, Code);

dcl	Pvtx		fixed bin;
dcl	Vtocx		fixed bin;
dcl	Vtoc_buf_descp	ptr;
dcl	Vtoc_bufp		ptr;
dcl	Code		fixed bin (35);

dcl	first_time	bit (1) aligned;
dcl	skip_waiting	bit (1) aligned;
dcl	steps		fixed bin;
dcl	wait_sw		bit (1) aligned;
dcl	1 Vtoc_buf_desc	aligned like vtoc_buf_desc based (Vtoc_buf_descp);


	wait_sw = "1"b;
	goto GET_BUFFER_JOIN;


GET_BUFFER_NOWAIT:
     entry (Pvtx, Vtocx, Vtoc_buf_descp, Vtoc_bufp, Code);

	wait_sw = "0"b;

GET_BUFFER_JOIN:
	Code = 0;
	vtoc_buffer.meters.get_buffer_calls = vtoc_buffer.meters.get_buffer_calls + 1;
	first_time = "1"b;


GET_BUFFER_RETRY:
	call vtoc_search$search (Pvtx, Vtocx, Vtoc_buf_descp);
						/* Look for existing buffer with this VTOCE */
	if Vtoc_buf_descp ^= null () & first_time
	then vtoc_buffer.meters.get_buffer_hits = vtoc_buffer.meters.get_buffer_hits + 1;
	first_time = "0"b;

	if Vtoc_buf_descp = null ()
	then do;					/* Not there */
		steps = 0;
		skip_waiting = "1"b;		/* Skip those with notify_sw the first pass */
		bufx = vtoc_buffer.search_index;	/* Roving pointer */
		do while ("1"b);
		     vtoc_buffer.meters.steps = vtoc_buffer.meters.steps + 1;
		     steps = steps + 1;
		     Vtoc_buf_descp = addr (vtoc_buf_desc_array (bufx));

		     if ^Vtoc_buf_desc.used
		     then goto FOUND;

		     if Vtoc_buf_desc.os
		     then vtoc_buffer.meters.skip_os = vtoc_buffer.meters.skip_os + 1;
		     else if Vtoc_buf_desc.write_sw & Vtoc_buf_desc.err
		     then vtoc_buffer.meters.skip_hot = vtoc_buffer.meters.skip_hot + 1;
		     else if Vtoc_buf_desc.notify_sw & skip_waiting
		     then vtoc_buffer.meters.skip_wait = vtoc_buffer.meters.skip_wait + 1;
		     else goto FOUND;		/* Nemine contradiscente */

		     if steps > MAX_STEPS
		     then call syserr (CRASH, "vtoc_man: Out of buffers");
		     bufx = bufx + 1;
		     if bufx > vtoc_buffer.n_bufs
		     then bufx = 1;
		     if bufx = vtoc_buffer.search_index
		     then do;			/* Went around once more */
			     skip_waiting = "0"b;	/* Only skip these on first pass */
			     call disk_run;		/* Poll for lost interrupts */
			end;
		end;

FOUND:
		if bufx >= vtoc_buffer.n_bufs
		then vtoc_buffer.search_index = 1;
		else vtoc_buffer.search_index = bufx + 1;
						/* Set to look at next first */

		if Vtoc_buf_desc.used
		then call FLUSH_BUFFER (Vtoc_buf_descp);

		Vtoc_buf_desc.pvtx = Pvtx;
		Vtoc_buf_desc.vtocx = Vtocx;
		Vtoc_buf_desc.used = "1"b;
		Vtoc_buf_desc.wait_index = bufx;
		Vtoc_buf_desc.buf_rel = rel (addr (vtoce_buffer_array (bufx)));

		call vtoc_search$hash_in (Vtoc_buf_descp);

	     end;

	if Vtoc_buf_desc.os & wait_sw
	then do;
		call WAIT (Vtoc_buf_descp, Code);
		if Code ^= 0
		then do;
			Vtoc_buf_descp = null ();
			Vtoc_bufp = null ();
			return;
		     end;
		goto GET_BUFFER_RETRY;
	     end;


	Vtoc_bufp = ptr (vtoc_buffer_segp, Vtoc_buf_desc.buf_rel);

     end GET_BUFFER;

%page;
/*        READ - Routine to read a VTOCE. It gets a buffer (possibly containing
	part of all of the VTOCE in question). If the parts desired are
	in the buffer, it returns with the buffer. If not, it reads the
	entire VTOCE and waits for the completion of the read. Note that
	the buffer can disappear if READ waits for an I/O (since it unlocks
	the vtoc buffers, waits, and relocks).

	READ_AHEAD - Similar to READ, except that it does not wait.
*/

READ:
     proc (Pvtx, Vtocx, Parts, Vtoc_buf_descp, Vtoc_bufp, Sector_read_required, Code);

dcl	Pvtx		fixed bin;
dcl	Vtocx		fixed bin;
dcl	Parts		bit (3) aligned;
dcl	Vtoc_buf_descp	ptr;
dcl	Vtoc_bufp		ptr;
dcl	Sector_read_required
			bit (1) aligned;
dcl	Code		fixed bin (35);

dcl	wait_sw		bit (1) aligned;

dcl	1 Vtoc_buf_desc	aligned like vtoc_buf_desc based (Vtoc_buf_descp);


	wait_sw = "1"b;
	goto READ_JOIN;


READ_AHEAD:
     entry (Pvtx, Vtocx, Parts, Vtoc_buf_descp, Vtoc_bufp, Sector_read_required, Code);

	wait_sw = "0"b;

READ_JOIN:
	Sector_read_required = "0"b;
	Code = 0;
	hot_buffer_tried = "0"b;			/* first time to retry_read */
RETRY_READ:
	if wait_sw
	then call GET_BUFFER (Pvtx, Vtocx, Vtoc_buf_descp, Vtoc_bufp, Code);
	else call GET_BUFFER_NOWAIT (Pvtx, Vtocx, Vtoc_buf_descp, Vtoc_bufp, Code);
	if Code ^= 0
	then return;

	if ^wait_sw & Vtoc_buf_desc.os
	then return;

	if Vtoc_buf_desc.err			/* I/O error */
	then do;
		if ^Vtoc_buf_desc.write_sw		/* Not hot buffer */
		then call FLUSH_BUFFER (Vtoc_buf_descp);
		else if ^hot_buffer_tried
		then do;				/* Hot buffer, retry write */
			hot_buffer_tried = "1"b;
			pvt_arrayp = addr (pvt$array);
			pvtep = addr (pvt_array (Pvtx));
			call syserr (LOG, "vtoc_man: Write I/O being retried by ^a for ^a_^a^a vtocx ^o",
			     pds$process_group_id, pvte.devname, convert (p99, pvte.logical_area_number),
			     pvte.sv_name, Vtocx);
			Vtoc_buf_desc.os = "0"b;	/* Should be anyhow... */

			call WRITE ((Vtoc_buf_desc.parts_used), Vtoc_buf_descp);
			goto RETRY_READ;
		     end;

		Code = error_table_$vtoc_io_err;
		Vtoc_buf_descp = null ();
		Vtoc_bufp = null ();
		return;
	     end;

	if (Vtoc_buf_desc.parts_used & Parts) = Parts	/* Got what they want */
	then return;

	Vtoc_buf_desc.write_sw = "0"b;
	Vtoc_buf_desc.err = "0"b;
	Vtoc_buf_desc.notify_sw = "0"b;
	Vtoc_buf_desc.ioq = "0"b;
	Vtoc_buf_desc.os = "1"b;

	dev_type = addr (pvt_array (Pvtx)) -> pvte.device_type;

	call dctl$read_sectors (Pvtx, CORE (Vtoc_buf_descp), RECORD (Vtoc_buf_descp), SECTOR (Vtoc_buf_descp),
	     SECTORS_PER_VTOCE (dev_type));
	Sector_read_required = "1"b;
	Vtoc_buf_desc.ioq = "1"b;
	Vtoc_buf_desc.parts_used = ALL_PARTS;

	vtoc_buffer.meters.disk_reads = vtoc_buffer.meters.disk_reads + 1;
	pds$vtoc_reads = pds$vtoc_reads + 1;

	if wait_sw
	then goto RETRY_READ;

	return;

     end READ;
%page;
/*        WRITE - This procedure writes the parts specified for a given
	vtoc buffer. It does not await its completion.
*/

WRITE:
     proc (Parts, Vtoc_buf_descp);

dcl	Parts		bit (3) aligned;
dcl	Vtoc_buf_descp	ptr;

dcl	partsx		fixed bin;

dcl	1 Vtoc_buf_desc	aligned like vtoc_buf_desc based (Vtoc_buf_descp);

dcl	n_sectors		fixed bin;
	if Vtoc_buf_desc.os
	then call syserr (CRASH, "vtoc_man: buffer out-of-service on write.");

	partsx = bin (Parts, 3);
	if ^VALID_WRITE (partsx)
	then call syserr (CRASH, "vtoc_man: Invalid write");

	Vtoc_buf_desc.err = "0"b;
	Vtoc_buf_desc.notify_sw = "0"b;
	Vtoc_buf_desc.ioq = "0"b;
	Vtoc_buf_desc.write_sw = "1"b;
	Vtoc_buf_desc.os = "1"b;

	dev_type = addr (pvt_array (Vtoc_buf_desc.pvtx)) -> pvte.device_type;

	if SECTORS_PER_VTOCE (dev_type) = 1
	then do;
		n_sectors = 1;
		if Parts ^= ALL_PARTS
		then do;
			call syserr (CRASH, "vtoc_man: Attempt to write less than entire VTOCE to ^d device.",
			     MODELN (dev_type));
		     end;
	     end;
	else n_sectors = SECTORS_TO_WRITE (partsx);
	call dctl$write_sectors ((Vtoc_buf_desc.pvtx), CORE (Vtoc_buf_descp) + CORE_OFFSET (partsx),
	     RECORD (Vtoc_buf_descp), SECTOR (Vtoc_buf_descp) + SECTOR_OFFSET (partsx), n_sectors);

	Vtoc_buf_desc.ioq = "1"b;
	if VALID_WRITE (bin ((Parts | Vtoc_buf_desc.parts_used), 3))
	then Vtoc_buf_desc.parts_used = Vtoc_buf_desc.parts_used | Parts;
	else Vtoc_buf_desc.parts_used = Parts;

	vtoc_buffer.meters.disk_writes = vtoc_buffer.meters.disk_writes + 1;
	pds$vtoc_writes = pds$vtoc_writes + 1;

     end WRITE;
%page;
/*        WAIT - Procedure to wait until a specified buffer is no longer
	out-of-service.
*/

WAIT:
     proc (Vtoc_buf_descp, Code);

dcl	Vtoc_buf_descp	ptr;
dcl	Code		fixed bin (35);

dcl	1 Vtoc_buf_desc	aligned like vtoc_buf_desc based (Vtoc_buf_descp);

	Code = 0;
	vtoc_buffer.meters.wait_calls = vtoc_buffer.meters.wait_calls + 1;

	do while (Vtoc_buf_desc.os);
	     wait_event = bit (bin (vtoc_buffer.wait_event_constant + Vtoc_buf_desc.wait_index, 36), 36);
	     call pxss$addevent (wait_event);
	     Vtoc_buf_desc.notify_sw = "1"b;
	     if Vtoc_buf_desc.os
	     then do;
		     vtoc_buffer.meters.wait_os = vtoc_buffer.meters.wait_os + 1;
		     call UNLOCK;
		     call pxss$wait;
		     call LOCK_CHECK (Code);
		     if Code ^= 0
		     then return;
		end;
	     else call pxss$delevent (wait_event);
	     Vtoc_buf_desc.notify_sw = "0"b;
	end;

     end WAIT;

%page;
/*        VALIDATE_VTOCX - Routine to check whether a given VTOCE index
	corresponds to a VTOCE on the volume. 
*/

VALIDATE_VTOCX:
     proc (Vtocx, Code);

dcl	Vtocx		fixed bin;
dcl	Code		fixed bin (35);

	if Vtocx < 0 | Vtocx >= pvte.n_vtoce
	then Code = error_table_$invalid_vtocx;
	else Code = 0;

     end VALIDATE_VTOCX;
%page;
/*        Setup, Locking, and Unlocking Routines

	SETUP_LOCK  - sets up global pointers, locks vtoc_buffers,
		    checks PVTE for still there, not being demounted

          LOCK_CHECK  - locks vtoc_buffers,
		    checks PVTE for still there, not being demounted

          UNLOCK      - unlocks vtoc_buffers
*/

SETUP_LOCK:
     proc (Pvtx, Code);

dcl	Pvtx		fixed bin;
dcl	Code		fixed bin (35);


dcl	code		fixed bin (35);

	vtoc_buffer_segp = addr (vtoc_buffer_seg$);
	vtoc_buf_desc_arrayp = ptr (vtoc_buffer_segp, vtoc_buffer.buf_desc_offset);
	vtoc_buf_arrayp = ptr (vtoc_buffer_segp, vtoc_buffer.buf_offset);
	pvt_arrayp = addr (pvt$array);

	Code = 0;
	pvtep = null ();

	if Pvtx < 0 | Pvtx > pvt$n_entries
	then Code = error_table_$invalid_pvtx;
	else pvtep = addr (pvt_array (Pvtx));

	call LOCK_CHECK (code);
	if code ^= 0
	then Code = code;

     end SETUP_LOCK;



LOCK_CHECK:
     proc (Code);

dcl	Code		fixed bin (35);

	Code = 0;

	if pvtep ^= null ()
	then do;
		if (pvid ^= ""b & pvid ^= pvte.pvid)
		then Code = error_table_$pvid_not_found;
		else if pvte.device_inoperative
		then Code = error_table_$vtoc_io_err;
		else if pvte.being_demounted2
		then Code = error_table_$pvid_not_found;
	     end;

	call lock$lock_fast (addr (vtoc_buffer.lock));


     end LOCK_CHECK;


UNLOCK:
     proc;

	call lock$unlock_fast (addr (vtoc_buffer.lock));


     end UNLOCK;

%page;
%include disk_pack;
%page;
%include pvte;
%page;
%include syserr_constants;
%page;
%include vtoc_buffer;
%page;
%include vtoce;
%page;
%include fs_dev_types;
%page;

/* BEGIN MESSAGE DOCUMENTATION

Message:
vtoc_man: Invalid free vtocx XXXXX on dskX_NN{s}

S:        $log

T:	$run

M:	A free VTOCE was allocated which has an invalid VTOCE index for the 
volume. This is indicative of damage to volume control structures. This
damage can be corrected by a volume salvage.

A:        $ignore

Message:
vtoc_man: Out of buffers try number N

S:        $info

T:        $run

M:        There may be a disk problem which prevents the vtoc buffers 
from being written to disk, or there may be a disk tuning problem. 
The system may crash within the next few minutes.

A:        $contact_sa

Message:
vtoc_man: UID ^= 0 in free VTOCE vtocx XXXXX dskX_NN{s}

S:        $log

T:        $run

M:        The contents of VTOCE XXXXX on dskX_NN{s} are incorrect, as free
VTOCEs should have a zero UID. The system attempts to find another free
VTOCE. This may indicate damage to volume control structures. This damage
can be corrected by a volume salvage.

A:        $ignore


Message:
vtoc_man: Buffer out-of-service during cleanup

S:        $crash

T:        When a volume is being demounted or during system shutdown.

M:        A likely software error in VTOC buffer management which caused
an inconsistency in the VTOC buffer.

A:        $recover


Message:
vtoc_man: Hot buffer abandoned during cleanup vtocx XXXXX dskX_NN{s}

S:        $log

T:        When a volume is being demounted or during system shutdown.

M:        An update to VTOCE XXXXX on dskX_NN{s} could not be completed
due to I/O errors. The VTOCE may be inconsistent or damaged.

A:        The VTOCE should be examined by means of dump_vtoce the next time
the volume is online. Any inconsistency can be corrected by a volume salvage.


Message:
vtoc_man: Write I/O being retried by PERSON.PROJECT.TAG for dskX_NN{s} vtocx XXXXX

S:	$log

T:	$run

M:	A buffer previously marked as "hot" is being requeued for I/O.

A:	$ignore


Message:
vtoc_man: write I/O recovered on crawlout by PERSON.PROJECT.TAG for dskX_NN{s} vtocx XXXXX

S:        $log

T:	$run

M:        The process of PERSON.PROJECT.TAG crawled out of ring-0 or terminated
with the VTOC buffer lock held. A buffer was marked out-of-service for write
to VTOCE XXXXX on dskX_NN{s} for which no I/O had been queued. The write I/O
was requeued.

A:        $ignore


Message:
vtoc_man: read reset of crawlout by PERSON.PROJECT.TAG for dskX_NN{s} vtocx XXXXXX

S:        $log

T:	$run

M:	The process of PERSON.PROJECT.TAG crawled out of ring-0 or terminated
with the VTOC buffer lock held. A buffer was marked out-of-service for read
to VTOCE XXXXX on dskX_NN{s} for which no I/O had been queued. The read I/O was
abandoned.

A:        $ignore


Message:
vtoc_man: Update in progress on crawlout by PERSON.PROJECT.TAG dskX_NN{s}

S:        $log

T:	$run

M:        The process of PERSON.PROJECT.TAG crawled out of ring-0 or terminated
with the vtoc buffer lock held and an update in progress for a VTOCE on dskX_NN{s}.
The VTOCE may be inconsistent. Any inconsistency can be corrected by a volume salvage.

A:        $ignore

Message:
vtoc_man: Invalid write

S:        $crash

T:        $run

M:        A likely software error in the calling sequence for output of a VTOCE.

A:        $recover


Message:
vtoc_man: buffer out-of-service on write

S:        $crash

T:	$run

M:	A likely software problem has caused an inconsistency in 
the VTOC buffer.

A:        $recover


Message:
vtoc_man: Attempt to write less than entire VTOCE to MODEL device.

S:        $crash

T:	$run

M:        An attempt has been made to write less than the entire VTOCE to a 
device MODEL that only supports a 512_word sector. For these devices the 
entire 192 word VTOCE must be written at one time. A likely software error 
n VTOC buffer management.

A:        $recover


END MESSAGE DOCUMENTATION */
     end vtoc_man$get_vtoce;




		    vtoc_search.alm                 11/11/89  1129.9rew 11/11/89  0851.5       45729



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 
"
"	vtoc_search - Routine to manage vtoc_buffer_seg's 
"	     hash table
"
"	Entries:
"
"	     hash_in  - hashes a VTOCE buffer desc into a list
"
"	     hash_out - hashes a VTOCE buffer desc out of a list
"
"	     search - searches for a given PVTE, VTOCE index
"
"	Written February 1982 by J. Bongiovanni
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 

	name	vtoc_search

	entry	hash_in
	entry	hash_out
	entry	search

	temp	save_pvtx_vtocx

null_ptr:
	its	-1,1
"
	include vtoc_buffer
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 
"
"	call vtoc_search$hash_in (vtoc_buf_descp)
"
"	     where vtoc_buf_descp -> buffer descriptor of interest
"
"	Must be called with VTOC buffer locked
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 

hash_in:
	push
	eppbp	ap|2,*		" bp -> vtoc_buf_descp
	eppbp	bp|0,*		" bp -> vtoc_buf_desc
	lda	bp|vtoc_buf_desc.pvtx " Areg has pvtx in Upper, vtocx in Lower
	tsx7	setup		" Set pointers, compute hash table index
	eax0	bp|0		" x0 = offset of this vtoc_buf_desc
	ldx3	bb|vtoc_buffer.hash_table,x2 " x3 = 1st offset this bucket
	stx0	bb|vtoc_buffer.hash_table,x2 " Make this the first
	stx3	bp|vtoc_buf_desc.ht_thread   " And the first shall be next
	return
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 
"
"	call vtoc_search$hash_out (vtoc_buf_descp)
"
"	where vtoc_buf_descp -> VTOC buffer descriptor of interest
"
"	This must be called with the VTOC buffer lock
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 

hash_out:
	push
	eppbp	ap|2,*		" bp -> vtoc_buf_descp
	eppbp	bp|0,*		" bp -> vtoc_buf_desc
	lda	bp|vtoc_buf_desc.pvtx " Areg has pvtx in Upper, vtocx in Lower
	tsx7	setup		" Set pointers, compute hash index
	tsx7	search_it		" Look for this one in list
	eax1	0,x1		" Found?
	tze	hash_out_returns	" No - shouldn't happen
	ldx3	bp|vtoc_buf_desc.ht_thread  " x3 = offset of next after this
	eax0	0,x0		" x0 = offset of previous
	tze	hash_out_empty	" None previous
	stx3	bb|vtoc_buf_desc.ht_thread,x0 " Link previous to next
	tra	hash_out_common
hash_out_empty:
	stx3	bb|vtoc_buffer.hash_table,x2  " Make next the first
hash_out_common:
	eax3	0		" Clear thread offset
	stx3	bp|vtoc_buf_desc.ht_thread  " In this one
hash_out_returns:
	return
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 
"
"	call vtoc_search$search (pvtx, vtocx, vtoc_buf_descp)
"
"	where
"
"	     pvtx = rel offset of PVTE (Input)
"	     vtocx = VTOCE index (Input)
"	     vtoc_buf_descp = ptr to vtoc_buf_desc or null
"
"	This must be called with the VTOC buffer lock.
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 

search:
	push
	lda	ap|2,*		" pvtx 
	ana	-1,dl		" Strip out any garbage
	als	18		" pvtx in Upper
	ora	ap|4,*		" vtocx in Lower
	tsx7	setup		" Set pointers, compute hash index
	tsx7	search_it		" Search hash thread
	eax1	0,x1		" x1 = offset of buf desc
	tze	search_not_found	" Not there
	eppbp	bb|0,x1		" bp -> buffer descriptor
	tra	search_returns
search_not_found:
	eppbp	null_ptr,*
search_returns:
	spribp	ap|6,*		" Return pointer or null
	return
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 
"
"	Internal procedure to search
"
"	tsx7	search_it
"
"	On entry,
"
"	     bb -> vtoc_buffer_seg
"	     Areg has pvte rel in Upper, vtocx in Lower
"	     x2 = hash index
"
"	On exit,
"
"	     x0 = offset of previous in thread (0 if none)
"	     x1 = offset of this entry (0 if none)
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 

search_it:
	eax0	0		" Initialize to none
	eax1	0
	ldx1	bb|vtoc_buffer.hash_table,x2 " x1 = offset of first
	tze	0,x7		" None

search_it_loop:
	cmpa	bb|vtoc_buf_desc.pvtx,x1 " This one a match
	tze	0,x7		" yes - exit
	eax0	0,x1		" Previous = current
	ldx1	bb|vtoc_buf_desc.ht_thread,x1  " Next
	tnz	search_it_loop	" Next exists
	eax1	0		" Not found
	tra	0,x7
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 
"
"	Internal procedure to set pointers and compute hash index
"
"	tsx7	setup
"
"	On entry,
"
"	     Areg has pvtx in Upper, vtocx in Lower
"
"	On exit,
"
"	     bb -> vtoc_buffer_seg
"
"	     x2 = hash index
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " 

setup:
	eppbb	vtoc_buffer_seg$
	sta	save_pvtx_vtocx	" pvtx, vtocx
	ldq	save_pvtx_vtocx

	qrl	18
	erq	save_pvtx_vtocx
	anq	bb|vtoc_buffer.hash_mask
	eax2	0,ql

	tra	0,x7


	end




		    vtoce_stock_man.pl1             11/11/89  1129.9r w 11/11/89  0851.6      150696



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */
vtoce_stock_man$get_free_vtoce:
     proc (Pvtep, Vtocx);

/*  Procedure to manage the VTOCE stock.  All actions are done under the
    protection of the per-volume VTOC Map lock.

    Entries:

    get_free_vtoce       - finds a free VTOCE, either from the stock or the
		       VTOC Map. Fills the stock if appropriate.

    return_free_vtoce    - returns a newly-freed VTOCE to the stock or the
		       VTOC Map. Drains the stock a bit if appropriate.

    return_if_not_free   - returns a VTOCE to the VTOC map unless it is
		       already free. Used by the volume scavenger.

    drain_stock_range    - drains a range of addresses from the stock.
		       For rebuild_disk.

    drain_stock          - shuts down the stock, updating all entries into
		       the VTOC map. Called during volume demounting.

    check_in_use         - checks whether a given VTOCE is in use. Used
		       to defend against a race with the scavenger.

    force_unlock         - unlocks the VTOC Map lock. Called when the lock
		       is hold by a process which crawls out.

    Note that we can be cavalier about inconsistencies in the VTOC Map,
    since the VTOCE contains sufficient information (unique-id, specifically)
    to prevent misuse.

    Written March 1982 by J. Bongiovanni
    Modified July 1982 by J. Bongiovanni for return_if_not_free
    Modified November 1982 by J. Bongiovanni for check_in_use
*/

/*  Parameter  */

	dcl     Low_vtocx		 fixed bin;	/* Low vtocx for range */
	dcl     High_vtocx		 fixed bin;	/* High vtocx for range */
	dcl     Pvtep		 ptr;		/* Pointer to PVTE */
	dcl     Vtocx		 fixed bin;	/* VTOCE index of interest, or -1 */
	dcl     Code		 fixed bin (35);	/* Error Code */

/*  Automatic  */

	dcl     bitx		 fixed bin;
	dcl     code		 fixed bin (35);
	dcl     last_index		 fixed bin;
	dcl     deposited		 bit (1) aligned;
	dcl     done_map		 bit (1);
	dcl     dummy		 bit (1);
	dcl     low_vtocx		 fixed bin;
	dcl     high_vtocx		 fixed bin;
	dcl     p99		 pic "99";
	dcl     stockx		 fixed bin;
	dcl     this_vtocx		 fixed bin;
	dcl     vtocx		 fixed bin;
	dcl     wordx		 fixed bin;

/*  External  */

	dcl     error_table_$invalid_vtocx fixed bin (35) external;
	dcl     error_table_$vtoce_free fixed bin (35) external;
	dcl     pds$processid	 bit (36) aligned external;
	dcl     pvt$n_vtoc_map_locks	 fixed bin (35) external;
	dcl     pvt$vtoc_map_lock_wait_constant bit (36) aligned external;
	dcl     volmap_abs_seg$	 external;

/*  Entry  */

	dcl     pxss$addevent	 entry (bit (36) aligned);
	dcl     pxss$delevent	 entry (bit (36) aligned);
	dcl     pxss$notify		 entry (bit (36) aligned);
	dcl     pxss$wait		 entry;
	dcl     pmut$swap_sdw	 entry (ptr, ptr);
	dcl     syserr		 entry options (variable);

/*  Builtin  */

	dcl     addr		 builtin;
	dcl     convert		 builtin;
	dcl     divide		 builtin;
	dcl     index		 builtin;
	dcl     mod		 builtin;
	dcl     null		 builtin;
	dcl     ptr		 builtin;
	dcl     rel		 builtin;
	dcl     stac		 builtin;
	dcl     stacq		 builtin;
	dcl     substr		 builtin;

/*  Condition  */

	dcl     any_other		 condition;
%page;
/*  get_free_vtoce -

    Attempt to withdraw from stock. If this fails, attempt to withdraw 
    from the VTOC Map (replenishing the stock to target at the same
    time). A vtocx of -1 is returned if no free VTOCEs exist.
*/

	pvtep = Pvtep;

	call SETUP_LOCK;

	stock_seg.meters.get_free_vtoce_calls = stock_seg.meters.get_free_vtoce_calls + 1;

	vtocx = -1;				/* Set none */

	vtocx = WITHDRAW_FROM_STOCK ();		/* Try for stock withdrawal */

	if vtocx = -1 & pvte.n_free_vtoce > 0 then do;	/* Failed, but some exist */


		call SETUP_ABS_SEG;

		last_index, wordx = vtoce_stock.search_index; /* Roving pointer */
		done_map = "0"b;
		do while (^done_map);

BIT_MAP_RETRY:

		     if vtoc_map.bit_map (wordx) ^= ""b then do; /* Some free here */
			     bit_map_wordp = addr (vtoc_map.bit_map (wordx));
			     if bit_map_word.bits ^= ""b then do; /* Avoid spurious damage */
				     last_index = wordx; /* Roving pointer */
				     bitx = index (bit_map_word.bits, "1"b);
				     substr (bit_map_word.bits, bitx, 1) = "0"b; /* Mark as free */
				     this_vtocx = 32 * wordx + bitx - 1;
				     if vtocx = -1	/* Haven't gotten one to return yet */
				     then vtocx = this_vtocx;
				     else dummy = DEPOSIT_TO_STOCK (this_vtocx);
				     if vtoce_stock.n_free_in_stock < vtoce_stock.target
				     then goto BIT_MAP_RETRY;
				end;
			end;

		     wordx = wordx + 1;
		     if wordx >= vtoc_map.bit_map_n_words
		     then wordx = 0;
		     if (wordx = vtoce_stock.search_index) /* Wrapped */
			| (vtoce_stock.n_free_in_stock >= vtoce_stock.target)
			| (pvte.n_free_vtoce <= 0)
		     then done_map = "1"b;


		end;

		vtoce_stock.search_index = last_index;	/* Set roving pointer */

		call RESET_ABS_SEG;
	     end;

	if vtocx ^= -1 then pvte.n_free_vtoce = pvte.n_free_vtoce - 1;

	call UNLOCK;

	Vtocx = vtocx;

	return;

%page;
/* return_free_vtoce -

   Attempts to return a newly-freed VTOCE to the stock. If this fails,
   it is returned to the VTOC Map (along with excess stock)
*/

return_free_vtoce:
     entry (Pvtep, Vtocx);

	pvtep = Pvtep;
	vtocx = Vtocx;

	call SETUP_LOCK;

	stock_seg.meters.return_free_vtoce_call = stock_seg.meters.return_free_vtoce_call + 1;
	deposited = "1"b;



	if ^DEPOSIT_TO_STOCK (vtocx)
	then do;					/* No room in stock */


		call SETUP_ABS_SEG;
		call DEPOSIT_TO_MAP (vtocx, "1"b, deposited);

		if vtoce_stock.n_free_in_stock > vtoce_stock.target /* Excess in stock */
		then do while (vtoce_stock.n_free_in_stock > vtoce_stock.target);
			vtocx = WITHDRAW_FROM_STOCK ();
			if vtocx ^= -1 then call DEPOSIT_TO_MAP (vtocx, "1"b, ("0"b));
		     end;

		call RESET_ABS_SEG;

	     end;

	if deposited then
	     pvte.n_free_vtoce = pvte.n_free_vtoce + 1;

	call UNLOCK;

	return;

%page;

/* return_if_not_free -

   returns a free VTOCE to the VTOC map, unless it is already free.
   It must first check the stock, and then the VTOC map.*/

return_if_not_free:
     entry (Pvtep, Vtocx, Code);

	pvtep = Pvtep;
	vtocx = Vtocx;

	call SETUP_LOCK;
	code = error_table_$vtoce_free;

	do stockx = 1 to vtoce_stock.n_in_stock;
	     if vtoce_stock.stock (stockx) = vtocx
	     then goto ALREADY_FREE;
	end;

	call SETUP_ABS_SEG;

	call DEPOSIT_TO_MAP (vtocx, "0"b, deposited);
	if deposited
	then do;
		pvte.n_free_vtoce = pvte.n_free_vtoce + 1;
		code = 0;
	     end;

	call RESET_ABS_SEG;

ALREADY_FREE:

	call UNLOCK;

	Code = code;

	return;


%page;

/* check_in_use -

   Checks whether a specified VTOCE is in-use (allocated) or free. If free,
   a non-zero error code is returned.
*/

check_in_use:
     entry (Pvtep, Vtocx, Code);

	pvtep = Pvtep;
	vtocx = Vtocx;

	call SETUP_LOCK;
	code = error_table_$vtoce_free;

	do stockx = 1 to vtoce_stock.n_in_stock;
	     if vtoce_stock.stock (stockx) = vtocx
	     then goto CHECK_IS_FREE;
	end;

	call SETUP_ABS_SEG;

	wordx = divide (vtocx, 32, 17);
	bitx = mod (vtocx, 32) + 1;
	if wordx < 0 | wordx >= vtoc_map.bit_map_n_words
	then do;
		code = error_table_$invalid_vtocx;
		goto CHECK_RESET;
	     end;
	bit_map_wordp = addr (vtoc_map.bit_map (wordx));
	if substr (bit_map_word.bits, bitx, 1) = "1"b
	then goto CHECK_RESET;

	code = 0;

CHECK_RESET:
	call RESET_ABS_SEG;

CHECK_IS_FREE:

	call UNLOCK;

	Code = code;

	return;


%page;

/* drain_stock_range -

   Deposits any vtocx's within a specified range from the stock into
   the VTOC Map.
*/

drain_stock_range:
     entry (Pvtep, Low_vtocx, High_vtocx);

	pvtep = Pvtep;
	low_vtocx = Low_vtocx;
	high_vtocx = High_vtocx;


	call SETUP_LOCK;

	call SETUP_ABS_SEG;

	do stockx = 1 to vtoce_stock.n_in_stock;
	     if vtoce_stock.stock (stockx) ^= -1
	     then if vtoce_stock.stock (stockx) >= low_vtocx
		     & vtoce_stock.stock (stockx) <= high_vtocx
		then do;
			vtocx = vtoce_stock.stock (stockx);
			vtoce_stock.stock (stockx) = -1;
			vtoce_stock.n_free_in_stock = vtoce_stock.n_free_in_stock - 1;
			call DEPOSIT_TO_MAP (vtocx, "1"b, ("0"b));
		     end;
	end;

	call RESET_ABS_SEG;

	call UNLOCK;

	return;


%page;

/* drain_stock - 

   Shuts down the stock by setting the target to 0 and depositing any remaining 
   VTOCEs into the VTOC Map
   The caller must have setup volmap_abs_seg
*/

drain_stock:
     entry (Pvtep);

	pvtep = Pvtep;

	call SETUP_LOCK;
	vtoc_mapp = ptr (addr (volmap_abs_seg$), pvte.vtoc_map_offset);

	vtoce_stock.target = 0;
	do while (vtoce_stock.n_free_in_stock > 0);
	     vtocx = WITHDRAW_FROM_STOCK ();
	     call DEPOSIT_TO_MAP (vtocx, "1"b, ("0"b));
	end;

	call UNLOCK;

	return;
%page;
/* force_unlock -

   Unlocks the VTOC Map lock.
*/

force_unlock:
     entry (Pvtep);

	pvtep = Pvtep;

	call UNLOCK;

	return;
%page;
/* Internal Procedure to deposit a single VTOCE index to the stock,
   returning an indication of success */

DEPOSIT_TO_STOCK:
     proc (vtocx) returns (bit (1) aligned);

	dcl     vtocx		 fixed bin;

	dcl     found_empty		 bit (1);



	stock_seg.meters.deposit_vstock_calls = stock_seg.meters.deposit_vstock_calls + 1;

	if vtoce_stock.n_free_in_stock >= vtoce_stock.n_in_stock
	then do;					/* No room */
		stock_seg.meters.deposit_vstock_fails = stock_seg.meters.deposit_vstock_fails + 1;
		return ("0"b);
	     end;


	found_empty = "0"b;
	do stockx = 1 to vtoce_stock.n_in_stock while (^found_empty);
	     if vtoce_stock.stock (stockx) = -1
	     then do;
		     found_empty = "1"b;
		     vtoce_stock.stock (stockx) = vtocx;
		     vtoce_stock.n_free_in_stock = vtoce_stock.n_free_in_stock + 1;
		end;
	end;

	if ^found_empty
	then call syserr (CRASH, "vtoce_stock_man: VTOCE stock inconsistent on ^a_^a",
		pvte.devname, convert (p99, pvte.logical_area_number));

	return ("1"b);


     end DEPOSIT_TO_STOCK;
%page;
/*  Internal Procedure to withdraw a single VTOCE index from the stock.
    A vtocx of -1 is returned if this cannot be done.
*/
WITHDRAW_FROM_STOCK:
     proc () returns (fixed bin);

	dcl     stockx		 fixed bin;
	dcl     vtocx		 fixed bin;

	vtocx = -1;

	stock_seg.meters.withdraw_vstock_calls = stock_seg.meters.withdraw_vstock_calls + 1;

	if vtoce_stock.n_free_in_stock > 0
	then do stockx = 1 to vtoce_stock.n_in_stock
		while (vtocx = -1);
		if vtoce_stock.stock (stockx) ^= -1 then do;
			vtocx = vtoce_stock.stock (stockx);
			vtoce_stock.stock (stockx) = -1;
			vtoce_stock.n_free_in_stock = vtoce_stock.n_free_in_stock - 1;
		     end;
	     end;

	if vtocx = -1
	then stock_seg.meters.withdraw_vstock_fails = stock_seg.meters.withdraw_vstock_fails + 1;

	return (vtocx);

     end WITHDRAW_FROM_STOCK;
%page;
/*  Internal Procedure to deposit a VTOCE index to the VTOC Map  */

DEPOSIT_TO_MAP:
     proc (vtocx, complain, deposited);

	dcl     vtocx		 fixed bin;
	dcl     complain		 bit (1) aligned;
	dcl     deposited		 bit (1) aligned;

	dcl     bit_no		 fixed bin;
	dcl     word_no		 fixed bin;

	deposited = "1"b;

	word_no = divide (vtocx, 32, 17);
	bit_no = mod (vtocx, 32) + 1;

	if word_no < 0 | word_no >= vtoc_map.bit_map_n_words
	then do;
		if complain then
		     call syserr (ANNOUNCE, "vtoce_stock_man: Attempt to deposit invalid vtocx ^o on ^a_^a",
			vtocx, pvte.devname, convert (p99, pvte.logical_area_number));
		deposited = "0"b;
	     end;
	else do;
		bit_map_wordp = addr (vtoc_map.bit_map (word_no));
		if substr (bit_map_word.bits, bit_no, 1) = "1"b
		then do;
			if complain then do;
				call syserr (ANNOUNCE, "vtoce_stock_man: Attempt to deposit free vtocx ^o on ^a_^a",
				     vtocx, pvte.devname, convert (p99, pvte.logical_area_number));
				pvte.vol_trouble_count = pvte.vol_trouble_count + 1;
			     end;
			deposited = "0"b;
		     end;
		else substr (bit_map_word.bits, bit_no, 1) = "1"b;
	     end;

	stock_seg.meters.deposit_vtoc_map = stock_seg.meters.deposit_vtoc_map + 1;

     end DEPOSIT_TO_MAP;
%page;
/* Internal Procedure to setup pointers, validate that the PVTE and
   the VTOCE stock are in sync, and lock the VTOC Map lock */

SETUP_LOCK:
     proc;

	dcl     wait_event		 bit (36) aligned;


	on any_other goto OUT_OF_SYNC;

	vtoce_stockp = pvte.vtoc_map_stock_ptr;
	if vtoce_stockp = null () then do;
OUT_OF_SYNC:
		revert any_other;
		call syserr (CRASH, "vtoce_stock_man: PVTE and VTOCE stock out-of-synch on ^a_^a",
		     pvte.devname, convert (p99, pvte.logical_area_number));
	     end;

	if vtoce_stock.pvtep ^= pvtep then goto OUT_OF_SYNC;

	revert any_other;

	if pvte.vtoc_map_lock = pds$processid
	then call syserr (CRASH, "vtoce_stock_man: MYLOCK of VTOC Map Lock for ^a_^a",
		pvte.devname, convert (p99, pvte.logical_area_number));

	do while (^stac (addr (pvte.vtoc_map_lock), pds$processid));
	     wait_event = substr (pvt$vtoc_map_lock_wait_constant, 1, 18)
		|| rel (pvtep);
	     call pxss$addevent (wait_event);
	     pvte.vtoc_map_lock_notify = "1"b;
	     if stac (addr (pvte.vtoc_map_lock), pds$processid) /* Watch for race */
	     then do;
		     call pxss$delevent ((""b));
		     goto LOCK_GOT;
		end;
	     call pxss$wait;
	end;

LOCK_GOT:
	pvt$n_vtoc_map_locks = pvt$n_vtoc_map_locks + 1;
	stock_segp = addr (stock_seg$);
	return;


     end SETUP_LOCK;
%page;
/*  Internal Procedure to unlock the VTOC Map lock and notify, if necessary */

UNLOCK:
     proc;


	dcl     wait_event		 bit (36) aligned;

	if ^stacq (pvte.vtoc_map_lock, ""b, pds$processid)
	then call syserr (CRASH, "vtoce_stock_man: STACQ fails for VTOC Map lock on ^a_^a",
		pvte.devname, convert (p99, pvte.logical_area_number));

	if pvte.vtoc_map_lock_notify then do;
		pvte.vtoc_map_lock_notify = "0"b;
		wait_event = substr (pvt$vtoc_map_lock_wait_constant, 1, 18) || rel (pvtep);
		call pxss$notify (wait_event);
	     end;

     end UNLOCK;
%page;
/* Internal Procedure to setup volmap_abs_seg and vtoc_mapp */
SETUP_ABS_SEG:
     proc;

	call pmut$swap_sdw (addr (volmap_abs_seg$), addr (pvte.volmap_seg_sdw));
	vtoc_mapp = ptr (addr (volmap_abs_seg$), pvte.vtoc_map_offset);



     end SETUP_ABS_SEG;



/* Internal Procedure to reset volmap_abs_seg  */

RESET_ABS_SEG:
     proc;

	dcl     tsdw		 fixed bin (71);


	tsdw = 0;
	call pmut$swap_sdw (addr (volmap_abs_seg$), addr (tsdw));
	vtoc_mapp = null ();


     end RESET_ABS_SEG;




%page; %include pvte;
%page; %include stock_seg;
%page; %include syserr_constants;
%page; %include vtoc_map;
%page;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   vtoce_stock_man: VTOCE stock inconsistent on dskX_NN

   S:     $crash

   T:	$run

   M:	There is an internal inconsistency in the stock of free VTOCES
   on the device indicated. This is probably a software malfunction.

   A:     $recover

   Message:
   vtoce_stock_man: Attempt to deposit invalid vtocx YYYYYY on dskX_NN

   S:     $info

   T:	$run

   M:     There was an attempt to return a free VTOCE to the pool of free
   VTOCEs for the device indicated, but the index of the VTOCE was not
   valid. This indicates possible damage to the device. Such damage can
   be corrected by a physical volume salvage.

   A:	$inform

   Message:
   vtoce_stock_man: Attempt to deposit free vtocx YYYYYY on dskX_NN

   S:     $info

   T:	$run

   M:	A VTOCE was returned to the free pool of VTOCEs on the device indicated,
   but the VTOCE was already marked as free. This indicates possible device
   damage. This damage can be corrected by a physical volume salvage.

   A:     $inform

   Message:
   vtoce_stock_man: PVTE and VTOCE stock out-of-synch on dskX_NN

   S:     $crash

   T:	$run

   M:	There is an inconsistency between the Physical Volume Table
   Entry and the VTOCE Stock for the device indicated. This is probably
   a software error.

   A:     $recover

   Message:
   vtoce_stock_man: MYLOCK of VTOC Map for dskX_NN

   S:     $crash

   T:	$run

   M:     A process attempted to acquire a lock on the VTOC Map for the device
   indicated while already owning the lock. This is probably a software error.

   A:     $recover

   Message:
   vtoce_stock_man: STACQ fails for VTOC Map lock on dskX_NN

   S:     $crash

   T:	$run

   M:	A process was unable to unlock the VTOC Map lock for the device
   indicated. This is probably a hardware failure, either in the CPU or in 
   main memory.

   A:     $recover

   END MESSAGE DOCUMENTATION */

     end vtoce_stock_man$get_free_vtoce;



		    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
