COMPILATION LISTING OF SEGMENT set_max_length Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 03/08/85 1023.3 mst Fri Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1983 * 4* * * 5* *********************************************************** */ 6 7 8 9 /* format: style2,idind30,indcomtxt */ 10 11 set_max_length: 12 sml: 13 procedure options (variable); 14 15 /* Changed to round up mod 1024 instead of mod 16 by Steve Herbst 11/20/75 */ 16 /* MCR 4271, 4272 Add -record and make args nonpositional 01/08/80 S. Herbst */ 17 /* Made to work on mailboxes and queues 03/28/80 S. Herbst */ 18 /* Add -maximum 05/12/80 S. Herbst */ 19 /* Modified 2/20/83 Jay Pattin for object_type_ */ 20 /* 256K max length check, 3/1 E. N. Kittlitz */ 21 /* 830927 BIM object_type_ -> fs_util_ */ 22 /* 850206 MSharpe to replace -fcnt with -inase/inaee */ 23 24 dcl (dirname, new_path) char (168); 25 dcl (entname, ename) char (32); 26 dcl (length_string, seg_type) char (32); 27 dcl answer char (3) var; 28 29 dcl arg char (alng) based (aptr) unaligned; 30 dcl b_name char (32) based; 31 32 dcl (aptr, bentp) ptr; 33 dcl (eptr, nptr) ptr init (null); 34 35 dcl (arg_count, ecount, entry_len, j, retc) 36 fixed bin; 37 dcl alng fixed bin (21); 38 dcl base fixed bin; 39 dcl code fixed bin (35); 40 dcl (max_length, fixed_max_length) 41 fixed bin (19); 42 43 dcl (brf_sw, len_sw, mbx_sw, max_sw, pth_sw, record_sw) 44 bit (1); 45 46 dcl whoami char (16) int static init ("set_max_length"); 47 48 dcl decimal fixed bin int static init (1); 49 dcl octal fixed bin int static init (2); 50 51 dcl label (2) char (8) init ("decimal", "octal"); 52 53 dcl sys_info$max_seg_size fixed bin (18) ext; 54 55 dcl ( 56 error_table_$action_not_performed, 57 error_table_$argerr, 58 error_table_$badopt, 59 error_table_$dirseg, 60 error_table_$incorrect_access, 61 error_table_$invalid_max_length, 62 error_table_$no_info, 63 error_table_$noarg 64 ) ext fixed bin (35); 65 66 dcl 1 query_info aligned, 67 2 version fixed bin init (2), 68 2 yes_or_no_sw bit (1) unaligned init ("1"b), 69 2 suppress_name_sw bit (1) unaligned init ("0"b), 70 2 status_code fixed bin (35), 71 2 query_code fixed bin (35) init (0); 72 73 dcl sml_entry entry (char (*), char (*), fixed bin (19), fixed bin (35)) variable; 74 dcl sbc_entry entry (char (*), char (*), fixed bin (24), fixed bin (35)) variable; 75 76 dcl check_path_name_ ext 77 entry (ptr, fixed bin (21), bit (1) aligned, char (16) aligned, ptr, ptr, 78 ptr, fixed bin (17), ptr, ptr, fixed bin (17)); 79 dcl check_path_name_$indiv ext entry (ptr, ptr, bit (1) aligned); 80 dcl cu_$arg_ptr ext entry (fixed bin (17), ptr, fixed bin (21), fixed bin (35)); 81 dcl cv_dec_check_ ext entry (char (*), fixed bin (35)) returns (fixed bin (35)); 82 dcl cv_oct_check_ ext entry (char (*), fixed bin (35)) returns (fixed bin (35)); 83 dcl ( 84 com_err_, 85 com_err_$suppress_name, 86 command_query_ 87 ) ext entry options (variable); 88 89 dcl ( 90 hcs_$set_max_length, 91 fs_util_$set_max_length 92 ) ext entry (char (*), char (*), fixed bin (19), fixed bin (35)); 93 dcl hcs_$truncate_file ext entry (char (*), char (*), fixed bin (19), fixed bin (35)); 94 dcl ( 95 hcs_$set_bc, 96 fs_util_$set_bit_count 97 ) ext entry (char (*), char (*), fixed bin (24), fixed bin (35)); 98 99 dcl cleanup condition; 100 101 dcl (addr, divide, length, mod, null, rtrim, substr) 102 builtin; 103 104 on cleanup call sml_cleanup; 105 106 brf_sw, len_sw, max_sw, pth_sw, record_sw = "0"b; 107 base = decimal; 108 sml_entry = fs_util_$set_max_length; 109 sbc_entry = fs_util_$set_bit_count; 110 111 do arg_count = 1 by 1; 112 113 call cu_$arg_ptr (arg_count, aptr, alng, code); 114 if code ^= 0 115 then do; 116 if arg_count < 2 117 then do; /* must have at least 2 args */ 118 USAGE: 119 call com_err_$suppress_name (0, whoami, 120 "Usage: set_max_length path length {-control_args}"); 121 goto free_up; 122 end; 123 goto process_request; /* ready to do work */ 124 end; 125 if index (arg, "-") = 1 126 then do; 127 128 if (arg = "-dc") | (arg = "-decimal") 129 then base = decimal; 130 131 else if (arg = "-oc") | (arg = "-octal") 132 then base = octal; 133 134 else if (arg = "-bf") | (arg = "-brief") 135 then brf_sw = "1"b; 136 137 else if (arg = "-rec") | (arg = "-record") 138 then record_sw = "1"b; 139 140 else if (arg = "-word") 141 then record_sw = "0"b; 142 143 else if (arg = "-maximum") | (arg = "-max") 144 then if len_sw 145 then do; 146 MAX_USAGE: 147 call com_err_ (0, whoami, "-maximum inconsistent with length argument."); 148 return; 149 end; 150 else max_sw = "1"b; 151 152 else if arg = "-interpret_as_standard_entry" | arg = "-inase" 153 then do; 154 sml_entry = hcs_$set_max_length; 155 sbc_entry = hcs_$set_bc; 156 end; 157 else if arg = "-interpret_as_extended_entry" | arg = "-inaee" 158 then do; 159 sml_entry = fs_util_$set_max_length; 160 sbc_entry = fs_util_$set_bit_count; 161 end; 162 163 else do; /* not a legal control argument */ 164 call com_err_ (error_table_$badopt, whoami, arg); 165 return; 166 end; 167 168 end; /* must be pathname */ 169 else if ^pth_sw 170 then do; 171 call check_path_name_ (aptr, alng, "0"b, (whoami), addr (dirname), addr (entname), 172 addr (new_path), ecount, eptr, nptr, retc); 173 if retc = 2 174 then return; /* err and freeing all done */ 175 ename = entname; 176 pth_sw = "1"b; 177 end; 178 else do; /* max length number */ 179 if len_sw 180 then go to USAGE; /* supplied two length strings */ 181 if max_sw 182 then go to MAX_USAGE; 183 length_string = arg; 184 len_sw = "1"b; /* indicate that have length (and pathname) */ 185 end; 186 187 end; 188 189 process_request: 190 if max_sw 191 then do; 192 max_length = sys_info$max_seg_size; 193 go to SET; 194 end; 195 196 if ^len_sw 197 then go to USAGE; 198 199 if base = decimal 200 then max_length = cv_dec_check_ (length_string, code); 201 else max_length = cv_oct_check_ (length_string, code); 202 if code ^= 0 203 then do; /* code indicates which digit failed */ 204 call com_err_ (0, whoami, "Invalid ^a number ^a", label (base), length_string); 205 go to free_up; 206 end; 207 208 if record_sw 209 then max_length = max_length * 1024; 210 211 else if mod (max_length, 1024) ^= 0 212 then do; /* must be in terms of records used */ 213 fixed_max_length = divide (max_length + 1023, 1024, 19, 0) * 1024; 214 if ^brf_sw 215 then do; 216 if base = decimal 217 then call com_err_ (0, whoami, "^d is not a multiple of 1024 words, ^d used for max length", 218 max_length, fixed_max_length); 219 else call com_err_ (0, whoami, 220 "^o is not a multiple of 2000 (1024 decimal) words, ^o used for max length", 221 max_length, fixed_max_length); 222 end; 223 max_length = fixed_max_length; 224 end; 225 226 if max_length > sys_info$max_seg_size 227 then do; 228 call com_err_ (0, whoami, 229 "The specified value exceeds the supported maximum length for a segment. Please type ""help 256K_segments.gi""." 230 ); 231 go to free_up; 232 end; 233 234 SET: 235 do j = 1 to ecount; /* loop through all enames */ 236 237 if retc = 1 238 then do; /* a star name */ 239 call check_path_name_$indiv (addr (dirname), bentp, "0"b); 240 ename = bentp -> b_name; 241 end; 242 243 call sml_entry (dirname, ename, max_length, code); 244 if code ^= 0 245 then do; 246 if retc = 1 247 then if code = error_table_$dirseg 248 then go to loop_end; /* skip directories */ 249 if code = error_table_$argerr 250 then do; /* wrong max length */ 251 argerr: 252 if base = decimal 253 then call com_err_ (0, whoami, "Invalid max length ^d.", max_length); 254 else call com_err_ (0, whoami, "Invalid max length ^o.", max_length); 255 go to free_up; 256 end; 257 else if code = error_table_$invalid_max_length 258 then do; 259 query_info.status_code = code; 260 if base = decimal 261 then call command_query_ (addr (query_info), answer, whoami, 262 "Max length is less than current length, do you want to truncate ^a to ^d?", 263 new_path, max_length); 264 else call command_query_ (addr (query_info), answer, whoami, 265 "Max length is less than current length, do you want to truncate ^a to ^o?", 266 new_path, max_length); 267 if answer = "no" 268 then go to loop_end; 269 call hcs_$truncate_file (dirname, ename, max_length, code); 270 if code ^= 0 271 then goto dont_care_err; 272 call sbc_entry (dirname, ename, max_length * 36, code); 273 call sml_entry (dirname, ename, max_length, code); 274 if code ^= 0 275 then goto dont_care_err; 276 end; 277 else do; 278 dont_care_err: 279 call com_err_ (code, whoami, new_path); 280 /* if incorrect access on parent directory */ 281 if (code = error_table_$incorrect_access) | (code = error_table_$no_info) 282 then go to free_up; /* skip processing rest of star names */ 283 end; /* code is 0, continue loop */ 284 end; 285 286 loop_end: 287 end; 288 289 free_up: 290 call sml_cleanup; 291 return; 292 293 sml_cleanup: 294 proc; 295 declare freen_ entry (pointer); 296 /* Ycch, but we have no structure to free */ 297 298 if eptr ^= null 299 then call freen_ (eptr); 300 if nptr ^= null 301 then call freen_ (nptr); /* proc */ 302 end; 303 304 /* proc */ 305 end set_max_length; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 03/08/85 1005.7 set_max_length.pl1 >spec>on>maggie_fixes>set_max_length.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. addr builtin function dcl 101 ref 171 171 171 171 171 171 239 239 260 260 264 264 alng 000272 automatic fixed bin(21,0) dcl 37 set ref 113* 125 128 128 131 131 134 134 137 137 140 143 143 152 152 157 157 164 164 171* 183 answer 000254 automatic varying char(3) dcl 27 set ref 260* 264* 267 aptr 000256 automatic pointer dcl 32 set ref 113* 125 128 128 131 131 134 134 137 137 140 143 143 152 152 157 157 164 171* 183 arg based char unaligned dcl 29 set ref 125 128 128 131 131 134 134 137 137 140 143 143 152 152 157 157 164* 183 arg_count 000266 automatic fixed bin(17,0) dcl 35 set ref 111* 113* 116* b_name based char(32) unaligned dcl 30 ref 240 base 000273 automatic fixed bin(17,0) dcl 38 set ref 107* 128* 131* 199 204 216 251 260 bentp 000260 automatic pointer dcl 32 set ref 239* 240 brf_sw 000277 automatic bit(1) unaligned dcl 43 set ref 106* 134* 214 check_path_name_ 000032 constant entry external dcl 76 ref 171 check_path_name_$indiv 000034 constant entry external dcl 79 ref 239 cleanup 000324 stack reference condition dcl 99 ref 104 code 000274 automatic fixed bin(35,0) dcl 39 set ref 113* 114 199* 201* 202 243* 244 246 249 257 259 269* 270 272* 273* 274 278* 281 281 com_err_ 000044 constant entry external dcl 83 ref 146 164 204 216 219 228 251 254 278 com_err_$suppress_name 000046 constant entry external dcl 83 ref 118 command_query_ 000050 constant entry external dcl 83 ref 260 264 cu_$arg_ptr 000036 constant entry external dcl 80 ref 113 cv_dec_check_ 000040 constant entry external dcl 81 ref 199 cv_oct_check_ 000042 constant entry external dcl 82 ref 201 decimal constant fixed bin(17,0) initial dcl 48 ref 107 128 199 216 251 260 dirname 000100 automatic char(168) unaligned dcl 24 set ref 171 171 239 239 243* 269* 272* 273* divide builtin function dcl 101 ref 213 ecount 000267 automatic fixed bin(17,0) dcl 35 set ref 171* 234 ename 000234 automatic char(32) unaligned dcl 25 set ref 175* 240* 243* 269* 272* 273* entname 000224 automatic char(32) unaligned dcl 25 set ref 171 171 175 eptr 000262 automatic pointer initial dcl 33 set ref 33* 171* 298 298* error_table_$argerr 000016 external static fixed bin(35,0) dcl 55 ref 249 error_table_$badopt 000020 external static fixed bin(35,0) dcl 55 set ref 164* error_table_$dirseg 000022 external static fixed bin(35,0) dcl 55 ref 246 error_table_$incorrect_access 000024 external static fixed bin(35,0) dcl 55 ref 281 error_table_$invalid_max_length 000026 external static fixed bin(35,0) dcl 55 ref 257 error_table_$no_info 000030 external static fixed bin(35,0) dcl 55 ref 281 fixed_max_length 000276 automatic fixed bin(19,0) dcl 40 set ref 213* 216* 219* 223 freen_ 000064 constant entry external dcl 295 ref 298 300 fs_util_$set_bit_count 000062 constant entry external dcl 94 ref 109 160 fs_util_$set_max_length 000054 constant entry external dcl 89 ref 108 159 hcs_$set_bc 000060 constant entry external dcl 94 ref 155 hcs_$set_max_length 000052 constant entry external dcl 89 ref 154 hcs_$truncate_file 000056 constant entry external dcl 93 ref 269 j 000270 automatic fixed bin(17,0) dcl 35 set ref 234* label 000304 automatic char(8) initial array unaligned dcl 51 set ref 51* 51* 204* len_sw 000300 automatic bit(1) unaligned dcl 43 set ref 106* 143 179 184* 196 length_string 000244 automatic char(32) unaligned dcl 26 set ref 183* 199* 201* 204* max_length 000275 automatic fixed bin(19,0) dcl 40 set ref 192* 199* 201* 208* 208 211 213 216* 219* 223* 226 243* 251* 254* 260* 264* 269* 272 273* max_sw 000301 automatic bit(1) unaligned dcl 43 set ref 106* 150* 181 189 mod builtin function dcl 101 ref 211 new_path 000152 automatic char(168) unaligned dcl 24 set ref 171 171 260* 264* 278* nptr 000264 automatic pointer initial dcl 33 set ref 33* 171* 300 300* null builtin function dcl 101 ref 33 33 298 300 octal constant fixed bin(17,0) initial dcl 49 ref 131 pth_sw 000302 automatic bit(1) unaligned dcl 43 set ref 106* 169 176* query_code 3 000310 automatic fixed bin(35,0) initial level 2 dcl 66 set ref 66* query_info 000310 automatic structure level 1 dcl 66 set ref 260 260 264 264 record_sw 000303 automatic bit(1) unaligned dcl 43 set ref 106* 137* 140* 208 retc 000271 automatic fixed bin(17,0) dcl 35 set ref 171* 173 237 246 sbc_entry 000320 automatic entry variable dcl 74 set ref 109* 155* 160* 272 sml_entry 000314 automatic entry variable dcl 73 set ref 108* 154* 159* 243 273 status_code 2 000310 automatic fixed bin(35,0) level 2 dcl 66 set ref 259* suppress_name_sw 1(01) 000310 automatic bit(1) initial level 2 packed unaligned dcl 66 set ref 66* sys_info$max_seg_size 000014 external static fixed bin(18,0) dcl 53 ref 192 226 version 000310 automatic fixed bin(17,0) initial level 2 dcl 66 set ref 66* whoami 000010 internal static char(16) initial unaligned dcl 46 set ref 118* 146* 164* 171 204* 216* 219* 228* 251* 254* 260* 264* 278* yes_or_no_sw 1 000310 automatic bit(1) initial level 2 packed unaligned dcl 66 set ref 66* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. entry_len automatic fixed bin(17,0) dcl 35 error_table_$action_not_performed external static fixed bin(35,0) dcl 55 error_table_$noarg external static fixed bin(35,0) dcl 55 length builtin function dcl 101 mbx_sw automatic bit(1) unaligned dcl 43 rtrim builtin function dcl 101 seg_type automatic char(32) unaligned dcl 26 substr builtin function dcl 101 NAMES DECLARED BY EXPLICIT CONTEXT. MAX_USAGE 000607 constant label dcl 146 ref 181 SET 001323 constant label dcl 234 ref 193 USAGE 000450 constant label dcl 118 ref 179 196 argerr 001422 constant label dcl 251 dont_care_err 001732 constant label dcl 278 ref 270 274 free_up 001763 constant label dcl 289 ref 121 205 231 255 281 loop_end 001761 constant label dcl 286 ref 246 267 process_request 001026 constant label dcl 189 ref 123 set_max_length 000355 constant entry external dcl 11 sml 000345 constant entry external dcl 11 sml_cleanup 001771 constant entry internal dcl 293 ref 104 289 NAME DECLARED BY CONTEXT OR IMPLICATION. index builtin function ref 125 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2312 2400 2033 2322 Length 2624 2033 66 207 257 4 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME sml 339 external procedure is an external procedure. on unit on line 104 64 on unit sml_cleanup 68 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 whoami sml STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME sml 000100 dirname sml 000152 new_path sml 000224 entname sml 000234 ename sml 000244 length_string sml 000254 answer sml 000256 aptr sml 000260 bentp sml 000262 eptr sml 000264 nptr sml 000266 arg_count sml 000267 ecount sml 000270 j sml 000271 retc sml 000272 alng sml 000273 base sml 000274 code sml 000275 max_length sml 000276 fixed_max_length sml 000277 brf_sw sml 000300 len_sw sml 000301 max_sw sml 000302 pth_sw sml 000303 record_sw sml 000304 label sml 000310 query_info sml 000314 sml_entry sml 000320 sbc_entry sml THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_var_desc call_ext_out_desc call_ext_out call_int_this call_int_other return mod_fx1 enable ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. check_path_name_ check_path_name_$indiv com_err_ com_err_$suppress_name command_query_ cu_$arg_ptr cv_dec_check_ cv_oct_check_ freen_ fs_util_$set_bit_count fs_util_$set_max_length hcs_$set_bc hcs_$set_max_length hcs_$truncate_file THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$argerr error_table_$badopt error_table_$dirseg error_table_$incorrect_access error_table_$invalid_max_length error_table_$no_info sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 33 000311 51 000314 66 000333 11 000344 104 000363 106 000405 107 000412 108 000414 109 000421 111 000424 113 000426 114 000443 116 000445 118 000450 121 000475 123 000476 125 000477 128 000513 131 000526 134 000541 137 000554 140 000567 143 000575 146 000607 148 000634 150 000635 152 000640 154 000650 155 000655 156 000660 157 000661 159 000671 160 000676 161 000701 164 000702 165 000726 168 000727 169 000730 171 000732 173 001001 175 001004 176 001007 177 001011 179 001012 181 001014 183 001016 184 001022 187 001024 189 001026 192 001030 193 001033 196 001034 199 001036 201 001064 202 001106 204 001110 205 001152 208 001153 211 001161 213 001165 214 001172 216 001174 219 001234 223 001270 226 001272 228 001276 231 001322 234 001323 237 001333 239 001336 240 001355 243 001361 244 001405 246 001407 249 001416 251 001422 254 001456 255 001506 257 001507 259 001511 260 001512 264 001557 267 001620 269 001625 270 001652 272 001654 273 001703 274 001727 276 001731 278 001732 281 001753 286 001761 289 001763 291 001767 293 001770 298 001776 300 002011 302 002025 ----------------------------------------------------------- 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