COMPILATION LISTING OF SEGMENT initiate_file_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 10/25/83 1532.7 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1983 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 /* Initiate a segment or an archive component. 12* 13* Written 8 April 1981 by M. N. Davidoff. 14* Modified: 19 February by G. Palter to not return error_table_$zero_length_seg 15* Modified 3/82 BIM for creation. 16**/ 17 18 /* format: style2 */ 19 20 initiate_file_: 21 procedure (P_dirname, P_entryname, P_mode, P_seg_ptr, P_bit_count, P_code); 22 23 create_requested = "0"b; 24 component_name = ""; 25 go to join; 26 27 28 create: 29 entry (P_dirname, P_entryname, P_mode, P_seg_ptr, P_created, P_bit_count, P_code); 30 31 P_created = "0"b; 32 create_requested = "1"b; 33 component_name = ""; 34 go to join; 35 36 37 component: 38 entry (P_dirname, P_entryname, P_component_name, P_mode, P_seg_ptr, P_bit_count, P_code); 39 40 component_name = P_component_name; 41 create_requested = "0"b; 42 go to join; 43 44 /* parameters */ 45 46 declare P_bit_count fixed binary (24); 47 declare P_code fixed binary (35); 48 declare P_component_name char (*); 49 declare P_created bit (1) aligned; 50 declare P_dirname char (*); 51 declare P_entryname char (*); 52 declare P_mode bit (*); 53 declare P_seg_ptr pointer; 54 55 /* automatic */ 56 57 declare bit_count fixed binary (24); 58 declare create_code fixed binary (35); 59 declare code fixed binary (35); 60 declare component_name char (32); 61 declare create_requested bit (1); 62 declare created bit (1); 63 declare 1 effective_mode, 64 2 pad1 bit (1), 65 2 read bit (1), 66 2 execute bit (1), 67 2 write bit (1), 68 2 pad2 bit (1); 69 declare effective_mode_bin fixed binary (5); 70 declare 1 required_mode, 71 2 read bit (1), 72 2 execute bit (1), 73 2 write bit (1); 74 declare seg_ptr pointer; 75 76 /* builtin */ 77 78 declare (bit, index, null, reverse, rtrim, string) 79 builtin; 80 81 /* condition */ 82 83 declare cleanup condition; 84 85 /* external static */ 86 87 declare error_table_$archive_component_modification 88 fixed binary (35) external static; 89 declare error_table_$namedup fixed binary (35) external static; 90 declare error_table_$no_e_permission 91 fixed binary (35) external static; 92 declare error_table_$no_m_permission 93 fixed binary (35) external static; 94 declare error_table_$no_r_permission 95 fixed binary (35) external static; 96 declare error_table_$no_w_permission 97 fixed binary (35) external static; 98 declare error_table_$not_archive 99 fixed binary (35) external static; 100 101 /* entry */ 102 103 declare archive_$get_component entry (pointer, fixed binary (24), char (*), pointer, fixed binary (24), 104 fixed binary (35)); 105 declare hcs_$delentry_file entry (char (*), char (*), fixed bin (35)); 106 declare hcs_$append_branch entry (character (*), character (*), fixed binary (5), fixed binary (35)); 107 declare hcs_$fs_get_mode entry (pointer, fixed binary (5), fixed binary (35)); 108 declare hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, 109 fixed bin (35)); 110 declare hcs_$initiate_count entry (char (*), char (*), char (*), fixed binary (24), fixed binary (2), 111 pointer, fixed binary (35)); 112 declare terminate_file_ entry (pointer, fixed binary (24), bit (*), fixed binary (35)); 113 1 1 /* BEGIN INCLUDE FILE ... terminate_file.incl.pl1 */ 1 2 /* format: style2,^inddcls,idind32 */ 1 3 1 4 declare 1 terminate_file_switches based, 1 5 2 truncate bit (1) unaligned, 1 6 2 set_bc bit (1) unaligned, 1 7 2 terminate bit (1) unaligned, 1 8 2 force_write bit (1) unaligned, 1 9 2 delete bit (1) unaligned; 1 10 1 11 declare TERM_FILE_TRUNC bit (1) internal static options (constant) initial ("1"b); 1 12 declare TERM_FILE_BC bit (2) internal static options (constant) initial ("01"b); 1 13 declare TERM_FILE_TRUNC_BC bit (2) internal static options (constant) initial ("11"b); 1 14 declare TERM_FILE_TERM bit (3) internal static options (constant) initial ("001"b); 1 15 declare TERM_FILE_TRUNC_BC_TERM bit (3) internal static options (constant) initial ("111"b); 1 16 declare TERM_FILE_FORCE_WRITE bit (4) internal static options (constant) initial ("0001"b); 1 17 declare TERM_FILE_DELETE bit (5) internal static options (constant) initial ("00001"b); 1 18 1 19 /* END INCLUDE FILE ... terminate_file.incl.pl1 */ 114 115 116 join: 117 string (required_mode) = P_mode; 118 P_seg_ptr = null; 119 P_bit_count = 0; 120 P_code = 0; 121 122 seg_ptr = null; 123 created = "0"b; 124 125 if component_name ^= "" & before (reverse (rtrim (P_entryname)), ".") ^= "evihcra" 126 then call finish_error (error_table_$not_archive); 127 128 on cleanup call finish_error (0); 129 130 call hcs_$initiate_count (P_dirname, P_entryname, "", bit_count, 0, seg_ptr, code); 131 if seg_ptr = null 132 then do; 133 if ^create_requested 134 then call finish_error (code); 135 136 string (effective_mode) = ""b; 137 effective_mode = required_mode, by name; 138 139 call hcs_$append_branch (P_dirname, P_entryname, bin (string (effective_mode), 5), create_code); 140 string (effective_mode) = ""b; /* leave for next use */ 141 if create_code ^= error_table_$namedup 142 then code = create_code; /* report original error if it was a lack of status access */ 143 else if create_code = 0 144 then code = 0; 145 146 if code ^= 0 147 then call finish_error (code); 148 149 call hcs_$initiate (P_dirname, P_entryname, "", 0, 0, seg_ptr, code); 150 if seg_ptr = null 151 then do; 152 call hcs_$delentry_file (P_dirname, P_entryname, (0)); 153 call finish_error (code); 154 end; 155 created = "1"b; 156 end; 157 158 call hcs_$fs_get_mode (seg_ptr, effective_mode_bin, code); 159 if code ^= 0 160 then call finish_error (code); 161 162 string (effective_mode) = bit (effective_mode_bin); 163 164 if component_name = "" 165 then if required_mode.read & ^effective_mode.read 166 then call finish_error (error_table_$no_r_permission); 167 168 else if required_mode.write & ^effective_mode.write 169 then call finish_error (error_table_$no_w_permission); 170 171 else if required_mode.execute & ^effective_mode.execute 172 then call finish_error (error_table_$no_e_permission); 173 174 else ; 175 176 else begin; 177 declare component_bit_count fixed binary (24); 178 declare component_ptr pointer; 179 180 if ^effective_mode.read 181 then call finish_error (error_table_$no_r_permission); 182 183 call archive_$get_component (seg_ptr, bit_count, component_name, component_ptr, component_bit_count, 184 code); 185 if code ^= 0 186 then call finish_error (code); 187 188 if required_mode.write 189 then call finish_error (error_table_$archive_component_modification); 190 191 else if required_mode.execute 192 then call finish_error (error_table_$no_e_permission); 193 194 seg_ptr = component_ptr; 195 bit_count = component_bit_count; 196 end; 197 198 P_seg_ptr = seg_ptr; 199 P_bit_count = bit_count; 200 201 if created 202 then P_created = "1"b; /* only set for created entrypoint */ 203 204 return: 205 return; 206 207 finish_error: 208 procedure (final_code); 209 210 declare final_code fixed binary (35); /* (Input) */ 211 212 if ((final_code = error_table_$no_r_permission) | (final_code = error_table_$no_w_permission) 213 | (final_code = error_table_$no_e_permission)) & created 214 then final_code = error_table_$no_m_permission; /* not enough access to create it with proper access */ 215 216 P_seg_ptr = null; 217 P_bit_count = 0; 218 P_code = final_code; 219 220 if seg_ptr ^= null 221 then if created 222 then call terminate_file_ (seg_ptr, 0, TERM_FILE_DELETE, 0); 223 else call terminate_file_ (seg_ptr, 0, TERM_FILE_TERM, 0); 224 else if created 225 then call hcs_$delentry_file (P_dirname, P_entryname, 0); 226 227 if final_code ^= 0 /* Zero ONLY in cleanup case */ 228 then goto return; 229 end finish_error; 230 231 end initiate_file_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/25/83 1444.2 initiate_file_.pl1 >spec>on>eod-fix>initiate_file_.pl1 114 1 04/06/83 1239.4 terminate_file.incl.pl1 >ldd>include>terminate_file.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. P_bit_count parameter fixed bin(24,0) dcl 46 set ref 20 28 37 119* 199* 217* P_code parameter fixed bin(35,0) dcl 47 set ref 20 28 37 120* 218* P_component_name parameter char unaligned dcl 48 ref 37 40 P_created parameter bit(1) dcl 49 set ref 28 31* 201* P_dirname parameter char unaligned dcl 50 set ref 20 28 37 130* 139* 149* 152* 224* P_entryname parameter char unaligned dcl 51 set ref 20 28 37 125 130* 139* 149* 152* 224* P_mode parameter bit unaligned dcl 52 ref 20 28 37 116 P_seg_ptr parameter pointer dcl 53 set ref 20 28 37 118* 198* 216* TERM_FILE_DELETE 000000 constant bit(5) initial unaligned dcl 1-17 set ref 220* TERM_FILE_TERM 000001 constant bit(3) initial unaligned dcl 1-14 set ref 223* archive_$get_component 000026 constant entry external dcl 103 ref 183 bit builtin function dcl 78 ref 162 bit_count 000100 automatic fixed bin(24,0) dcl 57 set ref 130* 183* 195* 199 cleanup 000122 stack reference condition dcl 83 ref 128 code 000102 automatic fixed bin(35,0) dcl 59 set ref 130* 133* 141* 143* 146 146* 149* 153* 158* 159 159* 183* 185 185* component_bit_count 000142 automatic fixed bin(24,0) dcl 177 set ref 183* 195 component_name 000103 automatic char(32) unaligned dcl 60 set ref 24* 33* 40* 125 164 183* component_ptr 000144 automatic pointer dcl 178 set ref 183* 194 create_code 000101 automatic fixed bin(35,0) dcl 58 set ref 139* 141 141 143 create_requested 000113 automatic bit(1) unaligned dcl 61 set ref 23* 32* 41* 133 created 000114 automatic bit(1) unaligned dcl 62 set ref 123* 155* 201 212 220 224 effective_mode 000115 automatic structure level 1 packed unaligned dcl 63 set ref 136* 137* 139 139 140* 162* effective_mode_bin 000116 automatic fixed bin(5,0) dcl 69 set ref 158* 162 error_table_$archive_component_modification 000010 external static fixed bin(35,0) dcl 87 set ref 188* error_table_$namedup 000012 external static fixed bin(35,0) dcl 89 ref 141 error_table_$no_e_permission 000014 external static fixed bin(35,0) dcl 90 set ref 171* 191* 212 error_table_$no_m_permission 000016 external static fixed bin(35,0) dcl 92 ref 212 error_table_$no_r_permission 000020 external static fixed bin(35,0) dcl 94 set ref 164* 180* 212 error_table_$no_w_permission 000022 external static fixed bin(35,0) dcl 96 set ref 168* 212 error_table_$not_archive 000024 external static fixed bin(35,0) dcl 98 set ref 125* execute 0(01) 000117 automatic bit(1) level 2 in structure "required_mode" packed unaligned dcl 70 in procedure "initiate_file_" set ref 171 191 execute 0(02) 000115 automatic bit(1) level 2 in structure "effective_mode" packed unaligned dcl 63 in procedure "initiate_file_" set ref 171 final_code parameter fixed bin(35,0) dcl 210 set ref 207 212 212 212 212* 218 227 hcs_$append_branch 000032 constant entry external dcl 106 ref 139 hcs_$delentry_file 000030 constant entry external dcl 105 ref 152 224 hcs_$fs_get_mode 000034 constant entry external dcl 107 ref 158 hcs_$initiate 000036 constant entry external dcl 108 ref 149 hcs_$initiate_count 000040 constant entry external dcl 110 ref 130 null builtin function dcl 78 ref 118 122 131 150 216 220 read 000117 automatic bit(1) level 2 in structure "required_mode" packed unaligned dcl 70 in procedure "initiate_file_" set ref 164 read 0(01) 000115 automatic bit(1) level 2 in structure "effective_mode" packed unaligned dcl 63 in procedure "initiate_file_" set ref 164 180 required_mode 000117 automatic structure level 1 packed unaligned dcl 70 set ref 116* 137 reverse builtin function dcl 78 ref 125 rtrim builtin function dcl 78 ref 125 seg_ptr 000120 automatic pointer dcl 74 set ref 122* 130* 131 149* 150 158* 183* 194* 198 220 220* 223* string builtin function dcl 78 set ref 116* 136* 139 139 140* 162* terminate_file_ 000042 constant entry external dcl 112 ref 220 223 write 0(03) 000115 automatic bit(1) level 2 in structure "effective_mode" packed unaligned dcl 63 in procedure "initiate_file_" set ref 168 write 0(02) 000117 automatic bit(1) level 2 in structure "required_mode" packed unaligned dcl 70 in procedure "initiate_file_" set ref 168 188 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. TERM_FILE_BC internal static bit(2) initial unaligned dcl 1-12 TERM_FILE_FORCE_WRITE internal static bit(4) initial unaligned dcl 1-16 TERM_FILE_TRUNC internal static bit(1) initial unaligned dcl 1-11 TERM_FILE_TRUNC_BC internal static bit(2) initial unaligned dcl 1-13 TERM_FILE_TRUNC_BC_TERM internal static bit(3) initial unaligned dcl 1-15 index builtin function dcl 78 terminate_file_switches based structure level 1 packed unaligned dcl 1-4 NAMES DECLARED BY EXPLICIT CONTEXT. component 000153 constant entry external dcl 37 create 000102 constant entry external dcl 28 finish_error 001051 constant entry internal dcl 207 ref 125 128 133 146 153 159 164 168 171 180 185 188 191 initiate_file_ 000034 constant entry external dcl 20 join 000223 constant label dcl 116 set ref 25 34 42 return 001047 constant label dcl 204 ref 227 NAMES DECLARED BY CONTEXT OR IMPLICATION. before builtin function ref 125 bin builtin function ref 139 139 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1452 1516 1222 1462 Length 1736 1222 44 204 227 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME initiate_file_ 180 external procedure is an external procedure. on unit on line 128 72 on unit begin block on line 176 begin block shares stack frame of external procedure initiate_file_. finish_error 84 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME initiate_file_ 000100 bit_count initiate_file_ 000101 create_code initiate_file_ 000102 code initiate_file_ 000103 component_name initiate_file_ 000113 create_requested initiate_file_ 000114 created initiate_file_ 000115 effective_mode initiate_file_ 000116 effective_mode_bin initiate_file_ 000117 required_mode initiate_file_ 000120 seg_ptr initiate_file_ 000142 component_bit_count begin block on line 176 000144 component_ptr begin block on line 176 THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out call_int_this call_int_other return tra_ext enable shorten_stack ext_entry_desc int_entry reverse_cs set_cs_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. archive_$get_component hcs_$append_branch hcs_$delentry_file hcs_$fs_get_mode hcs_$initiate hcs_$initiate_count terminate_file_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$archive_component_modification error_table_$namedup error_table_$no_e_permission error_table_$no_m_permission error_table_$no_r_permission error_table_$no_w_permission error_table_$not_archive LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 20 000026 23 000067 24 000070 25 000073 28 000074 31 000135 32 000137 33 000141 34 000144 37 000145 40 000213 41 000221 42 000222 116 000223 118 000233 119 000235 120 000236 122 000237 123 000240 125 000241 128 000307 130 000335 131 000401 133 000405 136 000415 137 000417 139 000436 140 000470 141 000472 143 000500 146 000503 149 000513 150 000560 152 000564 153 000610 155 000616 158 000620 159 000633 162 000643 164 000652 168 000674 171 000712 174 000727 180 000730 183 000742 185 000775 188 001005 191 001020 194 001032 195 001034 198 001036 199 001040 201 001042 204 001047 207 001050 212 001056 216 001073 217 001076 218 001077 220 001101 223 001136 224 001165 227 001212 229 001220 ----------------------------------------------------------- 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