COMPILATION LISTING OF SEGMENT get_archive_file_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/12/82 1244.6 mst Fri 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 get_archive_file_: procedure (dir_name, seg_name, ac_file, rtn_code); 12 13 dcl dir_name char(*), /* directory name for archives */ 14 seg_name char(*), /* source segment name */ 15 ac_file char(2), /* first name component of archive */ 16 rtn_code fixed bin(17); /* error code */ 17 dcl substr builtin; 18 dcl fd_file char(32); 19 dcl gls_switch bit(1); /*switch to pick entry*/ 20 21 22 /* 23* 24* get_archive_file_: Procedure to locate a segment in 25* a series of archives (a1...a9, b1...b9, etc.). The 26* first character of the archive name must match the 27* first character of the name of the desired segment. 28* 29* Possible return codes are: 30* 31* 0 - Segment found, ac_file is containing archive 32* 1 - Segment not found, ac_file is shortest archive 33* 2 - Format error in archive file (ac_file) 34* other - A standard file system error code 35* 36* P. R. Bos, April 1971 37* 38* 14 apr 72 39* 40* entry point "srchgls" added by steve tepper. returns entire archive segment name 41* instead of just first name component. 42* 43**/ 44 45 46 dcl archive_util_$first_element ext entry (ptr, fixed bin(17)), 47 archive_util_$search ext entry (ptr, ptr, char (*) aligned, fixed bin), 48 cv_bin_$dec ext entry (fixed bin(17), char(12) aligned), 49 hcs_$initiate_count entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (24), fixed bin (2), 50 ptr, fixed bin), 51 hcs_$terminate_noname ext entry (ptr, fixed bin(17)); 52 53 dcl (error_table_$noentry, 54 error_table_$segknown) ext fixed bin(17); 55 56 dcl (p, q, s) ptr; 57 58 dcl (cd, code, i) fixed bin(17), 59 (bc, shortest_bc) fixed bin(24); 60 61 dcl (ac_name char(32), 62 chr char(1), 63 dir char(168), 64 seg char(32), 65 shortest_ac_file char(2), 66 string char(12)) aligned; 67 68 69 gls_switch="0"b; /* we are not called by gls*/ 70 go to crud; 71 72 73 srchgls: entry(dir_name,seg_name,fd_file,rtn_code); /*entry from gls*/ 74 75 gls_switch="1"b; /*we _a_r_e called by gls*/ 76 77 crud: ; 78 /* */ 79 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 80 81 82 dir = dir_name; /* align directory name */ 83 seg = seg_name; /* align segment name */ 84 chr = substr(seg, 1, 1); /* first char of segment name */ 85 shortest_ac_file = chr || "1"; /* initialize */ 86 shortest_bc = 1000000; 87 88 do i = 1 to 9; /* search in order: x1 x2 x3 ... */ 89 call cv_bin_$dec(i, string); /* convert to char. */ 90 ac_file = chr || substr(string, 12, 1); /* form archive name component */ 91 ac_name = ac_file || ".archive"; /* archive file name */ 92 call hcs_$initiate_count(dir, ac_name, "", bc, 1, s, code); /* get bit count and ptr */ 93 p = s; /* copy it: archive_util clobbers ptr */ 94 if code ^= 0 then if code ^= error_table_$segknown then do; 95 if code = error_table_$noentry then do; /* segment not found */ 96 if shortest_bc < 450000 then /* .. about 12 pages */ 97 ac_file = shortest_ac_file; /* return name of shortest file */ 98 rtn_code = 1; /* indicate segment not found in archives */ 99 go to return; 100 end; 101 else /* unexpected error (no dir, etc.) */ 102 go to ac_err; /* abort */ 103 end; 104 call archive_util_$first_element(p, code); /* check file */ 105 if code ^= 0 then /* empty archive or error condition */ 106 go to ck_code; 107 call archive_util_$search(p, q, seg, code); /* search archive for source segment */ 108 ck_code: call hcs_$terminate_noname(s, cd); /* terminate segment */ 109 if code = 0 then do; /* segment found */ 110 rtn_code = 0; /* set return code */ 111 go to return; 112 end; 113 else if code = 1 then /* code 1, segment not found in archive */ 114 if bc < shortest_bc then do; /* remember name and bit count */ 115 shortest_bc = bc; /* .. of shortest archive */ 116 shortest_ac_file = ac_file; 117 end; 118 else; /* null clause */ 119 else do; /* code > 1, error condition */ 120 ac_err: rtn_code = code; /* reflect code to caller */ 121 go to return; 122 end; 123 end; 124 ac_file = shortest_ac_file; /* all 9 archives used, return shortest */ 125 rtn_code = 1; /* indicate segment not found */ 126 go to return; 127 128 129 130 /* return code fudger*/ 131 return: if gls_switch="0"b then return; 132 else do; 133 fd_file=ac_name; 134 return; 135 end; 136 137 138 end get_archive_file_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/12/82 1112.1 get_archive_file_.pl1 >spec>on>11/12/82>get_archive_file_.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. ac_file parameter char(2) unaligned dcl 13 set ref 11 90* 91 96* 116 124* ac_name 000115 automatic char(32) dcl 61 set ref 91* 92* 133 archive_util_$first_element 000010 constant entry external dcl 46 ref 104 archive_util_$search 000012 constant entry external dcl 46 ref 107 bc 000113 automatic fixed bin(24,0) dcl 58 set ref 92* 113 115 cd 000110 automatic fixed bin(17,0) dcl 58 set ref 108* chr 000125 automatic char(1) dcl 61 set ref 84* 85 90 code 000111 automatic fixed bin(17,0) dcl 58 set ref 92* 94 94 95 104* 105 107* 109 113 120 cv_bin_$dec 000014 constant entry external dcl 46 ref 89 dir 000126 automatic char(168) dcl 61 set ref 82* 92* dir_name parameter char unaligned dcl 13 ref 11 73 82 error_table_$noentry 000022 external static fixed bin(17,0) dcl 53 ref 95 error_table_$segknown 000024 external static fixed bin(17,0) dcl 53 ref 94 fd_file parameter char(32) unaligned dcl 18 set ref 73 133* gls_switch 000100 automatic bit(1) unaligned dcl 19 set ref 69* 75* 131 hcs_$initiate_count 000016 constant entry external dcl 46 ref 92 hcs_$terminate_noname 000020 constant entry external dcl 46 ref 108 i 000112 automatic fixed bin(17,0) dcl 58 set ref 88* 89* p 000102 automatic pointer dcl 56 set ref 93* 104* 107* q 000104 automatic pointer dcl 56 set ref 107* rtn_code parameter fixed bin(17,0) dcl 13 set ref 11 73 98* 110* 120* 125* s 000106 automatic pointer dcl 56 set ref 92* 93 108* seg 000200 automatic char(32) dcl 61 set ref 83* 84 107* seg_name parameter char unaligned dcl 13 ref 11 73 83 shortest_ac_file 000210 automatic char(2) dcl 61 set ref 85* 96 116* 124 shortest_bc 000114 automatic fixed bin(24,0) dcl 58 set ref 86* 96 113 115* string 000211 automatic char(12) dcl 61 set ref 89* 90 substr builtin function dcl 17 ref 84 90 NAMES DECLARED BY EXPLICIT CONTEXT. ac_err 000346 constant label dcl 120 ref 95 ck_code 000313 constant label dcl 108 ref 105 crud 000074 constant label dcl 77 ref 70 get_archive_file_ 000023 constant entry external dcl 11 return 000363 constant label dcl 131 ref 99 111 121 126 srchgls 000052 constant entry external dcl 73 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 514 542 373 524 Length 722 373 26 144 121 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME get_archive_file_ 180 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME get_archive_file_ 000100 gls_switch get_archive_file_ 000102 p get_archive_file_ 000104 q get_archive_file_ 000106 s get_archive_file_ 000110 cd get_archive_file_ 000111 code get_archive_file_ 000112 i get_archive_file_ 000113 bc get_archive_file_ 000114 shortest_bc get_archive_file_ 000115 ac_name get_archive_file_ 000125 chr get_archive_file_ 000126 dir get_archive_file_ 000200 seg get_archive_file_ 000210 shortest_ac_file get_archive_file_ 000211 string get_archive_file_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. archive_util_$first_element archive_util_$search cv_bin_$dec hcs_$initiate_count hcs_$terminate_noname THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$noentry error_table_$segknown LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000016 69 000043 70 000044 73 000045 75 000072 77 000074 82 000075 83 000103 84 000110 85 000113 86 000116 88 000120 89 000125 90 000136 91 000150 92 000163 93 000227 94 000231 95 000236 96 000240 98 000250 99 000253 104 000254 105 000265 107 000267 108 000313 109 000324 110 000326 111 000330 113 000331 115 000336 116 000337 118 000345 120 000346 121 000350 123 000351 124 000353 125 000360 126 000362 131 000363 133 000365 134 000372 ----------------------------------------------------------- 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