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>_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>_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 => MSA does not exist. */ /* 1 => MSA is a single SSA. */ /* 2 => MSA is a directory. (ERROR CONDITION) */ /* 3 => 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 <= 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, */ /* & if alloc also tried in first SSA of chain, */ /* then append a new SSA, and return its area. */ if ssa.Pfirst -> ssa.id.last_signal = area_info.signal_id then do; error = signal_error; if area_info.space <= 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 -> 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>_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>_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) = ">" || 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->ssa.Pfirst, Pareap, null, 0, i, Nstart, "0"b, small_ssa_size); /* initialize the SSA. */ Pold_ssa->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 > 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)->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) ^= ">"); 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) = ">" || 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->ssa.Pfirst, Pold_ssa->ssa.Pareap, null, 0, Pold_ssa->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->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->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 & 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 > 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 > 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: */ /* */ /*