COMPILATION LISTING OF SEGMENT mrds_dm_check_path Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/18/85 1015.4 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 mrds_dm_check_path: check_path: procedure (I_in_path, O_containing_dir, O_db_dir_name, O_new_found, O_code); 10 11 /* DESCRIPTION: 12* 13* this routine takes a relative pathname, and determines if it is a 14* old or new architecture MRDS database. It attempts to require the 15* minimum of access to do this. It was written primarily for 16* mmi_$get_authorization and mmi_$get_secured_state. 17* 18**/ 19 20 /* PARAMETERS: 21* 22* I_in_path - - (input) char(*), the relative or absolute path to be 23* examined. Suffixes are not required. 24* 25* O_containing_dir - - (output) char(*) the containing directory of 26* the database 27* 28* O_db_dir_name - - (output) char(*), the entry name, with suffix, if 29* any, of the database dir 30* 31* O_new_found - - (output) bit(1), on => this is a new version 32* database architecture (created by MR8 or later MRDS) 33* 34* O_code - - (output) fixed bin(35), the error status encoding it 35* will be error_table_$incorrect_access if the user has no access 36* to the data model entry. 37* 38**/ 39 40 /* HISTORY: 41* 42* 83-01-25 Roger Lackey : Rewritten to use the following sequence: 43* what is given for db_path 44* if not found then try db_path with .db suffix 45* 46* 83-01-27 Roger Lackey: Corrected check fo .db suffix 47* 48* 83-02-01 Roger Lackey: Returns mrds_error_$no_database if no model is found. 49* 50* 83-04-29 Davids: Extensive modifications for performance reasons. 51* The db_path variable is set in the main procedure instead of the internal 52* find_model procedure. This reduces the number of times the variable is set 53* (and rtrim and concatenate are referenced) by half (2 instead of 4). 54* The check_db_path internal procedure was eliminated (with its call to 55* hcs_$status_minf and needed error handling). The existance of the 56* db_dir is now checked by checking for the no_dir error returned from status 57* when the check for the db_model segment is made There was always 1 call 58* and if the input path did not contain a .db suffix and the db dir did there 59* was another call. The call to the internal check_model procedure is made 60* with just the code variable instead of the special model_code which is 61* assigned to code if the model was found. A variable called db_dir_length 62* was created instead of referencing the length builtin 3 times. 63**/ 64 65 /* mrds_dm_check_path: check_path: procedure (I_in_path, O_containing_dir, O_db_dir_name, O_new_found, O_code); */ 66 dcl I_in_path char (*) parameter; 67 dcl O_code fixed bin (35) parameter; 68 dcl O_containing_dir char (*) parameter; 69 dcl O_db_dir_name char (*) parameter; 70 dcl O_new_found bit (1) parameter; 71 72 O_containing_dir = ""; 73 O_db_dir_name = ""; 74 O_new_found = "0"b; 75 O_code = 0; 76 77 model_found = "0"b; 78 79 db_dir = ""; /* Incase of error in expandpath */ 80 81 call expand_pathname_ (I_in_path, containing_dir, temp_db_dir, code); 82 if code ^= 0 83 then do; 84 containing_dir = ""; 85 goto exit; 86 end; 87 88 db_dir = rtrim (temp_db_dir); 89 db_path = pathname_ (containing_dir, (db_dir)); 90 91 call check_model (model_found, code); 92 93 if ^model_found /* See if db_dir has .db suffix */ 94 then do; 95 db_dir_length = length (db_dir); 96 97 if db_dir_length < 30 98 then do; 99 if db_dir_length > 3 100 then do; 101 if substr (db_dir, db_dir_length - 2, 3) = ".db" 102 then goto exit; 103 end; 104 105 db_dir = db_dir || ".db"; 106 db_path = rtrim (db_path) || ".db"; 107 108 call check_model (model_found, code); 109 end; 110 end; 111 112 exit: O_containing_dir = containing_dir; 113 O_db_dir_name = db_dir; 114 115 if model_found 116 then do; 117 if model_name = "db_model" 118 then O_new_found = "1"b; 119 end; 120 else do; /* No database */ 121 code = mrds_error_$no_database; 122 call expand_pathname_$add_suffix ((db_dir), "db", temp_dir_path, O_db_dir_name, dummy_code); 123 end; 124 125 O_code = code; 126 127 return; 128 129 130 /* * * * * * * * * * * * * * * * * * check_model * * * * * * * * * * * */ 131 132 check_model: proc (cm_model_found, cm_model_code); 133 134 dcl cm_model_code fixed bin (35) parameter; 135 dcl cm_model_found bit (1) aligned parameter; 136 137 model_name = "db_model"; 138 call find_model (model_name, cm_model_found, cm_model_code); 139 if cm_model_code ^= error_table_$no_dir & ^cm_model_found 140 then do; 141 model_name = "data_model"; 142 call find_model (model_name, cm_model_found, cm_model_code); 143 end; 144 145 end check_model; 146 147 /* * * * * * * * * * * * * * * find_model * * * * * * * * * * * * */ 148 149 find_model: proc (name, fm_found, fm_code); 150 151 dcl name char (*) parameter;/* Model name to try */ 152 dcl fm_found bit (1) parameter aligned; /* ON = Model found */ 153 dcl fm_code fixed bin (35) parameter; /* Error code for this internal procedure */ 154 155 156 call hcs_$status_minf (db_path, model_name, no_chase, entry_type, bit_count, fm_code); 157 if fm_code = 0 158 then do; 159 if model_name = "db_model" 160 then do; 161 if entry_type ^= SEGMENT 162 then do; 163 fm_code = error_table_$noentry; 164 fm_found = "0"b; 165 end; 166 else fm_found = "1"b; 167 end; 168 else do; 169 if entry_type ^= DIR | bit_count = 0 170 then do; 171 fm_code = error_table_$noentry; 172 fm_found = "0"b; 173 end; 174 else fm_found = "1"b; 175 end; 176 end; /* END if fm_code = 0 then do */ 177 else if fm_code = error_table_$incorrect_access 178 then do; 179 fm_code = mrds_error_$no_model_access; 180 fm_found = "1"b; 181 end; 182 183 end find_model; 184 185 186 dcl bit_count fixed bin (24); /* bit count of entry */ 187 dcl code fixed bin (35); /* error status encoding */ 188 dcl containing_dir char (168); /* containing dir of db */ 189 dcl db_dir char (32) varying; /* db dir entry */ 190 dcl db_dir_length fixed bin; /* number of chars in db_dir */ 191 dcl db_path char (168); 192 dcl DIR fixed bin init (2);/* entry = direcotry */ 193 dcl dummy_code fixed bin (35); 194 dcl entry_type fixed bin (2); /* type of entry found */ 195 dcl error_table_$incorrect_access fixed bin (35) ext static; 196 dcl error_table_$noentry fixed bin (35) ext;/* no entry found */ 197 dcl expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)); 198 dcl error_table_$no_dir fixed bin (35) ext;/* some dir in path doesnt exists */ 199 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); /* gets abs containing dir, and entryname */ 200 dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); /* gets entry type */ 201 dcl length builtin; 202 dcl model_name char (32); 203 dcl mrds_error_$no_database fixed bin (35) ext static; 204 dcl mrds_error_$no_model_access fixed bin (35) ext static; 205 dcl model_found bit (1) aligned; 206 dcl no_chase fixed bin (1) init (0) int static options (constant); /* don't chase links */ 207 dcl pathname_ entry (char (*), char (*)) returns (char (168)); 208 dcl rtrim builtin; 209 dcl SEGMENT fixed bin init (1);/* entry = segment */ 210 dcl substr builtin; 211 dcl temp_db_dir char (32); 212 dcl temp_dir_path char (168); 213 214 end mrds_dm_check_path; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/85 0906.4 mrds_dm_check_path.pl1 >special_ldd>online>mrds.pbf-04/18/85>mrds_dm_check_path.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. DIR 000240 automatic fixed bin(17,0) initial dcl 192 set ref 169 192* I_in_path parameter char unaligned dcl 66 set ref 9 9 81* O_code parameter fixed bin(35,0) dcl 67 set ref 9 9 75* 125* O_containing_dir parameter char unaligned dcl 68 set ref 9 9 72* 112* O_db_dir_name parameter char unaligned dcl 69 set ref 9 9 73* 113* 122* O_new_found parameter bit(1) unaligned dcl 70 set ref 9 9 74* 117* SEGMENT 000254 automatic fixed bin(17,0) initial dcl 209 set ref 161 209* bit_count 000100 automatic fixed bin(24,0) dcl 186 set ref 156* 169 cm_model_code parameter fixed bin(35,0) dcl 134 set ref 132 138* 139 142* cm_model_found parameter bit(1) dcl 135 set ref 132 138* 139 142* code 000101 automatic fixed bin(35,0) dcl 187 set ref 81* 82 91* 108* 121* 125 containing_dir 000102 automatic char(168) unaligned dcl 188 set ref 81* 84* 89* 112 db_dir 000154 automatic varying char(32) dcl 189 set ref 79* 88* 89 95 101 105* 105 113 122 db_dir_length 000165 automatic fixed bin(17,0) dcl 190 set ref 95* 97 99 101 db_path 000166 automatic char(168) unaligned dcl 191 set ref 89* 106* 106 156* dummy_code 000241 automatic fixed bin(35,0) dcl 193 set ref 122* entry_type 000242 automatic fixed bin(2,0) dcl 194 set ref 156* 161 169 error_table_$incorrect_access 000010 external static fixed bin(35,0) dcl 195 ref 177 error_table_$no_dir 000016 external static fixed bin(35,0) dcl 198 ref 139 error_table_$noentry 000012 external static fixed bin(35,0) dcl 196 ref 163 171 expand_pathname_ 000020 constant entry external dcl 199 ref 81 expand_pathname_$add_suffix 000014 constant entry external dcl 197 ref 122 fm_code parameter fixed bin(35,0) dcl 153 set ref 149 156* 157 163* 171* 177 179* fm_found parameter bit(1) dcl 152 set ref 149 164* 166* 172* 174* 180* hcs_$status_minf 000022 constant entry external dcl 200 ref 156 length builtin function dcl 201 ref 95 model_found 000253 automatic bit(1) dcl 205 set ref 77* 91* 93 108* 115 model_name 000243 automatic char(32) unaligned dcl 202 set ref 117 137* 138* 141* 142* 156* 159 mrds_error_$no_database 000024 external static fixed bin(35,0) dcl 203 ref 121 mrds_error_$no_model_access 000026 external static fixed bin(35,0) dcl 204 ref 179 name parameter char unaligned dcl 151 ref 149 no_chase 000010 constant fixed bin(1,0) initial dcl 206 set ref 156* pathname_ 000030 constant entry external dcl 207 ref 89 rtrim builtin function dcl 208 ref 88 106 substr builtin function dcl 210 ref 101 temp_db_dir 000255 automatic char(32) unaligned dcl 211 set ref 81* 88 temp_dir_path 000265 automatic char(168) unaligned dcl 212 set ref 122* NAMES DECLARED BY EXPLICIT CONTEXT. check_model 000432 constant entry internal dcl 132 ref 91 108 check_path 000037 constant entry external dcl 9 exit 000327 constant label dcl 112 ref 85 101 find_model 000514 constant entry internal dcl 149 ref 138 142 mrds_dm_check_path 000070 constant entry external dcl 9 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 776 1030 640 1006 Length 1220 640 32 154 136 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME check_path 328 external procedure is an external procedure. check_model internal procedure shares stack frame of external procedure check_path. find_model internal procedure shares stack frame of external procedure check_path. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME check_path 000100 bit_count check_path 000101 code check_path 000102 containing_dir check_path 000154 db_dir check_path 000165 db_dir_length check_path 000166 db_path check_path 000240 DIR check_path 000241 dummy_code check_path 000242 entry_type check_path 000243 model_name check_path 000253 model_found check_path 000254 SEGMENT check_path 000255 temp_db_dir check_path 000265 temp_dir_path check_path THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc return shorten_stack ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. expand_pathname_ expand_pathname_$add_suffix hcs_$status_minf pathname_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$incorrect_access error_table_$no_dir error_table_$noentry mrds_error_$no_database mrds_error_$no_model_access LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 192 000024 209 000026 9 000032 72 000116 73 000124 74 000131 75 000135 77 000136 79 000137 81 000140 82 000166 84 000170 85 000173 88 000174 89 000214 91 000244 93 000247 95 000252 97 000254 99 000256 101 000260 105 000264 106 000276 108 000324 112 000327 113 000335 115 000343 117 000346 119 000356 121 000357 122 000362 123 000425 125 000426 127 000431 132 000432 137 000434 138 000437 139 000460 141 000470 142 000473 145 000513 149 000514 156 000525 157 000563 159 000566 161 000572 163 000575 164 000600 165 000601 166 000602 167 000604 169 000605 171 000612 172 000615 173 000616 174 000617 176 000621 177 000622 179 000625 180 000627 183 000631 ----------------------------------------------------------- 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