COMPILATION LISTING OF SEGMENT adjust_bit_count Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 10/25/83 1537.0 mst Tue 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 adjust_bit_count: abc: proc; 12 13 /* This command sets the bit counts of segments to the last 14* bit of the last non-zero word or character */ 15 16 /* Written 3/4/76 by Steve Herbst */ 17 /* Fixed to complain about directories 05/15/79 S. Herbst */ 18 19 dcl 1 paths (arg_count) based(paths_ptr), /* ptrs and lengths of pathname args */ 20 2 path_ptr ptr, 21 2 path_len fixed bin; 22 23 dcl 1 entries (ecount) aligned based(entries_ptr), /* entry info from hcs_$star_ */ 24 2 etype fixed bin(1) unaligned, 25 2 nnames fixed bin(15) unaligned, 26 2 nindex fixed bin unaligned; 27 28 dcl LINK_TYPE fixed bin int static options(constant) init(0); 29 30 dcl names (99) char(32) aligned based(names_ptr); /* entry names from hcs_$star_ */ 31 32 dcl area area based(area_ptr); 33 34 dcl arg char(arg_len) based(arg_ptr); 35 dcl dn char(168); 36 dcl (en, star_name) char(32); 37 38 dcl (character, chase_sw, long, match, stars) bit(1) aligned; 39 40 dcl (area_ptr, arg_ptr, entries_ptr, names_ptr, paths_ptr) ptr; 41 42 dcl (arg_count, arg_len, ecount, i, j, path_count) fixed bin; 43 dcl (bit_count, old_bit_count) fixed bin(24); 44 dcl code fixed bin(35); 45 46 dcl error_table_$badopt fixed bin(35) ext; 47 dcl error_table_$badstar fixed bin(35) ext; 48 dcl error_table_$dirseg fixed bin(35) ext; 49 dcl error_table_$nomatch fixed bin(35) ext; 50 51 dcl adjust_bit_count_ entry(char(*),char(*),bit(1)aligned,fixed bin(24),fixed bin(35)); 52 dcl check_star_name_$entry entry(char(*),fixed bin(35)); 53 dcl com_err_ entry options(variable); 54 dcl cu_$arg_count entry(fixed bin); 55 dcl cu_$arg_ptr entry(fixed bin,ptr,fixed bin,fixed bin(35)); 56 dcl expand_path_ entry(ptr,fixed bin,ptr,ptr,fixed bin(35)); 57 dcl get_system_free_area_ entry returns(ptr); 58 dcl hcs_$get_link_target entry(char(*),char(*),char(*),char(*),fixed bin(35)); 59 dcl hcs_$star_ entry(char(*),char(*),fixed bin(2),ptr,fixed bin,ptr,ptr,fixed bin(35)); 60 dcl hcs_$status_minf entry(char(*),char(*),fixed bin(1),fixed bin(2),fixed bin(24),fixed bin(35)); 61 dcl ioa_ entry options(variable); 62 63 dcl (addr, null, substr) builtin; 64 65 dcl cleanup condition; 66 /* */ 67 call cu_$arg_count(arg_count); 68 if arg_count=0 then do; 69 NO_PATH: call com_err_(0,"","Usage is: adjust_bit_count paths -control_args-"); 70 return; 71 end; 72 73 entries_ptr, names_ptr, paths_ptr = null; 74 on condition(cleanup) call clean_up; 75 76 area_ptr = get_system_free_area_(); 77 allocate paths in(area) set(paths_ptr); 78 path_count = 0; 79 80 character, chase_sw, long = "0"b; 81 82 do i = 1 to arg_count; 83 call cu_$arg_ptr(i,arg_ptr,arg_len,code); 84 if substr(arg,1,1)="-" then 85 if arg="-character" | arg="-ch" then character = "1"b; 86 else if arg="-long" | arg="-lg" then long = "1"b; 87 else if arg="-chase" then chase_sw = "1"b; 88 else if arg="-no_chase" then chase_sw = "0"b; 89 else do; 90 call com_err_(error_table_$badopt,"adjust_bit_count","^a",arg); 91 free paths in(area); 92 return; 93 end; 94 else do; /* pathname argument */ 95 path_count = path_count+1; 96 path_ptr(path_count) = arg_ptr; 97 path_len(path_count) = arg_len; 98 end; 99 end; 100 101 if path_count=0 then do; 102 free paths in(area); 103 go to NO_PATH; 104 end; 105 /* */ 106 do i = 1 to path_count; 107 108 call expand_path_(path_ptr(i),path_len(i),addr(dn),addr(en),code); 109 if code^=0 then do; 110 arg_ptr = path_ptr(i); 111 arg_len = path_len(i); 112 call com_err_(code,"adjust_bit_count","^a",arg); 113 go to NEXT_PATH; 114 end; 115 116 call check_star_name_$entry(en,code); 117 if code=0 then do; 118 stars = "0"b; 119 ecount = 1; 120 end; 121 else if code=error_table_$badstar then do; 122 call com_err_(code,"adjust_bit_count","^a",en); 123 go to NEXT_PATH; 124 end; 125 else do; 126 stars = "1"b; 127 star_name = en; 128 call hcs_$star_(dn,en,3,area_ptr,ecount,entries_ptr,names_ptr,code); 129 if code^=0 then do; 130 call com_err_(code,"adjust_bit_count","^a>^a",dn,en); 131 go to NEXT_PATH; 132 end; 133 end; 134 135 match = "0"b; 136 137 do j = 1 to ecount; /* for each starname match */ 138 139 if stars then do; 140 en = names(nindex(j)); 141 if etype(j)=LINK_TYPE then 142 if chase_sw then do; 143 call hcs_$get_link_target(dn,en,dn,en,code); 144 if code^=0 then go to NEXT_MATCH; 145 end; 146 else go to NEXT_MATCH; 147 end; 148 149 if long then do; 150 call hcs_$status_minf(dn,en,1,(0),old_bit_count,code); 151 bit_count = old_bit_count; 152 end; 153 154 call adjust_bit_count_(dn,en,character,bit_count,code); 155 156 if code = error_table_$dirseg then do; 157 if ^stars then call com_err_ (code, "adjust_bit_count", 158 "^a^[>^]^a", dn, dn ^= ">", en); 159 end; 160 else do; 161 162 match = "1"b; 163 164 if code ^= 0 then 165 if bit_count=-1 then call com_err_(code,"adjust_bit_count","^a>^a",dn,en); 166 else call com_err_(code,"adjust_bit_count", 167 "^a>^a^/^-Computed bit count = ^d",dn,en,bit_count); 168 169 else if long & bit_count^=old_bit_count then 170 call ioa_("Bit count of ^a>^a changed from ^d to ^d", 171 dn,en,old_bit_count,bit_count); 172 end; 173 NEXT_MATCH: end; 174 175 if stars then do; 176 177 if ^match then call com_err_ (error_table_$nomatch, "adjust_bit_count", 178 "^a^[>^]^a", dn, dn ^= ">", star_name); 179 180 free entries in(area); 181 free names in(area); 182 end; 183 184 NEXT_PATH: end; 185 186 call clean_up; 187 return; 188 189 clean_up: proc; 190 191 if paths_ptr^=null then free paths in(area); 192 if entries_ptr^=null then free entries in(area); 193 if names_ptr^=null then free names in(area); 194 195 end clean_up; 196 197 end adjust_bit_count; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/25/83 1444.5 adjust_bit_count.pl1 >spec>on>eod-fix>adjust_bit_count.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. LINK_TYPE constant fixed bin(17,0) initial dcl 28 ref 141 addr builtin function dcl 63 ref 108 108 108 108 adjust_bit_count_ 000020 constant entry external dcl 51 ref 154 area based area(1024) dcl 32 ref 77 91 102 180 181 191 192 193 area_ptr 000200 automatic pointer dcl 40 set ref 76* 77 91 102 128* 180 181 191 192 193 arg based char unaligned dcl 34 set ref 84 84 84 86 86 87 88 90* 112* arg_count 000212 automatic fixed bin(17,0) dcl 42 set ref 67* 68 77 82 91 102 191 arg_len 000213 automatic fixed bin(17,0) dcl 42 set ref 83* 84 84 84 86 86 87 88 90 90 97 111* 112 112 arg_ptr 000202 automatic pointer dcl 40 set ref 83* 84 84 84 86 86 87 88 90 96 110* 112 bit_count 000220 automatic fixed bin(24,0) dcl 43 set ref 151* 154* 164 166* 169 169* character 000172 automatic bit(1) dcl 38 set ref 80* 84* 154* chase_sw 000173 automatic bit(1) dcl 38 set ref 80* 87* 88* 141 check_star_name_$entry 000022 constant entry external dcl 52 ref 116 cleanup 000224 stack reference condition dcl 65 ref 74 code 000222 automatic fixed bin(35,0) dcl 44 set ref 83* 108* 109 112* 116* 117 121 122* 128* 129 130* 143* 144 150* 154* 156 157* 164 164* 166* com_err_ 000024 constant entry external dcl 53 ref 69 90 112 122 130 157 164 166 177 cu_$arg_count 000026 constant entry external dcl 54 ref 67 cu_$arg_ptr 000030 constant entry external dcl 55 ref 83 dn 000100 automatic char(168) unaligned dcl 35 set ref 108 108 128* 130* 143* 143* 150* 154* 157* 157 164* 166* 169* 177* 177 ecount 000214 automatic fixed bin(17,0) dcl 42 set ref 119* 128* 137 180 192 en 000152 automatic char(32) unaligned dcl 36 set ref 108 108 116* 122* 127 128* 130* 140* 143* 143* 150* 154* 157* 164* 166* 169* entries based structure array level 1 dcl 23 ref 180 192 entries_ptr 000204 automatic pointer dcl 40 set ref 73* 128* 140 141 180 192 192 error_table_$badopt 000010 external static fixed bin(35,0) dcl 46 set ref 90* error_table_$badstar 000012 external static fixed bin(35,0) dcl 47 ref 121 error_table_$dirseg 000014 external static fixed bin(35,0) dcl 48 ref 156 error_table_$nomatch 000016 external static fixed bin(35,0) dcl 49 set ref 177* etype based fixed bin(1,0) array level 2 packed unaligned dcl 23 ref 141 expand_path_ 000032 constant entry external dcl 56 ref 108 get_system_free_area_ 000034 constant entry external dcl 57 ref 76 hcs_$get_link_target 000036 constant entry external dcl 58 ref 143 hcs_$star_ 000040 constant entry external dcl 59 ref 128 hcs_$status_minf 000042 constant entry external dcl 60 ref 150 i 000215 automatic fixed bin(17,0) dcl 42 set ref 82* 83* 106* 108 108 110 111* ioa_ 000044 constant entry external dcl 61 ref 169 j 000216 automatic fixed bin(17,0) dcl 42 set ref 137* 140 141* long 000174 automatic bit(1) dcl 38 set ref 80* 86* 149 169 match 000175 automatic bit(1) dcl 38 set ref 135* 162* 177 names based char(32) array dcl 30 ref 140 181 193 names_ptr 000206 automatic pointer dcl 40 set ref 73* 128* 140 181 193 193 nindex 0(18) based fixed bin(17,0) array level 2 packed unaligned dcl 23 ref 140 null builtin function dcl 63 ref 73 191 192 193 old_bit_count 000221 automatic fixed bin(24,0) dcl 43 set ref 150* 151 169 169* path_count 000217 automatic fixed bin(17,0) dcl 42 set ref 78* 95* 95 96 97 101 106 path_len 2 based fixed bin(17,0) array level 2 dcl 19 set ref 97* 108* 111 path_ptr based pointer array level 2 dcl 19 set ref 96* 108* 110 paths based structure array level 1 unaligned dcl 19 set ref 77 91 102 191 paths_ptr 000210 automatic pointer dcl 40 set ref 73* 77* 91 96 97 102 108 108 110 111 191 191 star_name 000162 automatic char(32) unaligned dcl 36 set ref 127* 177* stars 000176 automatic bit(1) dcl 38 set ref 118* 126* 139 157 175 substr builtin function dcl 63 ref 84 NAMES DECLARED BY EXPLICIT CONTEXT. NEXT_MATCH 001350 constant label dcl 173 ref 141 144 NEXT_PATH 001436 constant label dcl 184 ref 113 123 131 NO_PATH 000140 constant label dcl 69 ref 103 abc 000114 constant entry external dcl 11 adjust_bit_count 000123 constant entry external dcl 11 clean_up 001446 constant entry internal dcl 189 ref 74 186 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1722 1770 1506 1732 Length 2172 1506 46 166 213 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME abc 246 external procedure is an external procedure. on unit on line 74 64 on unit clean_up 64 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME abc 000100 dn abc 000152 en abc 000162 star_name abc 000172 character abc 000173 chase_sw abc 000174 long abc 000175 match abc 000176 stars abc 000200 area_ptr abc 000202 arg_ptr abc 000204 entries_ptr abc 000206 names_ptr abc 000210 paths_ptr abc 000212 arg_count abc 000213 arg_len abc 000214 ecount abc 000215 i abc 000216 j abc 000217 path_count abc 000220 bit_count abc 000221 old_bit_count abc 000222 code abc THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_ne_as call_ext_out_desc call_ext_out call_int_this call_int_other return enable ext_entry int_entry alloc_based free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. adjust_bit_count_ check_star_name_$entry com_err_ cu_$arg_count cu_$arg_ptr expand_path_ get_system_free_area_ hcs_$get_link_target hcs_$star_ hcs_$status_minf ioa_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$badstar error_table_$dirseg error_table_$nomatch LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000113 67 000130 68 000136 69 000140 70 000165 73 000166 74 000172 76 000214 77 000223 78 000231 80 000232 82 000235 83 000245 84 000262 86 000303 87 000316 88 000325 90 000333 91 000373 92 000377 93 000400 95 000401 96 000402 97 000406 99 000411 101 000413 102 000415 103 000421 106 000422 108 000431 109 000456 110 000460 111 000465 112 000470 113 000527 116 000530 117 000545 118 000547 119 000550 120 000552 121 000553 122 000556 123 000612 126 000613 127 000615 128 000620 129 000664 130 000666 131 000727 135 000730 137 000731 139 000741 140 000743 141 000755 143 000763 144 001012 149 001014 150 001016 151 001056 154 001060 156 001111 157 001115 159 001172 162 001173 164 001175 166 001243 169 001311 173 001350 175 001352 177 001354 180 001432 181 001434 184 001436 186 001440 187 001444 189 001445 191 001453 192 001464 193 001473 195 001502 ----------------------------------------------------------- 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