COMPILATION LISTING OF SEGMENT archive_ Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/19/85 0811.0 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 archive_: proc (); 12 13 /* * ARCHIVE_ -- subroutine entriers for manipulating archives 14* * 15* * archive_$get_component 16* * Returns a pointer to a named archive component, given a pointer to the archive 17* * archive_$get_component_info 18* * Finds a component and returns complete info about it. 19* * archive_$next_component 20* * Returns a pointer to the next component in an archive. 21* * archive_$next_component_info 22* * Returns complete info about the next component. 23* * archive_$list_components 24* * Returns a list of archive components and info. 25* * 26* * 01/13/81, W. Olin Sibert 27* */ 28 /* Fixed bug detecting format error if only one, null, component (archive is just a header) 04/18/85 Steve Herbst */ 29 30 31 /* * Note: this procedure assumes that all archives do, in fact, contain only the strings 32* * archive_data_$ident and archive_data_$header_end to identify their headers. The use 33* * of archive_data_$header_begin and archive_data_$header_end was evidently an improvement 34* * which was never implemented, and can therefore be ignored here. No existing code in 35* * the system generates archives containing either of those strings. The archive command, 36* * in fact, cannot deal with such archives. 37* */ 38 39 dcl P_archive_ptr pointer parameter; /* Input: pointer to archive */ 40 dcl P_archive_bc fixed bin (24) parameter; /* Input: archive bitcount */ 41 /* All entries take the same first two arguments */ 42 dcl P_component_name char (*) parameter; /* Input: component to search for or update */ 43 /* Output for archive_$next_component */ 44 dcl P_component_ptr pointer parameter; /* Output: pointer to base of component */ 45 /* Input/Output for archive_$next_component("" _info) */ 46 dcl P_component_bc fixed bin (24) parameter; /* Output: bitcount of component */ 47 dcl P_archive_component_info_ptr pointer parameter; /* Input: pointer to archive_component_info to fill in */ 48 dcl P_info_version fixed bin parameter; /* Input: version number of listing structure caller wants */ 49 dcl P_area_ptr pointer parameter; /* Input: pointer to area for list */ 50 dcl P_n_components fixed bin; /* Output: number of components in archive */ 51 dcl P_component_list_ptr pointer parameter; /* Output: pointer to array of component infos */ 52 dcl P_code fixed bin (35) parameter; 53 54 dcl archive_ptr pointer; /* Pointer and size of the archive being worked on */ 55 dcl archive_bc fixed bin (24); 56 dcl archive_size fixed bin (19); 57 58 dcl component_name char (32); 59 dcl component_ptr pointer; 60 61 dcl header_ptr pointer; /* All information about the current component */ 62 dcl 1 comp_info like archive_component_info aligned automatic; 63 64 dcl comp_list_ptr pointer; 65 dcl n_components fixed bin; 66 dcl comp_idx fixed bin; 67 dcl 1 comp_list (n_components) like archive_component_info aligned based (comp_list_ptr); 68 dcl output_area_ptr pointer; 69 dcl output_area area based (output_area_ptr); 70 71 dcl info_sw bit (1) aligned; 72 73 dcl convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35)); 74 75 dcl error_table_$archive_fmt_err fixed bin (35) external static; 76 dcl error_table_$bad_arg fixed bin (35) external static; 77 dcl error_table_$no_component fixed bin (35) external static; 78 dcl error_table_$not_archive fixed bin (35) external static; 79 dcl error_table_$unimplemented_version fixed bin (35) external static; 80 81 dcl archive_data_$ident char (8) aligned external static; 82 dcl archive_data_$header_end char (8) aligned external static; 83 84 dcl (addrel, baseno, binary, divide, ltrim, null, pointer, rel, rtrim, size, string, substr, unspec, verify) builtin; 85 86 dcl cleanup condition; 87 88 /* */ 89 90 archive_$get_component: entry (P_archive_ptr, P_archive_bc, P_component_name, P_component_ptr, P_component_bc, P_code); 91 92 P_component_ptr = null (); 93 P_component_bc = 0; 94 info_sw = "0"b; 95 goto GET_COMPONENT_COMMON; 96 97 98 archive_$get_component_info: entry (P_archive_ptr, P_archive_bc, P_component_name, P_archive_component_info_ptr, P_code); 99 100 archive_component_info_ptr = P_archive_component_info_ptr; 101 if archive_component_info.version ^= ARCHIVE_COMPONENT_INFO_VERSION_1 then 102 call FINISH (error_table_$unimplemented_version); 103 104 info_sw = "1"b; 105 goto GET_COMPONENT_COMMON; 106 107 108 GET_COMPONENT_COMMON: 109 call CHECK_ARCHIVE; 110 111 component_name = P_component_name; 112 113 do header_ptr = (NEXT_HEADER_PTR ()) 114 repeat (NEXT_HEADER_PTR ()) 115 while (header_ptr ^= null ()); 116 117 if comp_info.name = component_name then 118 goto FOUND_COMPONENT; 119 end; 120 121 call FINISH (error_table_$no_component); /* never returns */ 122 123 FOUND_COMPONENT: 124 if info_sw then /* only call convert_date_to_binary_ if needful, to */ 125 call GET_ALL_COMPONENT_INFO; /* avoid unnecessary expense. */ 126 127 if ^info_sw then do; /* Return pointer and length */ 128 P_component_ptr = comp_info.comp_ptr; 129 P_component_bc = comp_info.comp_bc; 130 end; 131 else archive_component_info = comp_info; /* Just fill in the structure from our copy */ 132 133 call FINISH (0); /* All done, return successfully */ 134 135 /* */ 136 137 archive_$next_component: entry (P_archive_ptr, P_archive_bc, P_component_ptr, P_component_bc, P_component_name, P_code); 138 139 component_ptr = P_component_ptr; /* Input/Output parameter */ 140 141 P_component_ptr = null (); /* Initialize output arguments */ 142 P_component_bc = 0; 143 P_component_name = ""; 144 info_sw = "0"b; 145 goto NEXT_COMPONENT_COMMON; 146 147 148 archive_$next_component_info: entry (P_archive_ptr, P_archive_bc, P_component_ptr, P_archive_component_info_ptr, P_code); 149 150 component_ptr = P_component_ptr; /* Input/Output parameter */ 151 P_component_ptr = null (); /* Initialize output argument */ 152 archive_component_info_ptr = P_archive_component_info_ptr; 153 if archive_component_info.version ^= ARCHIVE_COMPONENT_INFO_VERSION_1 then 154 call FINISH (error_table_$unimplemented_version); 155 156 info_sw = "1"b; 157 goto NEXT_COMPONENT_COMMON; 158 159 160 NEXT_COMPONENT_COMMON: 161 call CHECK_ARCHIVE; /* Get set up */ 162 163 if baseno (archive_ptr) ^= baseno (component_ptr) then /* Ought to do something about this */ 164 if component_ptr ^= null () then /* But don't reject the "first" flag */ 165 call FINISH (error_table_$bad_arg); 166 167 if component_ptr = null () then /* Set up for NEXT_HEADER_PTR protocol */ 168 header_ptr = null (); 169 else if binary (rel (component_ptr), 18) < size (archive_header) then /* Must be a sensible pointer */ 170 call FINISH (error_table_$bad_arg); 171 else if binary (rel (component_ptr), 18) > archive_size then /* Must not be past the end */ 172 call FINISH (error_table_$bad_arg); 173 else if pointer (component_ptr, rel (component_ptr)) ^= component_ptr then /* Make sure it's a word boundary */ 174 call FINISH (error_table_$bad_arg); 175 else do; 176 header_ptr = addrel (component_ptr, 0 - size (archive_header)); /* Back up the header itself */ 177 call GET_COMPONENT_INFO; 178 end; 179 180 header_ptr = NEXT_HEADER_PTR (); /* get the next one */ 181 182 if header_ptr = null () then do; /* We have run out of components */ 183 if info_sw then do; /* Clear out the comp_info as well */ 184 unspec (archive_component_info) = ""b; 185 archive_component_info.version = ARCHIVE_COMPONENT_INFO_VERSION_1; 186 archive_component_info.comp_ptr = null (); 187 end; 188 else P_component_bc = 0; 189 190 call FINISH (0); /* All done with this archive */ 191 end; 192 193 P_component_ptr = comp_info.comp_ptr; /* Return the Input/Output parameter */ 194 195 if info_sw then do; /* only call convert_date_to_binary_ if needful, to */ 196 call GET_ALL_COMPONENT_INFO; /* avoid unnecessary expense. */ 197 archive_component_info = comp_info; 198 end; 199 200 else do; /* Otherwise, just return pointer and length */ 201 P_component_bc = comp_info.comp_bc; 202 P_component_name = comp_info.name; 203 end; 204 205 call FINISH (0); /* All done, return successfully */ 206 207 /* */ 208 209 archive_$list_components: entry (P_archive_ptr, P_archive_bc, 210 P_info_version, P_area_ptr, P_component_list_ptr, P_n_components, P_code); 211 212 output_area_ptr = P_area_ptr; /* Locate the area we shall allocate the list in */ 213 P_n_components = 0; /* Initialize output arguments */ 214 P_component_list_ptr = null (); 215 216 if P_info_version ^= ARCHIVE_COMPONENT_INFO_VERSION_1 then /* Make sure we agree with the caller */ 217 call FINISH (error_table_$unimplemented_version); /* about the info structure version */ 218 219 call CHECK_ARCHIVE; /* See if it's in the least OK */ 220 221 n_components = 0; /* First, count the components -- this will also validate */ 222 header_ptr = null (); /* the entire archive */ 223 224 do header_ptr = (NEXT_HEADER_PTR ()) 225 repeat (NEXT_HEADER_PTR ()) 226 while (header_ptr ^= null ()); 227 228 n_components = n_components + 1; 229 end; 230 231 if (n_components = 0) | (output_area_ptr = null ()) then do; /* Nothing there, or no list wanted */ 232 P_n_components = n_components; 233 call FINISH (0); /* Return successfully */ 234 end; 235 236 on cleanup begin; 237 if comp_list_ptr ^= null () then 238 free comp_list in (output_area); 239 P_component_list_ptr = null (); /* Don't let user think we didn't free this */ 240 end; 241 242 allocate comp_list in (output_area) set (comp_list_ptr); 243 244 comp_idx = 1; 245 do header_ptr = (NEXT_HEADER_PTR ()) /* Now, go through and list the components */ 246 repeat (NEXT_HEADER_PTR ()) 247 while (header_ptr ^= null ()); 248 249 call GET_ALL_COMPONENT_INFO; /* Fill in the whole thing */ 250 comp_list (comp_idx) = comp_info; /* and put it in the array */ 251 comp_idx = comp_idx + 1; /* Advance to next component */ 252 end; 253 254 P_component_list_ptr = comp_list_ptr; 255 P_n_components = n_components; 256 257 call FINISH (0); /* All done for listing */ 258 259 /* */ 260 261 MAIN_RETURN: /* This label is the only way out of the program */ 262 return; 263 264 FORMAT_ERROR: /* General-purpose format error exit */ 265 if comp_list_ptr ^= null () then /* Clean up anything we might have allocated */ 266 free comp_list; 267 comp_list_ptr = null (); 268 269 call FINISH (error_table_$archive_fmt_err); 270 271 272 273 FINISH: proc (P_return_code); 274 275 dcl P_return_code fixed bin (35) parameter; 276 277 /* This is just a convenient way of exiting and returning a specific error code */ 278 279 P_code = P_return_code; /* Set the main procedure return code */ 280 goto MAIN_RETURN; 281 282 end FINISH; 283 284 285 286 CHECK_ARCHIVE: proc (); 287 288 /* This procedure copies the standard parameters, and verifies that the 289* segment does, indeed, seem to be an archive. */ 290 291 comp_list_ptr = null (); /* For cleanup handler */ 292 archive_ptr = pointer (P_archive_ptr, 0); /* Adjust to base of archive segment */ 293 294 archive_bc = P_archive_bc; 295 archive_size = divide (archive_bc, 36, 19, 0); 296 297 if archive_bc ^= (36 * archive_size) then /* Can't be if bitcount is not word aligned */ 298 call FINISH (error_table_$not_archive); 299 300 header_ptr = null (); /* Make NEXT_HEADER_PTR look for the first */ 301 302 if archive_size = 0 then /* No components is OK, though perhaps undesired */ 303 return; 304 305 if archive_size < size (archive_header) then /* Must have enough to be an archive */ 306 call FINISH (error_table_$not_archive); 307 308 if (archive_ptr -> archive_header.header_begin ^= archive_data_$ident) then 309 call FINISH (error_table_$not_archive); /* Probably not, and this is a better message than */ 310 /* format error if it truly isn't an archive */ 311 312 if (archive_ptr -> archive_header.header_end ^= archive_data_$header_end) then 313 call FINISH (error_table_$not_archive); 314 315 P_code = 0; /* Set standard output parameter for success, and */ 316 return; /* assume it's valid, and let someone else */ 317 end CHECK_ARCHIVE; /* find out that it is not if need be. */ 318 319 /* */ 320 321 NEXT_HEADER_PTR: proc () returns (pointer); 322 323 /* This procedure advances header_ptr to point to the header for the next component, 324* validates the header, and returns the pointer to it. It assumes that header_ptr 325* already points to a validated header, unless it is null, in which case it sets 326* header_ptr to point to the first header in the archive. 327* */ 328 329 if header_ptr = null () then /* First component */ 330 if archive_size = 0 then /* But, archive is empty */ 331 return (null ()); 332 else header_ptr = archive_ptr; /* really first */ 333 else do; 334 if binary (rel (header_ptr), 18) + size (archive_header) + comp_info.comp_lth >= archive_size then 335 return (null ()); /* We have reached the last component */ 336 header_ptr = addrel (header_ptr, (size (archive_header) + comp_info.comp_lth)); 337 end; 338 339 call GET_COMPONENT_INFO; /* make sure this header seems OK, */ 340 /* and extract all the information from it */ 341 return (header_ptr); 342 end NEXT_HEADER_PTR; 343 344 /* */ 345 346 GET_COMPONENT_INFO: proc (); 347 348 /* This procedure ascertains that header_ptr points to something looking 349* reasonably like an archive component header. It verifies as well as it 350* can that the times and the access are valid, although it does not actually 351* calculate them. To fill in those values, GET_ALL_COMPONENT_INFO should be 352* called. 353* */ 354 355 dcl TIME_CHARACTERS char (13) internal static options (constant) init ("0123456789 ./"); 356 dcl MODE_CHARACTERS char (5) internal static options (constant) init ("rewa "); 357 dcl BITCOUNT_CHARS char (10) internal static options (constant) init ("0123456789"); 358 359 360 361 if (header_ptr -> archive_header.header_begin ^= archive_data_$ident) then 362 goto FORMAT_ERROR; 363 364 if (header_ptr -> archive_header.header_end ^= archive_data_$header_end) then 365 goto FORMAT_ERROR; 366 367 /* These machinations with the bitcount are necessary because some archives in the system contain 368* the bitcount left justified in the eight character field, rather than right justified. How they 369* got that way is anybodys guess, but if archive can handle them, this should, too. 370* */ 371 372 if header_ptr -> archive_header.bit_count = "" then 373 goto FORMAT_ERROR; 374 if verify (rtrim (ltrim (header_ptr -> archive_header.bit_count)), BITCOUNT_CHARS) ^= 0 then 375 goto FORMAT_ERROR; 376 377 if verify (header_ptr -> archive_header.timeup, TIME_CHARACTERS) ^= 0 then 378 goto FORMAT_ERROR; 379 if verify (header_ptr -> archive_header.time, TIME_CHARACTERS) ^= 0 then 380 goto FORMAT_ERROR; 381 382 unspec (comp_info) = ""b; 383 comp_info.version = ARCHIVE_COMPONENT_INFO_VERSION_1; /* So it's safer to just return this structure */ 384 comp_info.comp_ptr = addrel (header_ptr, size (archive_header)); /* First data after header structure */ 385 comp_info.comp_bc = binary (ltrim (rtrim (header_ptr -> archive_header.bit_count)), 28); 386 /* Avoid size condition here by using precision 28 */ 387 388 comp_info.name = header_ptr -> archive_header.name; 389 comp_info.comp_lth = divide (comp_info.comp_bc + 35, 36, 18, 0); 390 391 if archive_size < (binary (rel (comp_info.comp_ptr), 18) + comp_info.comp_lth) then 392 goto FORMAT_ERROR; /* component extends past the end, sad to say */ 393 /* This will also catch generally oversize bitcounts */ 394 if verify (header_ptr -> archive_header.mode, MODE_CHARACTERS) ^= 0 then 395 goto FORMAT_ERROR; 396 397 return; 398 end GET_COMPONENT_INFO; 399 400 /* */ 401 402 GET_ALL_COMPONENT_INFO: proc (); 403 404 /* This procedure fills in all the rest of the comp_info structure, which is 405* is only needed by some entrypoints. 406* */ 407 408 dcl 1 mode_str unaligned, /* For mode testing */ 409 2 read char (1) unaligned, 410 2 execute char (1) unaligned, 411 2 write char (1) unaligned, 412 2 pad char (1) unaligned; 413 dcl code fixed bin (35); 414 415 416 string (mode_str) = header_ptr -> archive_header.mode; 417 comp_info.access = ""b; /* Prepare to figure out the access modes */ 418 419 if mode_str.read = "r" then 420 substr (comp_info.access, 1, 1) = "1"b; /* Read */ 421 else if mode_str.read ^= " " then 422 goto FORMAT_ERROR; 423 424 if mode_str.execute = "e" then 425 substr (comp_info.access, 2, 1) = "1"b; /* Execute */ 426 else if mode_str.execute ^= " " then 427 goto FORMAT_ERROR; 428 429 if mode_str.write = "w" then 430 substr (comp_info.access, 3, 1) = "1"b; /* Write */ 431 else if mode_str.write ^= " " then 432 goto FORMAT_ERROR; 433 434 if (mode_str.pad ^= " ") & (mode_str.pad ^= "a") then /* Obsolete -- used to mean append */ 435 goto FORMAT_ERROR; /* Complain if it's wrong, anyway */ 436 437 call convert_date_to_binary_ (string (header_ptr -> archive_header.time), comp_info.time_modified, code); 438 if code ^= 0 then /* Just complain about archive badness, rather than */ 439 goto FORMAT_ERROR; /* whatever specific error it is */ 440 441 call convert_date_to_binary_ (string (header_ptr -> archive_header.timeup), comp_info.time_updated, code); 442 if code ^= 0 then 443 goto FORMAT_ERROR; 444 445 return; 446 end GET_ALL_COMPONENT_INFO; 447 448 /* 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 */ 448 449 /* BEGIN INCLUDE FILE ... archive_component_info.incl.pl1 ... WOS 01/13/81 */ 2 2 /* Structure describing an archive component, used by archive_ */ 2 3 2 4 dcl archive_component_info_ptr pointer; 2 5 2 6 dcl 1 archive_component_info aligned based (archive_component_info_ptr), 2 7 2 version fixed bin, 2 8 2 comp_bc fixed bin (24), 2 9 2 comp_ptr pointer, 2 10 2 name char (32) unaligned, 2 11 2 time_modified fixed bin (71), 2 12 2 time_updated fixed bin (71), 2 13 2 comp_lth fixed bin (19), 2 14 2 access bit (36) unaligned; 2 15 2 16 dcl ARCHIVE_COMPONENT_INFO_VERSION_1 fixed bin internal static options (constant) init (1); 2 17 2 18 /* BEGIN INCLUDE FILE ... archive_component_info.incl.pl1 ... WOS 01/13/81 */ 449 450 451 end archive_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/85 1658.2 archive_.pl1 >spec>on>archive.pbf-04/18/85>archive_.pl1 448 1 02/06/76 1405.1 archive_header.incl.pl1 >ldd>include>archive_header.incl.pl1 449 2 04/16/81 0942.6 archive_component_info.incl.pl1 >ldd>include>archive_component_info.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. ARCHIVE_COMPONENT_INFO_VERSION_1 constant fixed bin(17,0) initial dcl 2-16 ref 101 153 185 216 383 BITCOUNT_CHARS 000000 constant char(10) initial unaligned dcl 357 ref 374 MODE_CHARACTERS 000004 constant char(5) initial unaligned dcl 356 ref 394 P_archive_bc parameter fixed bin(24,0) dcl 40 ref 90 98 137 148 209 294 P_archive_component_info_ptr parameter pointer dcl 47 ref 98 100 148 152 P_archive_ptr parameter pointer dcl 39 ref 90 98 137 148 209 292 P_area_ptr parameter pointer dcl 49 ref 209 212 P_code parameter fixed bin(35,0) dcl 52 set ref 90 98 137 148 209 279* 315* P_component_bc parameter fixed bin(24,0) dcl 46 set ref 90 93* 129* 137 142* 188* 201* P_component_list_ptr parameter pointer dcl 51 set ref 209 214* 239* 254* P_component_name parameter char unaligned dcl 42 set ref 90 98 111 137 143* 202* P_component_ptr parameter pointer dcl 44 set ref 90 92* 128* 137 139 141* 148 150 151* 193* P_info_version parameter fixed bin(17,0) dcl 48 ref 209 216 P_n_components parameter fixed bin(17,0) dcl 50 set ref 209 213* 232* 255* P_return_code parameter fixed bin(35,0) dcl 275 ref 273 279 TIME_CHARACTERS 000006 constant char(13) initial unaligned dcl 355 ref 377 379 access 21 000120 automatic bit(36) level 2 packed unaligned dcl 62 set ref 417* 419* 424* 429* addrel builtin function dcl 84 ref 176 336 384 archive_bc 000102 automatic fixed bin(24,0) dcl 55 set ref 294* 295 297 archive_component_info based structure level 1 dcl 2-6 set ref 131* 184* 197* archive_component_info_ptr 000160 automatic pointer dcl 2-4 set ref 100* 101 131 152* 153 184 185 186 197 archive_data_$header_end 000026 external static char(8) dcl 82 ref 312 364 archive_data_$ident 000024 external static char(8) dcl 81 ref 308 361 archive_header based structure level 1 dcl 1-4 ref 169 176 305 334 336 384 archive_ptr 000100 automatic pointer dcl 54 set ref 163 292* 308 312 332 archive_size 000103 automatic fixed bin(19,0) dcl 56 set ref 171 295* 297 302 305 329 334 391 baseno builtin function dcl 84 ref 163 163 binary builtin function dcl 84 ref 169 171 334 385 391 bit_count 25 based char(8) level 2 dcl 1-4 ref 372 374 385 cleanup 000152 stack reference condition dcl 86 ref 236 code 000233 automatic fixed bin(35,0) dcl 413 set ref 437* 438 441* 442 comp_bc 1 000120 automatic fixed bin(24,0) level 2 dcl 62 set ref 129 201 385* 389 comp_idx 000145 automatic fixed bin(17,0) dcl 66 set ref 244* 250 251* 251 comp_info 000120 automatic structure level 1 dcl 62 set ref 131 197 250 382* comp_list based structure array level 1 dcl 67 set ref 237 242 250* 264 comp_list_ptr 000142 automatic pointer dcl 64 set ref 237 237 242* 250 254 264 264 267* 291* comp_lth 20 000120 automatic fixed bin(19,0) level 2 dcl 62 set ref 334 336 389* 391 comp_ptr 2 based pointer level 2 in structure "archive_component_info" dcl 2-6 in procedure "archive_" set ref 186* comp_ptr 2 000120 automatic pointer level 2 in structure "comp_info" dcl 62 in procedure "archive_" set ref 128 193 384* 391 component_name 000104 automatic char(32) unaligned dcl 58 set ref 111* 117 component_ptr 000114 automatic pointer dcl 59 set ref 139* 150* 163 163 167 169 171 173 173 173 176 convert_date_to_binary_ 000010 constant entry external dcl 73 ref 437 441 divide builtin function dcl 84 ref 295 389 error_table_$archive_fmt_err 000012 external static fixed bin(35,0) dcl 75 set ref 269* error_table_$bad_arg 000014 external static fixed bin(35,0) dcl 76 set ref 163* 169* 171* 173* error_table_$no_component 000016 external static fixed bin(35,0) dcl 77 set ref 121* error_table_$not_archive 000020 external static fixed bin(35,0) dcl 78 set ref 297* 305* 308* 312* error_table_$unimplemented_version 000022 external static fixed bin(35,0) dcl 79 set ref 101* 153* 216* execute 0(09) 000232 automatic char(1) level 2 packed unaligned dcl 408 set ref 424 426 header_begin based char(8) level 2 dcl 1-4 ref 308 361 header_end 27 based char(8) level 2 dcl 1-4 ref 312 364 header_ptr 000116 automatic pointer dcl 61 set ref 113* 113* 167* 176* 180* 182 222* 224* 224* 245* 245* 300* 329 332* 334 336* 336 341 361 364 372 374 377 379 384 385 388 394 416 437 437 441 441 info_sw 000150 automatic bit(1) dcl 71 set ref 94* 104* 123 127 144* 156* 183 195 ltrim builtin function dcl 84 ref 374 385 mode 17 based char(4) level 2 dcl 1-4 ref 394 416 mode_str 000232 automatic structure level 1 packed unaligned dcl 408 set ref 416* n_components 000144 automatic fixed bin(17,0) dcl 65 set ref 221* 228* 228 231 232 237 242 255 264 name 3 based char(32) level 2 in structure "archive_header" dcl 1-4 in procedure "archive_" ref 388 name 4 000120 automatic char(32) level 2 in structure "comp_info" packed unaligned dcl 62 in procedure "archive_" set ref 117 202 388* null builtin function dcl 84 ref 92 113 141 151 163 167 167 182 186 214 222 224 231 237 239 245 264 267 291 300 329 329 334 output_area based area(1024) dcl 69 ref 237 242 output_area_ptr 000146 automatic pointer dcl 68 set ref 212* 231 237 242 pad 0(27) 000232 automatic char(1) level 2 packed unaligned dcl 408 set ref 434 434 pointer builtin function dcl 84 ref 173 292 read 000232 automatic char(1) level 2 packed unaligned dcl 408 set ref 419 421 rel builtin function dcl 84 ref 169 171 173 334 391 rtrim builtin function dcl 84 ref 374 385 size builtin function dcl 84 ref 169 176 305 334 336 384 string builtin function dcl 84 set ref 416* 437 437 441 441 substr builtin function dcl 84 set ref 419* 424* 429* time 20 based char(16) level 2 dcl 1-4 ref 379 437 437 time_modified 14 000120 automatic fixed bin(71,0) level 2 dcl 62 set ref 437* time_updated 16 000120 automatic fixed bin(71,0) level 2 dcl 62 set ref 441* timeup 13 based char(16) level 2 dcl 1-4 ref 377 441 441 unspec builtin function dcl 84 set ref 184* 382* verify builtin function dcl 84 ref 374 377 379 394 version based fixed bin(17,0) level 2 in structure "archive_component_info" dcl 2-6 in procedure "archive_" set ref 101 153 185* version 000120 automatic fixed bin(17,0) level 2 in structure "comp_info" dcl 62 in procedure "archive_" set ref 383* write 0(18) 000232 automatic char(1) level 2 packed unaligned dcl 408 set ref 429 431 NAMES DECLARED BY EXPLICIT CONTEXT. CHECK_ARCHIVE 000732 constant entry internal dcl 286 ref 108 160 219 FINISH 000725 constant entry internal dcl 273 ref 101 121 133 153 163 169 171 173 190 205 216 233 257 269 297 305 308 312 FORMAT_ERROR 000703 constant label dcl 264 ref 361 364 372 374 377 379 391 394 421 426 431 434 438 442 FOUND_COMPONENT 000172 constant label dcl 123 ref 117 GET_ALL_COMPONENT_INFO 001304 constant entry internal dcl 402 ref 123 196 249 GET_COMPONENT_COMMON 000134 constant label dcl 108 ref 95 105 GET_COMPONENT_INFO 001076 constant entry internal dcl 346 ref 177 339 MAIN_RETURN 000702 constant label dcl 261 ref 280 NEXT_COMPONENT_COMMON 000330 constant label dcl 160 ref 145 157 NEXT_HEADER_PTR 001035 constant entry internal dcl 321 ref 113 119 180 224 229 245 252 archive_ 000027 constant entry external dcl 11 archive_$get_component 000043 constant entry external dcl 90 archive_$get_component_info 000076 constant entry external dcl 98 archive_$list_components 000522 constant entry external dcl 209 archive_$next_component 000222 constant entry external dcl 137 archive_$next_component_info 000270 constant entry external dcl 148 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2536 2566 2260 2546 Length 3032 2260 30 227 256 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME archive_ 354 external procedure is an external procedure. on unit on line 236 64 on unit FINISH internal procedure shares stack frame of external procedure archive_. CHECK_ARCHIVE internal procedure shares stack frame of external procedure archive_. NEXT_HEADER_PTR internal procedure shares stack frame of external procedure archive_. GET_COMPONENT_INFO internal procedure shares stack frame of external procedure archive_. GET_ALL_COMPONENT_INFO internal procedure shares stack frame of external procedure archive_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME archive_ 000100 archive_ptr archive_ 000102 archive_bc archive_ 000103 archive_size archive_ 000104 component_name archive_ 000114 component_ptr archive_ 000116 header_ptr archive_ 000120 comp_info archive_ 000142 comp_list_ptr archive_ 000144 n_components archive_ 000145 comp_idx archive_ 000146 output_area_ptr archive_ 000150 info_sw archive_ 000160 archive_component_info_ptr archive_ 000232 mode_str GET_ALL_COMPONENT_INFO 000233 code GET_ALL_COMPONENT_INFO THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc return enable ext_entry ext_entry_desc int_entry any_to_any_tr alloc_based free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. convert_date_to_binary_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. archive_data_$header_end archive_data_$ident error_table_$archive_fmt_err error_table_$bad_arg error_table_$no_component error_table_$not_archive error_table_$unimplemented_version LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000026 90 000034 92 000064 93 000066 94 000067 95 000070 98 000071 100 000113 101 000117 104 000131 105 000133 108 000134 111 000135 113 000145 117 000154 119 000160 121 000163 123 000172 127 000175 128 000177 129 000201 130 000203 131 000204 133 000210 137 000213 139 000243 141 000246 142 000250 143 000251 144 000261 145 000262 148 000263 150 000302 151 000305 152 000307 153 000313 156 000325 157 000327 160 000330 163 000331 167 000353 169 000362 171 000400 173 000412 176 000432 177 000436 180 000437 182 000441 183 000445 184 000447 185 000453 186 000455 187 000457 188 000460 190 000461 193 000464 195 000466 196 000470 197 000471 198 000475 201 000476 202 000500 205 000510 209 000513 212 000532 213 000536 214 000537 216 000541 219 000553 221 000554 222 000555 224 000557 228 000566 229 000567 231 000572 232 000600 233 000603 236 000606 237 000622 239 000633 240 000637 242 000640 244 000646 245 000650 249 000656 250 000657 251 000666 252 000667 254 000672 255 000675 257 000677 261 000702 264 000703 267 000713 269 000715 451 000724 273 000725 279 000727 280 000731 286 000732 291 000733 292 000735 294 000741 295 000743 297 000745 300 000757 302 000761 305 000764 308 000775 312 001014 315 001033 316 001034 321 001035 329 001037 332 001050 334 001053 336 001064 339 001071 341 001072 346 001076 361 001077 364 001110 372 001117 374 001125 377 001163 379 001175 382 001207 383 001212 384 001214 385 001217 388 001255 389 001261 391 001264 394 001271 397 001303 402 001304 416 001305 417 001310 419 001311 421 001321 424 001323 426 001334 429 001336 431 001347 434 001351 437 001360 438 001407 441 001411 442 001441 445 001443 ----------------------------------------------------------- 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