COMPILATION LISTING OF SEGMENT ti_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1645.9 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 ti_$getseg: proc(dir,ename,segp,crock,code); 12 13 14 /* The subroutine ti_ (translator interface) is the interface between Multics 15* standard translators and the file system. 16* NOTE: THIS PROCEDURE ASSUMES THAT THE POINTER RETURNED BY LISTEN_$GET_AREA 17* POINTS TO THE SAME SEGMENT FOR THE LIFE OF THE PROCESS */ 18 19 20 /* initially coded in June 1969 by V. Voydock */ 21 /* modified on April 15, 1970 at 8:25 P. M. by V. Voydock */ 22 /* modified by E. Stone on Aug. 4 1970 */ 23 /* modified on December 7, 1970 by V. Voydock to follow new ring conventions */ 24 /* Modified in June 1971 by V. Voydock to not know what segment 25* listen_$get_area uses as an area */ 26 /* Coding style cleaned up by V. Voydock in August 1971 */ 27 28 dcl cleanup condition; 29 dcl 1 x based(p) aligned, /* template to fill in ACL info */ 30 2 number_of_acl_entries bit(18) unaligned, 31 2 offset_of_saved_acl bit(18) unaligned; 32 33 dcl 1 working_acl aligned internal static, 34 2 process_group_id char(32) aligned, 35 2 mode bit(5) unaligned, 36 2 reterr bit(13) unaligned, 37 2 (rb1,rb2,rb3) bit(6) unaligned; 38 39 dcl dir char(*) aligned, 40 ename char(*) aligned; 41 42 dcl (aclp initial(null), 43 area_ptr int static, 44 segp, /* ptr to segment "dir>ename" */ 45 p 46 ) ptr; 47 48 dcl (code, /* error code */ 49 error_table_$seg_unknown external, 50 error_table_$nolinkag external, 51 acnt /* number of entries in ACL returned by readacl */ 52 ) fixed bin; 53 54 dcl crock fixed bin(35); /* ACL storage information */ 55 56 dcl first_time bit(1) aligned internal static initial("1"b); 57 58 dcl cu_$level_get ext entry returns(fixed bin(6)), 59 get_group_id_$tag_star ext entry returns(char(32) aligned), 60 listen_$get_area ext entry returns(ptr), 61 term_$nomakeunknown ext entry(ptr,fixed bin), 62 hcs_$truncate_seg external entry(ptr,fixed bin,fixed bin), 63 hcs_$make_seg ext entry(char(*) aligned,char(*) aligned,char(*) aligned,fixed bin(5),ptr,fixed bin), 64 hcs_$acl_list ext entry(char(*) aligned,char(*) aligned,ptr,fixed bin,ptr,fixed bin), 65 hcs_$acl_replace ext entry(char(*) aligned, char(*) aligned,ptr,fixed bin,fixed bin); 66 67 dcl (addr, 68 fixed, 69 max, 70 null, 71 ptr, 72 rel 73 ) builtin; 74 /* */ 75 /* Set up acl. This acl will be used either while the translation takes 76* place or when it is done or both (with the mode changed appropriately) */ 77 if first_time then 78 do; 79 process_group_id=get_group_id_$tag_star (); 80 area_ptr=listen_$get_area (); 81 first_time="0"b; 82 end; 83 rb1=bit (cu_$level_get (), 6); 84 rb2,rb3 = rb1; 85 86 /* Create segment in directory dir with entry name ename, null reference name 87* and rwa access attributes */ 88 call hcs_$make_seg(dir,ename,"",01011b,segp,code); 89 90 /* If the segment did not previously exist zero the ACL storage argument, "crock", 91* This will tell ti_$finobj or ti_$findata that the segment does 92* not have an ACL to restore */ 93 if code=0 then do; crock=0; return; end; 94 95 /* If unable to create segment return with error code */ 96 if segp=null then return; 97 98 /* If segment did already exist, terminate it, truncate it, and save 99* its ACL so that it can be restored by ti_$finobj or ti_$findata */ 100 call term_$nomakeunknown(segp,code); 101 if code^=0 then 102 if code^=error_table_$seg_unknown then 103 if code^=error_table_$nolinkag then return; 104 else code=0; 105 else code=0; 106 107 /* Set up cleanup handler to free storage, in case processing 108* is interrupted before control returns to caller */ 109 on cleanup begin; if aclp^=null then do; crock=0; free aclp->acl; end; end; 110 111 /* Save the old ACL in the area returned by listen_$get_area */ 112 call hcs_$acl_list(dir,ename,aclp,acnt,area_ptr,code); 113 if code^=0 then return; 114 115 /* Pack information into the argument crock which will allow ti_$finobj or 116* ti_$findata to restore the ACL which has just been saved. In particular, 117* we pack the number of entries in the saved ACL into the left half of crock and 118* the offset relative to the base of the segment in which listen_$get_area has 119* its area into the right half of crock. From this offset, the other entries 120* can rebuild a pointer to the saved ACL */ 121 p=addr(crock); 122 number_of_acl_entries=bit (fixed(acnt,18), 18); 123 offset_of_saved_acl=rel(aclp); 124 125 /* Put the ACL to be used during the translation onto the segment. */ 126 mode="01011"b; 127 call hcs_$acl_replace(dir,ename,addr(working_acl),1,code); 128 if code^=0 then return; 129 130 /* Truncate the segment */ 131 call hcs_$truncate_seg(segp,0,code); 132 return; 133 /* */ 134 135 finobj: entry(segp,bitcnt,crock,code); 136 137 dcl 1 acl based(aclp) aligned, 138 2 pad char(32), 139 2 mmode bit(5); 140 141 dcl f_dir char(168) aligned, 142 f_ename char(32) aligned; 143 144 dcl (lng, 145 bitcnt 146 ) fixed bin; 147 148 dcl processing_object bit(1) aligned; 149 150 dcl hcs_$terminate_noname ext entry(ptr,fixed bin), 151 hcs_$fs_get_path_name ext entry(ptr,char(*) aligned,fixed bin,char(*) aligned,fixed bin), 152 hcs_$set_bc ext entry(char(*) aligned,char(*) aligned,fixed bin,fixed bin); 153 /* */ 154 /* Indicate that this is call to the "finobj" entry */ 155 processing_object="1"b; 156 go to COMMON; 157 158 findata: entry(segp,bitcnt,crock,code); 159 160 processing_object="0"b; 161 162 COMMON: 163 164 /* Get pathname of segment pointed to by segp */ 165 call hcs_$fs_get_path_name(segp,f_dir,lng,f_ename,code); 166 if code^=0 then return; 167 168 /* Set bit count of segment to bitcnt */ 169 call hcs_$set_bc(f_dir,f_ename,bitcnt,code); 170 if code^=0 then return; 171 172 /* Restore old ACL if it exists, otherwise give default ACL */ 173 if crock^=0 then 174 do; 175 p=addr(crock); 176 aclp=ptr(area_ptr,offset_of_saved_acl); /* get ptr to ACL */ 177 acnt=fixed(number_of_acl_entries,17); 178 179 /* If called from ti_$finobj check the old ACL. If it has only one entry and 180* if the entry is for the current user and if it has RWA as its mode, change 181* the the mode to RE since it is very likely that this acl is left over from 182* an earlier compilation which the user quit out of */ 183 if processing_object then if acnt=1 then if mmode="01011"b then mmode="01100"b; 184 call hcs_$acl_replace(f_dir,f_ename,aclp,acnt,code); /* restore old ACL */ 185 if code^=0 then return; 186 /* Free up storage used to store ACL and indicate this has been done */ 187 if acnt>0 then free aclp->acl; 188 crock=0; 189 end; 190 else 191 192 /* If no old ACL exists then we must put a default ACL on the segment. 193* In the case of data segments this is RWA for the given user. Since this is the 194* same ACL that was used during the compilation, this ACL is already on the segment 195* and nothing need be done. If this is an object segment, then the default ACL 196* is RE for the user, and we must put this on the segment */ 197 if processing_object then 198 do; 199 mode="01100"b; 200 call hcs_$acl_replace(f_dir,f_ename,addr(working_acl),1,code); 201 if code^=0 then return; 202 end; 203 204 /* Terminate segment */ 205 call hcs_$terminate_noname(segp,code); 206 207 return; 208 /* */ 209 210 211 clean_up: entry(crock); 212 213 214 /* Get pointer to storage to be freed up */ 215 if crock=0 then return; 216 p=addr(crock); 217 aclp=ptr(area_ptr,offset_of_saved_acl); 218 acnt=fixed(number_of_acl_entries,17); 219 220 /* Free up the storage and indicate that storage has been cleaned up */ 221 if acnt>0 then free aclp->acl; 222 crock=0; 223 224 225 end ti_$getseg; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1614.7 ti_.pl1 >dumps>old>recomp>ti_.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. acl based structure level 1 dcl 137 set ref 109 187 221 aclp 000106 automatic pointer initial dcl 42 set ref 42* 109 109 112* 123 176* 183 183 184* 187 217* 221 acnt 000112 automatic fixed bin(17,0) dcl 48 set ref 112* 122 177* 183 184* 187 218* 221 addr builtin function dcl 67 ref 121 127 127 175 200 200 216 area_ptr 000022 internal static pointer dcl 42 set ref 80* 112* 176 217 bitcnt parameter fixed bin(17,0) dcl 144 set ref 135 158 169* cleanup 000100 stack reference condition dcl 28 ref 109 code parameter fixed bin(17,0) dcl 48 set ref 11 88* 93 100* 101 101 101 104* 105* 112* 113 127* 128 131* 135 158 162* 166 169* 170 184* 185 200* 201 205* crock parameter fixed bin(35,0) dcl 54 set ref 11 93* 109* 121 135 158 173 175 188* 211 215 216 222* cu_$level_get 000032 constant entry external dcl 58 ref 83 dir parameter char dcl 39 set ref 11 88* 112* 127* ename parameter char dcl 39 set ref 11 88* 112* 127* error_table_$nolinkag 000030 external static fixed bin(17,0) dcl 48 ref 101 error_table_$seg_unknown 000026 external static fixed bin(17,0) dcl 48 ref 101 f_dir 000113 automatic char(168) dcl 141 set ref 162* 169* 184* 200* f_ename 000165 automatic char(32) dcl 141 set ref 162* 169* 184* 200* first_time 000024 internal static bit(1) initial dcl 56 set ref 77 81* fixed builtin function dcl 67 ref 122 177 218 get_group_id_$tag_star 000034 constant entry external dcl 58 ref 79 hcs_$acl_list 000046 constant entry external dcl 58 ref 112 hcs_$acl_replace 000050 constant entry external dcl 58 ref 127 184 200 hcs_$fs_get_path_name 000054 constant entry external dcl 150 ref 162 hcs_$make_seg 000044 constant entry external dcl 58 ref 88 hcs_$set_bc 000056 constant entry external dcl 150 ref 169 hcs_$terminate_noname 000052 constant entry external dcl 150 ref 205 hcs_$truncate_seg 000042 constant entry external dcl 58 ref 131 listen_$get_area 000036 constant entry external dcl 58 ref 80 lng 000175 automatic fixed bin(17,0) dcl 144 set ref 162* mmode 10 based bit(5) level 2 dcl 137 set ref 183 183* mode 10 000010 internal static bit(5) level 2 packed unaligned dcl 33 set ref 126* 199* null builtin function dcl 67 ref 42 96 109 number_of_acl_entries based bit(18) level 2 packed unaligned dcl 29 set ref 122* 177 218 offset_of_saved_acl 0(18) based bit(18) level 2 packed unaligned dcl 29 set ref 123* 176 217 p 000110 automatic pointer dcl 42 set ref 121* 122 123 175* 176 177 216* 217 218 process_group_id 000010 internal static char(32) level 2 dcl 33 set ref 79* processing_object 000176 automatic bit(1) dcl 148 set ref 155* 160* 183 190 ptr builtin function dcl 67 ref 176 217 rb1 10(18) 000010 internal static bit(6) level 2 packed unaligned dcl 33 set ref 83* 84 rb2 10(24) 000010 internal static bit(6) level 2 packed unaligned dcl 33 set ref 84* rb3 10(30) 000010 internal static bit(6) level 2 packed unaligned dcl 33 set ref 84* rel builtin function dcl 67 ref 123 segp parameter pointer dcl 42 set ref 11 88* 96 100* 131* 135 158 162* 205* term_$nomakeunknown 000040 constant entry external dcl 58 ref 100 working_acl 000010 internal static structure level 1 dcl 33 set ref 127 127 200 200 x based structure level 1 dcl 29 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. max builtin function dcl 67 NAMES DECLARED BY EXPLICIT CONTEXT. COMMON 000444 constant label dcl 162 ref 156 clean_up 000673 constant entry external dcl 211 findata 000426 constant entry external dcl 158 finobj 000404 constant entry external dcl 135 ti_$getseg 000030 constant entry external dcl 11 NAME DECLARED BY CONTEXT OR IMPLICATION. bit builtin function ref 83 122 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1152 1232 727 1162 Length 1430 727 60 161 222 16 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ti_$getseg 172 external procedure is an external procedure. on unit on line 109 64 on unit STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 working_acl ti_$getseg 000022 area_ptr ti_$getseg 000024 first_time ti_$getseg STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ti_$getseg 000106 aclp ti_$getseg 000110 p ti_$getseg 000112 acnt ti_$getseg 000113 f_dir ti_$getseg 000165 f_ename ti_$getseg 000175 lng ti_$getseg 000176 processing_object ti_$getseg THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return enable ext_entry ext_entry_desc int_entry free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cu_$level_get get_group_id_$tag_star hcs_$acl_list hcs_$acl_replace hcs_$fs_get_path_name hcs_$make_seg hcs_$set_bc hcs_$terminate_noname hcs_$truncate_seg listen_$get_area term_$nomakeunknown THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$nolinkag error_table_$seg_unknown LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 42 000017 11 000023 77 000060 79 000063 80 000071 81 000100 83 000102 84 000117 88 000124 93 000164 93 000166 93 000167 96 000170 100 000174 101 000205 104 000214 105 000216 109 000217 109 000233 109 000240 109 000241 109 000243 112 000244 113 000301 121 000303 122 000305 123 000312 126 000316 127 000323 128 000360 131 000362 132 000376 135 000377 155 000421 156 000423 158 000424 160 000443 162 000444 166 000474 169 000476 170 000523 173 000525 175 000527 176 000531 177 000537 183 000542 184 000553 185 000602 187 000604 188 000610 189 000611 190 000612 199 000614 200 000621 201 000654 205 000656 207 000667 211 000670 215 000704 216 000706 217 000710 218 000716 221 000721 222 000725 225 000726 ----------------------------------------------------------- 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