


		    convert_v2_mstb_.pl1            12/05/84  1433.1r w 12/05/84  0851.6       67374


/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   *                                                         *
   *********************************************************** */
/* format: style2 */

convert_v2_mstb_:
     procedure (P_source_dirname, P_source_entryname, P_target_dirname, P_target_entryname, P_convert_procedure,
	P_new_entry_size, P_code);

/**** This program converts a V2 MSTB to a V3 MSTB.  It relies upon the
      supplied conversion procedure to translate a V2 entry to a V3 entry. */

/**** Written 1984-07-31 by EJS */

/* Parameters */

	dcl     P_code		 fixed bin (35) parameter;
	dcl     P_convert_procedure	 entry (ptr, ptr, ptr, fixed bin (35)) variable parameter;
	dcl     P_ec		 fixed bin (35) parameter;
	dcl     P_new_entry_size	 fixed bin (18) unsigned;
	dcl     P_septr		 ptr parameter;
	dcl     P_source_dirname	 char (*) parameter;
	dcl     P_source_entryname	 char (*) parameter;
	dcl     P_table_ptr		 ptr parameter;
	dcl     P_target_dirname	 char (*) parameter;
	dcl     P_target_entryname	 char (*) parameter;
	dcl     P_teptr		 ptr parameter;

/* Automatic */

	dcl     code		 fixed bin (35);
	dcl     i			 fixed bin (35);
	dcl     key		 char (32);
	dcl     source_dirname	 char (168);
	dcl     source_entry_ptr	 ptr;
	dcl     target_entry_ptr	 ptr;
	dcl     source_entryname	 char (32);
	dcl     source_header_ptr	 ptr;
	dcl     source_table_ptr	 ptr;
	dcl     target_dirname	 char (168);
	dcl     target_entryname	 char (32);
	dcl     target_header_ptr	 ptr;
	dcl     target_table_ptr	 ptr;

/* Structures */

/**** The following declarations are of the old (obsolete) version
      2 MSTBs.  They are here solely for the pupose of converting
      V2 MSTBs to Version 3. */

	declare 1 mt_header_v2	 aligned based,
		2 comp_hdr	 aligned like comp_header_v2,
		2 mti		 aligned like ms_table_info_v2,
		2 (number_components, entries_per_component, entry_offset)
				 unsigned fixed binary (18),
		2 (total_entries, deleted_entries, used_entries)
				 fixed binary (35),
		2 meters,
		  3 searches	 fixed binary (35),
		  3 entries_examined fixed binary (35);

	declare 1 comp_header_v2	 aligned based,
		2 type		 character (32),
		2 (dt_created, dt_updated)
				 fixed binary (71),
		2 component	 unsigned fixed binary (18);

	declare 1 entry_v2		 aligned based,
		2 (used, deleted, inconsistent)
				 bit unaligned,
		2 lock		 bit (36) aligned,	/* unused */
		2 key		 character (32) unaligned;

	declare ms_table_info_version_2
				 fixed init (2) internal static options (constant);

	declare 1 ms_table_info_v2	 aligned based,
		2 version		 fixed,		/* Should be 2 */
		2 type		 character (32),	/* what table is this? */
		2 (
		header_size,			/* length of table header in words */
		entry_size
		)		 unsigned fixed (18),
						/* same for table entries */
		2 max_entries	 unsigned fixed bin (18),
						/* how many entries */
		2 max_size	 fixed bin (19);	/* max segment length */

	dcl     1 mti_v2		 aligned like ms_table_info_v2;
	dcl     1 mti_v3		 aligned like ms_table_info;

/* External Entries */

	dcl     ms_table_mgr_$close	 entry (ptr, fixed bin (35));
	dcl     ms_table_mgr_$create	 entry (char (*), char (*), ptr, fixed bin (35));
	dcl     ms_table_mgr_$new_entry
				 entry (ptr, char (*), ptr, fixed bin (35));
	dcl     ms_table_mgr_$open	 entry (char (*), char (*), char (*) aligned, ptr, ptr, fixed bin (35));
	dcl     ms_table_mgr_$update_entry
				 entry (ptr, ptr, fixed bin (35));
	dcl     ms_table_mgr_v2_$abs_entry
				 entry (ptr, fixed bin (35), char (*), ptr, fixed bin (35));
	dcl     ms_table_mgr_v2_$close entry (ptr, fixed bin (35));
	dcl     ms_table_mgr_v2_$open	 entry (char (*), char (*), char (*) aligned, ptr, ptr, fixed bin (35));
	dcl     ms_table_mgr_v2_$table_data
				 entry (ptr, ptr, ptr, fixed bin (35), fixed bin (35));

/* External Static */

	dcl     error_table_$bad_index fixed bin (35) external static;
	dcl     error_table_$unimplemented_version
				 fixed bin (35) external static;
/* Conditions */

     dcl cleanup condition;
%page;
/* Program */

/* convert_v2_mstb_: entry  (P_source_dirname, P_source_entryname, P_target_dirname, P_target_entryname, P_convert_procedure, P_new_entry_size, P_code); */

	source_dirname = P_source_dirname;
	source_entryname = P_source_entryname;
	target_dirname = P_target_dirname;
	target_entryname = P_target_entryname;

	source_table_ptr = null ();			/* For cleanup purposes */
	target_table_ptr = null ();

	on condition (cleanup)
	     call CLEAN_UP ();

	call ms_table_mgr_v2_$open (source_dirname, source_entryname, "", source_table_ptr, source_header_ptr, code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

	call ms_table_mgr_v2_$table_data (source_table_ptr, addr (mti_v2), source_header_ptr, (0), code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

	if mti_v2.version ^= 2 & mti_v2.version ^= 1
	then do;
		code = error_table_$unimplemented_version;
		goto RETURN_TO_CALLER;
	     end;

	mti_v3 = mti_v2, by name;			/* Keep all the rest the same */
	mti_v3.version = MS_TABLE_INFO_VERSION_3;	/* Upgrade to V3 */
	mti_v3.keep_meters = "0"b;			/* This used to be the default */

	if P_new_entry_size ^= 0
	then mti_v3.entry_size = P_new_entry_size;

	call ms_table_mgr_$create (target_dirname, target_entryname, addr (mti_v3), code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

	call ms_table_mgr_$open (target_dirname, target_entryname, (mti_v3.type), target_table_ptr, target_header_ptr,
	     code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

/**** I'm not sure how to find the maximum number of entries.  This should
      work, however. */

	do i = 1 by 1 while (code ^= error_table_$bad_index);
	     call PROCESS_ENTRY (i);
	end;

	if code = error_table_$bad_index
	then code = 0;

RETURN_TO_CALLER:
	call CLEAN_UP ();
	P_code = code;
	return;
%page;
default_convert_proc:
     entry (P_table_ptr, P_septr, P_teptr, P_ec);

	dcl     based_storage	 (based_storage_length) bit (36) aligned based;
	dcl     based_storage_length	 fixed bin (18) unsigned;
	dcl     1 table_info	 aligned like mti_v2;

	call ms_table_mgr_v2_$table_data (P_table_ptr, addr (table_info), (null ()), (0), P_ec);
	if P_ec ^= 0
	then return;

	based_storage_length = table_info.entry_size;

	P_teptr -> based_storage = P_septr -> based_storage;
	return;
%page;
PROCESS_ENTRY:
     procedure (idx);

	dcl     idx		 fixed bin (35);

	call ms_table_mgr_v2_$abs_entry (source_table_ptr, idx, key, source_entry_ptr, code);
	if code ^= 0
	then return;

	call ms_table_mgr_$new_entry (target_table_ptr, key, target_entry_ptr, code);
	if code ^= 0
	then goto RETURN_TO_CALLER;			/* Need better error handling */

	call P_convert_procedure (source_table_ptr, source_entry_ptr, target_entry_ptr, code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

	call ms_table_mgr_$update_entry (target_table_ptr, target_entry_ptr, code);
	if code ^= 0
	then goto RETURN_TO_CALLER;			/* Need better error handling */

	return;
     end PROCESS_ENTRY;
%page;
CLEAN_UP: procedure ();

	if target_table_ptr ^= null ()
	then call ms_table_mgr_$close (target_table_ptr, (0));
	if source_table_ptr ^= null ()
	then call ms_table_mgr_v2_$close (source_table_ptr, (0));

	return;
end CLEAN_UP;

/* format: off */
%page; %include ms_table_info;
%page; %include ms_table_status;
%page; %include mstb_format;
/* format: on */

     end convert_v2_mstb_;
  



		    display_mstb.pl1                12/05/84  1241.7r w 12/05/84  0851.1       37962


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


display_mstb:
     procedure options (variable);

/* display_mstb: Display information about a multisegment table. */
/* Written by C. Hornig, February 1980. */
/* Modified by B. Margolin, July 1983, for Version 2 MSTB */
/* Modified 1984-07-23 BIM for Version 3 MSTB */

%include mstb_format;
%include ms_table_info;

dcl ME char (32) static options (constant) init ("display_mstb");

dcl error_table_$unimplemented_version fixed bin (35) external;

dcl com_err_ entry options (variable);
dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
dcl date_time_ entry (fixed bin(71), char(*));
dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
dcl ioa_ entry options (variable);
dcl msf_manager_$open entry (char (*), char (*), pointer, fixed bin (35));
dcl msf_manager_$get_ptr entry (pointer, fixed bin, bit (1) aligned, pointer, fixed bin (24), fixed bin (35));
dcl msf_manager_$close entry (pointer);
dcl pathname_ entry (char(*), char(*)) returns(char(168));

dcl ap ptr;
dcl al fixed bin (21);
dcl arg char (al) based (ap);
dcl i fixed bin;
dcl code fixed bin (35);
dcl dirname char (168);
dcl ename char (32);
dcl fcbp ptr;

/* * * * * * * * * * DISPLAY_MSTB * * * * * * * * * */

	call cu_$arg_ptr (1, ap, al, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, "Usage: display_mstb path");
	     return;
	     end;
	call expand_pathname_ (arg, dirname, ename, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, "^a", arg);
	     return;
	     end;
	call msf_manager_$open (dirname, ename, fcbp, code);
	if fcbp = null () then do;
	     call com_err_ (code, ME, "Opening ^a>^a.", dirname, ename);
	     return;
	     end;
	call msf_manager_$get_ptr (fcbp, 0, "0"b, segp, (0), code);
	if segp = null () then do;
	     call com_err_ (code, ME, "Reading first component of ^a>^a.", dirname, ename);
	     goto close_msf;
	     end;

	hdrp = segp;
	if mt_header.mti.version ^= MS_TABLE_INFO_VERSION_3 then do;
	     call com_err_ (error_table_$unimplemented_version, ME);
	     return;
	     end;
	call ioa_ ("Version ^d MSTB ^a is of type ^a.", mt_header.mti.version,
	     pathname_ (dirname, ename), mt_header.mti.type);
	call ioa_ (" ^d components, ^d entries, ^d used, ^d deleted, ^d free. (^2d% full)", mt_header.number_components + 1,
	     mt_header.total_entries, mt_header.used_entries, mt_header.deleted_entries,
	     (mt_header.total_entries - mt_header.used_entries - mt_header.deleted_entries),
	     divide (100 * (mt_header.deleted_entries + mt_header.used_entries), mt_header.total_entries, 17, 0));
	call ioa_ (" entry size = ^d, header size = ^d, component size = ^d.", mt_header.mti.entry_size,
	     mt_header.mti.header_size, mt_header.mti.max_size);

	call ioa_ ("lock = ^w, pclock = ^d, ^d entries_per_component, entry_offset = ^d",
	     mt_header.lock, mt_header.pclock, mt_header.entries_per_component, mt_header.entry_offset);
	call ioa_ ("perm_data_checksum = ^d", mt_header.perm_data_checksum);
	
	i = 0;
	call display_component;
	do i = 1 to mt_header.number_components;
	     call msf_manager_$get_ptr (fcbp, i, "0"b, segp, (0), code);
	     if segp = null then do;
		call com_err_ (code, ME, "Reading component ^d.", i);
		go to close_msf;
	     end;
	     call display_component;
	end;

close_msf:
	call msf_manager_$close (fcbp);
	return;
	

display_component:
	procedure;

declare ts (2) char (16);
	
	call date_time_ (comp_header.dt_created, ts (1));
	call date_time_ (comp_header.dt_updated, ts (2));

	call ioa_ ("^d: type ^a, created ^a, updated ^a, component ^d.",
	     i,
	     comp_header.type, ts (1), ts (2), comp_header.component);
	return;
     end display_component;
     
     end display_mstb;
  



		    ms_table_mgr_.pl1               12/05/84  1241.7rew 12/05/84  0851.1      185139


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


/* format: style2 */
ms_table_mgr_:
     procedure;

/* Multi-segment table manager for large system tables. */
/* Written by C. Hornig, June 1979. */
/* Modified by C. Hornig, January 1980, for salvager */
/* Modified by B. Margolin, July 1983, for case-insensitive searching */
/* Modified 1984-07-23 BIM for structure redesign. */
/* Modified 1984-07-31 by Eric Swenson to fix various bugs. */

	declare (
	        (Dirname, Ename)	 character (*),	/* MSF pathname */
	        Create_info_ptr	 pointer,		/* to ms_table_info */
	        Status_ptr		 pointer,		/* to mstb_status */
	        Type		 character (*) aligned,
						/* type of table (for checking) */
	        Tp		 pointer,		/* my data pointer */
	        Hp		 pointer,		/* header pointer */
	        Ne		 fixed bin (35),	/* number of used entries */
	        Key		 character (*),
	        Ep		 pointer,		/* pointer to entry */
	        Record		 fixed bin (35),
	        Code		 fixed (35),
	        Write		 bit (1) aligned,
	        Clock		 fixed bin (35),
	        Locker		 bit (36) aligned,
	        Locked_to_locker	 bit (1) aligned
	        )			 parameter;


/* External Static */

	dcl     error_table_$bad_index fixed bin (35) external static;
	dcl     error_table_$checksum_failure
				 fixed bin (35) external static;
	dcl     error_table_$id_already_exists
				 fixed bin (35) external static;
	dcl     error_table_$id_not_found
				 fixed bin (35) external static;
	dcl     error_table_$inconsistent
				 fixed bin (35) external static;
	dcl     error_table_$invalid_lock_reset
				 fixed bin (35) external;
	dcl     error_table_$locked_by_this_process
				 fixed bin (35) external static;
	dcl     error_table_$namedup	 fixed bin (35) external static;
	dcl     error_table_$no_record fixed bin (35) external static;
	dcl     error_table_$noalloc	 fixed bin (35) external static;
	dcl     error_table_$noentry	 fixed bin (35) external static;
	dcl     error_table_$request_id_ambiguous
				 fixed bin (35) external static;
	dcl     error_table_$unimplemented_version
				 fixed bin (35) external static;

/* External Entries */

	declare delete_$path	 entry (character (*), character (*), bit (36) aligned, character (*),
				 fixed binary (35));
	declare hash_index_		 entry (pointer, fixed bin (21), fixed bin (35), fixed bin (35))
				 returns (fixed bin (35));
	declare hcs_$set_bc_seg	 entry (ptr, fixed bin (24), fixed bin (35));
	declare hcs_$set_max_length_seg
				 entry (pointer, fixed bin (19), fixed bin (35));

	declare mstb_checksum_$sum_entry
				 entry (ptr, fixed bin (35)) returns (fixed bin (18) unsigned aligned);
	declare mstb_checksum_$check_entry
				 entry (ptr, fixed bin (35), fixed bin (18) unsigned aligned)
				 returns (bit (1) aligned);

	declare msf_manager_$open	 entry (character (*), character (*), pointer, fixed bin (35));
	declare msf_manager_$get_ptr	 entry (pointer, unsigned fixed bin (18), bit aligned, pointer, fixed bin (24),
				 fixed bin (35));
	declare msf_manager_$msf_get_ptr
				 entry (pointer, fixed binary, bit (1), pointer, fixed binary (24),
				 fixed binary (35));
	declare msf_manager_$close	 entry (pointer);

	declare set_lock_$lock	 entry (bit (36) aligned, fixed binary, fixed binary (35));
	declare set_lock_$unlock	 entry (bit (36) aligned, fixed binary (35));

/* Automatic */

	declare code		 fixed bin (35);
	declare i			 unsigned fixed bin (18);
	declare bc		 fixed bin (24);
	declare component		 unsigned fixed bin (18);
	declare (enum, record)	 fixed bin (35);
	declare now		 fixed bin (71);
	declare case_ins		 bit (1);
	declare tp		 pointer;
	dcl     ignore_mylock	 bit (1) aligned automatic;
	dcl     unlock_when_done	 bit (1) aligned automatic;

/* Constant */

	dcl     DONT_IGNORE_MYLOCK	 bit (1) aligned internal static options (constant) initial ("0"b);

	declare (addr, addrel, clock, divide, max, mod, null, pointer, size, currentize)
				 builtin;

	declare (cleanup, fixedoverflow)
				 condition;


/* * * * * * * * * * CREATE * * * * * * * * * */

create:
     entry (Dirname, Ename, Create_info_ptr, Code);

/* Create MSF "Path" with characteristics described in ms_table_info. */

	Code = 0;

/**** There is no compatability behind V3, since the reformat was pretty
      drastic. */

	if Create_info_ptr -> ms_table_info.version ^= MS_TABLE_INFO_VERSION_3
	then do;
		Code = error_table_$unimplemented_version;
		return;
	     end;

	call msf_manager_$open (Dirname, Ename, tp, code);
	if code ^= error_table_$noentry
	then do;
		if code = 0
		then do;
			Code = error_table_$namedup;
			call msf_manager_$close (tp);
		     end;
		else Code = code;
		return;
	     end;

	call msf_manager_$msf_get_ptr (tp, 0, "1"b, hdrp, bc, code);
						/* create the header */
	if hdrp = null ()
	then do;
		Code = code;
		return;
	     end;
	mt_header.mti = Create_info_ptr -> ms_table_info;
	if mod (mt_header.mti.entry_size, 2) ^= 0
	then mt_header.mti.entry_size = mt_header.mti.entry_size + 1;
	mt_header.used_entries, mt_header.deleted_entries = 0;
	mt_header.entries_per_component = divide (mt_header.max_size - size (comp_header), currentsize (entry), 18);
	mt_header.entry_offset = 1 + divide (size (mt_header) - size (comp_header) - 1, currentsize (entry), 18);
	mt_header.number_components =
	     max (1, divide (mt_header.max_entries + mt_header.entry_offset - 1, mt_header.entries_per_component, 18));
	mt_header.total_entries =
	     (1 + mt_header.number_components) * mt_header.entries_per_component - mt_header.entry_offset;

	mt_header.lock = ""b;
	mt_header.pclock = 0;
	mt_header.meters = 0;
	mt_header.header.pad = ""b;
	now = clock ();
	do i = 0 to mt_header.number_components;
	     call msf_manager_$get_ptr (tp, i, "1"b, segp, bc, code);
	     if code ^= 0
	     then do;
		     Code = code;
		     return;
		end;
	     comp_header.type = mt_header.mti.type;
	     comp_header.dt_created, comp_header.dt_updated = now;
	     comp_header.component = i;
	     call hcs_$set_max_length_seg (segp, (mt_header.max_size), code);
	     call hcs_$set_bc_seg (segp, 36 * mt_header.max_size, code);
	end;

	call set_mt_header_check;
	call msf_manager_$close (tp);
RETURN:
	return;

/* * * * * * * * * DELETE * * * * * * * * * * */


delete:
     entry (Dirname, Ename, Code);

	Code = 0;
	string (delete_options) = ""b;
	delete_options.force, delete_options.directory, delete_options.segment, delete_options.raw = "1"b;

/**** We have to have chased the links already to have validated the suffix */

	call delete_$path (Dirname, Ename, string (delete_options), "ms_table_mgr_$delete", Code);
	return;

/* * * * * * * * * * OPEN * * * * * * * * * * */

open:
     entry (Dirname, Ename, Type, Tp, Hp, Code);

	Code = 0;
	Tp, Hp = null ();

	call msf_manager_$open (Dirname, Ename, tp, code);
	if tp = null ()
	then do;
		Code = code;
		return;
	     end;
	call get_header;
	if mt_header.version ^= MS_TABLE_INFO_VERSION_3
	then do;
		Code = error_table_$unimplemented_version;
		return;
	     end;
	if (mt_header.mti.type ^= Type) & (Type ^= "")
	then do;
		Code = error_table_$inconsistent;
		return;
	     end;
	Hp = addr (mt_header.header_data);
	Tp = tp;
	return;

/* * * * * * * * * * VERIFY * * * * * * * * * */


/**** Verify, called per-bootload, revalidates all the checksums. 
      It stops at the first problem. It is assumed that the salvager
      is used to make a complete survey of the data. */


verify:
     entry (Tp, Code);

	Code = 0;
	tp = Tp;

	call get_header;				/* This will abort if the header info fails to check */
	do i = 0 to mt_header.number_components;
	     call get_component (i);
	     if comp_header.type ^= mt_header.mti.type | comp_header.component ^= i
		| comp_header.dt_updated ^= mt_header.comp_hdr.dt_updated
	     then do;
		     Code = error_table_$inconsistent;
		     return;
		end;
	end;
	return;

/* * * * * * * * * * TABLE_INFO * * * * * * * * * * */

table_data:
     entry (Tp, Create_info_ptr, Hp, Ne, Code);

	Code, Ne = 0;
	Hp = null ();
	tp = Tp;

	call get_header;
	Create_info_ptr -> ms_table_info = mt_header.mti;
	Hp = pointer (hdrp, size (mt_header));
	Ne = mt_header.used_entries - mt_header.deleted_entries;
	return;

/* * * * * * * * * * STATUS * * * * * * * * */

status:
     entry (Tp, Status_ptr, Code);
	Code = 0;
	tp = Tp;
	call get_header;

	if Status_ptr -> mstb_status.version ^= MSTB_STATUS_VERSION_1
	then do;
		Code = error_table_$unimplemented_version;
		return;
	     end;

	Status_ptr -> mstb_status = mt_header.header, by name;
	Status_ptr -> mstb_status.version = MSTB_STATUS_VERSION_1;
						/* vapped by by-name */
	return;

/* * * * * * * * * * CLOSE * * * * * * * * * */

close:
     entry (Tp, Code);

	Code = 0;
	tp = Tp;

	call msf_manager_$close (tp);
	return;

/* * * * * * * * * * NEW_ENTRY_IGNORE_MYLOCK * * * * * * * * * */

/**** Same as NEW__ENTRY below, but does not error return on mylock error.*/

new_entry_ignore_mylock:
     entry (Tp, Key, Ep, Code);

	ignore_mylock = "1"b;
	goto NEW_ENTRY_JOIN;

/* * * * * * * * * * NEW_ENTRY * * * * * * * * * */

/**** A new-entry will be filled in and returned to us with a call to
      update_entry. */

new_entry:
     entry (Tp, Key, Ep, Code);

	ignore_mylock = "0"b;

NEW_ENTRY_JOIN:
	Code = 0;
	Ep = null ();
	tp = Tp;

	call get_header;				/* Must get header before calling lock */

	on cleanup call unlock ();
	call lock (ignore_mylock);
	if code ^= 0
	then do;
		Code = code;
		return;
	     end;

	if hash_search (Key, "0"b)
	then do;
		Code = error_table_$id_already_exists;
		go to NEW_ENTRY_UNLOCK_RETURN;
	     end;

	if ep = null ()
	then do;
		Code = error_table_$noalloc;
		go to NEW_ENTRY_UNLOCK_RETURN;
	     end;

/**** Past here we will not unlock the lock */

	entry.key = Key;
	entry.inconsistent,				/* checksum will fail, its not set */
	     entry.used = "1"b;
	mt_header.used_entries = mt_header.used_entries + 1;
	call set_checkpoint;
	Ep = addr (entry.entry_data);
	return;

NEW_ENTRY_UNLOCK_RETURN:
	call unlock;
	return;

/* * * * * * * * * * FIND_ENTRY * * * * * * * * * */

find_entry:
     entry (Tp, Key, Ep, Write, Clock, Code);

	case_ins = "0"b;
	go to FIND_ENTRY_COMMON;

find_entry_case_ins:
     entry (Tp, Key, Ep, Write, Clock, Code);

	case_ins = "1"b;

FIND_ENTRY_COMMON:
	Code = 0;
	Ep = null ();
	tp = Tp;

	call get_header;
	if Write
	then do;
		call lock (DONT_IGNORE_MYLOCK);
		if code ^= 0
		then do;
			Code = code;
			return;
		     end;
	     end;
	else Clock = mt_header.pclock;

	if ^hash_search (Key, case_ins)
	then do;
		Code = error_table_$id_not_found;
		go to FIND_ERROR_RETURN;
	     end;
	if ep = null ()
	then do;					/* Ambiguous */
		Code = error_table_$request_id_ambiguous;
		go to FIND_ERROR_RETURN;
	     end;

	begin;
	     dcl	   1 copy_entry	      aligned like entry automatic;

	     copy_entry = ep -> entry;
	     copy_entry.checksum = 0;

	     if ^mstb_checksum_$check_entry (addr (copy_entry), divide (currentsize (entry), 2, 35, 0),
		(entry.checksum))
	     then Code = error_table_$checksum_failure;
	end;

	if Write
	then entry.inconsistent = "1"b;
	Ep = addr (entry.entry_data);
	return;

FIND_ERROR_RETURN:
	if Write
	then call unlock;
	return;

/* * * * * * * * * * DELETE_ENTRY_IGNORE_MYLOCK * * * * * * * * * */

delete_entry_ignore_mylock:
     entry (Tp, Key, Code);

	ignore_mylock = "1"b;
	goto DELETE_ENTRY_JOIN;

/* * * * * * * * * * DELETE_ENTRY * * * * * * * * * */

delete_entry:
     entry (Tp, Key, Code);

	ignore_mylock = "0"b;

DELETE_ENTRY_JOIN:
	Code = 0;
	tp = Tp;

	call get_header;
	on cleanup call unlock;
	call lock (ignore_mylock);
	if code ^= 0
	then do;
		Code = code;
		return;
	     end;
	if ^hash_search (Key, "0"b)
	then do;
		Code = error_table_$id_not_found;
		goto DELETE_ENTRY_UNLOCK_RETURN;
	     end;

	entry.deleted = "1"b;
	entry.checksum = 0;
	entry.checksum = mstb_checksum_$sum_entry (ep, divide (currentsize (entry), 2, 35, 0));
	mt_header.deleted_entries = mt_header.deleted_entries + 1;

	call set_checkpoint;

DELETE_ENTRY_UNLOCK_RETURN:
	call unlock ();
	return;

/* * * * * * * * * * ABS_ENTRY * * * * * * * ** * */

abs_entry:
     entry (Tp, Record, Key, Write, Ep, Clock, Code);

	Code = 0;
	Ep = null ();
	Key = "";
	tp = Tp;

	call get_header;
	if Write
	then do;
		on cleanup call unlock;
		call lock (DONT_IGNORE_MYLOCK);
		if code ^= 0
		then do;
			Code = code;
			return;
		     end;
	     end;
	else Clock = mt_header.pclock;

	record = Record - 1;
	if record + mt_header.entry_offset >= mt_header.total_entries
	then do;
		Code = error_table_$bad_index;
		go to FIND_ERROR_RETURN;
	     end;
	call get_entry (record);
	if entry.deleted | ^entry.used
	then do;
		Code = error_table_$no_record;
		go to FIND_ERROR_RETURN;
	     end;
	begin;

	     dcl	   1 copy_entry	      aligned like entry automatic;

	     copy_entry = ep -> entry;
	     copy_entry.checksum = 0;

	     if ^mstb_checksum_$check_entry (addr (copy_entry), divide (currentsize (entry), 2, 35, 0),
		(entry.checksum))
	     then Code = error_table_$checksum_failure;
	end;

	Ep = addr (entry.entry_data);
	Key = entry.key;
	if Write
	then entry.inconsistent = "1"b;
	return;

/* * * * * * * * * * UPDATE_ENTRY_DONT_UNLOCK * * * * * * * * * */

update_entry_dont_unlock:
     entry (Tp, Ep, Code);

	unlock_when_done = "0"b;
	goto UPDATE_ENTRY_JOIN;

/* * * * * * * * * * UPDATE_ENTRY * * * * * * * * * * */

update_entry:
     entry (Tp, Ep, Code);

	unlock_when_done = "1"b;

UPDATE_ENTRY_JOIN:
	tp = Tp;
	Code = 0;
	call get_header;

/* Uk. We have to turn one of their ep's into one of ours. */

	begin;
	     declare 1 dummy_entry	      aligned like entry;
	     ep = addwordno (Ep, -(wordno (addr (dummy_entry.entry_data)) - wordno (addr (dummy_entry))));
	end;

/**** Null out the caller-supplied Ep so that caller will not unknowingly
      update the entry after our checksum has been calculated. */

	Ep = null ();

	entry.inconsistent = "0"b;
	entry.checksum = 0;
	entry.checksum = mstb_checksum_$sum_entry (ep, divide (currentsize (entry), 2, 35, 0));
	call set_checkpoint;
	if unlock_when_done
	then call unlock ();
	return;


lock:
     entry (Tp, Code);

	tp = Tp;
	Code = 0;
	call get_header;
	call lock (DONT_IGNORE_MYLOCK);
	Code = code;
	return;


unlock:
     entry (Tp, Code);

	tp = Tp;
	Code = 0;
	call get_header;
	call unlock;
	return;

check_lock:
     entry (Dirname, Ename, Locker, Locked_to_locker);

	/*** WARNING - if we make set_lock_ use the HC, this will need to be changed. */

	Locked_to_locker = "0"b;
	call open (Dirname, Ename, "", tp, hdrp, code);
	if code ^= 0
	then return;				/* broken table */
	if Locker = mt_header.lock
	then do;
		Locked_to_locker = "1"b;
		call unlock;
	     end;
	call close (tp, (0));			/* if there is a static opening it will be undisturbed. */
	return;

get_change_clock:
     entry (Tp, Clock, Code);

	tp = Tp;
	Code = 0;
	call get_header;
	Clock = mt_header.pclock;
	return;


/* * * * * * * * * * GET_HEADER * * * * * * * * * */

get_header:
     procedure;

	call msf_manager_$get_ptr (tp, 0, "0"b, hdrp, bc, code);
	if hdrp = null ()
	then do;
		Code = code;
		goto RETURN;
	     end;
	segp = hdrp;
	component = 0;
	call check_mt_header_check;			/* aborts us on error */
     end;

/* * * * * * * * * * GET_COMPONENT * * * * * * * * * * */

get_component:
     procedure (Component);

	declare Component		 unsigned fixed bin (18) parameter;

	component = Component;
	call msf_manager_$get_ptr (tp, component, "0"b, segp, bc, code);
	if segp = null ()
	then do;
		Code = code;
		goto RETURN;
	     end;
	return;
     end;

/* * * * * * * * * * SET_CHECKPOINT * * * * * * * * * */

set_checkpoint:
     procedure;

	declare now		 fixed bin (71);

	now = clock ();
	do i = 0 to mt_header.number_components;
	     call get_component (i);
	     comp_header.dt_updated = now;
	end;
	on fixedoverflow
	     begin;
		mt_header.pclock = 1;
		go to SET_CLOCK;
	     end;
(fixedoverflow):
	mt_header.pclock = mt_header.pclock + 1;
SET_CLOCK:
	return;
     end set_checkpoint;

/* * * * * * * * * * HASH_SEARCH * * * * * * * * * */

hash_search:
     procedure (Key, Case_ins) returns (bit aligned);

	declare (
	        Key		 character (*),
	        Case_ins		 bit (1)
	        )			 parameter;
	declare (hash_key, match_key)	 character (32) aligned;
	declare (found_one, case_ins)	 bit (1);
	declare save_ep		 ptr;
	declare hash		 fixed bin (35);
	declare saved_clock		 fixed bin (35);

	hash_key = lowercase (Key);
	case_ins = Case_ins;
	if case_ins
	then match_key = hash_key;			/* Lowercase */
	else match_key = Key;			/* Normal */

	hash = hash_index_ (addr (hash_key), 32, 1, mt_header.total_entries);

	if mt_header.keep_meters
	then mt_header.meters.searches = mt_header.meters.searches + 1;

RETRY:
	saved_clock = mt_header.pclock;
	found_one = "0"b;
	save_ep = null ();
	do enum = hash to mt_header.total_entries - mt_header.entry_offset - 1, 0 to hash - 1;
	     call get_entry (enum);

	     if mt_header.keep_meters
	     then mt_header.meters.entries_examined = mt_header.meters.entries_examined + 1;
	     if ^entry.used
	     then do;				/* End of hash bucket */
		     if case_ins & found_one
		     then do;
			     ep = save_ep;
			     go to RETURN_1;
			end;
		     goto RETURN_0;
		end;
	     if ^entry.deleted
	     then do;
		     if case_ins
		     then do;			/* Case-insensitive match */
			     if lowercase (entry.key) = match_key
			     then if found_one
				then do;
					ep = null ();
						/* This nonsense combination */
					go to RETURN_1;
						/* indicates ambiguous match */
				     end;
				else do;
					found_one = "1"b;
					save_ep = ep;
						/* Save for later */
				     end;
			end;			/* Case-sensitive match */
		     else if entry.key = match_key
		     then go to RETURN_1;
		end;
	end;
	if found_one
	then do;
		ep = save_ep;
		go to RETURN_1;
	     end;
	else do;
		ep = null ();
		go to RETURN_0;
	     end;

RETURN_0:
	if saved_clock ^= mt_header.pclock
	then go to RETRY;
	return ("0"b);
RETURN_1:
	if saved_clock ^= mt_header.pclock
	then go to RETRY;
	return ("1"b);

lowercase:
     proc (String) returns (char (32)) reducible;

	dcl     String		 char (*) parameter;
	dcl     (
	        LOWER		 init ("abcdefghijklmnopqrstuvwxyz"),
	        UPPER		 init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ")
	        )			 char (26) int static options (constant);
	dcl     translate		 builtin;

	return (translate (String, LOWER, UPPER));

     end lowercase;


     end hash_search;

/* * * * * * * * * * GET_ENTRY * * * * * * * * * */

get_entry:
     procedure (Enum);

	declare Enum		 fixed bin (35) parameter;
	declare enum		 fixed bin (35);
	declare ecomp		 unsigned fixed bin (18);

	enum = Enum + mt_header.entry_offset;
	ecomp = divide (enum, mt_header.entries_per_component, 18);
	if ecomp ^= component
	then call get_component (ecomp);
	ep = pointer (segp, size (comp_header) + (currentsize (entry)) * mod (enum, mt_header.entries_per_component));
     end get_entry;

lock:
     procedure (P_ignore_mylock);

	dcl     P_ignore_mylock	 bit (1) aligned parameter;

	call set_lock_$lock (mt_header.lock, 5, code);
	if (code = error_table_$locked_by_this_process & P_ignore_mylock) | code = error_table_$invalid_lock_reset
	then code = 0;
	return;
     end lock;

unlock:
     procedure;

	call set_lock_$unlock (mt_header.lock, code);
	return;
     end unlock;

set_mt_header_check:
     procedure;

	mt_header.perm_data_checksum = mt_header_check ();
	return;
     end set_mt_header_check;

mt_header_check:
     procedure returns (fixed bin (35));

	return (mt_header.number_components + mt_header.entries_per_component + mt_header.entry_offset
	     + mt_header.total_entries + mt_header.header_size + mt_header.entry_size);
     end mt_header_check;

check_mt_header_check:
     procedure;

	if mt_header.perm_data_checksum ^= mt_header_check ()
	then do;
		Code = error_table_$inconsistent;
		go to RETURN;
	     end;
     end check_mt_header_check;

/* format: off */
%page;%include ms_table_info;
%page;%include ms_table_status;
%page;%include mstb_format;
%page;%include delete_options;
/* format: on */

     end ms_table_mgr_;
 



		    ms_table_mgr_v2_.pl1            12/05/84  1433.1rew 12/05/84  0851.1      125505


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

/* format: style2 */

ms_table_mgr_v2_:
     procedure;

/* Multi-segment table manager for large system tables. */
/* Written by C. Hornig, June 1979. */
/* Modified by C. Hornig, January 1980, for salvager */
/* Modified by B. Margolin, July 1983, for case-insensitive searching */

	declare (
	        (Dirname, Ename)	 character (*),	/* MSF pathname */
	        Create_info		 pointer,		/* to ms_table_info */
	        Type		 character (*) aligned,
						/* type of table (for checking) */
	        Tp		 pointer,		/* my data pointer */
	        Hp		 pointer,		/* header pointer */
	        Ne		 fixed bin (35),	/* number of used entries */
	        Key		 character (*),
	        Ep		 pointer,		/* pointer to entry */
	        Record		 fixed bin (35),
	        Code		 fixed (35)
	        )			 parameter;


/**** The following declarations are for the old (obsolete)
      version 2 MSTBs.  They exist here solely for conversion
      purposes. */

	declare 1 mt_header_v2	 aligned based,
		2 comp_hdr	 aligned like comp_header_v2,
		2 mti		 aligned like ms_table_info_v2,
		2 (number_components, entries_per_component, entry_offset)
				 unsigned fixed binary (18),
		2 (total_entries, deleted_entries, used_entries)
				 fixed binary (35),
		2 meters,
		  3 searches	 fixed binary (35),
		  3 entries_examined fixed binary (35);

	declare 1 comp_header_v2	 aligned based,
		2 type		 character (32),
		2 (dt_created, dt_updated)
				 fixed binary (71),
		2 component	 unsigned fixed binary (18);

	declare 1 entry_v2		 aligned based,
		2 (used, deleted, inconsistent)
				 bit unaligned,
		2 lock		 bit (36) aligned,	/* unused */
		2 key		 character (32) unaligned;

	declare ms_table_info_version_2
				 fixed init (2) internal static options (constant);

	declare 1 ms_table_info_v2	 aligned based,
		2 version		 fixed,		/* Should be 2 */
		2 type		 character (32),	/* what table is this? */
		2 (
		header_size,			/* length of table header in words */
		entry_size
		)		 unsigned fixed (18),
						/* same for table entries */
		2 max_entries	 unsigned fixed bin (18),
						/* how many entries */
		2 max_size	 fixed bin (19);	/* max segment length */

	dcl     1 mt_header		 aligned like mt_header_v2 based (hdrp);
	dcl     1 comp_header	 aligned like comp_header_v2 based (segp);
	dcl     1 entry		 aligned like entry_v2 based (ep);

	declare (
	        error_table_$namedup,
	        error_table_$bad_index,
	        error_table_$no_record,
	        error_table_$unimplemented_version,
	        error_table_$inconsistent,
	        error_table_$noalloc,
	        error_table_$noentry,
	        error_table_$request_id_ambiguous,
	        error_table_$id_already_exists,
	        error_table_$id_not_found
	        )			 fixed bin (35) external;

	declare hash_index_		 entry (pointer, fixed bin (21), fixed bin (35), fixed bin (35))
				 returns (fixed bin (35)),
	        hcs_$set_bc_seg	 entry (ptr, fixed bin (24), fixed bin (35)),
	        hcs_$set_max_length_seg
				 entry (pointer, fixed bin (19), fixed bin (35)),
	        msf_manager_$open	 entry (character (*), character (*), pointer, fixed bin (35)),
	        msf_manager_$get_ptr	 entry (pointer, unsigned fixed bin (18), bit aligned, pointer, fixed bin (24),
				 fixed bin (35)),
	        msf_manager_$close	 entry (pointer);

	declare code		 fixed bin (35),
	        i			 unsigned fixed bin (18),
	        bc		 fixed bin (24),
	        component		 unsigned fixed bin (18),
	        (enum, record)	 fixed bin (35),
	        now		 fixed bin (71),
	        case_ins		 bit (1),
	        ep		 pointer,
	        hdrp		 pointer,
	        segp		 pointer,
	        tp		 pointer;

	declare (addr, addrel, clock, divide, max, mod, null, pointer, size)
				 builtin;

/* * * * * * * * * * CREATE * * * * * * * * * */

create:
     entry (Dirname, Ename, Create_info, Code);

/* Create MSF "Path" with characteristics described in ms_table_info. */

	Code = 0;

	if Create_info -> ms_table_info_v2.version ^= ms_table_info_version_2
	     & Create_info -> ms_table_info_v2.version ^= 1
						/* We still support version 1 */
	then do;
		Code = error_table_$unimplemented_version;
		return;
	     end;

	call msf_manager_$open (Dirname, Ename, tp, code);
	if code ^= error_table_$noentry
	then do;
		if code = 0
		then do;
			Code = error_table_$namedup;
			call msf_manager_$close (tp);
		     end;
		else Code = code;
		return;
	     end;

	call msf_manager_$get_ptr (tp, 1, "1"b, segp, bc, code);
						/* create the second component to force an MSF */
	call msf_manager_$get_ptr (tp, 0, "1"b, hdrp, bc, code);
						/* create the header */
	if hdrp = null ()
	then do;
		Code = code;
		return;
	     end;
	mt_header.mti = Create_info -> ms_table_info_v2;
	mt_header.used_entries, mt_header.deleted_entries = 0;
	mt_header.entries_per_component =
	     divide (mt_header.max_size - size (comp_header), size (entry) + mt_header.entry_size, 18);
	mt_header.entry_offset =
	     1
	     +
	     divide (size (mt_header_v2) - size (comp_header) + mt_header.header_size - 1,
	     size (entry) + mt_header.entry_size, 18);
	mt_header.number_components =
	     max (1, divide (mt_header.max_entries + mt_header.entry_offset - 1, mt_header.entries_per_component, 18));
	mt_header.total_entries =
	     (1 + mt_header.number_components) * mt_header.entries_per_component - mt_header.entry_offset;

	now = clock ();
	do i = 0 to mt_header.number_components;
	     call msf_manager_$get_ptr (tp, i, "1"b, segp, bc, code);
	     if code ^= 0
	     then do;
		     Code = code;
		     return;
		end;
	     comp_header.type = mt_header.mti.type;
	     comp_header.dt_created, comp_header.dt_updated = now;
	     comp_header.component = i;
	     call hcs_$set_max_length_seg (segp, (mt_header.max_size), code);
	     call hcs_$set_bc_seg (segp, 36 * mt_header.max_size, code);
	end;

	call msf_manager_$close (tp);
return:
	return;

/* * * * * * * * * * OPEN * * * * * * * * * * */

open:
     entry (Dirname, Ename, Type, Tp, Hp, Code);

	Code = 0;
	Tp, Hp = null ();

	call msf_manager_$open (Dirname, Ename, tp, code);
	if tp = null ()
	then do;
		Code = code;
		return;
	     end;
	call get_header;
	if mt_header.version ^= ms_table_info_version_2 & mt_header.version ^= 1
						/* Upward compatible */
	then do;
		Code = error_table_$unimplemented_version;
		return;
	     end;
	if (mt_header.mti.type ^= Type) & (Type ^= "")
	then do;
		Code = error_table_$inconsistent;
		return;
	     end;
	Hp = pointer (hdrp, size (mt_header_v2));
	Tp = tp;
	return;

/* * * * * * * * * * VERIFY * * * * * * * * * */

verify:
     entry (Tp, Code);

	Code = 0;
	tp = Tp;

	call get_header;
	do i = 0 to mt_header.number_components;
	     call get_component (i);
	     if comp_header.type ^= mt_header.mti.type | comp_header.component ^= i
		| comp_header.dt_updated ^= mt_header.comp_hdr.dt_updated
	     then do;
		     Code = error_table_$inconsistent;
		     return;
		end;
	end;
	return;

/* * * * * * * * * * TABLE_INFO * * * * * * * * * * */

table_data:
     entry (Tp, Create_info, Hp, Ne, Code);

	Code, Ne = 0;
	Hp = null ();
	tp = Tp;

	call get_header;
	Create_info -> ms_table_info_v2 = mt_header.mti;
	Hp = pointer (hdrp, size (mt_header));
	Ne = mt_header.used_entries - mt_header.deleted_entries;
	return;

/* * * * * * * * * * CLOSE * * * * * * * * * */

close:
     entry (Tp, Code);

	Code = 0;
	tp = Tp;

	call msf_manager_$close (tp);
	return;

/* * * * * * * * * * NEW_ENTRY * * * * * * * * * */

new_entry:
     entry (Tp, Key, Ep, Code);

	Code = 0;
	Ep = null ();
	tp = Tp;

	call get_header;
	if hash_search (Key, "0"b)
	then do;
		Code = error_table_$id_already_exists;
		return;
	     end;

	if ep = null ()
	then do;
		Code = error_table_$noalloc;
		return;
	     end;

	entry.key = Key;
	entry.used = "1"b;
	mt_header.used_entries = mt_header.used_entries + 1;
	call set_checkpoint;
	Ep = addrel (ep, size (entry));
	return;

/* * * * * * * * * * FIND_ENTRY * * * * * * * * * */

find_entry:
     entry (Tp, Key, Ep, Code);

	case_ins = "0"b;
	go to find_entry_common;

find_entry_case_ins:
     entry (Tp, Key, Ep, Code);

	case_ins = "1"b;

find_entry_common:
	Code = 0;
	Ep = null ();
	tp = Tp;

	call get_header;
	if case_ins & mt_header.version = 1
	then do;					/* No case-insensitive searching in v1 */
		Code = error_table_$unimplemented_version;
		return;
	     end;
	if ^hash_search (Key, case_ins)
	then do;
		Code = error_table_$id_not_found;
		return;
	     end;
	if ep = null ()
	then do;					/* Ambiguous */
		Code = error_table_$request_id_ambiguous;
		return;
	     end;

	Ep = addrel (ep, size (entry));		/* return pointer to HIS part of entry */
	return;

/* * * * * * * * * * DELETE_ENTRY * * * * * * * * * */

delete_entry:
     entry (Tp, Key, Code);

	Code = 0;
	tp = Tp;

	call get_header;
	if ^hash_search (Key, "0"b)
	then do;
		Code = error_table_$id_not_found;
		return;
	     end;

	entry.deleted = "1"b;
	mt_header.deleted_entries = mt_header.deleted_entries + 1;
	call set_checkpoint;
	return;

/* * * * * * * * * * ABS_ENTRY * * * * * * * ** * */

abs_entry:
     entry (Tp, Record, Key, Ep, Code);

	Code = 0;
	Ep = null ();
	Key = "";
	tp = Tp;

	call get_header;
	record = Record - 1;
	if record + mt_header.entry_offset >= mt_header.total_entries
	then do;
		Code = error_table_$bad_index;
		return;
	     end;
	call get_entry (record);
	if entry.deleted | ^entry.used
	then Code = error_table_$no_record;
	else do;
		Ep = addrel (ep, size (entry));
		Key = entry.key;
	     end;
	return;

/* * * * * * * * * * NUMBER_ENTRIES * * * * * * * * * */

number_entries:
     entry (Tp) returns (unsigned fixed (18));

	tp = Tp;

	call get_header;
	return (mt_header.used_entries - mt_header.deleted_entries);

/* * * * * * * * * * GET_HEADER * * * * * * * * * */

get_header:
     procedure;

	call msf_manager_$get_ptr (tp, 0, "0"b, hdrp, bc, code);
	if hdrp = null ()
	then do;
		Code = code;
		goto return;
	     end;
	segp = hdrp;
	component = 0;
     end;

/* * * * * * * * * * GET_COMPONENT * * * * * * * * * * */

get_component:
     procedure (Component);

	declare Component		 unsigned fixed bin (18) parameter;

	component = Component;
	call msf_manager_$get_ptr (tp, component, "0"b, segp, bc, code);
	if segp = null ()
	then do;
		Code = code;
		goto return;
	     end;
	return;
     end;

/* * * * * * * * * * SET_CHECKPOINT * * * * * * * * * */

set_checkpoint:
     procedure;

	declare now		 fixed bin (71);

	now = clock ();
	do i = 0 to mt_header.number_components;
	     call get_component (i);
	     comp_header.dt_updated = now;
	end;
     end;

/* * * * * * * * * * HASH_SEARCH * * * * * * * * * */

hash_search:
     procedure (Key, Case_ins) returns (bit aligned);

	declare (
	        Key		 character (*),
	        Case_ins		 bit (1)
	        )			 parameter;
	declare (hash_key, match_key)	 character (32) aligned,
	        (found_one, case_ins)	 bit (1),
	        save_ep		 ptr,
	        hash		 fixed bin (35);

	if mt_header.version = 1
	then do;
		hash_key, match_key = Key;
		case_ins = "0"b;
	     end;
	else do;					/* Version 2, different hash */
		hash_key = lowercase (Key);
		case_ins = Case_ins;
		if case_ins
		then match_key = hash_key;		/* Lowercase */
		else match_key = Key;		/* Normal */
	     end;
	hash = hash_index_ (addr (hash_key), 32, 1, mt_header.total_entries);
						/*	     mt_header.meters.searches = mt_header.meters.searches + 1; */
	found_one = "0"b;
	save_ep = null ();
	do enum = hash to mt_header.total_entries - mt_header.entry_offset - 1, 0 to hash - 1;
	     call get_entry (enum);			/*		mt_header.meters.entries_examined = mt_header.meters.entries_examined + 1; */
	     if ^entry.used
	     then do;				/* End of hash bucket */
		     if case_ins & found_one
		     then do;
			     ep = save_ep;
			     return ("1"b);
			end;
		     return ("0"b);			/* Don't null pointer to unused entry */
		end;
	     if ^entry.deleted
	     then do;
		     if case_ins
		     then do;			/* Case-insensitive match */
			     if lowercase (entry.key) = match_key
			     then if found_one
				then do;
					ep = null ();
						/* This nonsense combination */
					return ("1"b);
						/* indicates ambiguous match */
				     end;
				else do;
					found_one = "1"b;
					save_ep = ep;
						/* Save for later */
				     end;
			end;			/* Case-sensitive match */
		     else if entry.key = match_key
		     then return ("1"b);
		end;
	end;
	if found_one
	then do;
		ep = save_ep;
		return ("1"b);
	     end;
	else do;
		ep = null ();
		return ("0"b);
	     end;

lowercase:
     proc (String) returns (char (32)) reducible;

	dcl     String		 char (*) parameter;
	dcl     (
	        LOWER		 init ("abcdefghijklmnopqrstuvwxyz"),
	        UPPER		 init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ")
	        )			 char (26) int static options (constant);
	dcl     translate		 builtin;

	return (translate (String, LOWER, UPPER));

     end lowercase;


     end hash_search;

/* * * * * * * * * * GET_ENTRY * * * * * * * * * */

get_entry:
     procedure (Enum);

	declare Enum		 fixed bin (35) parameter,
	        enum		 fixed bin (35),
	        ecomp		 unsigned fixed bin (18);

	enum = Enum + mt_header.entry_offset;
	ecomp = divide (enum, mt_header.entries_per_component, 18);
	if ecomp ^= component
	then call get_component (ecomp);
	ep = pointer (segp,
	     size (comp_header) + (size (entry) + mt_header.entry_size) * mod (enum, mt_header.entries_per_component));
     end get_entry;

     end;
   



		    mstb_checksum_.alm              12/05/84  1433.1rew 12/05/84  0851.1       26226


" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1984 *
" *                                                         *
" ***********************************************************
	name	mstb_checksum_

" Checksums for mstb components.  It logically adds up double words
" and then collapses the resulting double word into an 18-bit checksum.
" 

" BIM 1984-07-23
" Modified 1984-08-13 by E. Swenson so that it would work.
"
" declare mstb_checksum_$sum_entry (pointer, fixed bin (35)) returns (fixed bin (18) unsigned);
"
" checksum =  mstb_checksum_$sum_entry (addr (vector), n_doublewords);
"
" Where: vector is a double-word aligned vector of pairs
" n_doublewords is its length in double-words.
" checksum (output) is the resultant checksum.
"
" declare mstb_checksum_$check_entry entry (pointer, fixed bin (35), fixed bin (18) unsigned)
"			       returns (bit (1) aligned)
" valid = mstb_checksum_$check_entry (vector_ptr, n_doublewords, checksum)
"
"

" Parameters for sum_entry

	equ	se.vector_ptr,2
	equ	se.vector_count,4
	equ	se.entry_checksum,6

" Parameters for check_entry

	equ	ce.vector_ptr,2
	equ	ce.vector_count,4
	equ	ce.checksum,6
	equ	ce.return_value,8

"

	entry	sum_entry,check_entry

sum_entry:
	epp1	ap|se.vector_ptr,*	          " ptr to ptr to vector
	epp1	pr1|0,*			" ptr to vector
	lda	ap|se.vector_count,*	" N
	als	1			" offset 2 past last
	eax1	0,al			" into X1
	fld	0,du
sum_entry.loop:
	adlaq	pr1|-2,x1			" Pick up next pair
	sbx1	2,du			" done?
	tnz	sum_entry.loop		" not until zero
	sta	ap|se.entry_checksum,*	" need a temporary
	adlq	ap|se.entry_checksum,*	" add a and q
	eax1	0,ql
	anq	=o777777,du
	stq	ap|se.entry_checksum,*
	adlx1	ap|se.entry_checksum,*	" add upper to lower
	sxl1	ap|se.entry_checksum,*	" store result
	lda	=o777777,ql
	ansa	ap|se.entry_checksum,*	" only want upper 18 bits
	short_return

check_entry:
	epp1	ap|ce.vector_ptr,*
	epp1	pr1|0,*		          " pointer to the vector
	lda	ap|ce.vector_count,*	" N
	als	1			" offset 2 past last
	eax1	0,al			" into X1
	fld	0,dl
"	lda	0,dl
"	ldq	ap|ce.checksum,*		" ignore bit offset
"	anq	=o777777,dl
"	negl				" prime checksum with initial
					" value.
check_entry.loop:
	adlaq	pr1|-2,x1			" Pick up next pair
	sbx1	2,du			" done?
	tnz	check_entry.loop		" not until zero
	sta	ap|ce.return_value,*	" need a temporary
	adlq	ap|ce.return_value,*	" add a and q
	eax1	0,ql
	anq	=o777777,du
	stq	ap|ce.return_value,*
	adlx1	ap|ce.return_value,*	" add upper to lower
	sxl1	ap|ce.return_value,*	" store result
	lda	=o777777,ql
	ansa	ap|ce.return_value,*	" only want upper 18 bits
	ldq	ap|ce.return_value,*	" need it to compare
	cmpq	ap|ce.checksum,*
	tnz	check_entry.fail
	lda	=o400000,du
	sta	ap|ce.return_value,*
	short_return
check_entry.fail:
	stz	ap|ce.return_value,*
	short_return

	end
  



		    salvage_mstb.pl1                12/05/84  1241.7r w 12/05/84  0851.1       60894


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


/* format: style4,delnl,insnl,ifthenstmt,indend,declareind8,dclind4 */
salvage_mstb:
     procedure options (variable);

/* Recover and rahash a multi-segment table. */
/* Written by C. Hornig, January 1980. */
/* Modified by B. Margolin, July 1983, for Version 2 MSTB */
/* Modified 1984-08-17 by E. Swenson for Version 3 MSTBs. */

%include ms_table_info;

dcl error_table_$bad_conversion fixed bin (35) ext static;
dcl error_table_$checksum_failure fixed bin (35) external static;
dcl error_table_$unimplemented_version fixed bin (35) ext static;
dcl error_table_$no_record fixed bin (35) ext static;
dcl error_table_$bad_index fixed bin (35) ext static;
dcl error_table_$id_already_exists fixed bin (35) ext static;
dcl iox_$error_output ptr external static;

dcl ME char (32) init ("salvage_mstb") static options (constant);
dcl NO_WRITE bit (1) aligned initial ("0"b) internal static options (constant);

dcl com_err_ entry options (variable);
dcl copy_acl_ entry (char (*), char (*), char (*), char (*), bit (1) aligned, fixed bin (35));
dcl cu_$arg_count entry returns (fixed bin);
dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
dcl hcs_$chname_file entry (char (*), char (*), char (*), char (*), fixed bin (35));
dcl ioa_$ioa_switch entry options (variable);
dcl ms_table_mgr_$abs_entry entry (ptr, fixed bin (35), char (*), bit (1) aligned, ptr, fixed bin (35), fixed bin (35));
dcl ms_table_mgr_$create entry (char (*), char (*), ptr, fixed bin (35));
dcl ms_table_mgr_$close entry (ptr, fixed bin (35));
dcl ms_table_mgr_$open entry (char (*), char (*), char (*), ptr, ptr, fixed bin (35));
dcl ms_table_mgr_$new_entry entry (ptr, char (*), ptr, fixed bin (35));
dcl ms_table_mgr_$table_data entry (ptr, ptr, ptr, fixed bin (35), fixed bin (35));
dcl ms_table_mgr_$update_entry entry (ptr, ptr, fixed bin (35));
dcl unique_chars_ entry (bit (*)) returns (char (15));

dcl copy_header (mti.header_size) fixed bin (35) based;
dcl copy_entry (mti.entry_size) fixed bin (35) based;

dcl 1 mti aligned like ms_table_info;
dcl (tp, ntp, hp, nhp, ep, nep) ptr;
dcl key char (32);
dcl ndirname char (168);
dcl (nename, oename) char (32);
dcl ne fixed bin (35);
dcl code fixed bin (35);
dcl i fixed bin (35);
dcl ap ptr;
dcl al fixed bin (21);
dcl argument char (al) based (ap);

dcl addr builtin;

dcl rtrim builtin;

/* * * * * * * * * * * SALVAGE_MSTB * * * * * * * * * */

	i = cu_$arg_count ();
	if i < 1 | i > 2 then do;
	     call com_err_ (0, ME, "Usage: salvage_mstb path {entries}");
	     return;
	end;
	call cu_$arg_ptr (1, ap, al, code);		/* get the path */
	call expand_pathname_ (argument, ndirname, oename, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, "^a", argument);
	     return;
	end;

	call ms_table_mgr_$open (ndirname, oename, "", tp, hp, code);
						/* open the old MSTB */
	if code ^= 0 then do;
	     call com_err_ (code, ME, "Opening MSTB ^a>^a.", ndirname, oename);
	     return;
	end;

	call ms_table_mgr_$table_data (tp, addr (mti), hp, ne, code);
						/* find out about the old one */
	if code ^= 0 then do;
	     call com_err_ (code, ME, "Getting MSTB data.");
	     return;
	end;

	if mti.version ^= MS_TABLE_INFO_VERSION_3 then do;
	     call com_err_ (error_table_$unimplemented_version, ME);
	     return;
	end;

	call cu_$arg_ptr (2, ap, al, code);		/* did the caller specify the table size? */
	if code ^= 0
	then mti.max_entries = 3 * ne;		/* no, default to 1/3 full */
	else do;
	     mti.max_entries = cv_dec_check_ (argument, code);
						/* yes, get it */
	     if code ^= 0 then do;
		call com_err_ (error_table_$bad_conversion, ME, "^a", argument);
		return;
	     end;
	end;

	nename = unique_chars_ (""b) || "." || oename;
	call ms_table_mgr_$create (ndirname, nename, addr (mti), code);
						/* create the new copy */
	if code ^= 0 then do;
	     call com_err_ (code, ME, "Creating new MSTB.");
	     return;
	end;
	call ms_table_mgr_$open (ndirname, nename, (mti.type), ntp, nhp, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, "Opening new MSTB.");
	     return;
	end;

	nhp -> copy_header = hp -> copy_header;		/* copy the table header */
	do i = 1 by 1;				/* now copy the records */
	     call ms_table_mgr_$abs_entry (tp, i, key, NO_WRITE, ep, (0), code);
	     if code = 0 then do;			/* got one */
		call ms_table_mgr_$new_entry (ntp, key, nep, code);
						/* create in new copy */
		if code = 0 then do;		/* got an entry */
		     call COPY_ENTRY ();		/* Copy the entry */
		     if code ^= 0 then goto ENTRY_ERROR;
		end;
		else if code = error_table_$id_already_exists then ;
						/* ignore */
		else do;
ENTRY_ERROR:
		     call com_err_ (code, ME, "Processing entry ^d key ^a.", i, key);
		     return;
		end;
	     end;
	     else if code = error_table_$bad_index then goto done_copying_entries;
	     else if code = error_table_$no_record then ;
	     else if code = error_table_$checksum_failure
	     then call ioa_$ioa_switch (iox_$error_output, "^a: Checksum failure processing entry ^d.", ME, i);
	     else do;
		call com_err_ (code, ME, "Reading entry ^d.", i);
		return;
	     end;
	     end;
done_copying_entries:
	call ms_table_mgr_$close (ntp, (0));		/* and clean up */
	call ms_table_mgr_$close (tp, (0));		/* switch names: */
	call copy_acl_ (ndirname, oename, ndirname, nename, ("0"b), code);
	if code ^= 0 then call com_err_ (code, ME, "Unable to copy MSTB ACL.");
	call hcs_$chname_file (ndirname, oename, oename, rtrim (oename) || ".-." || unique_chars_ (""b), code);
						/* XXX -> XXX.-.!shriek */
	if code ^= 0 then call com_err_ (code, ME, "Unable to rename old MSTB.");
	call hcs_$chname_file (ndirname, nename, nename, oename, code);
						/* !shriek.XXX -> XXX */
	if code ^= 0 then call com_err_ (code, ME, "Unable to rename new MSTB.");

	return;
%page;
COPY_ENTRY:
     procedure ();

/**** This internal procedure copies the old entry into the new entry
      and updates the table entry. */

	nep -> copy_entry = ep -> copy_entry;		/* Slurp */
	call ms_table_mgr_$update_entry (ntp, nep, code);
	return;
     end COPY_ENTRY;

     end salvage_mstb;


		    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