<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">



		    msa_manager_.pl1                12/17/85  1305.6rew 12/16/85  1658.5      498933



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

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
	/*									*/
	/* N__a_m_e:  msa_manager_							*/
	/*									*/
	/*      A multi-segment area (MSA) is logically an infinite area in which PL/I type	*/
	/* allocations may be performed.  Physically, it is a multi-segment file (MSF) whose	*/
	/* segments each contain a header used by the msa_manager_, and an allocation area.	*/
	/* Each of these segments is called a single-segment area (SSA).			*/
	/*									*/
	/*      This procedure creates, terminates, truncates, and deletes multi-segment areas	*/
	/* (MSA's); handles "area" conditions signalled for the single-segment areas (SSA's)	*/
	/* which make up an MSA; and re-initiates an MSA which has been terminated so that it may	*/
	/* be used, perhaps in a different process.					*/
	/*									*/
	/*      Two entry points are also provided to get and release system MSA's created and	*/
	/* managed in the caller's process directory.					*/
	/*									*/
	/*      The current version of alloc_, the Multics program which performs allocations	*/
	/* when a PL/I allocate statement is encountered, does not pass any information about	*/
	/* an allocation failure when it signals "area".  Because msa_manager_ requires a	*/
	/* pointer to the SSA in which the allocation failed, and because msa_manager_		*/
	/* must be able to tell the allocation program to reattempt the failing allocation in	*/
	/* another SSA, some information must be passed when "area" is signalled.  The		*/
	/* smart_alloc_ subroutine may be used as an intermediary between the PL/I allocate	*/
	/* statement and alloc_.  It will pass the information msa_manager_ needs when "area"	*/
	/* is signalled, and it will allow msa_manager_ to change the area in which the allocation*/
	/* is to be reattempted.  (See Notes below for a description of the information structure	*/
	/* which msa_manager_ expects when "area" is signalled.  See the description of the	*/
	/* smart_alloc_ subroutine to learn how to tell PL/I to invoke smart_alloc_ to execute	*/
	/* an allocate statement.)							*/
	/*									*/
	/*      Using smart_alloc_ in all programs, here is a typical usage sequence for an MSA:	*/
	/* 1) The control program of a subsystem (the program invoked before any allocations	*/
	/*    are to be performed, and which does not return until all allocations have been	*/
	/*    performed) creates an MSA, consisting initially of a single segment, an SSA.	*/
	/*    The control program references the MSA through an pointer to the current 		*/
	/*    SSA of the MSA.  This pointer is called the MSA pointer.  It may be allocated in	*/
	/*    the control program's automatic or static storage, or it may optionally be	*/
	/*    allocated in the header of the first SSA of the MSA, and referenced by the control	*/
	/*    program as a based MSA pointer. For example,				*/
	/*									*/
	/*   	dcl	msa_ptr ptr based (Pmsa_ptr);					*/
	/*									*/

	/* 2) The control program also establishes msa_manager_$area_handler as its "area"	*/
	/*    condition handler.							*/
	/* 3) The control program may then perform allocations in the MSA, using the PL/I allocate*/
	/*    statement, or it may pass the MSA pointer (not a dummy variable, or some other copy	*/
	/*    of this pointer, but the pointer itself) to one or more other subprograms to allow	*/
	/*    them to perform allocations in the MSA.					*/
	/* 4) When an allocation cannot be performed because the first SSA is full, then	*/
	/*    smart_alloc_ signals the "area" condition, passing an information structure to the	*/
	/*    "area" condition handler, which is msa_manager_$area_handler.			*/
	/* 5) msa_manager_$area_handler converts the SSA, a single-segment file (SSF), into a	*/
	/*    multi-segment file (MSF), consisting of the original SSA, plus a new SSA.		*/
	/*    It updates the pointer in the information structure passed by smart_alloc_ to point	*/
	/*    to this new SSA, and it also updates the control program's MSA pointer to point	*/
	/*    to this new SSA.							*/
	/* 6) On return from the handler, smart_alloc_ then reattempts the allocation in the new	*/
	/*    SSA.								*/
	/* 7) When this new SSA fills up, the "area" condition is signalled again.  This time,	*/
	/*    msa_manager_$area_handler attempts to perform the allocaton in each of the	*/
	/*    existing SSA's, before appending a new SSA to the MSA.  In this way, the MSA grows	*/
	/*    only when necessary, taking advantage of any space freed in existing SSA's 	*/
	/*    whenever possible.							*/
	/* 8) Finally, when the control program has finished using the MSA, it may delete it,	*/
	/*    truncate it to zero length for later use, or terminate it for later re-initiation	*/
	/*    (perhaps in another process).						*/
	/*									*/
	/* E__n_t_r_y:  msa_manager_$make							*/
	/*									*/
	/*      This entry point creates a new MSA in the directory specified by the caller.	*/
	/* If an MSA of the same name already exists in that directory, nd_handler_ is invoked	*/
	/* to ask the user whether the existing MSA should be deleted.  If the user answers "no",	*/
	/* then an error code of error_table_$namedup is returned.				*/
	/*									*/
	/* U__s_a_g_e									*/
	/*									*/
	/*      dcl  msa_manager_$make entry (char(*), char(*), ptr, fixed bin(35),		*/
	/*	   ptr, fixed bin(35);						*/
	/*									*/
	/*      call msa_manager_$make (directory, entry, Pareap, Luser, Puser, code);		*/
	/*									*/
	/* 1) directory	is the path name of the directory in which the MSA is to be created.	*/
	/*		(In)							*/
	/* 2) entry	is the entry name of the MSA to be created.  If this name is a null	*/
	/*		character string, then the final entry name of the directory path	*/
	/*		is used as the entry name of the MSA. (In)			*/
	/* 3) Pareap	points to the MSA pointer for the MSA which was created.		*/
	/*		If Pareap is a null pointer on input, then it will point to an MSA	*/
	/*		pointer created in the header of the first SSA of the MSA. (Out)	*/
	/*		Otherwise, Pareap points to an MSA pointer defined by the caller. (In)*/
	/* 4) Luser	is the length (in words) of a user-defined region which is to be	*/
	/*		created in the header of the first SSA of the MSA.  The caller may	*/
	/*		use this region to store base pointers to an information structure	*/
	/*		contained in the MSA, to store identifying information, etc.  The	*/
	/*		region is guaranteed to begin on a double-word boundary.  If a	*/
	/*		length of 0 is specified, then no user-defined region is created. (In)*/
	/* 5) Puser	points to the Luser words of the user-defined region in the		*/
	/*		header of the first SSA. (Out)				*/
	/* 6) code	may be one of the following status codes. (Out)			*/

	/*    error_table_$namedup							*/
	/*		the MSA already exists, and the user did not want to delete it.	*/
	/*									*/
	/*    error_table_$dirseg							*/
	/*		_d_i_r_e_c_t_o_r_y&gt;_e_n_t_r_y identifies a directory.  msa_manager_$make cannot	*/
	/*		delete directories in order to create an MSA.			*/
	/*									*/
	/*		Any status code returned by hcs_$append_branchx, hcs_$initiate, or	*/
	/*		hcs_$set_bc_seg.						*/
	/*									*/
	/* E__n_t_r_y:  msa_manager_$area_handler						*/
	/*									*/
	/*      This entry point acts as a condition handler for the "area" condition which	*/
	/* is signalled when an allocation fails in one of the SSA's of an MSA.  It expects	*/
	/* to receive an information structure from the program which signalled "area".  From	*/
	/* this structure, it gets a pointer to the area segment in which the allocation failed.	*/
	/* It examines the header of the segment containing this area to insure that it is an 	*/
	/* SSA.  If it is not an SSA, or if no information structure is passed to the		*/
	/* handler, then it passes the "area" condition on to a handler defined by the caller 	*/
	/* at an earlier point in the user's stack.					*/
	/*      If the area is an SSA, then the area handler changes both the area pointer in the	*/
	/* information structure and the control program's MSA pointer to point to another SSA	*/
	/* in the MSA, if one exists, and returns to the allocation program so that the allocation*/
	/* can be reattempted in this new SSA.						*/
	/*      If the allocation also fails in this SSA, then the allocation program will	*/
	/* signal the "area" condition again, and the area handler will return a pointer to the	*/
	/* next SSA in the MSA.  This process continues until the allocation succeeds, or	*/
	/* until the allocation has failed in each SSA of the MSA.				*/
	/*      If the allocation has failed in each of the existing SSA's, then a new SSA is 	*/
	/* appended to the MSA, and the allocation is reattempted.				*/
	/*      If the allocation fails in this new SSA (which is completely empty), or if	*/
	/* an error occurs while appending a new SSA to the MSA, then the allocation		*/
	/* will never succeed, and the "area_handler_error_" condition is signalled, passing the	*/
	/* signal information structure shown in the Notes below.				*/
	/*      If the "area_handler_error_" condition handler returns, then the original	*/
	/* "area" condition is passed on to a handler defined earlier in the user's stack.	*/
	/*									*/
	/* U__s_a_g_e									*/
	/*									*/
	/*      dcl  msa_manager_$area_handler entry (ptr, char(*), ptr, ptr, bit(1) aligned);	*/
	/*									*/
	/*      call msa_manager_$area_handler (Pmc, condition, Pwc_mc, Pinfo, continue_sw);	*/
	/*									*/
	/* 1) Pmc		points to hardware state information. (Ignored)			*/
	/*      Given a pointer to an MSA pointer, this entry deletes the MSA which		*/
	/* is pointed to.								*/
	/*		be "area". (In)						*/
	/* 3) Pwc_mc	points to wall crossing state information. (Ignored)		*/
	/* 4) Pinfo	points to the allocation program's information structure. 		*/
	/*		(See N__o_t_e_s below.) (In)					*/
	/* 5) continue_sw	is "0"b. (In)						*/
	/*		is "1"b if the "area" condition is to be passed on to another handler.*/
	/*		(Out)							*/
	/*									*/
	/* E__n_t_r_y:  msa_manager_$delete						*/
	/*									*/
	/*      This entry deletes an existing MSA, given a pointer to the MSA's pointer.	*/

	/* U__s_a_g_e									*/
	/*									*/
	/*      dcl  msa_manager_$delete entry (ptr, fixed bin(35));			*/
	/*									*/
	/*      call msa_manager_$delete (Pareap, code);					*/
	/*									*/
	/* 1) Pareap	points to the MSA pointer of the MSA to be deleted. (In)		*/
	/* 2) code	may be any status code returned by hcs_$fs_get_path_name, by	*/
	/*		hcs_$delentry_seg, or by delete_$path. (Out)			*/
	/*									*/
	/* E__n_t_r_y:  msa_manager_$truncate						*/
	/*									*/
	/*      Given a pointer to an MSA pointer, this entry terminates the SSA's		*/
	/* of the MSA, deletes all but the first SSA of the MSA, truncates this SSA, and stores	*/
	/* it as a single-segment file (SSF).  The entry point is useful for commands which 	*/
	/* must use the same specifically-named MSA during each of their invocations, because it	*/
	/* eliminates the overhead of creating an entirely new MSA in successive invocations.	*/
	/*									*/
	/* U__s_a_g_e									*/
	/*									*/
	/*      dcl  msa_manager_$truncate entry (ptr, fixed bin(35));			*/
	/*									*/
	/*      call msa_manager_$truncate (Pareap, code);				*/
	/*									*/
	/* 1) Pareap	points to the MSA pointer of the MSA to be truncated. (In)		*/
	/* 2) code	may be any status code returned from hcs_$fs_get_path_name, from	*/
	/*		hcs_$set_bc_seg, hcs_$truncate_seg, hcs_$terminate_seg, or		*/
	/*		unmake_msf_. (Out)						*/
	/*									*/
	/* E__n_t_r_y:  msa_manager_$terminate						*/
	/*									*/
	/*      Given a pointer to an MSA pointer, this entry terminates the SSA's of		*/
	/* the MSA.  As some later time (eg, in another process), these SSA's 		*/
	/* can be re-initiated (with the same segment numbers, of course) to allow use of the	*/
	/* data stored in the MSA, or to allow further data storage.  All of the data stored in	*/
	/* the MSA at the time of termination is preserved.				*/
	/*									*/
	/* U__s_a_g_e									*/
	/*									*/
	/*      dcl  msa_manager_$terminate entry (ptr, fixed bin(35));			*/
	/*									*/
	/*      call msa_manager_$terminate (Pareap, code);				*/
	/*									*/
	/* 1) Pareap	points to the MSA pointer of the MSA to be terminated. (In)		*/
	/* 2) code	may be any code returned from hcs_$terminate_seg. (Out)		*/
	/*									*/
	/* E__n_t_r_y:  msa_manager_$initiate						*/
	/*									*/
	/*      This entry point re-initiates an MSA which has been terminated.  Each SSA segment	*/
	/* in the MSA is re-initiated with the same segment number it had at its creation in	*/
	/* order to preserve the value of any pointers stored in the MSA.			*/

	/* U__s_a_g_e									*/
	/*									*/
	/*      dcl  msa_manager_$initiate entry (char(*), char(*), ptr, fixed bin(35),		*/
	/*	   ptr, fixed bin(35));						*/
	/*									*/
	/*      call msa_manager_$initiate (directory, entry, Pareap, Luser, Puser, code);	*/
	/*									*/
	/* 1) directory	is the path name of the directory which contains the MSA to be	*/
	/*		initiated. (In)						*/
	/* 2) entry	is the entry name of the MSA to be initiated.  If this name is a null	*/
	/*		character string, then the final entry name of the directory path	*/
	/*		is used as the entry name of the MSA. (In)			*/
	/* 3) Pareap	points to the MSA pointer for the MSA which was initiated.		*/
	/*		If Pareap is a null pointer on input, then it will point to an MSA	*/
	/*		pointer created in the header of the first SSA of the MSA. (Out)	*/
	/*		Otherwise, Pareap points to an MSA pointer defined by the caller. (In)*/
	/* 4) Luser	is the length (in words) of the user-defined region is the header of	*/
	/*		the first SSA of the MSA, if one exists;  or 0, if no user-defined	*/
	/*		region exists. (Out)					*/
	/* 5) Puser	points to the user-defined region in the header of the first	*/
	/*		SSA of the MSA, if one exists;  or is a null pointer, if no 	*/
	/*		user-defined region exists.					*/
	/* 6) code	is one of the following status codes. (Out)			*/
	/*									*/
	/*    error_table_$invalidsegno						*/
	/*		One of the SSA's of the MSA could not be re-initiated because	*/
	/*		another segment in the user's process was already initiated with the	*/
	/*		segment number which that MSA was initiated with originally. 	*/
	/*		Pareap points to the base of the segment which must be terminated.	*/
	/*		The initiation may be re-attempted without prior termination, once	*/
	/*		this segment has been terminated.				*/
	/*									*/
	/*    error_table_$moderr							*/
	/*		The user does not have write access to one of the SSA's of the MSA.	*/
	/*		Pareap points to the base of the SSA segment to which write access	*/
	/*		must be given.  The initiation may be reattempted without prior	*/
	/*		termination, once write access has been set.			*/
	/*									*/
	/*    error_table_$noentry							*/
	/*		The MSA to be re-initiated was not found, or the first SSA of this	*/
	/*		MSA was not found.						*/
	/*									*/
	/*    error_table_$dirseg							*/
	/*		_d_i_r_e_c_t_o_r_y&gt;_e_n_t_r_y is a directory, not an MSA.  It cannot be initiated.	*/
	/*									*/
	/*									*/
	/*    error_table_$seg_not_found						*/
	/*		An SSA, other than the first SSA of the MSA, was discovered to be	*/
	/* 		missing.  A new SSA is created to replace the old SSA, but some	*/
	/*		data may be missing.  The MSA has been fully re-initiated.		*/
	/*									*/
	/*		Any error code from hcs_$fs_get_mode, from hcs_$set_bc_seg,		*/
	/*		from hcs_$append_branchx, or from hcs_$initiate.			*/
	/*									*/
	/*    error_table_$improper_data_format						*/
	/*		An attempt was made to re-initiate an MSA whichdidn't contain	*/
	/*		the identifier string in its header.  The assumption is that the	*/
	/*		segment is _n_o_t an MSA.					*/
	/*									*/

	/* E__n_t_r_y:  msa_manager_$make_special						*/
	/*									*/
	/*      This entry point is like msa_manager_$make, except that the caller may specify	*/
	/* a lower bound on the segment numbers used to initiate the SSA's of the MSA.  If this	*/
	/* lower bound is high enough (eg, 400 or 440), then no problem should occur in 	*/
	/* re-initiating a terminated MSA.						*/
	/*									*/
	/* U__s_a_g_e									*/
	/*									*/
	/*      dcl  msa_manager_$make_special entry (fixed bin, char(*), char(*), ptr,		*/
	/*	   fixed bin(35), ptr, fixed bin(35));					*/
	/*									*/
	/*      call msa_manager_$make_special (min_seg_no, directory, entry, Pareap, Luser,	*/
	/* Puser, code);								*/
	/*									*/
	/* 1) min_seg_no	is the minimum segment number SSA's may be initiated with. (In)	*/
	/* 2) - 7)	are the same as for msa_manager_$make.				*/
	/*									*/
	/* E__n_t_r_y:  get_system_msa_$get_system_msa_					*/
	/*									*/
	/*      This entry point returns with the caller's MSA pointer pointing to a		*/
	/* system MSA maintained in the user's process directory.  This MSA will exist for the	*/
	/* life of the user's process, and is reserved for the exclusive use of the calling	*/
	/* program and its subprograms.						*/
	/*									*/
	/*      Entries in the process directory named system_multi_segment_area__r._n, where	*/
	/* _r is the current ring number and _n is an integer.  Any system MSA's which exist when	*/
	/* this entry point is called are examined to see if they are in use.  The MSA pointer	*/
	/* will point to the first unused MSA on return, or to a new system MSA if no		*/
	/* unused system MSA's are found.						*/
	/*									*/
	/*      After the control program is through with the MSA, it should call		*/
	/* release_system_msa_ to truncate the MSA and make it available to other programs.	*/
	/*									*/
	/* U__s_a_g_e									*/
	/*									*/
	/*      dcl  get_system_msa_ entry (ptr, fixed bin(35), ptr);			*/
	/*									*/
	/*      call get_system_msa_ (Pareap, Luser, Puser);				*/
	/*									*/
	/* 1) - 3)	are the same as for msa_manager_$make.				*/
	/*									*/
	/* E__n_t_r_y:  release_system_msa_$release_system_msa_				*/
	/*									*/
	/*      This entry point truncates a system MSA, and releases it for use by other	*/
	/* programs.								*/
	/*									*/
	/* U__s_a_g_e									*/
	/*									*/
	/*      dcl  release_system_msa_ entry (ptr, fixed bin(35));			*/
	/*									*/
	/*      call release_system_msa_ (Pareap, code);					*/
	/*									*/
	/* 1) - 2)	same as for msa_manager_$truncate.				*/

	/* N__o_t_e_s									*/
	/*									*/
	/*      The information structure which must be passed to msa_manager_$area_handler	*/
	/* is as follows:								*/
	/*									*/
	/*  dcl 1 area_info		aligned,						*/
	/*	2 length		fixed bin,					*/
	/*	2 version		fixed bin,					*/
	/*	2 action_flags	aligned,						*/
	/*	  3 cant_restart	bit(1) unal,					*/
	/*	  3 default_restart bit(1) unal,					*/
	/*	2 info_string	char(256) varying aligned,				*/
	/*	2 status_code	fixed bin(35),					*/
	/*	2 Parea		ptr,						*/
	/*	2 space		fixed bin(35),					*/
	/*	2 signal_id	bit(70) aligned;					*/
	/*									*/
	/* 1) length	(Ignored)							*/
	/* 2) version	must be 1.						*/
	/* 3) cant_restart	must be "0"b.						*/
	/* 4) default_restart							*/
	/*		(Ignored)							*/
	/* 5) info_string	(Ignored)							*/
	/* 6) status_code	(Ignored)							*/
	/* 7) Parea	points to the area in which the allocation failed. (In)		*/
	/*		points to the area in which the allocation is to be reattempted. (Out)*/
	/* 8) space	is the amount of space being allocated in the MSA. (Ignored)	*/
	/* 9) signal_id	is an identifier supplied by unique_bits_ which changes for each	*/
	/*		different allocation, but which remains constant during all 	*/
	/*		attempts to recover from a failure in performing the same allocation.	*/
	/*		(In)							*/
	/*									*/
	/*      The following information structure is passed by msa_manager_$area_handler when	*/
	/* it signals the "area_handler_error_" condition.  This condition is signalled if	*/
	/* an error occurs while appending an empty SSA to the MSA, or if an allocation fails in	*/
	/* an empty SSA.  Under both of these conditions, the allocation can never succeed.	*/
	/*									*/
	/*  dcl 1 area_error_info	aligned,						*/
	/*	2 length		fixed bin,					*/
	/*	2 version		fixed bin init(0),					*/
	/*	2 action_flags	aligned,						*/
	/*	  3 cant_restart	bit(1) unal init ("1"b),				*/
	/*	  3 default_restart bit(1) unal init ("0"b),				*/
	/*	2 info_string	char(256) varying aligned,				*/
	/*	2 status_code	fixed bin(35);					*/
	/*									*/
	/* 1) length	is the length of the area_error_info structure.			*/
	/* 2) version	is the version number of this structure (= 1).			*/
	/* 3) cant_restart	is on, specifying that the handler for the "area_handler_error_"	*/
	/*		cannot return to msa_manager_$area_handler.			*/
	/* 4) default_restart							*/
	/*		is off, specifying that the handler for the "area_handler_error_"	*/
	/*		must take positive action.					*/
	/* 5) info_string	is an error message which indicates the cause of the signal.	*/
	/* 6) status_code	is a status code which indicates the cause of the signal.		*/
	/*								          */
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */


/****^  HISTORY COMMENTS:
  1) change(73-02-01,GDixon), approve(), audit(), install():
     Initially created.
  2) change(73-04-01,GDixon), approve(), audit(), install():
     add the make_special entry point.
  3) change(73-07-01,GDixon), approve(), audit(), install():
      a) expect standard header in condition info structure.
      b) make msa_manager_ work in multiple rings.
      c) allow creation of MSA pointer in header of first SSA.
  4) change(74-06-01,PKelley), approve(), audit(), install():
      a) Changed to not store SSA segment numbers as bit count of the SSA.
         Segment numbers are now derived from a pointer stored within each SSA.
         Bit counts of SSAs are now set to 64 K bits.
      b) Fixed bug which when re-initiating an MSA resulted in erroneous report
         of SSA component missing and subsequent creation of an extra SSA.
  5) change(74-07-01,PKelley), approve(), audit(), install():
     Improved consistency of msa_manager_ by refusing to re-initialize an
     existing SSA if the MSA identifying string was not found in its header.
  6) change(79-08-01,GDixon), approve(), audit(), install():
     Changed to allow 256K SSA when attempting to allocate space larger than
     63K.  64K SSAs continue to be used as a normal rule.  Bit count of each
     ssa is set to its size (64K or 256K), and size now stored in SSA header
     for each SSA.
  7) change(80-05-01,Texada), approve(), audit(), install():
     Changed to set the bit count of SSA's when allocated to preclude premature
     reuse.  Changed to use active_all_rings_data$max_segno as limit for
     segment numbers.
  8) change(85-11-24,GDixon), approve(85-12-11,MCR7315),
     audit(85-12-12,Martinson), install(85-12-16,MR12.0-1001):
     Changed the release_system_msa_ and msa_manager_$truncate entrypoints to
     properly truncate and set bit counts on MSA's which are being truncated to
     SSAs.  Prior to the change, component 0 of the MSA was converted to an SSA
     without being truncated or having its bit count set to 0.  This prevented
     system MSAs from being reused; successive calls to get_system_msa_ always
     created a new MSA, and cluttered up the process directory with unusable
     MSA segments.
                                                   END HISTORY COMMENTS */


/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


msa_manager_:	procedure;


     dcl						/*	parameters			*/
	Pmc			ptr,		/* ptr to machine conditions for area handler.	*/
	cond			char(*),		/* name of signalled condition for area handler.	*/
	Pwc_mc			ptr,		/* ptr to wall crossing machine conditions.	*/
	Pinfo			ptr,		/* ptr to "area" condition information str.(In)	*/
	Scont			bit(1) aligned,	/* non-zero if system to continue looking for a	*/
						/* handler for the "area" condition.		*/
	ANstart			fixed bin,	/* minimum segment number SSA's may be initiated	*/
						/* with. (In)				*/
	Adirectory		char(*),		/* directory part of MSA pathname. (In)		*/
	Aentry			char(*),		/* entry part of MSA pathname. (In)		*/
	Pareap			ptr,		/* ptr to user's area ptr. (In)		*/
	Luser			fixed bin(35),	/* length of user's region in first SSA header.	*/
						/* (In/Out)				*/
	Puser			ptr,		/* ptr to user's region in first SSA header. (Out)*/
	Acode			fixed bin(35);	/* a status code. (Out)			*/

     dcl						/*	automatic variables			*/
	Pold_ssa			ptr,		/* ptr to previous SSA in MSA chain.		*/
	Ldirectory		fixed bin,	/* length of non-blank part of _d_i_r_e_c_t_o_r_y	*/
	Nstart			fixed bin,	/* min seg no SSA's may be initiated with.	*/
	Pssa			ptr,		/* ptr to current SSA.			*/
	1 area_error_info		aligned,		/* "area_handler_error_" information structure.	*/
	  2 length		fixed bin,	/* length of this structure (in words).		*/
	  2 version		fixed bin,	/* version of this structure (1)		*/
	  2 action_flags		aligned,
	    3 cant_restart		bit(1) unal,	/* condition is not restartable.		*/
	    3 default_restart	bit(1) unal,	/* therefore, there is no default restart.	*/
	    3 pad			bit(34) unal,
	  2 info_string		char(256) varying aligned,
						/* a meaningful info string.			*/
	  2 status_code		fixed bin(35),	/* a meaningful status code.			*/
	bit_count			fixed bin(24),	/* bit count attribute of SSA.		*/
	code			fixed bin(35),	/* a status code.				*/
	directory			char(168) aligned,	/* a directory pathname.			*/
	e			fixed bin,	/* entry point indicator.			*/
	entry			char(32) aligned,	/* name of an entry in a directory.		*/
	error			label local,	/* return point from int subroutines when an	*/
						/* error occurs.				*/
	i			fixed bin (35),	/* a do group index.			*/
	mode			fixed bin(5),	/* user's access to SSA segment.		*/
	msa_count			fixed bin(35),	/* one less than the number of SSA's in MSA chain.*/
	rings (3)			fixed bin(6),	/* ring brackets				*/
	type			fixed bin(2),	/* type of MSA which was found by status:	*/
						/*   0 =&gt; MSA does not exist.			*/
						/*   1 =&gt; MSA is a single SSA.		*/
						/*   2 =&gt; MSA is a directory. (ERROR CONDITION)	*/
						/*   3 =&gt; MSA is an msf containing segments,	*/
						/*        each of which is an SSA.		*/
	validation_level		fixed bin(6);	/* a saved validation level.			*/
	
     dcl						/*	based variables			*/
	areap			ptr based (Pareap),
						/* the control program's MSA pointer.		*/
	1 area_info		based (Pinfo),	/* "area" condition information structure.	*/
	  2 length		fixed bin,	/* length of this structure (in words).		*/
	  2 version		fixed bin,	/* version of this structure (must be 1).	*/
	  2 action_flags		aligned,
	    3 cant_restart		bit(1) unal,	/* "area" handler cannot return (should never be).*/
	    3 default_restart	bit(1) unal,	/* "area" handler can return without doing	*/
						/* anything (should never be).		*/
	  2 info_string		char(256) varying aligned,
						/* a meaningful info string.			*/
	  2 status_code		fixed bin(35),	/* a meaningful status code.			*/
	  2 Parea			ptr,		/* ptr to full area (In); ptr to new area (Out)	*/
	  2 space			fixed bin(35),	/* amount of space which must be allocated. (In)	*/
	  2 signal_id		bit(70) aligned,	/* id associated with this signalled area cond.	*/
						/* this allocation. (In)			*/
	1 ssa			based (Pssa),	/* header for an SSA (single segment area).	*/
	  2 id,					/* id's used for searching for space in msa	*/
	    3 string		char(8) aligned,	/* id, initialized to "msa_" for identifying MSA's*/
	    3 new_ssa		bit(70) aligned,	/* signal id which caused SSA to be created.	*/
	    3 last_signal		bit(70) aligned,	/* id of last signal to look for space in ssa	*/
	  2 Parea			ptr,		/* ptr to the area in this SSA.		*/
	  2 Pfirst		ptr,		/* ptr to first SSA of this MSA chain.		*/
	  2 Pnext			ptr,		/* ptr to next SSA of this MSA chain.		*/
	  2 Pareap		ptr,		/* ptr to user's area ptr.			*/
	  2 Puser			ptr,		/* ptr to user region in this header.		*/
	  2 Pcur_area		ptr,		/* (possibly) the MSA pointer.		*/
	  2 Luser			fixed bin(35),	/* length of user region in this header.	*/
	  2 Nseg			fixed bin(35),	/* MSA # of this SSA in MSA chain (0 to n).	*/
	  2 Nstart		fixed bin,	/* 0 or minimum seg no which new SSA's may have.	*/
	  2 area_size		fixed bin(19);	/* size of this SSA (64K or sys_info$max_seg_size)*/
		
     dcl						/*	builtin functions			*/
         (addr, baseptr, divide, fixed, length, mod, null, ptr, rel, size, substr)
				builtin;

     dcl						/*	function and subroutine entries	*/
	area_			entry (fixed bin(35), ptr),
	backup_name_		entry (char(*) aligned) returns (char(32)),
	convert_binary_integer_$decimal_string
				entry (fixed bin(35)) returns (char(12) varying),
	cu_$level_get		entry returns (fixed bin(6)),
	cu_$level_set		entry (fixed bin(6)),
	delete_$path		entry (char(*) aligned, char(*) aligned, bit(6) aligned, char(*) aligned,
				       fixed bin(35)),
	expand_path_		entry (ptr, fixed bin, ptr, ptr, fixed bin(35)),
	get_pdir_			entry returns (char(168) aligned),
	get_group_id_$tag_star	entry returns (char(32) aligned),
	get_ring_			entry returns (fixed bin(35)),
	hcs_$append_branchx		entry (char(*) aligned, char(*) aligned, fixed bin(5), (3) fixed bin(6),
				       char(*) aligned, fixed bin(1), fixed bin(1), fixed bin(24),
				       fixed bin(35)),
	hcs_$delentry_seg		entry (ptr, fixed bin(35)),
	hcs_$fs_get_mode		entry (ptr, fixed bin(5), fixed bin(35)),
	hcs_$fs_get_path_name	entry (ptr, char(*) aligned, fixed bin, char(*) aligned, fixed bin(35)),
	hcs_$get_link_target	entry (char(*), char(*), char(*) aligned, char(*) aligned, fixed bin(35)),
	hcs_$get_ring_brackets	entry (char(*) aligned, char(*) aligned, (3) fixed bin(6), fixed bin(35)),
	hcs_$initiate		entry (char(*) aligned, char(*) aligned, char(*) aligned, fixed bin(1),
				       fixed bin(2), ptr, fixed bin(35)),
	hcs_$set_bc		entry (char(*) aligned, char(*) aligned, fixed bin(24), fixed bin(35)),
	hcs_$set_bc_seg		entry (ptr, fixed bin(24), fixed bin(35)),
	hcs_$status_minf		entry (char(*) aligned, char(*) aligned, fixed bin(1), fixed bin(2),
				       fixed bin(24), fixed bin(35)),
	hcs_$terminate_seg		entry (ptr, fixed bin(1), fixed bin(35)),
	hcs_$truncate_seg		entry (ptr, fixed bin, fixed bin(35)),
	make_msf_			entry (char(*) aligned, char(*) aligned, (3) fixed bin(6),
				       fixed bin(35)),
	nd_handler_		entry (char(*) aligned, char(*) aligned, char(*) aligned, fixed bin(35)),
	signal_			entry (char(*), ptr, ptr),
	unmake_msf_		entry (char(*) aligned, char(*) aligned, bit(1) aligned, (3) fixed bin(6),
				       fixed bin(35));

     dcl						/*	static variables			*/
         (active_all_rings_data_$max_segno,
          error_table_$dirseg,
	error_table_$improper_data_format,
	error_table_$invalidsegno,
	error_table_$moderr,
	error_table_$namedup,
	error_table_$noalloc,
	error_table_$noentry,
	error_table_$seg_not_found,
	error_table_$segknown)	fixed bin(35) ext static,
	small_ssa_size		fixed bin(35) int static options(constant) init (65536),
	sys_info$max_seg_size	fixed bin(35) ext static;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/**/
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

area_handler:	entry (Pmc, cond, Pwc_mc, Pinfo, Scont);

	if Pinfo = null then do;			/* if we weren't signalled by a smart allocater	*/
pass_on:	     Scont = "1"b;				/* then there's not much we can do. Pass condition*/
	     return;				/* on to next handler.			*/
	     end;
	if area_info.version ^= 1 then		/* we can only handle a version 1 structure.	*/
	     go to pass_on;
	if area_info.cant_restart then		/* if we cannot restart the allocation, then this	*/
	     go to pass_on;				/* signal is not for us.			*/
	Pssa = ptr (area_info.Parea, 0);		/* get ptr to SSA containing area in which the	*/
						/* allocation failed.			*/
	if ssa.id.string ^= "msa_" then		/* if this isn't an MSA, pass condition on.	*/
	     go to pass_on;

	ssa.id.last_signal = area_info.signal_id;	/* indicate that there's no space in this SSA for	*/
						/* the allocation causing this signal.		*/
	if ssa.id.new_ssa = area_info.signal_id then do;	/* if the allocation couldn't be performed in	*/
						/* an empty SSA, then it will never fit.	*/
	     area_error_info.status_code = error_table_$noalloc;
	     area_error_info.info_string = "msa_manager_$area_handler:  the allocation is too large to fit in the MSA.";
	     go to signal;
	     end;

	do Pssa = Pssa repeat (ssa.Pnext) while (ssa.Pnext ^= null);
	     if ssa.id.last_signal ^= area_info.signal_id then
		if area_info.space &lt;= ssa.area_size - 1024 then
		     go to return_area;		/* look through SSA's which follow this full SSA	*/
						/*   in MSA chain to find one in which the alloc.	*/
	     					/*   has not yet been tried.  Return this area.	*/
		else 				/* However, if SSA is a small (64K) SSA and space */
						/*   required is more than 63K, skip this area.	*/
		     ssa.id.last_signal = area_info.signal_id;
	     end;

	if ssa.id.last_signal = area_info.signal_id then	/* if alloc already tried in last SSA of chain,	*/
						/* &amp; if alloc also tried in first SSA of chain,	*/
						/* then append a new SSA, and return its area.	*/
	     if ssa.Pfirst -&gt; ssa.id.last_signal = area_info.signal_id then do;
		error = signal_error;
		if area_info.space &lt;= small_ssa_size - 1024 then
		     call append (small_ssa_size);
		else call append (sys_info$max_seg_size);
		end;
	     else					/* otherwise, go back to first SSA in MSA chain	*/
		Pssa = ssa.Pfirst;			/* and try the allocation in SSA's which precede	*/
						/* first SSA in which alloc was tried.		*/
return_area:
	area_info.Parea,
	ssa.Pareap -&gt; areap = ssa.Parea;		/* return ptr to SSA's area we found, and set	*/
	return;					/* user's area ptr to point to this SSA area, too	*/
signal_error:					/* a fatal error occurred appending an empty SSA	*/
	area_error_info.pad = "0"b;			/* to the MSA.				*/
	area_error_info.status_code = code;
	area_error_info.info_string = "msa_manager_$area_handler:  error appending an SSA to the MSA  " ||
	     directory || ".";
signal:	area_error_info.default_restart = "0"b;
	area_error_info.cant_restart = "1"b;
	area_error_info.version = 1;
	area_error_info.length = size (area_error_info);
	call signal_ ("area_handler_error_", null, addr (area_error_info));
	go to pass_on;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


make_special:	entry (ANstart, Adirectory, Aentry, Pareap, Luser, Puser, Acode);
						/* create an MSA in which all SSA's are initiated	*/
	Nstart = ANstart;				/* with segment numbers greater than ANstart	*/
	go to common;				/* to simplify their re-initiation.		*/


make:		entry (Adirectory, Aentry, Pareap, Luser, Puser, Acode);
						/* create an MSA.				*/

	Nstart = 0;				/* initiate SSA's in MSA with any segment no.	*/
common:	Acode = 0;				/* clear error code.			*/
	error = return_code;			/* return any error code encountered.		*/
	if Aentry = "" then do;			/* copy arguments for use by internal subroutines	*/
	     call expand_path_ (addr(Adirectory), length (Adirectory), addr(directory), addr(entry), code);
	     if code ^= 0 then
		go to error;
	     end;
	else do;
	     directory = Adirectory;
	     entry = Aentry;
	     end;
	call status;				/* find out about _d_i_r_e_c_t_o_r_y&gt;_e_n_t_r_y.		*/
	go to make(type);				/* process according to type of dir entry.	*/

make(1):
make(3):	call nd_handler_ ("msa_manager_", directory, entry, code);
	if code ^= 0 then do;
	     Acode = error_table_$namedup;
	     return;
	     end;

make(0):	rings(1), rings(2), rings(3) = cu_$level_get();	/* set ring brackets of v,v,v on SSA.		*/
	call make_seg (Nstart, rings);		/* create first SSA of MSA chain.		*/
	call initialize (Pssa, Pareap, Puser, Luser, 0, Nstart, "1"b, small_ssa_size);
	return;					/* initialize this SSA, and return to caller.	*/

make(2):	Acode = error_table_$dirseg;			/* a directory with name of MSA already exists.	*/
	return;					/* complain to caller.			*/

return_code:					/* return to user with an error code.		*/
	Acode = code;
	return;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


/**/

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


initiate:		entry (Adirectory, Aentry, Pareap, Luser, Puser, Acode);
						/* initiate an existing MSA.			*/

	Acode = 0;
	error = return_code;			/* return any error codes which are encountered.	*/
	msa_count = 0;				/* initialize count (minus 1) of SSA's in MSA.	*/
	call hcs_$get_link_target (Adirectory, Aentry, directory, entry, code);
	if code ^= 0 then				/* copy arguments for use by internal subroutines	*/
	     go to error;				/* chasing links while we're at it.		*/
	call status;				/* find out about _d_i_r_e_c_t_o_r_y&gt;_e_n_t_r_y.		*/
	go to init(type);

init(1):						/* MSA consists of a single SSA.		*/
	call re_initiate;				/* Re-initiate and initialize it.		*/
	call initialize (Pssa, Pareap, Puser, Luser, 0, 0, "0"b, small_ssa_size);
	return;

init(3):	do Ldirectory = 168  to 1 by -1 while (substr (directory, Ldirectory, 1) = " ");
	     end;					/* construct path of MSA's directory.		*/
	substr (directory, Ldirectory+1) = "&gt;" || entry;
	entry = "0";
	call status;				/* find out about first SSA of MSA.		*/
	go to init_1st_ssa(type);

init_1st_ssa(1):					/* first SSA of MSA exists.			*/
	call re_initiate;				/* re-initiate it with proper segment number.	*/
	call initialize (Pssa, Pareap, Puser, Luser, 0, 0, "0"b, small_ssa_size);
						/* initialize the SSA.			*/
	Nstart = ssa.Nstart;			/* get value of min seg no SSA's can have.	*/
	call hcs_$get_ring_brackets (directory, entry, rings, code);
	if code ^= 0 then				/* get ring brackets of SSA's in case we have	*/
	     go to error;				/* to remake any missing ones.		*/

	do i = 1 to msa_count;			/* if initiating an MSA, initiate SSA's which	*/
						/* follow the first SSA in the MSA chain.	*/
	     entry = convert_binary_integer_$decimal_string (i);
	     call status;				/* get name of, and find out about next SSA.	*/
	     Pold_ssa = Pssa;			/* save ptr to current SSA, for fwd chaining.	*/
	     go to init_ssa(type);

init_ssa(0):   call make_seg (Nstart, rings);		/* next SSA doesn't exist. Make it.		*/
	     Acode = error_table_$seg_not_found;	/* report the error to the user, but continue.	*/
	     go to initialize_;

init_ssa(1):   call re_initiate;			/* next SSA does exist. Re-initiate it.		*/
initialize_:   call initialize (Pold_ssa-&gt;ssa.Pfirst, Pareap, null, 0, i, Nstart, "0"b, small_ssa_size);
						/* initialize the SSA.			*/
	     Pold_ssa-&gt;ssa.Pnext = Pssa;		/* chain SSA to previous SSA.			*/
	     end;
	return;

init(0):						/* MSA doesn't exist.			*/
init_1st_ssa(0):					/* first SSA of MSA doesn't exist.		*/
	Acode = error_table_$noentry;			/* Cannot re-initiate MSA.			*/
	return;

init(2):
init_ssa(2):
init_ssa(3):
init_1st_ssa(2):
init_1st_ssa(3):
	Acode = error_table_$dirseg;			/* complain to user about unexpected dir's/msa's	*/
	return;


/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


/**/

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


get_system_msa_:	entry (Pareap, Luser, Puser);		/* get a system multi-segment area of your own.	*/

	rings(1), rings(2), rings(3) = get_ring_();	/* look for system MSA in the current ring.	*/
	directory = get_pdir_();
	entry = "system_multi_segment_area_" ||
	     convert_binary_integer_$decimal_string (fixed (rings(1), 35));
						/* make them per-ring data bases, like		*/
						/* system_free_4.00, ...			*/
	error = get_another;			/* keep trying if an error occurs.		*/

	do while ("1"b);				/* when I say "keep trying", I mean it.		*/
	     entry = backup_name_ (entry);		/* tack ".1" onto entry, or change ".1" to ".2",..*/
	     call status;				/* see if it already exists.			*/
	     go to gsa(type);

gsa(0):	     call make_seg (0, rings);		/* it doesn't. make and initialize it.		*/
	     go to gsa_0;

gsa(1):	     if bit_count &gt; 0 then			/* if found a SSA, but it's in use, then	*/
		go to get_another;			/* get another one.				*/
	     call re_initiate;			/* otherwise, initiate this one.		*/
	     ssa.id.string = "";			/* force complete reinitialization in next step.	*/
gsa_0:	     call initialize (Pssa, Pareap, Puser, Luser, 0, 0, "1"b, small_ssa_size);
						/* initialize the SSA.			*/
	     return;
gsa(2):
gsa(3):
get_another:   end;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


/**/

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


release_system_msa_:entry (Pareap, Acode);		/* give MSA back to the system.		*/

	e = 4;					/* don't tell anyone, but this is 		*/
	go to common2;				/* msa_manager_$truncate, for now.		*/

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


delete:		entry (Pareap, Acode);		/* delete MSA for ever and ever.		*/

	e = 3;
	go to common2;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


truncate:		entry (Pareap, Acode);		/* truncate MSA into a 0-length SSA.		*/

	e = 4;
	go to common2;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


terminate:	entry (Pareap, Acode);		/* terminate MSA, but leave it intact for use in	*/
						/* another process.				*/
	e = 5;


common2:	Pssa = ptr(areap,0)-&gt;ssa.Pfirst;		/* start with first SSA of MSA chain.		*/
	areap = null;				/* clear user's area ptr to avoid errors.	*/
	go to do(e);				/* do remaining work by entry point.		*/

do(3):						/* for delete, truncate, and release_system_area	*/
do(4):	if ssa.Pnext = null then do;			/* if MSA has only 1 SSA, then special case it	*/
	     go to end_ssa(e);

end_ssa(3):					/* delete SSA.				*/
	     call hcs_$delentry_seg (Pssa, Acode);
	     return;

end_ssa(4):					/* truncate SSA.				*/
	     call hcs_$set_bc_seg (Pssa, 0, Acode);	/* zero bit count to mark it as free.		*/
	     if Acode ^= 0 then
	          return;
	     call hcs_$truncate_seg (Pssa, 0, Acode);
	     call hcs_$terminate_seg (Pssa, 0b, Acode);	/* now terminate the SSA.			*/
	     return;
	     end;

	else do;					/* process multi-SSA MSA's here.		*/
	     call hcs_$fs_get_path_name (Pssa, directory, Ldirectory, entry, Acode);
	     if Acode ^= 0 then			/* get path name of first SSA in MSA chain.	*/
	          return;
	     call hcs_$get_ring_brackets (directory, entry, rings, Acode);
	     if Acode ^= 0 then			/* get ring brackets of 1st SSA in MSA.		*/
		return;
	     do i = Ldirectory to 1 by -1 while (substr (directory, i, 1) ^= "&gt;");
		end;				/* get path name of MSA directory.		*/
	     entry = substr (directory, fixed (i, 17) + 1);
	     substr (directory, fixed (i, 17)) = "";
	     go to end_msa(e);

end_msa(3):					/* delete MSA.				*/
	     call delete_$path (directory, entry, "100111"b, entry, Acode);
	     return;

end_msa(4):					/* make MSA into zero-length SSA.		*/
	     validation_level = cu_$level_get();	/* save the current validation level.		*/
	     call cu_$level_set (rings(1));		/* switch to the validation level in which the	*/
	     					/* MSA was created, so unmake_msf_ will work.	*/
	     call unmake_msf_ (directory, entry, "0"b, rings, Acode);
	     call cu_$level_set (validation_level);	/* reset validation level, before error check	*/
	     if Acode ^= 0 then
	          return;
	     go to end_ssa(4);			/* Now terminate the SSA's of the MSA.		*/
	     end;

do(5):						/* terminate MSA's SSA segments.		*/
	do Pssa = Pssa repeat (Pold_ssa) while (Pssa ^= null);
	     Pold_ssa = ssa.Pnext;
	     call hcs_$terminate_seg (Pssa, 0b, Acode);
	     if Acode ^= 0 then
		return;
	     end;
	return;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


/**/

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


append:	procedure (ssa_size);			/* append an SSA onto MSA chain.		*/

     dcl	ssa_size			fixed bin(35);
	
	call hcs_$fs_get_path_name (Pssa, directory, Ldirectory, entry, code);
	if code ^= 0 then				/* assuming we're currently dealing with last msa	*/
	     go to error;				/* on MSA chain, get its path name.		*/
	call hcs_$get_ring_brackets (directory, entry, rings, code);
	if code ^= 0 then				/* get the ring brackets of SSA for later use.	*/
	     go to error;
	if ssa.Nseg = 0 then do;			/* if our MSA is an SSA, then make it an MSA.	*/
	     substr (directory, Ldirectory+1) = "&gt;" || entry;
						/* put path of MSA directory into _d_i_r_e_c_t_o_r_y.	*/
	     validation_level = cu_$level_get();	/* save the current validation level.		*/
	     call cu_$level_set (rings(1));		/* change validation level to ring in which	*/
						/* first SSA of MSA was created so make_msf_ will	*/
						/* work properly.				*/
	     call make_msf_ (directory, "", rings, code);
						/* convert SSF to MSF containing our 1st SSA.	*/
	     call cu_$level_set (validation_level);	/* reset our validation level, before error check	*/
	     if code ^= 0 then
	     	go to error;
	     end;

	entry = convert_binary_integer_$decimal_string (ssa.Nseg+1);
						/* get entryname of new SSA to be appended.	*/
	Pold_ssa = Pssa;				/* save ptr to current SSA for fwd chaining	*/
	Nstart = ssa.Nstart;
	call make_seg (Nstart, rings);		/* make and initialize new SSA.		*/
	call initialize (Pold_ssa-&gt;ssa.Pfirst, Pold_ssa-&gt;ssa.Pareap, null, 0, Pold_ssa-&gt;ssa.Nseg+1, Nstart, "1"b, ssa_size);
	ssa.id.new_ssa = area_info.signal_id;		/* indicate new SSA created for the current alloc	*/
	Pold_ssa-&gt;ssa.Pnext = Pssa;

						/* update MSA directory's msf_indicator count.	*/
	call hcs_$set_bc (directory, "", fixed (ssa.Nseg+1, 24), code);
	if code ^= 0 then
	     go to error;

	end append;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


/**/

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


initialize:
	procedure (Pfirst, Pareap, Puser, Luser, Nseg, Nstart, Nsw, ssa_size);
						/* initialize an SSA.			*/

     dcl						/*	parameters			*/
	Pfirst			ptr,		/* ptr to first SSA in MSA chain.		*/
	Pareap			ptr,		/* ptr to user's area ptr.			*/
	Puser			ptr,		/* ptr to user area at head of SSA.		*/
	Luser			fixed bin(35),	/* length of user area at head of SSA.		*/
	Nseg			fixed bin(35),	/* MSA # of this SSA in MSA chain.		*/
	Nstart			fixed bin,	/* min seg # which an SSA can be initiated with.	*/
	Nsw			bit(1) aligned,	/* ON if we've created it and now initializing.	*/
						/* OFF if we're re-initializing existing SSA.	*/
	ssa_size			fixed bin(35);	/* size of segment used for new SSA.  Can be	*/
						/*   either 64K or sys_info$max_seg_size.	*/


	if ssa.id.string = "msa_" then		/* if this SSA has already been initialized,	*/
	     Luser = ssa.Luser;			/* save user header info; don't call area_	*/
	else do;					/* otherwise, reinitialize from top to bottom	*/
	     if ^Nsw then do;			/* unless we aren't creating it, then report	*/
		code = error_table_$improper_data_format;/* it as an illegal attempt to initialize.	*/
		Pareap, Puser = null;		/* zap any pointers.			*/
		Luser = 0;			/* return no traces.			*/
		go to error;			/* It probably isn't an MSA to begin with.	*/
		end;
	     ssa.id.string = "msa_";			/* start with the id.			*/
	     ssa.Parea = ptr (Pssa, divide (size(ssa)+Luser+7, 8, 35, 0) * 8);
						/* make SSA's area reside on mod 8 boundary.	*/
	     ssa.area_size = ssa_size;
	     call area_ (ssa_size - fixed(rel(ssa.Parea),35), ssa.Parea);
						/* initialize the SSA's area.			*/
	     if Luser = 0 then			/* if no user header region is required,	*/
		ssa.Puser = null;			/* forget about it.				*/
	     else					/* otherwise, get ptr to it.			*/
		ssa.Puser = ptr (Pssa, size(ssa));	/* size(ssa) should always = 0 mod 2 so that	*/
						/* user header is always doubleword aligned.	*/
	     ssa.Luser = Luser;			/* remember size of user region in SSA header.	*/
	     ssa.Nstart = Nstart;			/* remember min seg #.			*/
	     end;
	ssa.Pfirst = Pfirst;			/* initialize rest of SSA's header.		*/
	ssa.Pnext = null;				/* SSA is always last on any MSA chain.		*/
	if Pareap = null then			/* if pointer to MSA pointer is null, then	*/
	     Pareap = addr (ssa.Pcur_area);		/* create an MSA pointer in the header of this SSA*/
	ssa.Pareap = Pareap;			/* remember where MSA pointer is.		*/
	ssa.Nseg = Nseg;				/* store MSA # of this SSA in the MSA chain.	*/
	ssa.id.new_ssa,				/* init signal id's in this new SSA.		*/
	ssa.id.last_signal = "0"b;

	Puser = ssa.Puser;				/* return ptr to user region of SSA header.	*/
	Pareap-&gt;areap = ssa.Parea;			/* make user's area pointer point to SSA's area.	*/
	call hcs_$set_bc_seg (Pssa, fixed ( (ssa.area_size * 36), 24), code);
						/* set the bit count to prevent premature re-use*/
	end initialize;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


/**/

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


re_initiate:	procedure;			/* initiate an SSA, validating mode 	 	*/

     dcl						/*	parameter				*/
	Sseg			fixed bin(1);	/* reserved segment number switch.		*/

     dcl	Psave			ptr;		/* a pointer temporary			*/


	Pssa = null;				/* start out with null ptr			*/
	Sseg = 0;					/* don't know reserved segno at this point	*/
	Psave = Pareap;				/* just to keep it around			*/
						/* initiate SSA, possibly with reserved segno 	*/
						/* stored as initial value of Pssa.		*/
re_init:	call hcs_$initiate (directory, entry, "", Sseg, 0, Pssa, code);
	if (code ^= 0 &amp; code ^= error_table_$segknown) then
	     go to error;
	if ssa.id.string = "msa_" then
	if Pssa ^= ptr ( ssa.Parea, 0) then do;		/* do we have the right ptr value?		*/
	     Pareap = ptr ( ssa.Parea, 0);
	     call hcs_$terminate_seg ( Pssa, 0b, code);
						/* terminate it, so we can use proper segno	*/
	     if code ^= 0 then
		go to error;			/* whoops					*/
	     Sseg = 1;				/* initiate with reserved segno		*/
	     Pssa = Pareap;				/* this is the segno we want			*/
	     go to re_init;				/* and try it again				*/
	     end;
	call hcs_$fs_get_mode (Pssa, mode, code);	/* get user's access to this SSA.		*/
	if code ^= 0 then
	     go to error;
	if mod (mode, 4) = 0 then do;			/* if user doesn't have write access, complain	*/
	     code = error_table_$moderr;
	     go to error;
	     end;
	call hcs_$set_bc_seg (Pssa, fixed ( (ssa.area_size * 36), 24), code);
	if code ^= 0 then
	     go to error;
	Pareap = Psave;				/* restore pointer to MSA pointer.		*/

	end re_initiate;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


/**/

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


make_seg:	procedure (Nstart, rings);			/* make a new SSA segment.			*/

     dcl	Nstart			fixed bin,	/* min seg # SSA can be initiated with.		*/
	i			fixed bin,	/* do loop index.				*/
	rings (3)			fixed bin(6);	/* ring brackets to be put on new SSA.		*/

	validation_level = cu_$level_get();		/* save the current validation level.		*/
	call cu_$level_set (rings(1));		/* switch validation level to ring in which	*/
						/* SSA is to be created, so that correct initial	*/
						/* ACL for segments is placed on SSA.		*/
	call hcs_$append_branchx (directory, entry, 01011b, rings, get_group_id_$tag_star(), 0, 0, 0, code);
						/* create the SSA segment.			*/
	if code ^= 0 then do;			/* if creation failed, process the error.	*/
	     call cu_$level_set (validation_level);
	     go to error;
	     end;

	if Nstart = 0 then				/* if a high segment number is unnecessary,	*/
	     call hcs_$initiate (directory, entry, "", 0, 0, Pssa, code);
	else do;					/* otherwise, keep trying to initiate the SSA	*/
	     Pssa = null;				/* with a seg no &gt; Nstart until we succeed.	*/
	     do i = Nstart to active_all_rings_data_$max_segno while (Pssa = null);	
						/* starting with min seg #, keep incrementing	*/
		Pssa = baseptr (i);			/* seg # until we succeed in initiating ssa	*/
		call hcs_$initiate (directory, entry, "", 1, 0, Pssa, code);
		if code = error_table_$invalidsegno then do;
		   call cu_$level_set (validation_level); /* return to our validation level.		*/
		   goto error;
		   end;
		if code ^= 0 then Pssa = null;

		end;
	     end;
	call cu_$level_set (validation_level);		/* return to our validation level.		*/
	if Pssa = null then				/* No matter which way segment was created, if it	*/
	     go to error;				/* couldn't be initiated, complain to caller.	*/

	call hcs_$set_bc_seg (Pssa, fixed ( (ssa.area_size * 36), 24), code);
	if code ^= 0 then
	     go to error;				/* possible re-initiation of the MSA later.	*/
	end make_seg;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
/**/

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


status:		procedure;			/* get status info for an MSA or SSA segment	*/

	call hcs_$status_minf (directory, entry, 1, type, bit_count, code);
	if code ^= 0 then				/* get status info.				*/
	     if code = error_table_$noentry then do;	/* suppress entry not found errors.		*/
		type = 0;
		return;
		end;
	     else
		go to error;			/* report other errors to user.		*/
	if type = 2 then				/* set type code properly for an MSA.		*/
	     if bit_count &gt; 0 then do;
		type = 3;
		msa_count = bit_count - 1;		/* bit count is number of SSA's, however,	*/
		end;				/* msa count starts at 0.			*/

	end status;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


	end msa_manager_;
���



		    smart_alloc_.pl1                11/15/82  1909.3rew 11/15/82  1527.9      100278



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



	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
	/*									*/
	/* N__a_m_e:  smart_alloc_							*/
	/*									*/
	/*      A procedure which performs allocations within areas in an intelligent fashion.	*/
	/*									*/
	/* E__n_t_r_y:  smart_alloc_$smart_alloc_						*/
	/*									*/
	/*      This procedure uses alloc_ to perform an allocation within an area.  If the	*/
	/* allocation fails because the area is full, the procedure signals the "area" condition,	*/
	/* and passes an information structure for use by the handler.  The structure contains	*/
	/* a pointer to the area which is full when the handler is signalled.  On return,	*/
	/* the allocation in reattempted in the area pointed to by this pointer.  The handler	*/
	/* may have changed the pointer to point to a new area, or it may have created more	*/
	/* room in the original area.  If the allocation fails again, the"area condition is	*/
	/* re-signalled, and the process continues.					*/
	/*									*/
	/* U__s_a_g_e									*/
	/*									*/
	/*      All procedures which use smart_alloc_ must have the following rename option in 	*/
	/* their procedure statement:							*/
	/*									*/
	/*	&lt;label&gt;: procedure [( &lt;parms&gt; )] options (rename ((alloc_, smart_alloc_)));	*/
	/*									*/
	/*									*/
	/* Within such procedures, all allocations within an area will be performed by 		*/
	/* smart_alloc_.  The same applies to allocations made in procedures which are		*/
	/* internal to procedures using the rename option.				*/
	/*									*/
	/*      A condition handler should be provided for the "area" condition.		*/
	/* One possible handler is available in the msa_manager_ program.			*/
	/*									*/
	/*									*/
	/* A__l_g_o_r_i_t_h_m								*/
	/*									*/
	/* smart_alloc_								*/
	/*									*/
	/*   (1)	allocates space within the area pointed to by Parea, using alloc_;		*/
	/*   (2)	establishes an "area" condition handler which receives control if the		*/
	/*	allocation fails.							*/
	/*   (3)	if the allocation was successful, returns with:				*/
	/*		Preturn = 'pointer to the allocated space';			*/

	/*   (4)	if the allocation failed, then:					*/
	/*	(a)	calls  area_full, passing the size of the space to be		*/
	/*		allocated, Parea - the ptr to the area, and an allocation failure id.	*/
	/*	(b)	reattempts the allocation, using the (possibly-modified) area pointed	*/
	/*		to by Parea for the allocation;				*/
	/*									*/
	/*									*/
	/* E__n_t_r_y:  smart_alloc_$area_full						*/
	/*									*/
	/*      This procedure signals the "area" condition, passing a pointer to an information	*/
	/* structure describing the nature of the condition.  Programs which call lower-ring	*/
	/* subroutines that perform allocations within a caller-supplied area can use this	*/
	/* procedure to recover from allocation failures in these lower-ring subroutines.	*/
	/*									*/
	/* U__s_a_g_e									*/
	/*									*/
	/* 	dcl  smart_alloc_$area_full entry (fixed bin, ptr, bit(70) aligned);		*/
	/*									*/
	/*	call smart_alloc_$area_full (size, area_ptr, id);				*/
	/*									*/
	/* 1) size	is the amount of space required to satisfy the current allocation.	*/
	/*		If "size" = 0, then the amount of space required to satisfy the 	*/
	/*		the allocation requirements is unknown (eg, if if hcs_$status	*/
	/*		returned an  error_table_$noalloc  error code).			*/
	/*		The caller's "area" handler must make this space 			*/
	/*		available if it returns normally after being signalled.		*/
	/* 2) area_ptr	is a pointer to the area in which the allocation failed.  The value	*/
	/*		of this pointer may be changed by the handler of the "area" condition	*/
	/*		raised by smart_alloc_$area_full.  The new value should be used when	*/
	/*		the allocation is reattempted.				*/
	/* 3) id		is "0"b. (Input)						*/
	/*		is an allocation failure id which should be passed to area_full	*/
	/*		if the allocation fails again. (Output)				*/
	/*									*/
	/* A__l_g_o_r_i_t_h_m								*/
	/*									*/
	/* area_full								*/
	/*									*/
	/*   (1)  assigns a unique bit string to "id" if its "0"b.				*/
	/*   (2)	fills in the information structure shown below, using the size and area_ptr	*/
	/*        parameters, and the assigned allocation failure id.			*/
	/*									*/
	/*  dcl 1 info		aligned,						*/
	/*	2 length		fixed bin,	/* length of this structure (in words)	*/
	/*	2 version		fixed bin,	/* version of this structure (1)	*/
	/*	2 action_flags	aligned,						*/
	/*	  3 cant_restart	bit(1) unal,	/* off =&gt; allocation can be restarted.	*/
	/*	  3 default_restart bit(1) unal,	/* off =&gt; handler must do something.	*/
	/*	2 info_string	char(256) varying,	/* an informative error message.	*/
	/*	2 status_code	fixed bin(35),	/* error_table_$noalloc		*/
	/*	2 Parea		ptr,		/* ptr to area in which alloc. failed	*/
	/*	2 size		fixed bin,	/* amt of space needed for alloc.	*/
	/*	2 id		bit(70) aligned;	/* allocatin failure id.		*/
	/*									*/
	/*   (3)	signals the "area" condition, passing a pointer to the information structure	*/
	/*	shown above as the "info_ptr" of the signalled condition. (See signal_).	*/
	/*   (4)	returns to its caller.						*/

	/* N__o_t_e_s									*/
	/*									*/
	/* The caller's "area" handler may:						*/
	/*   (1)	execute a non-local go to instruction to terminate the allocation.		*/
	/*   (2)	free at least "size" amount of space in the area pointed to by "area_ptr", so	*/
	/*	that the allocation can be completed, unless "size" is zero, in which case an	*/
	/*	arbitrary amount of space could be freed.  If there were still too little space	*/
	/*	to satisfy the allocation requirements, then the "area" handler could identify	*/
	/*	this condition by observing that "id" is still the same, and could take other	*/
	/*	action, including freeing more space and trying again.			*/
	/*   (3)	change the value of the area pointer which was used in the allocation to point	*/
	/*	to another area in which the allocation would be attempted.  The programmer	*/
	/*	must take care that no dummy arguments are created when this area pointer	*/
	/*	is passed as an argument to another subroutine which will be performing 	*/
	/*	allocations within the area.  If a dummy argument were created, then		*/
	/*	the "area" condition handler could not change the value of the area pointer in	*/
	/*	any subroutine using this dummy pointer.				*/
	/*									*/
	/* E__x_a_m_p_l_e								*/
	/*									*/
	/*      id = "0"b;								*/
	/* call_again:								*/
	/*      call hcs_$status (dir, ent, chase, addr(status_block), area_ptr, code);		*/
	/*      if code = error_table_$noalloc then do;					*/
	/*           call smart_alloc_$area_full (0, area_ptr, id);				*/
	/*	   go to call_again;						*/
	/*	   end;								*/
	/*									*/
	/*									*/
	/* S__t_a_t_u_s									*/
	/*									*/
	/* 1) Created:  Jul, 1972 by G. C. Dixon					*/
	/* 2) Modified: Apr, 1973 by G. C. Dixon; use "id" instead of a fixed bin(35) number.	*/
	/* 3) Modified: Jul, 1973 by G. C. Dixon; include standard condition info header in info	*/
	/*				  structure				*/
	/*									*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */


/**/
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


smart_alloc_:	procedure (Asize, Parea, Preturn);



     dcl						/* 	parameters			*/

	Asize			fixed binary, 	/* size of the space to be allocated. (Input) 	*/
	Parea			ptr,		/* pointer to the allocation area. (Input) 	*/
	Preturn			ptr,		/* pointer to the allocated space. (Output) 	*/

	id			bit(70) aligned;	/* unique id of this allocation failure.	*/


     dcl						/*	automatic variables			*/
	1 info,
	  2 length		fixed bin,	/* length of this structure (in words)		*/
	  2 version		fixed bin,	/* version of this structure (1).		*/
	  2 action_flags		aligned,
	    3 cant_restart		bit(1) unal,	/* off =&gt; allocation can be retried.		*/
	    3 default_restart	bit(1) unal,	/* off =&gt; allocation will fail again if no action	*/
						/*        is taken except to return.		*/
	    3 pad			bit(34) unal,
	  2 info_string		char(256) var,	/* an information string.			*/
	  2 status_code		fixed bin(35),	/* a status code.				*/
	  2 Parea			ptr,		/* ptr to area in which allocation failed.	*/
	  2 size			fixed bin,	/* amt of space needed for the allocation.	*/
	  2 id			bit(70) aligned,	/* allocation failure id.			*/
	failure_id		bit(70) aligned;


     dcl						/*	program entries and builtin functions	*/
	addr			builtin,
	alloc_			entry (fixed binary, ptr, ptr),
	area			condition,
	null			builtin,
	signal_			entry (char(*), ptr, ptr),
	size			builtin,
	unique_bits_		entry returns (bit(70) aligned);

     dcl						/* 	static variable			*/
	error_table_$noalloc	fixed bin(35) ext static;





	failure_id = "0"b;				/* initialize failure id.			*/
						/* user's "area" condition handler is re-signalled*/
allocate: on area					/* trap "area" condition signalled by alloc_.	*/
	     go to handler;
	call alloc_ (Asize, Parea, Preturn);		/* attempt the allocation. 			*/
	return;

handler:  revert area;				/* revert to the caller's "area" condition	*/
	call area_full (Asize, Parea, failure_id);	/* handler, and call the area_full subroutine.	*/
	go to allocate;				/* then, retry the allocation.		*/

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */



area_full:	entry (Asize, Parea, id);

	if id = "0"b then				/* initialize failure id if it hasn't been done	*/
	     id = unique_bits_();

	info.size = Asize;				/* fill in the values of the data structure to	*/
	info.Parea = Parea;				/* be passed to the user's "area" handler when	*/
	info.id = id;				/* we signal "area".			*/

	info.length = size (info);			/* fill in header section of the data structure.	*/
	info.version = 1;
	info.cant_restart,
	info.default_restart = "0"b;
	info.pad = "0"b;				/* zero pad in case new action flags invented.	*/
	info.info_string = "";
	info.status_code = error_table_$noalloc;

	call signal_ ("area", null, addr (info));	/* signal the "area" condition, and return.	*/

	Parea = info.Parea;				/* return the updated area ptr for calls from	*/
						/* smart_alloc_ because PL/I creates a dummy ptr	*/
						/* to the area when an allocation is made via	*/
						/* an allocate statement.			*/


/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


	end smart_alloc_;






		    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
</pre></body></html>