COMPILATION LISTING OF SEGMENT mrds_dsl_resultant_storage Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/18/85 1033.8 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 /* HISTORY: 19* 20* Originally written by Jim Gray - - August 1979 21* Modified by Jim Gray - - 80-9-24, to add the entry $get_opening_temp_dir, 22* in order to be able to get the temp dir for a particular opening. 23* Also, if the temp_dir is all blanks (initial state), then it is now 24* set to the process directory (the default) in this routine during a $get. 25* 26* Modified by Ron Harvey - - 83-01-18, to use get_shortest_path_ before 27* saving off the directory. 28**/ 29 30 mrds_dsl_resultant_storage: procedure (); return; /* not valid entry */ 31 32 /* DESCRIPTION: 33* 34* this routine is used to set and retrieve the storage location for 35* the resultant database model that is created at open time from 36* the users model or submodel, and used for runtime access of the 37* data in the database by dsl_$store, retrieve, etc. 38* each opening may use a different storage location for it's resultant 39* via intervening calls to the $set entry to this routine, 40* with the pathname of the desired storage location. 41* the open modules that create the dbcb, rdbi, select 42* segments of the resultant call the $get entry to find 43* out what directory to store the resultant under. 44* 45**/ 46 47 /* PARAMETERS: 48* 49* set entry === 50* 51* relative_path - - (input) char(*), the pathname of the directory under which 52* the resultant model for the next opening is to be stored. this 53* should have a larger quota than the process directory if a 54* large database opening is planned, or many opens are to be done. 55* 56* error_code - - (output) fixed bin(35), error status encoding, 0 unless an error occurred, 57* such as an invalid pathname, or pathname not a directory. 58* 59* sub_errror_ - - (output) condition, signaled upone occurence of error to propvide more info 60* 61* get entry === 62* 63* returns(char(168)) - - (output) the current pathname that the last opening 64* would have stored it's resultant model under. the default(i.e. set was never called) 65* is the user's process directory. 66* 67* get_opening_temp_dir entry === 68* 69* database_index - - (input) fixed bin(35), the database opening index of the 70* particular opening whose temporary storage directory is desired. 71* 72* error_code - - (output) fixed bin(35), the error status encoding, 0 unless an error occurred, 73* such as an invalid database index. 74* 75* returns(char(168)) - - (output) the temporary storage directory path for the 76* particular database opening whose index was given. 77* 78* 79**/ 80 81 set: set_temp_dir: entry (relative_path, error_code); 82 83 /* check for a valid length, and legal pathname */ 84 85 error_code = 0; /* initialize */ 86 87 call expand_pathname_ (relative_path, directory_path, entryname, error_code); 88 if error_code ^= 0 then 89 call sub_err_ (error_code, caller_name, continue, info_ptr, return_value, "^/^a^a^a", 90 "Unable to expand the pathname """, relative_path, """."); 91 else do; 92 93 /* check to be sure that this is a directory */ 94 95 call hcs_$status_minf (directory_path, entryname, chase, type, bit_count, error_code); 96 if error_code ^= 0 then 97 call sub_err_ (error_code, caller_name, continue, info_ptr, return_value, "^/^a^a^a", 98 "Unable to get the status of the entry """, relative_path, """."); 99 else do; 100 101 MSF = ((bit_count > 0) & (type = DIRECTORY)); 102 if type ^= DIRECTORY | MSF then do; 103 error_code = error_table_$no_dir; 104 call sub_err_ (error_code, caller_name, continue, info_ptr, return_value, "^/^a^a^a", 105 "The pathname """, relative_path, """ does not refer to a directory."); 106 end; 107 else do; 108 109 /* good directory path, save it for reference by the $get entry */ 110 111 saved_directory = get_shortest_path_ (rtrim (directory_path) || ">" || rtrim (entryname)); 112 113 end; 114 115 end; 116 117 end; 118 119 return; 120 121 get: get_temp_dir: entry returns (char (168)); 122 123 /* return the remembered resultant model storage directory */ 124 125 if saved_directory = BLANK then 126 saved_directory = get_pdir_ (); 127 128 return (saved_directory); 129 130 get_opening_temp_dir: entry (db_index, code) returns (char (168)); 131 132 /* routine to get the temp dir for a particular database opening specified by it's index */ 133 134 code = 0; 135 returned_dir = BLANK; 136 137 /* check for a valid database opening index */ 138 139 call mu_database_index$get_resultant_model_pointer (db_index, dbcb_ptr); 140 if dbcb_ptr = null () then 141 code = mrds_error_$invalid_db_index; 142 else do; 143 144 /* get the path of the resultant model for this openiong */ 145 146 call hcs_$fs_get_path_name (dbcb_ptr, pathname, pathname_len, dbcb_segment, code); 147 if code ^= 0 then ; 148 else do; 149 150 returned_dir = pathname; 151 152 end; 153 154 end; 155 156 return (returned_dir); 157 158 declare saved_directory char (168) int static init ((168)" "); /* blanks => use process dir */ 159 declare pathname_len fixed bin; /* length of directory portion returned */ 160 declare code fixed bin (35); /* error code for get_opening_temp_dir entry */ 161 declare db_index fixed bin (35); /* database opening index */ 162 declare dbcb_ptr ptr; /* pointer to the resultant model */ 163 declare mrds_error_$invalid_db_index fixed bin (35) ext; /* not good opening index */ 164 declare returned_dir char (168); /* path to resultant model for a given opening */ 165 declare pathname char (168); /* temp for getting directory portion of dbcb segment path */ 166 declare dbcb_segment char (32); /* name of dbcb segment for this opening */ 167 declare hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); /* gets path from pointer */ 168 declare mu_database_index$get_resultant_model_pointer entry (fixed bin (35), ptr); /* gets resultant model ptr from index */ 169 declare get_pdir_ entry () returns (char (168)); /* gets process directory */ 170 declare BLANK char (1) init (" ") int static options (constant); /* space character */ 171 declare error_table_$no_dir fixed bin (35) ext;/* path not to directory */ 172 declare expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); /* breaks apart, and checks path */ 173 declare error_code fixed bin (35); /* error status encoding */ 174 declare get_shortest_path_ entry (char (*)) returns (char (168)); 175 declare hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); 176 declare bit_count fixed bin (24); /* current bit count of entry */ 177 declare MSF bit (1); /* on => multisegment file */ 178 declare DIRECTORY fixed bin (2) init (2); /* type for directory */ 179 declare chase fixed bin (1) init (1); /* causes links to be chased */ 180 declare directory_path char (168); /* directory portion of path */ 181 declare entryname char (32); /* entry portion of path */ 182 declare relative_path char (*); /* input pathname */ 183 declare sub_err_ entry options (variable); /* reports errors */ 184 declare type fixed bin (2); /* 0 => link, 1 => seg, 2 => dir */ 185 declare caller_name char (26) init ("mrds_dsl_resultant_storage"); /* name of calling routine */ 186 declare continue char (1) init ("c"); /* dont stop after printing mesg */ 187 declare info_ptr ptr init (null ());/* unused */ 188 declare return_value fixed bin (35) init (0); /* unused */ 189 declare (null, rtrim) builtin; 190 191 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/85 0907.8 mrds_dsl_resultant_storage.pl1 >special_ldd>online>mrds.pbf-04/18/85>mrds_dsl_resultant_storage.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. BLANK 001041 constant char(1) initial unaligned dcl 170 ref 125 135 DIRECTORY 000242 automatic fixed bin(2,0) initial dcl 178 set ref 101 102 178* MSF 000241 automatic bit(1) unaligned dcl 177 set ref 101* 102 bit_count 000240 automatic fixed bin(24,0) dcl 176 set ref 95* 101 caller_name 000327 automatic char(26) initial unaligned dcl 185 set ref 88* 96* 104* 185* chase 000243 automatic fixed bin(1,0) initial dcl 179 set ref 95* 179* code parameter fixed bin(35,0) dcl 160 set ref 130 134* 140* 146* 147 continue 000336 automatic char(1) initial unaligned dcl 186 set ref 88* 96* 104* 186* db_index parameter fixed bin(35,0) dcl 161 set ref 130 139* dbcb_ptr 000102 automatic pointer dcl 162 set ref 139* 140 146* dbcb_segment 000230 automatic char(32) unaligned dcl 166 set ref 146* directory_path 000244 automatic char(168) unaligned dcl 180 set ref 87* 95* 111 entryname 000316 automatic char(32) unaligned dcl 181 set ref 87* 95* 111 error_code parameter fixed bin(35,0) dcl 173 set ref 81 81 85* 87* 88 88* 95* 96 96* 103* 104* error_table_$no_dir 000072 external static fixed bin(35,0) dcl 171 ref 103 expand_pathname_ 000074 constant entry external dcl 172 ref 87 get_pdir_ 000070 constant entry external dcl 169 ref 125 get_shortest_path_ 000076 constant entry external dcl 174 ref 111 hcs_$fs_get_path_name 000064 constant entry external dcl 167 ref 146 hcs_$status_minf 000100 constant entry external dcl 175 ref 95 info_ptr 000340 automatic pointer initial dcl 187 set ref 88* 96* 104* 187* mrds_error_$invalid_db_index 000062 external static fixed bin(35,0) dcl 163 ref 140 mu_database_index$get_resultant_model_pointer 000066 constant entry external dcl 168 ref 139 null builtin function dcl 189 ref 140 187 pathname 000156 automatic char(168) unaligned dcl 165 set ref 146* 150 pathname_len 000100 automatic fixed bin(17,0) dcl 159 set ref 146* relative_path parameter char unaligned dcl 182 set ref 81 81 87* 88* 96* 104* return_value 000342 automatic fixed bin(35,0) initial dcl 188 set ref 88* 96* 104* 188* returned_dir 000104 automatic char(168) unaligned dcl 164 set ref 135* 150* 156 rtrim builtin function dcl 189 ref 111 111 saved_directory 000010 internal static char(168) initial unaligned dcl 158 set ref 111* 125 125* 128 sub_err_ 000102 constant entry external dcl 183 ref 88 96 104 type 000326 automatic fixed bin(2,0) dcl 184 set ref 95* 101 102 NAMES DECLARED BY EXPLICIT CONTEXT. get 000657 constant entry external dcl 121 get_opening_temp_dir 000724 constant entry external dcl 130 get_temp_dir 000642 constant entry external dcl 121 mrds_dsl_resultant_storage 000121 constant entry external dcl 30 set 000165 constant entry external dcl 81 set_temp_dir 000144 constant entry external dcl 81 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1252 1356 1043 1262 Length 1564 1043 104 172 206 52 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME mrds_dsl_resultant_storage 333 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 saved_directory mrds_dsl_resultant_storage STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME mrds_dsl_resultant_storage 000100 pathname_len mrds_dsl_resultant_storage 000102 dbcb_ptr mrds_dsl_resultant_storage 000104 returned_dir mrds_dsl_resultant_storage 000156 pathname mrds_dsl_resultant_storage 000230 dbcb_segment mrds_dsl_resultant_storage 000240 bit_count mrds_dsl_resultant_storage 000241 MSF mrds_dsl_resultant_storage 000242 DIRECTORY mrds_dsl_resultant_storage 000243 chase mrds_dsl_resultant_storage 000244 directory_path mrds_dsl_resultant_storage 000316 entryname mrds_dsl_resultant_storage 000326 type mrds_dsl_resultant_storage 000327 caller_name mrds_dsl_resultant_storage 000336 continue mrds_dsl_resultant_storage 000340 info_ptr mrds_dsl_resultant_storage 000342 return_value mrds_dsl_resultant_storage THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_e_as alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out return signal shorten_stack ext_entry ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. expand_pathname_ get_pdir_ get_shortest_path_ hcs_$fs_get_path_name hcs_$status_minf mu_database_index$get_resultant_model_pointer sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$no_dir mrds_error_$invalid_db_index LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 178 000102 179 000104 185 000106 186 000111 187 000113 188 000115 30 000120 30 000131 81 000140 85 000203 87 000205 88 000233 95 000317 96 000354 101 000440 102 000450 103 000454 104 000457 106 000540 111 000541 113 000627 119 000630 121 000637 125 000671 128 000704 130 000720 134 000736 135 000740 139 000743 140 000754 146 000765 147 001017 150 001023 156 001026 ----------------------------------------------------------- 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