COMPILATION LISTING OF SEGMENT suffixed_name_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1818.7 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 12 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 13 /* */ 14 /* N__a_m_e: suffixed_name_ */ 15 /* */ 16 /* This subroutine handles suffixed names. */ 17 /* */ 18 /* E__n_t_r_y: suffixed_name_$find */ 19 /* */ 20 /* This entry point attempts to find an entry which is supposed to (but may not) */ 21 /* have a suffixed name. The entry may be a directory, a segment, or a multi-segment */ 22 /* file. */ 23 /* */ 24 /* U__s_a_g_e */ 25 /* */ 26 /* dcl suffixed_name_$find entry (char(*), char(*), char(*), char(32) aligned, */ 27 /* fixed bin(2), fixed bin(35)); */ 28 /* */ 29 /* call suffixed_name_$find (directory, entry, suffix, name, type, mode, code); */ 30 /* */ 31 /* 1) directory name of directory in which entry is to be found.(In) */ 32 /* 2) entry entry name supplied by user which may or may not have a suffix.(In) */ 33 /* 3) suffix the suffix which is supposed to be on the entry. It should not */ 34 /* contain a period (".").(In) */ 35 /* 4) name name of the entry which was found.(Out) */ 36 /* 5) type switch indicating the type of entry which was found.(Out) */ 37 /* 1 = segment; 2 = directory; 3 = multi-segment file. */ 38 /* 6) mode caller's access mode to the entry which was found.(Out) */ 39 /* 7) code an error code.(Out) */ 40 /* */ 41 /* E__n_t_r_y: suffixed_name_$make */ 42 /* */ 43 /* This entry point makes a properly-suffixed name out of a user-supplied name */ 44 /* which may or may not be suffixed. */ 45 /* */ 46 /* U__s_a_g_e */ 47 /* */ 48 /* dcl suffixed_name_$make entry (char(*), char(*), char(*), char(32) aligned, */ 49 /* fixed bin(35)); */ 50 /* */ 51 /* call suffixed_name_$make (entry, suffix, name, code); */ 52 /* */ 53 /* 1) entry is the user-supplied entry name.(In) */ 54 /* 2) suffix is the suffix which is to be appended to the name.(In) */ 55 /* 3) name is the properly-suffixed name.(Out) */ 56 /* 4) code is a status code which indicates whether the properly-suffixed name */ 57 /* will fit into the _p_r_o_p_e_r__n_a_m_e string. (Out) */ 58 /* */ 59 /* E__n_t_r_y: suffixed_name_$new_suffix */ 60 /* */ 61 /* This entry point creates a properly-suffixed name from a (possibly-improperly-) */ 62 /* suffixed name supplied by the user. */ 63 /* */ 64 /* U__s_a_g_e */ 65 /* */ 66 /* dcl suffixed_name_$new_suffix entry(char(*), char(*), char(*), char(32) aligned, */ 67 /* fixed bin(35)); */ 68 /* */ 69 /* call suffixed_name_$new_suffix (name, suffix, new_suffix, new_name, code); */ 70 /* */ 71 /* 1) name is the suffixed name returned by suffixed_name_$find.(In) */ 72 /* 2) suffix is the suffix which is supposed to be on name.(In) */ 73 /* 3) new_suffix is the new suffix which is to be appended to the name to be made.(In) */ 74 /* 4) new_name is the name which was made.(Out) */ 75 /* 5) code is a status code which indicates whether the properly-suffixed new */ 76 /* name will fit into the _n_e_w__n_a_m_e string. (Out) */ 77 /* */ 78 /* N__o_t_e_s */ 79 /* */ 80 /* "code" may be any error code returned by hcs_$status_long, except */ 81 /* error_table_$no_s_permission. "name" will contain a properly-suffixed name, even if */ 82 /* "code" is non-zero. */ 83 /* */ 84 /* S__t_a_t_u_s */ 85 /* */ 86 /* 1) Created: Nov 1972 by Gary C. Dixon */ 87 /* 2) Modified: Jan 1973 by Gary C. Dixon; add mode argument to find entry point. */ 88 /* 3) Modified: Feb 1973 by Gary C. Dixon; add code argument to make/new_suffix entries. */ 89 /* 4) Modified: Dec 1980 by M. Broussard; fixed to work with names containing imbedded */ 90 /* blanks. */ 91 /* */ 92 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 93 94 suffixed_name_: procedure; /* procedure to handle suffixed names. */ 95 96 /* parameters */ 97 dcl directory char(*), /* absolute directory path of segment to be found */ 98 entry char(*), /* entry name to be suffixed. */ 99 suffix char(*), /* suffix character string (not including ".") */ 100 new_suffix char(*), /* new suffix character string (not including ".")*/ 101 name char(32) aligned, /* properly-suffixed name. */ 102 Stype fixed bin(2), /* type of entry which was found. */ 103 mode fixed bin(5), /* caller's access mode to the found dir entry. */ 104 code fixed bin(35); /* an error code. */ 105 106 /* automatic variables */ 107 dcl Lentry fixed bin, /* length of non-blank part of entry. */ 108 Lname fixed bin, /* length of a part of non-blank part of name. */ 109 Lnew_suffix fixed bin, /* length of non-blank part of new suffix. */ 110 Lsuffix fixed bin, /* length of non-blank part of suffix. */ 111 e fixed bin, /* an entry point indicator. */ 112 1 stat, /* a file system status block. */ 113 (2 type bit(2), /* entry type; "01"b=seg, "10"b=dir */ 114 2 pad1 bit(106), 115 2 mode bit(5), /* caller's access to the entry. */ 116 2 pad2 bit(151), 117 2 bitcnt bit(24), /* multi-segment file indicator count. */ 118 2 pad3 bit(72)) unal; 119 120 /* entries and builtin functions */ 121 dcl hcs_$status_long entry(char(*), char(*) aligned, fixed bin(1), ptr, ptr, fixed bin(35)), 122 fixed builtin, 123 index builtin, 124 length builtin, 125 null builtin, 126 rtrim builtin, 127 substr builtin; 128 129 /* static variables */ 130 dcl dir fixed bin(2) int static init (2), 131 error_table_$entlong fixed bin(35) ext static, 132 error_table_$no_s_permission fixed bin(35) ext static, 133 msf fixed bin(2) int static init (3); 134 135 136 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 137 138 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 139 140 141 142 find: entry (directory, entry, suffix, name, Stype, mode, code); 143 /* find the name of the entry which matches a */ 144 /* suffixed entry name. */ 145 e = 1; 146 go to common; 147 148 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 149 150 151 make: entry (entry, suffix, name, code); /* make a suffixed name out of a user-supplied */ 152 /* entry name which may or may not be suffixed. */ 153 e = 2; 154 go to common; 155 156 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 157 158 159 160 new_suffix: entry (entry, suffix, new_suffix, name, code); 161 /* change the suffix on a (possibly) suffixed */ 162 /* name to a new suffix. */ 163 e = 3; 164 165 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 166 167 168 common: Lentry = length (rtrim (entry)); 169 Lsuffix = length (rtrim (suffix)); 170 /* find lengths of non-blank parts of char strings*/ 171 172 if Lsuffix = 0 then /* if _s_u_f_f_i_x is null string, then use _e_n_t_r_y as */ 173 go to use_entry; /* the suffixed _n_a_m_e. */ 174 else if Lentry < Lsuffix + 1 then /* if the _s_u_f_f_i_x won't fit in _e_n_t_r_y, then */ 175 go to add_suffix; /* assume its not there. */ 176 else if substr (entry, Lentry-Lsuffix, Lsuffix+1) = "." || substr (suffix, 1, Lsuffix) then 177 /* otherwise, see if _s_u_f_f_i_x is already on _e_n_t_r_y. */ 178 use_entry: if Lentry <= length(name) then do; /* if so, and if _e_n_t_r_y isn't too long, then */ 179 name = substr (entry, 1, Lentry); /* use _e_n_t_r_y as the suffixed _n_a_m_e. */ 180 Lname = Lentry; 181 end; 182 else /* if _e_n_t_r_y won't fit into the _n_a_m_e string, then */ 183 go to long_entry_error; /* that's an error. Tell the caller. */ 184 else if Lentry + Lsuffix + 1 <= length(name) then do; 185 /* make suffixed _n_a_m_e by appending _s_u_f_f_i_x to */ 186 /* _e_n_t_r_y, if that will fit. */ 187 add_suffix: name = substr (entry, 1, Lentry) || "." || substr (suffix, 1, Lsuffix); 188 Lname = Lentry + Lsuffix + 1; 189 end; 190 else /* if all else fails, then report error to user. */ 191 go to long_entry_error; 192 go to do(e); /* perform remainder of processing according to */ 193 /* entry point. */ 194 195 do(1): call hcs_$status_long (directory, name, 1, addr (stat), null, code); 196 /* look for a directory entry with a name of */ 197 if code ^= 0 then /* _n_a_m_e. */ 198 if code = error_table_$no_s_permission then; /* ignore no_s_permission error code. We got what */ 199 /* information we want. */ 200 else /* other errors indicate that the directory entry */ 201 return; /* was not found. */ 202 Stype = fixed (stat.type, 2); /* convert type to a number. */ 203 mode = fixed (stat.mode, 5); /* same for access mode. */ 204 if Stype = dir then /* if its a directory, then */ 205 if stat.bitcnt then /* maybe its really an MSF. */ 206 Stype = msf; /* Ah ha! I was right. */ 207 do(2): code = 0; /* make sure no error is returned. */ 208 return; 209 210 do(3): Lnew_suffix = length (rtrim (new_suffix)); 211 /* compute actual length of the _n_e_w__s_u_f_f_i_x. */ 212 if Lsuffix > 0 then /* if _s_u_f_f_i_x is non-blank, remove _s_u_f_f_i_x from */ 213 Lname = Lname - Lsuffix; /* length count of _n_a_m_e (do not include the dot). */ 214 else /* if there's no suffix, add 1 to the length */ 215 Lname = Lname + 1; /* count to make it look like there's a dot. */ 216 if Lnew_suffix = 0 then /* if _n_e_w__s_u_f_f_i_x is null string, then */ 217 substr (name, Lname) = ""; /* return just the non-suffixed part of _n_a_m_e. */ 218 else if Lname + Lnew_suffix <= length(name) then /* if _n_e_w__s_u_f_f_i_x will fit in _n_a_m_e string, then */ 219 /* return suffixed _n_a_m_e formed by appending the */ 220 /* _n_e_w__s_u_f_f_i_x to non-suffix components of entry. */ 221 substr (name, Lname) = "." || substr (new_suffix, 1, Lnew_suffix); 222 /* (remember, dot is already included in Lname.) */ 223 else /* if all else fails, then report error to user. */ 224 go to long_entry_error; 225 go to do(2); /* clear error code and return. */ 226 /* */ 227 long_entry_error: /* report to user that suffixed name won't fit in */ 228 code = error_table_$entlong; /* _n_a_m_e. */ 229 return; 230 231 232 end suffixed_name_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1627.7 suffixed_name_.pl1 >dumps>old>recomp>suffixed_name_.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. Lentry 000100 automatic fixed bin(17,0) dcl 107 set ref 168* 174 176 176 179 180 184 187 188 Lname 000101 automatic fixed bin(17,0) dcl 107 set ref 180* 188* 212* 212 214* 214 216 218 218 Lnew_suffix 000102 automatic fixed bin(17,0) dcl 107 set ref 210* 216 218 218 Lsuffix 000103 automatic fixed bin(17,0) dcl 107 set ref 169* 172 174 176 176 176 184 187 188 212 212 Stype parameter fixed bin(2,0) dcl 97 set ref 142 202* 204 204* bitcnt 7(12) 000105 automatic bit(24) level 2 packed unaligned dcl 107 set ref 204 code parameter fixed bin(35,0) dcl 97 set ref 142 151 160 195* 197 197 207* 227* dir constant fixed bin(2,0) initial dcl 130 ref 204 directory parameter char unaligned dcl 97 set ref 142 195* e 000104 automatic fixed bin(17,0) dcl 107 set ref 145* 153* 163* 192 entry parameter char unaligned dcl 97 ref 142 151 160 168 176 179 187 error_table_$entlong 000012 external static fixed bin(35,0) dcl 130 ref 227 error_table_$no_s_permission 000014 external static fixed bin(35,0) dcl 130 ref 197 fixed builtin function dcl 121 ref 202 203 hcs_$status_long 000010 constant entry external dcl 121 ref 195 length builtin function dcl 121 ref 168 169 176 184 210 218 mode 3 000105 automatic bit(5) level 2 in structure "stat" packed unaligned dcl 107 in procedure "suffixed_name_" set ref 203 mode parameter fixed bin(5,0) dcl 97 in procedure "suffixed_name_" set ref 142 203* msf constant fixed bin(2,0) initial dcl 130 ref 204 name parameter char(32) dcl 97 set ref 142 151 160 176 179* 184 187* 195* 216* 218 218* new_suffix parameter char unaligned dcl 97 ref 160 210 218 null builtin function dcl 121 ref 195 195 rtrim builtin function dcl 121 ref 168 169 210 stat 000105 automatic structure level 1 packed unaligned dcl 107 set ref 195 195 substr builtin function dcl 121 set ref 176 176 179 187 187 216* 218* 218 suffix parameter char unaligned dcl 97 ref 142 151 160 169 176 187 type 000105 automatic bit(2) level 2 packed unaligned dcl 107 set ref 202 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. index builtin function dcl 121 NAMES DECLARED BY EXPLICIT CONTEXT. add_suffix 000265 constant label dcl 187 ref 174 common 000156 constant label dcl 168 ref 146 154 do 000000 constant label array(3) dcl 195 ref 192 225 find 000031 constant entry external dcl 142 long_entry_error 000510 constant label dcl 227 ref 176 184 218 make 000071 constant entry external dcl 151 new_suffix 000124 constant entry external dcl 160 suffixed_name_ 000015 constant entry external dcl 94 use_entry 000246 constant label dcl 176 ref 172 NAME DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 195 195 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 614 632 516 624 Length 1006 516 16 140 75 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME suffixed_name_ 126 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME suffixed_name_ 000100 Lentry suffixed_name_ 000101 Lname suffixed_name_ 000102 Lnew_suffix suffixed_name_ 000103 Lsuffix suffixed_name_ 000104 e suffixed_name_ 000105 stat suffixed_name_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc return shorten_stack ext_entry ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. hcs_$status_long THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$entlong error_table_$no_s_permission LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 94 000014 142 000022 145 000061 146 000063 151 000064 153 000114 154 000116 160 000117 163 000154 168 000156 169 000176 172 000216 174 000217 176 000223 179 000252 180 000256 181 000257 184 000260 187 000265 188 000315 192 000322 195 000324 197 000370 200 000376 202 000377 203 000403 204 000406 207 000416 208 000417 210 000420 212 000435 214 000442 216 000443 218 000457 225 000506 227 000510 229 000513 ----------------------------------------------------------- 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