COMPILATION LISTING OF SEGMENT mrds_dsl_close_all Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/18/85 1022.6 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 19 20 /* HISTORY: 21* 22* Originally written by Jim Gray - - July 1979 23* 24* 81-01-30 Jim Gray : modified to call mrds_dsl_db_openings$list_dbs instead 25* of mrds_dsl_list_dbs, after module renamed and modified for new interface $list_openings 26* 27* 28* 81-04-25 Jim Gray : changed size of work area to depend on mrds_data_$max_dbs 29* 30**/ 31 32 33 mrds_dsl_close_all: close_all: procedure (); 34 35 /* DESCRIPTION: 36* 37* this routine will determine what databases the user currently has open, 38* and proceed to close them all for him. an attempt will be made to close 39* all open databases, regardless of any errors encountered during 40* a close attempt on one particular database opening. 41* 42**/ 43 44 /* PARAMETERS: 45* 46* (input) none 47* 48* error_code - - (output) fixed bin (35) error status type encoding, 0 unless an error occurred. 49* 50* sub_error_ - - (output) condition, signaled upon occurence of an error to provide more info 51* 52**/ 53 54 /* check for the existance of a fixed bin (35) error code parameter */ 55 56 call cu_$arg_list_ptr (al_ptr); 57 num_ptrs = arg_list.arg_count; 58 nargs = arg_list.arg_count / 2; 59 60 if nargs ^= 1 then do; 61 code = error_table_$wrong_no_of_args; 62 call sub_err_ (code, caller_name, continue, info_ptr, return_value, "^/^a ^d ^a ^a", 63 "The number of arguments =", nargs, "was not 1 for the", 64 "error code argument, dcld ""fixed binary (35) aligned""."); 65 end; 66 else do; 67 68 error_code_ptr = arg_list.arg_des_ptr (1); 69 error_code = 0; /* initialize */ 70 71 /* get a parameter area, and establish a clean up handler */ 72 73 area_ptr = null (); 74 clean_up_condition = OFF; 75 76 on cleanup begin; 77 clean_up_condition = ON; 78 call clean_up (); 79 end; 80 81 call get_temp_segment_ (caller_name, area_ptr, error_code); 82 if error_code ^= 0 then 83 call sub_err_ (error_code, caller_name, continue, info_ptr, return_value, "^/^a", 84 "Unable to obtain temporary segment for open database list."); 85 else do; 86 87 work_area = empty (); 88 89 /* get the open database list */ 90 91 call mrds_dsl_db_openings$list_dbs (area_ptr, database_list_ptr); 92 if database_list_ptr = null () then ; /* no databases to close */ 93 else do; 94 95 do loop_index = 1 by 1 to database_list.number_open; 96 97 call mrds_dsl_close (database_list.db (loop_index).index, code); 98 if code = 0 then ; 99 else if error_code ^= 0 then ; /* return first encountered error code */ 100 else error_code = code; 101 end; 102 end; 103 end; 104 105 /* get rid of temporary segment */ 106 107 call clean_up (); 108 end; 109 110 clean_up: procedure (); 111 112 /* remove temporary parameter space */ 113 114 if area_ptr = null () then ; 115 else do; 116 117 call release_temp_segment_ (caller_name, area_ptr, code); 118 area_ptr = null (); 119 if code = 0 | clean_up_condition then ; 120 else do; 121 call sub_err_ (error_code, caller_name, continue, info_ptr, return_value, "^/^a", 122 "Unable to release the temporary parameter space for the list of open databases."); 123 if error_code ^= 0 then ; 124 else error_code = code; 125 126 end; 127 128 end; 129 130 end; 131 132 dcl cleanup condition; /* signaled upon quit/release */ 133 dcl clean_up_condition bit (1); /* on => cleanup signaled */ 134 dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); /* gets work space */ 135 dcl release_temp_segment_ entry (char (*), ptr, fixed bin (35)); /* deletes work space */ 136 dcl ON bit (1) init ("1"b); /* true value */ 137 dcl OFF bit (1) init ("0"b); /* false value */ 138 dcl work_area area (60 * mrds_data_$max_dbs) based (area_ptr); /* parameter space */ 139 dcl mrds_data_$max_dbs fixed bin (35) ext;/* max num open dbs */ 140 dcl area_ptr ptr; /* points to work space */ 141 dcl empty builtin; /* inits areas */ 142 dcl caller_name char (18) init ("mrds_dsl_close_all"); /* name of calling routine */ 143 dcl continue char (1) init ("c"); /* dont stop after printing mesg */ 144 dcl info_ptr ptr init (null ());/* unused */ 145 dcl return_value fixed bin (35) init (0); /* unused */ 146 dcl error_code_ptr ptr; /* pointer to error code argument */ 147 dcl mrds_dsl_db_openings$list_dbs entry (ptr, ptr); /* getS list of open databases */ 148 dcl mrds_dsl_close entry options (variable); /* closes open databases */ 149 dcl sub_err_ entry options (variable); /* reports errors */ 150 dcl loop_index fixed bin (35); /* opening index to be closed */ 151 dcl error_code fixed bin (35) based (error_code_ptr); /* return status code */ 152 dcl error_table_$wrong_no_of_args fixed bin (35) ext; /* arg count ^= 1 */ 153 dcl cu_$arg_list_ptr entry (ptr); /* gets argument list */ 154 dcl nargs fixed bin; /* argument count */ 155 dcl SPECIAL fixed bin init (8);/* special arg list type */ 156 dcl fixed_bin_35_descriptor bit (36) init ("100000100000000000000000000000100011"b); 157 dcl packed_mask bit (36) init ("111111101111111111111111111111111111"b); /* ignore alignment */ 158 dcl code fixed bin (35); /* temp error code variable */ 159 dcl null builtin; 160 1 1 /* BEGIN INCLUDE FILE mrds_database_list.incl.pl1 - - Jim Gray July 1979 */ 1 2 1 3 /* used by mrds_dsl_list_dbs to return an array of database opening information, 1 4* the databases opened for the calling process have their opening index 1 5* and opening model or submodel pathname returned in the array */ 1 6 1 7 declare database_list_ptr ptr ; /* points to array of indexes/pathnames */ 1 8 1 9 declare 1 database_list aligned based (database_list_ptr), /* array of paths/indexes */ 1 10 2 number_open fixed bin, /* total open by this process */ 1 11 2 db (number_of_openings refer (database_list.number_open)), /* array of open db info */ 1 12 3 index fixed bin (35), /* database opening index */ 1 13 3 path char (168); /* model or submodel opening pathname */ 1 14 1 15 declare number_of_openings fixed bin ; /* total number open by this process */ 1 16 1 17 /* END INCLUDE FILE mrds_database_list.incl.pl1 */ 1 18 161 2 1 /* BEGIN mdbm_descriptor.incl.pl1 -- jaw 5/31/78 */ 2 2 /* modified by Jim Gray - - Nov. 1979, to change type from fixed bin(5) to 2 3* unsigned fixed bin(6), so new packed decimal data types could be handled. 2 4* also the duplicate mrds_descriptor.incl.pl1 was eliminated. */ 2 5 2 6 dcl 1 descriptor based (desc_ptr), /* map of Multics descriptor */ 2 7 2 version bit (1) unal, /* DBM handles vers. 1 only */ 2 8 2 type unsigned fixed bin (6) unal, /* data type */ 2 9 2 packed bit (1) unal, /* on if data item is packed */ 2 10 2 number_dims bit (4) unal, /* dimensions */ 2 11 2 size, /* size for string data */ 2 12 3 scale bit (12) unal, /* scale for num. data */ 2 13 3 precision bit (12) unal, /* prec. for num. data */ 2 14 2 array_info (num_dims), 2 15 3 lower_bound fixed bin (35), /* lower bound of dimension */ 2 16 3 upper_bound fixed bin (35), /* upper bound of dimension */ 2 17 3 multiplier fixed bin (35); /* element separation */ 2 18 2 19 dcl desc_ptr ptr; 2 20 dcl num_dims fixed bin init (0) ; /* more useful form of number_dims */ 2 21 2 22 /* END mdbm_descriptor.incl.pl1 */ 2 23 2 24 162 3 1 /* BEGIN mdbm_arg_list.incl.pl1 -- jaw 5/31/78 */ 3 2 /* the duplicate mrds_arg_list.incl.pl1 was eliminated by Jim Gray, Nov. 1979 */ 3 3 3 4 /* layout of argument list for IDS and DBM entries with options (variable) */ 3 5 3 6 dcl 1 arg_list based (al_ptr), 3 7 2 arg_count fixed bin (17) unal, /* 2 * no. of args. */ 3 8 2 code fixed bin (17) unal, /* 4 => normal, 8 => special */ 3 9 2 desc_count fixed bin (17) unal, /* 2 * no. of descriptors */ 3 10 2 pad fixed bin (17) unal, /* must be 0 */ 3 11 2 arg_des_ptr (num_ptrs) ptr; /* argument/descriptor pointer */ 3 12 3 13 dcl al_ptr ptr; 3 14 dcl num_ptrs fixed bin; 3 15 3 16 /* END mdbm_arg_list.incl.pl1 */ 3 17 163 164 165 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/85 0907.2 mrds_dsl_close_all.pl1 >special_ldd>online>mrds.pbf-04/18/85>mrds_dsl_close_all.pl1 161 1 10/14/83 1608.7 mrds_database_list.incl.pl1 >ldd>include>mrds_database_list.incl.pl1 162 2 10/14/83 1608.6 mdbm_descriptor.incl.pl1 >ldd>include>mdbm_descriptor.incl.pl1 163 3 10/14/83 1609.0 mdbm_arg_list.incl.pl1 >ldd>include>mdbm_arg_list.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. OFF 000110 automatic bit(1) initial unaligned dcl 137 set ref 74 137* ON 000107 automatic bit(1) initial unaligned dcl 136 set ref 77 136* SPECIAL 000132 automatic fixed bin(17,0) initial dcl 155 set ref 155* al_ptr 000142 automatic pointer dcl 3-13 set ref 56* 57 58 68 area_ptr 000112 automatic pointer dcl 140 set ref 73* 81* 87 91* 114 117* 118* arg_count based fixed bin(17,0) level 2 packed unaligned dcl 3-6 ref 57 58 arg_des_ptr 2 based pointer array level 2 dcl 3-6 ref 68 arg_list based structure level 1 unaligned dcl 3-6 caller_name 000114 automatic char(18) initial unaligned dcl 142 set ref 62* 81* 82* 117* 121* 142* clean_up_condition 000106 automatic bit(1) unaligned dcl 133 set ref 74* 77* 119 cleanup 000100 stack reference condition dcl 132 ref 76 code 000135 automatic fixed bin(35,0) dcl 158 set ref 61* 62* 97* 98 100 117* 119 124 continue 000121 automatic char(1) initial unaligned dcl 143 set ref 62* 82* 121* 143* cu_$arg_list_ptr 000026 constant entry external dcl 153 ref 56 database_list based structure level 1 dcl 1-9 database_list_ptr 000136 automatic pointer dcl 1-7 set ref 91* 92 95 97 db 1 based structure array level 2 dcl 1-9 empty builtin function dcl 141 ref 87 error_code based fixed bin(35,0) dcl 151 set ref 69* 81* 82 82* 99 100* 121* 123 124* error_code_ptr 000126 automatic pointer dcl 146 set ref 68* 69 81 82 82 99 100 121 123 124 error_table_$wrong_no_of_args 000024 external static fixed bin(35,0) dcl 152 ref 61 fixed_bin_35_descriptor 000133 automatic bit(36) initial unaligned dcl 156 set ref 156* get_temp_segment_ 000010 constant entry external dcl 134 ref 81 index 1 based fixed bin(35,0) array level 3 dcl 1-9 set ref 97* info_ptr 000122 automatic pointer initial dcl 144 set ref 62* 82* 121* 144* loop_index 000130 automatic fixed bin(35,0) dcl 150 set ref 95* 97* mrds_data_$max_dbs 000014 external static fixed bin(35,0) dcl 139 ref 87 mrds_dsl_close 000020 constant entry external dcl 148 ref 97 mrds_dsl_db_openings$list_dbs 000016 constant entry external dcl 147 ref 91 nargs 000131 automatic fixed bin(17,0) dcl 154 set ref 58* 60 62* null builtin function dcl 159 ref 73 92 114 118 144 num_dims 000140 automatic fixed bin(17,0) initial dcl 2-20 set ref 2-20* num_ptrs 000144 automatic fixed bin(17,0) dcl 3-14 set ref 57* number_open based fixed bin(17,0) level 2 dcl 1-9 ref 95 packed_mask 000134 automatic bit(36) initial unaligned dcl 157 set ref 157* release_temp_segment_ 000012 constant entry external dcl 135 ref 117 return_value 000124 automatic fixed bin(35,0) initial dcl 145 set ref 62* 82* 121* 145* sub_err_ 000022 constant entry external dcl 149 ref 62 82 121 work_area based area dcl 138 set ref 87* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. desc_ptr automatic pointer dcl 2-19 descriptor based structure level 1 unaligned dcl 2-6 number_of_openings automatic fixed bin(17,0) dcl 1-15 NAMES DECLARED BY EXPLICIT CONTEXT. clean_up 000542 constant entry internal dcl 110 ref 78 107 close_all 000161 constant entry external dcl 33 mrds_dsl_close_all 000171 constant entry external dcl 33 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1040 1070 662 1050 Length 1334 662 30 227 156 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME close_all 208 external procedure is an external procedure. on unit on line 76 64 on unit clean_up 130 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME close_all 000106 clean_up_condition close_all 000107 ON close_all 000110 OFF close_all 000112 area_ptr close_all 000114 caller_name close_all 000121 continue close_all 000122 info_ptr close_all 000124 return_value close_all 000126 error_code_ptr close_all 000130 loop_index close_all 000131 nargs close_all 000132 SPECIAL close_all 000133 fixed_bin_35_descriptor close_all 000134 packed_mask close_all 000135 code close_all 000136 database_list_ptr close_all 000140 num_dims close_all 000142 al_ptr close_all 000144 num_ptrs close_all THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out call_int_this call_int_other return enable ext_entry int_entry trunc_fx2 divide_fx1 empty THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cu_$arg_list_ptr get_temp_segment_ mrds_dsl_close mrds_dsl_db_openings$list_dbs release_temp_segment_ sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$wrong_no_of_args mrds_data_$max_dbs LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 136 000131 137 000133 142 000134 143 000142 144 000144 145 000146 155 000147 156 000151 157 000153 2 20 000155 33 000160 56 000177 57 000206 58 000211 60 000217 61 000221 62 000224 65 000314 68 000315 69 000320 73 000321 74 000323 76 000325 77 000341 78 000344 79 000351 81 000352 82 000373 87 000443 91 000450 92 000461 95 000466 97 000475 98 000517 99 000522 100 000525 101 000527 107 000534 165 000540 110 000541 114 000547 117 000555 118 000575 119 000600 121 000605 123 000652 124 000656 130 000660 ----------------------------------------------------------- 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