COMPILATION LISTING OF SEGMENT lisp_segment_manager_ Compiled by: Multics PL/I Compiler, Release 30, of February 16, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 05/31/88 1500.5 mst Tue Options: optimize map 1 /****^ ************************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Massachusetts Institute of Technology, 1973 * 6* * * 7* ************************************************************** */ 8 9 /* format: style3,^ifthenstmt,indthenelse,^indnoniterdo,^indprocbody,dclind5,idind32,ll130 */ 10 11 12 /****^ HISTORY COMMENTS: 13* 1) change(73-11-03,DAM), approve(), audit(), install(): 14* This module (lisp_segment_manager_) manages all temporary segments 15* used by LISP. Completely rewritten. 16* 2) change(80-01-18,JSpencerLove), approve(), audit(), install(): 17* For changes in the PL/1 compiler. 18* 3) change(88-04-06,RBarstad), approve(88-04-17,MCR7874), 19* audit(88-05-31,GWMay), install(88-05-31,MR12.2-1050): 20* Standardize set_list_temp_dir entry for SCP6377. 21* END HISTORY COMMENTS */ 22 23 24 get_lists: 25 proc (sptr); /* entry to get a seg of lists space */ 26 27 type = ListsSeg; 28 mode = RWA; 29 30 /*** search for pre-existing segment of correct type */ 31 32 unallocated_entry = -1; 33 do segx = lbound (lists_table, 1) to hbound (lists_table, 1); 34 if lists_table (segx).segno = ""b 35 then if unallocated_entry < 0 36 then unallocated_entry = segx; 37 else ; 38 else /* segno ^= ""b */ 39 if ^lists_table (segx).allocated 40 then do; 41 42 /*** found segment that can be reused */ 43 44 lists_table (segx).allocated = "1"b; 45 sptr = baseptr (lists_table (segx).segno); 46 return; 47 end; 48 end; 49 50 if unallocated_entry < 0 51 then call table_full; 52 53 /*** create new segment */ 54 55 segx = unallocated_entry; 56 call create_new_segment; 57 lists_table (segx).segno = segno; 58 lists_table (segx).allocated = "1"b; 59 return; 60 61 free_lists: 62 entry (sptr); /* entry to dispose of a seg of lists space */ 63 64 type = ListsSeg; 65 segno = baseno (sptr); 66 67 do segx = lbound (lists_table, 1) to hbound (lists_table, 1); 68 if lists_table (segx).segno = segno 69 then do; /* found it - free it */ 70 71 call flush_seg; 72 lists_table (segx).allocated = "0"b; 73 return; 74 end; 75 end; 76 77 /*** not found in table ?? */ 78 79 call internal_error; 80 81 get_stack: 82 entry (sptr); 83 84 /* entry to allocate a seg for stack purposes. 85* the max length is set so stack overflow can be detected 86* before it's too late */ 87 88 type = StackSeg; 89 mode = RWA; 90 91 /*** search for pre-existing segment of correct type */ 92 93 unallocated_entry = -1; 94 do segx = lbound (stack_table, 1) to hbound (stack_table, 1); 95 if stack_table (segx).segno = ""b 96 then if unallocated_entry < 0 97 then unallocated_entry = segx; 98 else ; 99 else /* segno ^= ""b */ 100 if ^stack_table (segx).allocated 101 then do; 102 103 /*** found segment that can be reused */ 104 105 stack_table (segx).allocated = "1"b; 106 sptr = baseptr (stack_table (segx).segno); 107 if stack_table (segx).single_bound ^= InitialStackSize 108 then call set_initial_max_length; 109 return; 110 end; 111 end; 112 113 if unallocated_entry < 0 114 then call table_full; 115 116 /*** create new segment */ 117 118 segx = unallocated_entry; 119 call create_new_segment; 120 call set_initial_max_length; 121 stack_table (segx).segno = segno; 122 stack_table (segx).allocated = "1"b; 123 return; 124 125 126 set_initial_max_length: 127 proc; 128 129 call hcs_$set_max_length_seg (sptr, InitialStackSize, 0); 130 stack_table (segx).single_bound = InitialStackSize; 131 132 end; 133 134 free_stack: 135 entry (sptr); /* entry to dispose of a stack seg */ 136 137 138 type = StackSeg; 139 segno = baseno (sptr); 140 141 do segx = lbound (stack_table, 1) to hbound (stack_table, 1); 142 if stack_table (segx).segno = segno 143 then do; /* found it - free it */ 144 call flush_seg; 145 stack_table (segx).allocated = "0"b; 146 return; 147 end; 148 end; 149 150 /*** not found in table ?? */ 151 152 call internal_error; 153 154 get_array: 155 entry (sptr); /* entry to get a segment of array space */ 156 157 type = ArraySeg; 158 mode = REWA; /* arrays and subr blocks contain executable code and go in this seg */ 159 160 161 /*** search for pre-existing segment of correct type */ 162 163 unallocated_entry = -1; 164 do segx = lbound (array_table, 1) to hbound (array_table, 1); 165 if array_table (segx).segno = ""b 166 then if unallocated_entry < 0 167 then unallocated_entry = segx; 168 else ; 169 else /* segno ^= ""b */ 170 if ^array_table (segx).allocated 171 then do; 172 173 /*** found segment that can be reused */ 174 175 array_table (segx).allocated = "1"b; 176 sptr = baseptr (array_table (segx).segno); 177 return; 178 end; 179 end; 180 181 if unallocated_entry < 0 182 then call table_full; 183 184 /*** create new segment */ 185 186 segx = unallocated_entry; 187 call create_new_segment; 188 array_table (segx).segno = segno; 189 array_table (segx).allocated = "1"b; 190 return; 191 192 free_array: 193 entry (sptr); /* entry to dispose of a segment of arrays space */ 194 195 type = ArraySeg; 196 segno = baseno (sptr); 197 198 do segx = lbound (array_table, 1) to hbound (array_table, 1); 199 if array_table (segx).segno = segno 200 then do; /* found it - free it */ 201 call flush_seg; 202 array_table (segx).allocated = "0"b; 203 return; 204 end; 205 end; 206 207 /*** not found in table ?? */ 208 209 call internal_error; 210 211 /* subroutines used by the above */ 212 213 flush_seg: 214 proc; 215 216 call hcs_$truncate_seg (sptr, 0, 0); /* next guy who uses seg wants it to be all 0, 217* plus save space in process directory */ 218 end; 219 220 221 222 create_new_segment: 223 proc; 224 225 dcl 1 ename_struc automatic unaligned structure, 226 /* construct entry name here */ 227 2 lisp char (5) init ("lisp."), 228 2 stype char (5), /* filled in with user-specified type */ 229 2 dot char (1) init ("."), 230 2 unique char (15), /* "!BBBsdhasfwhatever" */ 231 ename char (26) unaligned def (ename_struc) pos (1); 232 233 ename_struc.stype = TypeString (type); 234 ename_struc.unique = unique_chars_ (unique_bits_ ()); 235 236 if lisp_temp_dir = "" 237 then lisp_temp_dir = get_pdir_ (); /* initialization/bug in make_seg */ 238 call hcs_$make_seg (lisp_temp_dir, ename, "", mode, sptr, code); 239 if sptr = null 240 then call cannot_make_seg; 241 242 segno = baseno (sptr); 243 sptr = baseptr (segno); /* Goddamn hardcore does not set ring number in pointer */ 244 245 end; 246 247 /* error routines */ 248 249 table_full: 250 proc; 251 252 call ioa_$ioa_switch (iox_$error_output, "^/Error: ^a segment table full in lisp_segment_manager_", TypeString (type)); 253 go to fatal_loss; 254 255 256 internal_error: 257 entry; 258 259 call ioa_$ioa_switch (iox_$error_output, 260 "^/Error: internal inconsistency in ^a segment table found by lisp_segment_manager_", TypeString (type)); 261 go to fatal_loss; 262 263 264 cannot_make_seg: 265 entry; 266 267 dcl long_msg char (100) aligned, 268 brief_msg char (8) aligned; 269 270 call convert_status_code_ (code, brief_msg, long_msg); 271 call ioa_$ioa_switch (iox_$error_output, "^/Error: ^a Trying to create lisp ^a segment in ^a.", long_msg, 272 TypeString (type), lisp_temp_dir); 273 go to fatal_loss; 274 275 276 fatal_loss: 277 call cu_$cl ("1"b); 278 call ioa_$ioa_switch (iox_$error_output, "lisp_segment_manager_: start after fatal error not allowed. Try pi."); 279 go to fatal_loss; 280 281 end; 282 283 /* entries to set and get the maxlength of a stack seg */ 284 285 get_stack_size: 286 entry (st_ptr, st_size); 287 288 dcl st_ptr pointer parameter, 289 st_size fixed bin (18) parameter; 290 291 call find_this_stack; 292 st_size = stack_table (segx).single_bound; 293 return; 294 295 296 set_stack_size: 297 entry (st_ptr, st_size); 298 299 call find_this_stack; 300 cursize = divide (st_size + 1023, 1024, 18, 0) * 1024; /* must be in pages */ 301 if cursize > MaximumStackSize 302 then go to cant_set_stack_size; 303 stptr = st_ptr; 304 call adjust_max_len; 305 if code ^= 0 306 then 307 cant_set_stack_size: 308 st_size = stack_table (segx).single_bound; /* lost - tell caller */ 309 return; 310 311 find_this_stack: 312 proc; 313 314 segno = baseno (st_ptr); 315 do segx = lbound (stack_table, 1) to hbound (stack_table, 1) while (stack_table (segx).segno ^= segno); 316 end; 317 if segx > hbound (stack_table, 1) 318 then do; 319 type = StackSeg; 320 call internal_error; 321 end; 322 323 end find_this_stack; 324 325 adjust_max_len: 326 proc; 327 328 /* set max len of stack(segx). stptr ->, to cursize */ 329 330 dcl truncsize fixed bin (18); 331 332 if baseno (stptr) = baseno (lisp_static_vars_$stack_ptr) 333 then truncsize = fixed (rel (lisp_static_vars_$stack_ptr), 18); 334 else if baseno (stptr) = baseno (lisp_static_vars_$unmkd_ptr) 335 then truncsize = fixed (rel (lisp_static_vars_$unmkd_ptr), 18); 336 else go to notrunc; /* ?? */ 337 338 call hcs_$truncate_seg (stptr, truncsize, code); /* needed before can decrease the max length */ 339 notrunc: 340 call hcs_$set_max_length_seg (stptr, cursize, code); 341 if code = 0 342 then stack_table (segx).single_bound = cursize; 343 end adjust_max_len; 344 345 grow_stacks: 346 entry (a_code); 347 348 /* this entry is called when a stack overflows. an attempt 349* is made to grow the stacks so that a user interrupt 350* may be taken. if the attempt fails, a non-zero code will 351* be returned. */ 352 353 do stptr = lisp_static_vars_$stack_ptr, lisp_static_vars_$unmkd_ptr; 354 355 segno = baseno (stptr); 356 cursize = fixed (rel (stptr), 18); 357 do segx = lbound (stack_table, 1) to hbound (stack_table, 1) while (stack_table (segx).segno ^= segno); 358 end; 359 if segx > hbound (stack_table, 1) 360 then do; 361 type = StackSeg; 362 call internal_error; 363 end; 364 if cursize > stack_table (segx).single_bound - StackSizeIncrement 365 then do; /* this stack needs to be grown */ 366 cursize = stack_table (segx).single_bound + StackSizeIncrement; 367 if cursize > MaximumStackSize 368 then do; /* barf!! we don't want stacks this big */ 369 a_code = error_table_$stack_overflow; 370 return; 371 end; 372 call adjust_max_len; 373 a_code = code; 374 if code ^= 0 375 then return; /* you have lost */ 376 /* prob. up to max size */ 377 end; 378 379 end; 380 381 a_code = 0; /* apparently we won */ 382 return; 383 384 shrink_stacks: 385 entry; 386 387 /* this entry is called after a stack overflow has been processed 388* to put the stacks back to normal max length so that stack 389* overflow can be detected again */ 390 391 do stptr = lisp_static_vars_$stack_ptr, lisp_static_vars_$unmkd_ptr; 392 393 segno = baseno (stptr); 394 do segx = lbound (stack_table, 1) to hbound (stack_table, 1) while (stack_table (segx).segno ^= segno); 395 end; 396 if segx > hbound (stack_table, 1) 397 then return; /* Oh, well. catch error later if really error */ 398 cursize = fixed (rel (stptr), 18); 399 do while (stack_table (segx).single_bound > InitialStackSize 400 & stack_table (segx).single_bound - StackSizeIncrement >= cursize); 401 stack_table (segx).single_bound = stack_table (segx).single_bound - StackSizeIncrement; 402 end; 403 cursize = stack_table (segx).single_bound; 404 call adjust_max_len; 405 end; 406 return; 407 408 set_lisp_temp_dir: 409 entry; 410 411 /* command to change the directory in which lisp temp segs are created. 412* does not move any temp segs that already exist */ 413 414 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 415 dcl pathname_ entry (char (*), char (*)) returns (char (168)); 416 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); 417 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 418 dcl error_table_$bad_arg fixed bin (35) ext static; 419 dcl arg_length fixed bin (21); 420 dcl arg_count fixed bin; 421 dcl arg char (arg_length) based (arg_ptr); 422 dcl arg_ptr ptr; 423 dcl arg_dir char (168); 424 dcl arg_entry char (32); 425 /**** dcl ioa_ entry() options(variable); for debug ****/ 426 427 arg_length = 0; 428 arg_count = 0; 429 arg_ptr = null; 430 arg_dir = ""; 431 arg_entry = ""; 432 code = 0; 433 434 call cu_$arg_count (arg_count, code); 435 if (code ^= 0) | (arg_count > 1) 436 then goto sltd_usage_error; 437 438 if arg_count = 0 /* default to process dir */ 439 then lisp_temp_dir = get_pdir_ (); 440 else do; /* arg_count must be 1 now */ 441 call cu_$arg_ptr (1, arg_ptr, arg_length, code); 442 if code ^= 0 443 then goto sltd_usage_error; 444 445 if (arg = "-pd") | (arg = "-process_dir") 446 then lisp_temp_dir = get_pdir_ (); 447 else if (arg = "-wd") | (arg = "-working_dir") 448 then lisp_temp_dir = get_wdir_ (); 449 /**** else if (arg = "-pr") | (arg = "-print") 450* then call ioa_ ("lisp_temp_dir = ""^a"".", lisp_temp_dir); for debug ****/ 451 else if substr (arg, 1, 1) = "-" 452 then do; 453 code = error_table_$bad_arg; 454 goto sltd_usage_error; 455 end; 456 else do; 457 call expand_pathname_ (arg, arg_dir, arg_entry, code); 458 if code ^= 0 459 then goto sltd_arg_error; 460 lisp_temp_dir = pathname_ (arg_dir, arg_entry); 461 end; 462 end; 463 goto set_lisp_temp_dir_exit; 464 465 sltd_usage_error: 466 call com_err_ (code, "set_lisp_temp_dir", "^/Usage: set_lisp_temp_dir {PATHNAME | -working_dir | -process_dir}"); 467 goto set_lisp_temp_dir_exit; 468 469 sltd_arg_error: 470 call com_err_ (code, "set_lisp_temp_dir", "^a", arg); 471 472 set_lisp_temp_dir_exit: 473 ; 474 return; 475 476 /* D E C L A R A T I O N S */ 477 478 /* Parameters */ 479 480 dcl sptr aligned pointer parameter, 481 /* may be (input) seg to free, or (output) seg that is allocated */ 482 a_code fixed bin (35) parameter; 483 /* (output) if non-zero, grow_stacks did not succeed */ 484 485 /* Automatic Variables */ 486 487 dcl type fixed bin, /* type of segment - StackSeg, ListsSeg, or ArraySeg */ 488 mode fixed bin (5), /* desired access mode (when creating a segment) */ 489 unallocated_entry fixed bin, /* used to remember first free slot in table when searching for new seg */ 490 segno bit (18), /* segment number of segment being gotten or freed */ 491 code fixed bin (35), /* Multics status code */ 492 segx fixed bin, /* index in a segment table */ 493 stptr pointer, /* a stack pointer (in grow_stacks) */ 494 cursize fixed bin (18); /* current (or next) size of segment */ 495 496 /* External Static */ 497 498 dcl lisp_static_vars_$stack_ptr external static pointer, 499 lisp_static_vars_$unmkd_ptr external static pointer; 500 501 dcl error_table_$stack_overflow fixed bin (35) external; 502 503 504 /* Manifest Constants */ 505 506 dcl ( 507 ListsSeg fixed bin init (1), /* code for list-space segment */ 508 ArraySeg fixed bin init (2), /* code for array/subr-block space segment */ 509 StackSeg fixed bin init (3), /* code for stack segment */ 510 TypeString (3) char (5) 511 init (/* printable strings corresponding to above codes */ "lists", "array", "stack"), 512 InitialStackSize fixed bin (18) init (51200), 513 /* 50K - initial max length for stack segments - should be plenty */ 514 StackSizeIncrement fixed bin (18) init (2048), 515 /* two pages should be enough to handle a stack overflow user intr */ 516 MaximumStackSize fixed bin (18) init (65536), 517 /* stack segs limited to this size so can detect oob errors 518* even with 256K segs we don't need that much and this helps to find bugs */ 519 RWA fixed bin (5) init (01011b), 520 /* access mode for stack and lists segments */ 521 REWA fixed bin (5) init (01111b) 522 /* access mode for array segments */ 523 ) internal static; 524 525 526 /* Builtin Functions */ 527 528 dcl (baseno, baseptr, divide, fixed, hbound, lbound, null, rel, substr) 529 builtin; 530 531 532 /* External Entries Called */ 533 534 dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned), 535 hcs_$truncate_seg entry (pointer, fixed bin (18), fixed bin (35)), 536 hcs_$set_max_length_seg entry (pointer, fixed bin (18), fixed bin (35)), 537 ioa_$ioa_switch entry options (variable), 538 iox_$error_output ext ptr, 539 unique_bits_ entry () returns (bit (70)), 540 unique_chars_ entry (bit (*)) returns (char (15)), 541 cu_$cl entry (bit (1) aligned), 542 get_pdir_ entry () returns (char (168)), 543 get_wdir_ entry () returns (char (168)), 544 com_err_ entry options (variable), 545 hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), pointer, fixed bin (35)); 546 547 548 /* Internal Static Data -- segment tables */ 549 550 dcl 1 lists_table (0:395) aligned static,/* Enough for 100,000 records of lists */ 551 2 segno bit (18) unaligned init ((396) (""b)), 552 /* segment number */ 553 2 allocated bit (1) unaligned init ((396) ("0"b)); 554 /* "1"b if someone is using the segment */ 555 556 dcl 1 array_table (0:60) aligned static, /* Enough for 10,000 records of arrays */ 557 2 segno bit (18) unaligned init ((61) (""b)), 558 /* segment number */ 559 2 allocated bit (1) unaligned init ((61) ("0"b)); 560 /* "1"b if someone is using the segment */ 561 562 dcl 1 stack_table (0:11) aligned static, /* Enough for six lisps */ 563 2 segno bit (18) unaligned init ((12) (""b)), 564 /* segment number */ 565 2 allocated bit (1) unaligned init ((12) ("0"b)), 566 /* "1"b if someone is using the segment */ 567 2 single_bound fixed bin (16, -2) unaligned; 568 /* the current setting of the maximum length of this segment */ 569 570 dcl lisp_temp_dir char (168) static init (""); 571 /* pathname of directory in which to keep temp segs. 572* needed since process directory quota is non-negotiable. 573* */ 574 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/31/88 1500.0 lisp_segment_manager_.pl1 >spec>install>1050>lisp_segment_manager_.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. ArraySeg constant fixed bin(17,0) initial dcl 506 ref 157 195 InitialStackSize 000014 internal static fixed bin(18,0) initial dcl 506 set ref 107 129* 130 399 ListsSeg constant fixed bin(17,0) initial dcl 506 ref 27 64 MaximumStackSize constant fixed bin(18,0) initial dcl 506 ref 301 367 REWA constant fixed bin(5,0) initial dcl 506 ref 158 RWA constant fixed bin(5,0) initial dcl 506 ref 28 89 StackSeg constant fixed bin(17,0) initial dcl 506 ref 88 138 319 361 StackSizeIncrement constant fixed bin(18,0) initial dcl 506 ref 364 366 399 401 TypeString 000010 internal static char(5) initial array packed unaligned dcl 506 set ref 233 252* 259* 271* a_code parameter fixed bin(35,0) dcl 480 set ref 345 369* 373* 381* allocated 0(18) 000015 internal static bit(1) initial array level 2 in structure "lists_table" packed packed unaligned dcl 550 in procedure "get_lists" set ref 38 44* 58* 72* allocated 0(18) 000726 internal static bit(1) initial array level 2 in structure "stack_table" packed packed unaligned dcl 562 in procedure "get_lists" set ref 99 105* 122* 145* allocated 0(18) 000631 internal static bit(1) initial array level 2 in structure "array_table" packed packed unaligned dcl 556 in procedure "get_lists" set ref 169 175* 189* 202* arg based char packed unaligned dcl 421 set ref 445 445 447 447 451 457* 469* arg_count 000101 automatic fixed bin(17,0) dcl 420 set ref 428* 434* 435 438 arg_dir 000104 automatic char(168) packed unaligned dcl 423 set ref 430* 457* 460* arg_entry 000156 automatic char(32) packed unaligned dcl 424 set ref 431* 457* 460* arg_length 000100 automatic fixed bin(21,0) dcl 419 set ref 427* 441* 445 445 447 447 451 457 457 469 469 arg_ptr 000102 automatic pointer dcl 422 set ref 429* 441* 445 445 447 447 451 457 469 array_table 000631 internal static structure array level 1 dcl 556 set ref 164 164 198 198 baseno builtin function dcl 528 ref 65 139 196 242 314 332 332 334 334 355 393 baseptr builtin function dcl 528 ref 45 106 176 243 brief_msg 000276 automatic char(8) dcl 267 set ref 270* code 000172 automatic fixed bin(35,0) dcl 487 set ref 238* 270* 305 338* 339* 341 373 374 432* 434* 435 441* 442 453* 457* 458 465* 469* com_err_ 001060 constant entry external dcl 534 ref 465 469 convert_status_code_ 001034 constant entry external dcl 534 ref 270 cu_$arg_count 001022 constant entry external dcl 417 ref 434 cu_$arg_ptr 001020 constant entry external dcl 416 ref 441 cu_$cl 001052 constant entry external dcl 534 ref 276 cursize 000176 automatic fixed bin(18,0) dcl 487 set ref 300* 301 339* 341 356* 364 366* 367 398* 399 403* divide builtin function dcl 528 ref 300 dot 2(18) 000226 automatic char(1) initial level 2 packed packed unaligned dcl 225 set ref 225* ename defined char(26) packed unaligned dcl 225 set ref 238* ename_struc 000226 automatic structure level 1 packed packed unaligned dcl 225 set ref 238 238 error_table_$bad_arg 001024 external static fixed bin(35,0) dcl 418 ref 453 error_table_$stack_overflow 001032 external static fixed bin(35,0) dcl 501 ref 369 expand_pathname_ 001014 constant entry external dcl 414 ref 457 fixed builtin function dcl 528 ref 332 334 356 398 get_pdir_ 001054 constant entry external dcl 534 ref 236 438 445 get_wdir_ 001056 constant entry external dcl 534 ref 447 hbound builtin function dcl 528 ref 33 67 94 141 164 198 315 317 357 359 394 396 hcs_$make_seg 001062 constant entry external dcl 534 ref 238 hcs_$set_max_length_seg 001040 constant entry external dcl 534 ref 129 339 hcs_$truncate_seg 001036 constant entry external dcl 534 ref 216 338 ioa_$ioa_switch 001042 constant entry external dcl 534 ref 252 259 271 278 iox_$error_output 001044 external static pointer dcl 534 set ref 252* 259* 271* 278* lbound builtin function dcl 528 ref 33 67 94 141 164 198 315 357 394 lisp 000226 automatic char(5) initial level 2 packed packed unaligned dcl 225 set ref 225* lisp_static_vars_$stack_ptr 001026 external static pointer dcl 498 ref 332 332 353 391 lisp_static_vars_$unmkd_ptr 001030 external static pointer dcl 498 ref 334 334 353 391 lisp_temp_dir 000742 internal static char(168) initial packed unaligned dcl 570 set ref 236 236* 238* 271* 438* 445* 447* 460* lists_table 000015 internal static structure array level 1 dcl 550 set ref 33 33 67 67 long_msg 000244 automatic char(100) dcl 267 set ref 270* 271* mode 000167 automatic fixed bin(5,0) dcl 487 set ref 28* 89* 158* 238* null builtin function dcl 528 ref 239 429 pathname_ 001016 constant entry external dcl 415 ref 460 rel builtin function dcl 528 ref 332 334 356 398 segno 000631 internal static bit(18) initial array level 2 in structure "array_table" packed packed unaligned dcl 556 in procedure "get_lists" set ref 165 176 188* 199 segno 000015 internal static bit(18) initial array level 2 in structure "lists_table" packed packed unaligned dcl 550 in procedure "get_lists" set ref 34 45 57* 68 segno 000171 automatic bit(18) packed unaligned dcl 487 in procedure "get_lists" set ref 57 65* 68 121 139* 142 188 196* 199 242* 243 314* 315 355* 357 393* 394 segno 000726 internal static bit(18) initial array level 2 in structure "stack_table" packed packed unaligned dcl 562 in procedure "get_lists" set ref 95 106 121* 142 315 357 394 segx 000173 automatic fixed bin(17,0) dcl 487 set ref 33* 34 34 38 44 45* 55* 57 58 67* 68 72* 94* 95 95 99 105 106 107* 118* 121 122 130 141* 142 145* 164* 165 165 169 175 176* 186* 188 189 198* 199 202* 292 305 315* 315* 317 341 357* 357* 359 364 366 394* 394* 396 399 399 401 401 403 single_bound 0(19) 000726 internal static fixed bin(16,-2) array level 2 packed packed unaligned dcl 562 set ref 107 130* 292 305 341* 364 366 399 399 401* 401 403 sptr parameter pointer dcl 480 set ref 24 45* 61 65 81 106* 129* 134 139 154 176* 192 196 216* 238* 239 242 243* st_ptr parameter pointer dcl 288 ref 285 296 303 314 st_size parameter fixed bin(18,0) dcl 288 set ref 285 292* 296 300 305* stack_table 000726 internal static structure array level 1 dcl 562 set ref 94 94 141 141 315 315 317 357 357 359 394 394 396 stptr 000174 automatic pointer dcl 487 set ref 303* 332 334 338* 339* 353* 355 356* 391* 393 398* stype 1(09) 000226 automatic char(5) level 2 packed packed unaligned dcl 225 set ref 233* substr builtin function dcl 528 ref 451 truncsize 000314 automatic fixed bin(18,0) dcl 330 set ref 332* 334* 338* type 000166 automatic fixed bin(17,0) dcl 487 set ref 27* 64* 88* 138* 157* 195* 233 252 259 271 319* 361* unallocated_entry 000170 automatic fixed bin(17,0) dcl 487 set ref 32* 34 34* 50 55 93* 95 95* 113 118 163* 165 165* 181 186 unique 2(27) 000226 automatic char(15) level 2 packed packed unaligned dcl 225 set ref 234* unique_bits_ 001046 constant entry external dcl 534 ref 234 234 unique_chars_ 001050 constant entry external dcl 534 ref 234 NAMES DECLARED BY EXPLICIT CONTEXT. adjust_max_len 002063 constant entry internal dcl 325 ref 304 372 404 cannot_make_seg 001722 constant entry internal dcl 264 ref 239 cant_set_stack_size 000673 constant label dcl 305 ref 301 create_new_segment 001504 constant entry internal dcl 222 ref 56 119 187 fatal_loss 001777 constant label dcl 276 set ref 253 261 273 279 find_this_stack 002031 constant entry internal dcl 311 ref 291 299 flush_seg 001464 constant entry internal dcl 213 ref 71 144 201 free_array 000561 constant entry external dcl 192 free_lists 000265 constant entry external dcl 61 free_stack 000427 constant entry external dcl 134 get_array 000472 constant entry external dcl 154 get_lists 000176 constant entry external dcl 24 get_stack 000330 constant entry external dcl 81 get_stack_size 000626 constant entry external dcl 285 grow_stacks 000707 constant entry external dcl 345 internal_error 001670 constant entry internal dcl 256 ref 79 152 209 320 362 notrunc 002126 constant label dcl 339 ref 334 set_initial_max_length 001435 constant entry internal dcl 126 ref 107 120 set_lisp_temp_dir 001122 constant entry external dcl 408 set_lisp_temp_dir_exit 001433 constant label dcl 472 ref 463 467 set_stack_size 000647 constant entry external dcl 296 shrink_stacks 001017 constant entry external dcl 384 sltd_arg_error 001373 constant label dcl 469 ref 458 sltd_usage_error 001340 constant label dcl 465 ref 435 442 454 table_full 001636 constant entry internal dcl 249 ref 50 113 181 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2534 3620 2160 2544 Length 4102 2160 1064 246 353 1004 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME get_lists 402 external procedure is an external procedure. set_initial_max_length internal procedure shares stack frame of external procedure get_lists. flush_seg internal procedure shares stack frame of external procedure get_lists. create_new_segment internal procedure shares stack frame of external procedure get_lists. table_full internal procedure shares stack frame of external procedure get_lists. find_this_stack internal procedure shares stack frame of external procedure get_lists. adjust_max_len internal procedure shares stack frame of external procedure get_lists. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 TypeString get_lists 000014 InitialStackSize get_lists 000015 lists_table get_lists 000631 array_table get_lists 000726 stack_table get_lists 000742 lisp_temp_dir get_lists STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME get_lists 000100 arg_length get_lists 000101 arg_count get_lists 000102 arg_ptr get_lists 000104 arg_dir get_lists 000156 arg_entry get_lists 000166 type get_lists 000167 mode get_lists 000170 unallocated_entry get_lists 000171 segno get_lists 000172 code get_lists 000173 segx get_lists 000174 stptr get_lists 000176 cursize get_lists 000226 ename_struc create_new_segment 000244 long_msg table_full 000276 brief_msg table_full 000314 truncsize adjust_max_len THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return_mac ext_entry trunc_fx1 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ convert_status_code_ cu_$arg_count cu_$arg_ptr cu_$cl expand_pathname_ get_pdir_ get_wdir_ hcs_$make_seg hcs_$set_max_length_seg hcs_$truncate_seg ioa_$ioa_switch pathname_ unique_bits_ unique_chars_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$stack_overflow iox_$error_output lisp_static_vars_$stack_ptr lisp_static_vars_$unmkd_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 24 000173 27 000203 28 000205 32 000207 33 000211 34 000215 37 000226 38 000227 44 000233 45 000235 46 000242 48 000243 50 000245 55 000250 56 000252 57 000253 58 000260 59 000262 61 000263 64 000272 65 000274 67 000302 68 000307 71 000314 72 000315 73 000321 75 000322 79 000324 81 000325 88 000335 89 000337 93 000341 94 000343 95 000347 98 000360 99 000361 105 000365 106 000367 107 000374 109 000403 111 000404 113 000406 118 000411 119 000413 120 000414 121 000415 122 000422 123 000424 134 000425 138 000434 139 000436 141 000444 142 000451 144 000456 145 000457 146 000463 148 000464 152 000466 154 000467 157 000477 158 000501 163 000503 164 000505 165 000511 168 000522 169 000523 175 000527 176 000531 177 000536 179 000537 181 000541 186 000544 187 000546 188 000547 189 000554 190 000556 192 000557 195 000566 196 000570 198 000576 199 000603 201 000610 202 000611 203 000615 205 000616 209 000620 285 000621 291 000633 292 000634 293 000644 296 000645 299 000654 300 000655 301 000663 303 000665 304 000670 305 000671 309 000703 345 000704 353 000714 355 000722 356 000725 357 000730 358 000742 359 000744 361 000747 362 000751 364 000752 366 000764 367 000770 369 000772 370 000775 372 000776 373 000777 374 001002 379 001003 381 001013 382 001015 384 001016 391 001024 393 001032 394 001035 395 001046 396 001050 398 001053 399 001056 401 001076 402 001103 403 001104 404 001107 405 001110 406 001120 408 001121 427 001127 428 001130 429 001131 430 001133 431 001136 432 001141 434 001142 435 001153 438 001160 441 001172 442 001211 445 001213 447 001235 451 001255 453 001261 454 001264 457 001265 458 001315 460 001317 463 001337 465 001340 467 001372 469 001373 472 001433 474 001434 126 001435 129 001436 130 001453 132 001463 213 001464 216 001465 218 001503 222 001504 225 001505 233 001512 234 001520 236 001545 238 001560 239 001616 242 001624 243 001632 245 001635 249 001636 252 001637 253 001667 256 001670 259 001671 261 001721 264 001722 270 001723 271 001736 273 001776 276 001777 278 002010 279 002030 311 002031 314 002032 315 002040 316 002052 317 002054 319 002057 320 002061 323 002062 325 002063 332 002064 334 002103 338 002114 339 002126 341 002141 343 002153 ----------------------------------------------------------- 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