COMPILATION LISTING OF SEGMENT archive_util_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1727.8 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 archive_util_$next_element: proc (header_ptr, code); 12 13 /* archive utility procedure to search archive segments 14* 15* expect pointer to archive segment in header_ptr 16* return code = 0 and header_ptr set to next element 17* unless at end of segment or if a format error 18* where header_ptr is left as given and code set to 1 if at end of segment 19* or to 2 if a format error is discovered. 20* 21* first_element or first_dissected must be called first. 22* thereafter, next_element or next_dissected must be called. 23* Due to the use of internal static variables, only one archive at a time 24* can be processed with this subroutine. 25* 26* Modified 781203 by PG to fix bug causing first_dissected to store code in wrong parameter. 27* */ 28 29 dcl header_ptr ptr; 30 dcl header_save ptr; 31 32 dcl header_length_bits init (900) fixed bin static; 33 34 dcl (code, scode, stype, icode) fixed bin (17), 35 bitcnt fixed bin (24), 36 highoffset internal static fixed bin (17); 37 38 dcl flag fixed bin (17); 39 40 dcl cv_dec_ entry (char (*) aligned, fixed bin (24)), 41 hcs_$status_mins external entry (ptr, fixed bin (17), fixed bin (24), fixed bin (17)); 42 43 dcl n fixed bin (24); 44 45 dcl next ptr; 46 47 dcl archive_data_$ident ext char (8) aligned; 48 dcl archive_data_$header_begin ext char (8) aligned; 49 50 /* builtins */ 51 52 dcl (addrel, bin, divide, null, rel, size) builtin; 53 54 /* include files */ 55 1 1 /* BEGIN INCLUDE FILE archive_header.incl.pl1 */ 1 2 1 3 1 4 dcl 1 archive_header aligned based, 1 5 2 header_begin char (8), 1 6 2 pad1 char (4), 1 7 2 name char (32), 1 8 2 timeup char (16), 1 9 2 mode char (4), 1 10 2 time char (16), 1 11 2 pad char (4), 1 12 2 bit_count char (8), 1 13 2 header_end char (8); 1 14 1 15 /* END INCLUDE archive_header.incl.pl1 */ 56 57 58 flag, icode = 0; 59 60 start: 61 call cv_dec_ (header_ptr -> archive_header.bit_count, n); 62 next = addrel (header_ptr, divide (n + header_length_bits + 35, 36, 17, 0)); 63 if bin (rel (next), 17) < highoffset then go to continue; 64 if bin (rel (next), 17) = highoffset then do; 65 icode = 1;header_ptr = null; go to comretn; 66 end; 67 icode = 2;header_ptr = null;go to comretn; 68 69 continue: 70 header_ptr = null; /* initialize for end of archive state */ 71 if next -> archive_header.header_begin = archive_data_$ident then header_ptr = next; 72 else if next -> archive_header.header_begin = archive_data_$header_begin then header_ptr = next; 73 if header_ptr ^= next then icode = 2; /* format error */ 74 75 comretn: 76 if flag = 1 then go to disected_return; 77 if flag = 2 then go to search_return; 78 code = icode; 79 return; 80 /* */ 81 first_element: entry (header_ptr, code); 82 83 icode, flag = 0; 84 85 first_elt2: 86 highoffset = 0; 87 call hcs_$status_mins (header_ptr, stype, bitcnt, scode); 88 if scode ^= 0 then do; 89 icode = scode; 90 go to comretn; 91 end; 92 highoffset = divide (bitcnt+35, 36, 17, 0); 93 if highoffset = 0 then do; 94 icode = 1; 95 go to comretn; 96 end; 97 next = header_ptr; 98 go to continue; 99 100 disected_element: entry (header_ptr, segptr, segname, bit_count, code5); 101 102 dcl segptr ptr, 103 code5 fixed bin (17), 104 segname char (32) aligned, 105 bit_count fixed bin (24); 106 107 flag = 1; 108 icode = 0; 109 go to start; 110 111 disected_return: 112 if header_ptr = null then 113 do; 114 segptr = null; 115 segname = ""; 116 bit_count = 0; 117 code5 = icode; 118 return; 119 end; 120 121 call cv_dec_ (header_ptr -> archive_header.bit_count, bit_count); 122 segptr = addrel (header_ptr, size (archive_header)); 123 segname = header_ptr -> archive_header.name; 124 code5 = icode; 125 return; 126 /* */ 127 first_disected: entry (header_ptr, segptr, segname, bit_count, code5); 128 129 flag = 1; 130 icode = 0; 131 go to first_elt2; 132 133 search: entry (header_ptr, segptr, segname, code4); 134 135 dcl code4 fixed bin (17); 136 137 flag = 2; 138 icode = 0; 139 header_save = header_ptr; 140 next = header_ptr; 141 go to continue; 142 143 search_return: 144 if header_ptr = null then do; 145 segptr = null; 146 code4 = icode; 147 header_ptr = header_save; 148 return; 149 end; 150 151 if segname ^= header_ptr -> archive_header.name then go to start; 152 segptr = addrel (header_ptr, size (archive_header)); 153 code4 = icode; 154 header_ptr = header_save; 155 return; 156 157 end /* archive_util_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1620.0 archive_util_.pl1 >dumps>old>recomp>archive_util_.pl1 56 1 02/06/76 1405.1 archive_header.incl.pl1 >ldd>include>archive_header.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. addrel builtin function dcl 52 ref 62 122 152 archive_data_$header_begin 000020 external static char(8) dcl 48 ref 72 archive_data_$ident 000016 external static char(8) dcl 47 ref 71 archive_header based structure level 1 dcl 1-4 set ref 122 152 bin builtin function dcl 52 ref 63 64 bit_count 25 based char(8) level 2 in structure "archive_header" dcl 1-4 in procedure "archive_util_$next_element" set ref 60* 121* bit_count parameter fixed bin(24,0) dcl 102 in procedure "archive_util_$next_element" set ref 100 116* 121* 127 bitcnt 000105 automatic fixed bin(24,0) dcl 34 set ref 87* 92 code parameter fixed bin(17,0) dcl 34 set ref 11 78* 81 code4 parameter fixed bin(17,0) dcl 135 set ref 133 146* 153* code5 parameter fixed bin(17,0) dcl 102 set ref 100 117* 124* 127 cv_dec_ 000012 constant entry external dcl 40 ref 60 121 divide builtin function dcl 52 ref 62 92 flag 000106 automatic fixed bin(17,0) dcl 38 set ref 58* 75 77 83* 107* 129* 137* hcs_$status_mins 000014 constant entry external dcl 40 ref 87 header_begin based char(8) level 2 dcl 1-4 ref 71 72 header_length_bits constant fixed bin(17,0) initial dcl 32 ref 62 header_ptr parameter pointer dcl 29 set ref 11 60 62 65* 67* 69* 71* 72* 73 81 87* 97 100 111 121 122 123 127 133 139 140 143 147* 151 152 154* header_save 000100 automatic pointer dcl 30 set ref 139* 147 154 highoffset 000010 internal static fixed bin(17,0) dcl 34 set ref 63 64 85* 92* 93 icode 000104 automatic fixed bin(17,0) dcl 34 set ref 58* 65* 67* 73* 78 83* 89* 94* 108* 117 124 130* 138* 146 153 n 000107 automatic fixed bin(24,0) dcl 43 set ref 60* 62 name 3 based char(32) level 2 dcl 1-4 ref 123 151 next 000110 automatic pointer dcl 45 set ref 62* 63 64 71 71 72 72 73 97* 140* null builtin function dcl 52 ref 65 67 69 111 114 143 145 rel builtin function dcl 52 ref 63 64 scode 000102 automatic fixed bin(17,0) dcl 34 set ref 87* 88 89 segname parameter char(32) dcl 102 set ref 100 115* 123* 127 133 151 segptr parameter pointer dcl 102 set ref 100 114* 122* 127 133 145* 152* size builtin function dcl 52 ref 122 152 stype 000103 automatic fixed bin(17,0) dcl 34 set ref 87* NAMES DECLARED BY EXPLICIT CONTEXT. archive_util_$next_element 000014 constant entry external dcl 11 comretn 000125 constant label dcl 75 ref 65 67 90 95 continue 000073 constant label dcl 69 ref 63 98 141 disected_element 000215 constant entry external dcl 100 disected_return 000226 constant label dcl 111 ref 75 first_disected 000304 constant entry external dcl 127 first_element 000140 constant entry external dcl 81 first_elt2 000147 constant label dcl 85 ref 131 search 000322 constant entry external dcl 133 search_return 000340 constant label dcl 143 ref 77 start 000023 constant label dcl 60 ref 109 151 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 526 550 372 536 Length 746 372 22 162 133 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME archive_util_$next_element 85 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 highoffset archive_util_$next_element STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME archive_util_$next_element 000100 header_save archive_util_$next_element 000102 scode archive_util_$next_element 000103 stype archive_util_$next_element 000104 icode archive_util_$next_element 000105 bitcnt archive_util_$next_element 000106 flag archive_util_$next_element 000107 n archive_util_$next_element 000110 next archive_util_$next_element THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cv_dec_ hcs_$status_mins THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. archive_data_$header_begin archive_data_$ident LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000010 58 000021 60 000023 62 000043 63 000053 64 000060 65 000061 65 000063 65 000065 67 000066 67 000070 67 000072 69 000073 71 000076 72 000111 73 000117 75 000125 77 000130 78 000132 79 000135 81 000136 83 000145 85 000147 87 000151 88 000166 89 000170 90 000171 92 000172 93 000177 94 000200 95 000202 97 000203 98 000207 100 000210 107 000222 108 000224 109 000225 111 000226 114 000233 115 000235 116 000241 117 000242 118 000244 121 000245 122 000264 123 000271 124 000277 125 000301 127 000302 129 000311 130 000313 131 000314 133 000315 137 000327 138 000331 139 000332 140 000336 141 000337 143 000340 145 000345 146 000347 147 000351 148 000353 151 000354 152 000363 153 000365 154 000367 155 000371 ----------------------------------------------------------- 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