COMPILATION LISTING OF SEGMENT apl_load_command_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 11/29/83 1609.1 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright (c) 1972 by Massachusetts Institute of * 5* * Technology and Honeywell Information Systems, Inc. * 6* * * 7* * * 8* ****************************************************** */ 9 10 /* Procedure to )LOAD an APL workspace. 11* Richard S. Lamson, August 1973. 12* 13* Artificial respiration and external heart massage applied 10/9/73, by PG 14* Modified for Version 3 workspaces by PG, 12/4/73 15* Modified 740430 by PG for )COPY and )PCOPY 16* Modified 740621 by PG to fix loading of boolean values and alignment of numeric values 17* Modified 741010 by PG to check for zero-length refer, to check for 18* copying into pendent function, to fix "not copied" msg, and to use new names. 19* Modified 741119 by PG to fix )COPY to push a save frame first. 20* Modified 750723 by PG to not load width, check for non-symbol beads in load_symbol, and enable 21* loading of localized variables. 22* Modified 761011 by PG to use new parse_frame declaration, and be able to load both version 3 and 23* version 4 (new saved_pf declaration) workspaces. 24* Modified 780523 by William York to let apl_storage_manager_ handle storage allocation by itself, 25* with no unnecessary help from the load command. 26* Modified 780901 by PG to fix 329 (apl refuses to enter apl if continue workspace is locked!). 27* Modified 781220 by PG to fix 330 (load and copy didn't terminate segments), and 226 (poor error msgs). 28* Modified 790131 by PG to fix 351 (copy didn't ignore symbols with no meaning, thus clobbering existing symbols). 29* Modified 790814 by PG to fix 412 (load didn't set function_bead.lexed_function_bead_ptr for functions 30* on the SI, and load_bead didn't update loaded_bead_table for anything!) 31* modified 811210 by TO to use APL search paths. 32**/ 33 34 apl_load_command_: 35 procedure (bv_wsid, bv_lock, bv_code); 36 37 /* program */ 38 39 autoload = "0"b; 40 go to join; 41 42 apl_load_command_$autoload: 43 entry (bv_wsid, bv_lock, bv_code); 44 45 autoload = "1"b; 46 47 join: 48 fcbp = null; 49 loaded_bead_table_pointer = null; 50 51 on cleanup 52 call clean_up; /* give back our temp seg. */ 53 54 call initialize_load_command (bv_code); 55 if bv_code ^= 0 56 then do; 57 if ^(autoload & bv_wsid = "continue" & bv_code = error_table_$noentry) 58 then do; 59 call convert_status_code_ (bv_code, short_msg, long_msg); 60 call ioa_$ioa_switch (apl_static_$apl_output, "apl: ^a ^a^[>^]^a", long_msg, dname, 61 (dname ^= ">" & ename ^= ""), ename); 62 end; 63 64 if autoload 65 then bv_code = apl_error_table_$cant_autoload; 66 67 call clean_up; 68 return; 69 end; 70 71 /* The following values are session parameters, not workspace parameters, and hence 72* do not get cleared or loaded: tabs, width, check mode, error mode, and everything in 73* ws_info.switches. */ 74 75 call apl_clear_workspace_; 76 77 ws_info.digits = saved_ws_info.digits; 78 ws_info.index_origin = saved_ws_info.index_origin; 79 ws_info.random_link = saved_ws_info.random_link; 80 ws_info.fuzz = saved_ws_info.fuzz; 81 ws_info.float_index_origin = saved_ws_info.float_index_origin; 82 ws_info.integer_fuzz = saved_ws_info.integer_fuzz; 83 ws_info.lock = saved_ws_info.lock; 84 ws_info.wsid = bv_wsid; 85 86 saved_symbol_count = saved_ws_info.number_of_symbols; 87 88 do symbol_number = 1 to saved_symbol_count; 89 call load_symbol (symbol_number); 90 end; 91 92 do symbol_number = 1 to saved_symbol_count; 93 loaded_bead_pointer (symbol_number) -> symbol_bead.meaning_pointer = 94 load_bead (loaded_bead_pointer (symbol_number) -> symbol_bead.meaning_pointer -> saved_sb.meaning_pointer) 95 ; 96 end; /* meaning_pointer points to saved copy of symbol_bead (set by load_symbol) */ 97 98 ws_info.latent_expression = load_bead (saved_ws_info.latent_expression); 99 100 parse_frame_ptr = ws_info.current_parse_frame_ptr; 101 previous_frame_pointer = null; 102 103 do saved_frame_pointer = un_pseudo_pointer (saved_ws_info.current_parse_frame_ptr) 104 repeat (un_pseudo_pointer (saved_pf.last_parse_frame_ptr)) while (saved_frame_pointer ^= null); 105 106 parse_frame.last_parse_frame_ptr = previous_frame_pointer; 107 parse_frame.parse_frame_type, frame_type = saved_pf.parse_frame_type; 108 109 go to load_frame (frame_type); 110 111 load_frame (5): /* SAVE FRAME */ 112 parse_frame_ptr -> save_frame.saved_symbol_count, symbol_count = saved_sf.saved_symbol_count; 113 114 do symbol_number = 1 to symbol_count; 115 parse_frame_ptr -> save_frame.symbol_pointer (symbol_number) = 116 load_bead (saved_sf.symbol_pointer (symbol_number)); 117 118 parse_frame_ptr -> save_frame.saved_meaning_pointer (symbol_number) = 119 load_bead (saved_sf.saved_meaning_pointer (symbol_number)); 120 121 parse_frame_ptr -> save_frame.global_meaning_pointer_pointer (symbol_number) = null; 122 end; 123 124 previous_frame_pointer = parse_frame_ptr; 125 parse_frame_ptr = addr (parse_frame_ptr -> save_frame.symbol_pointer (symbol_count + 1)); 126 go to next_frame; 127 128 load_frame (1): /* SUSPENDED FRAME */ 129 load_frame (3): /* EVALUATED FRAME */ 130 if saved_ws_info.save_version = 3 131 then do; 132 source_length, 133 addr (parse_frame.old_meaning_ptrs (1)) -> suspended_source_length = 134 addr (v3_saved_pf.old_meaning_ptrs (1)) -> suspended_source_length; 135 136 addr (parse_frame.old_meaning_ptrs (2)) -> suspended_source = 137 addr (v3_saved_pf.old_meaning_ptrs (2)) -> suspended_source; 138 end; 139 else do; /* v4 */ 140 source_length, 141 addr (parse_frame.old_meaning_ptrs (1)) -> suspended_source_length = 142 addr (saved_pf.old_meaning_ptrs (1)) -> suspended_source_length; 143 144 addr (parse_frame.old_meaning_ptrs (2)) -> suspended_source = 145 addr (saved_pf.old_meaning_ptrs (2)) -> suspended_source; 146 end; 147 148 number_of_ptrs = divide (source_length + 3, 4, 21, 0) + 1; 149 150 /* Top frame source is of form ")save xxx", or some sort of function call, 151* in the case where the workspace has been saved during quad-input, 152* or after an error. */ 153 154 if saved_pf.re_lex_source = "0"b 155 then do; 156 parse_frame.lexed_function_bead_ptr = null; 157 parse_frame.function_bead_ptr = null; 158 go to copy_other_stuff; 159 end; 160 161 call apl_line_lex_ (addr (parse_frame.old_meaning_ptrs (2)) -> suspended_source, 162 parse_frame.lexed_function_bead_ptr, errors_occurred, 0, (temporary_bead_pointer)); 163 164 if errors_occurred 165 then go to fatal_error; 166 167 go to copy_other_stuff; 168 169 load_frame (2): /* FUNCTION FRAME */ 170 parse_frame.function_bead_ptr = load_bead (saved_pf.function_bead_ptr); 171 172 call apl_function_lex_ (parse_frame.function_bead_ptr -> function_bead.text, 173 bead_pointer, errors_occurred, 0, (temporary_bead_pointer)); 174 175 if errors_occurred 176 then go to fatal_error; 177 178 parse_frame.lexed_function_bead_ptr = bead_pointer; 179 parse_frame.function_bead_ptr -> function_bead.lexed_function_bead_pointer = bead_pointer; 180 bead_pointer -> lexed_function_bead.reference_count = bead_pointer -> lexed_function_bead.reference_count + 1; 181 182 number_of_ptrs = parse_frame.lexed_function_bead_ptr -> lexed_function_bead.number_of_localized_symbols; 183 do symbol_number = 1 to number_of_ptrs; /* load old meanings of localized symbols */ 184 if saved_ws_info.save_version = 3 185 then temp_symbol = v3_saved_pf.old_meaning_ptrs (symbol_number); 186 else temp_symbol = saved_pf.old_meaning_ptrs (symbol_number); 187 188 parse_frame.old_meaning_ptrs (symbol_number) = load_bead (temp_symbol); 189 end; 190 go to copy_other_stuff; 191 192 load_frame (4): /* EXECUTE FRAME */ 193 /*** reductions_pointer = ????? */ 194 bead_pointer = reduction_stack (parseme_count - 2).semantics; 195 data_elements = bead_pointer -> value_bead.total_data_elements; 196 197 call apl_execute_lex_ (bead_pointer -> value_bead.data_pointer -> character_string_overlay, 198 parse_frame.lexed_function_bead_ptr, errors_occurred, 0, (temporary_bead_pointer)); 199 200 if errors_occurred 201 then go to fatal_error; 202 203 number_of_ptrs = 0; 204 205 copy_other_stuff: 206 reductions_pointer = addrel (parse_frame_ptr, size (parse_frame)); 207 if saved_ws_info.save_version = 3 208 then saved_reductions_pointer = addr (v3_saved_pf.old_meaning_ptrs (number_of_ptrs + 1)); 209 else saved_reductions_pointer = addr (saved_pf.old_meaning_ptrs (number_of_ptrs + 1)); 210 211 parse_frame.reduction_stack_ptr = reductions_pointer; 212 parseme_count, parse_frame.current_parseme = saved_pf.current_parseme; 213 parse_frame.current_lexeme = saved_pf.current_lexeme; 214 parse_frame.current_line_number = saved_pf.current_line_number; 215 216 if saved_pf.return_point = 0 /* gone...but equivalent to another point */ 217 then parse_frame.return_point = 8; 218 else parse_frame.return_point = saved_pf.return_point; 219 220 parse_frame.put_result = saved_pf.put_result; 221 parse_frame.print_final_value = saved_pf.print_final_value; 222 parse_frame.initial_value_stack_ptr = ws_info.value_stack_ptr; 223 parse_frame.number_of_ptrs = number_of_ptrs; 224 225 do reduction_number = 1 to parseme_count; 226 reduction_stack.type (reduction_number), reduction_type = saved_rs (reduction_number).type; 227 228 unspec (reduction_stack (reduction_number).bits) = unspec (saved_rs (reduction_number).bits); 229 230 load_this_one = "0"b; 231 232 if reduction_type = op_type 233 then if reduction_stack (reduction_number).function | reduction_stack (reduction_number).has_list 234 then load_this_one = "1"b; 235 else if reduction_stack (reduction_number).semantics_valid 236 then reduction_stack_for_op (reduction_number).semantics = 237 saved_rs_for_op (reduction_number).semantics; 238 else ; 239 else load_this_one = "1"b; 240 241 if load_this_one 242 then do; 243 if reduction_stack (reduction_number).semantics_valid 244 then if reduction_stack (reduction_number).semantics_on_stack 245 then reduction_stack (reduction_number).semantics = 246 load_bead_on_stack (saved_rs (reduction_number).semantics); 247 else reduction_stack (reduction_number).semantics = 248 load_bead (saved_rs (reduction_number).semantics); 249 end; 250 251 reduction_stack (reduction_number).lexeme = saved_rs (reduction_number).lexeme; 252 end; 253 254 previous_frame_pointer = parse_frame_ptr; 255 parse_frame_ptr = addr (reduction_stack (parseme_count + 1)); 256 257 next_frame: 258 end; 259 260 ws_info.current_parse_frame_ptr = previous_frame_pointer; 261 262 call apl_destroy_save_frame_; 263 call clean_up; 264 265 non_local_return: 266 return; 267 268 fatal_error: 269 call clean_up; 270 call apl_system_error_ (apl_error_table_$cant_load_ws); 271 return; 272 273 apl_copy_command_: 274 entry (bv_wsid, bv_lock, bv_protected, bv_names, bv_number_of_names, bv_code); 275 276 /* parameters */ 277 278 declare ( 279 bv_protected bit (1) aligned, 280 bv_number_of_names fixed bin, 281 bv_names char (*) dim (*) 282 ) parameter; 283 284 /* program */ 285 286 not_found = ""; 287 not_copied = ""; 288 fcbp = null; 289 loaded_bead_table_pointer = null; 290 autoload = "0"b; 291 292 on cleanup 293 call clean_up; 294 295 call initialize_load_command (bv_code); 296 if bv_code ^= 0 297 then do; 298 call convert_status_code_ (bv_code, short_msg, long_msg); 299 call ioa_$ioa_switch (apl_static_$apl_output, "apl: ^a ^a^[>^]^a", long_msg, dname, 300 (dname ^= ">" & ename ^= ""), ename); 301 call clean_up; 302 return; 303 end; 304 305 call apl_create_save_frame_ (); 306 307 saved_symbol_count = saved_ws_info.number_of_symbols; 308 309 if bv_number_of_names = 0 310 then do; 311 /* copy all names */ 312 313 do symbol_index = 1 to saved_symbol_count; 314 symbol_pointer = un_pseudo_pointer (bead_description_table (symbol_index).bead_pointer); 315 316 if symbol_pointer -> saved_general_bead.type.symbol 317 then if symbol_pointer -> saved_sb.meaning_pointer ^= 0 318 /* ignore if no meaning */ 319 then call copy (symbol_pointer); 320 end; 321 end; 322 else do; 323 /* selected copy */ 324 325 do copy_index = 1 to bv_number_of_names; 326 found = "0"b; 327 do symbol_index = 1 to saved_symbol_count while (^found); 328 symbol_pointer = un_pseudo_pointer (bead_description_table (symbol_index).bead_pointer); 329 if symbol_pointer -> saved_general_bead.type.symbol 330 then if symbol_pointer -> saved_sb.meaning_pointer ^= 0 331 /* ignore if no meaning */ 332 then if bv_names (copy_index) = symbol_pointer -> saved_sb.name 333 then do; 334 call copy (symbol_pointer); 335 found = "1"b; 336 end; 337 end; 338 339 if ^found 340 then call not_found_ (before (bv_names (copy_index), " ")); 341 end; 342 end; 343 344 if length (not_found) ^= 0 345 then do; 346 not_found = not_found || nl; 347 call iox_$put_chars (apl_static_$apl_output, addrel (addr (not_found), 1), length (not_found), code); 348 end; 349 350 if length (not_copied) ^= 0 351 then do; 352 not_copied = not_copied || nl; 353 call iox_$put_chars (apl_static_$apl_output, addrel (addr (not_copied), 1), length (not_copied), code); 354 end; 355 356 call apl_destroy_save_frame_update_; 357 call clean_up; 358 return; 359 360 initialize_load_command: 361 procedure (bv_code); 362 363 /* parameters */ 364 365 dcl bv_code fixed bin (35) parameter; 366 367 /* program */ 368 369 call apl_translate_pathname_$use_search_paths (bv_wsid, dname, ename, fcbp, bv_code); 370 if bv_code ^= 0 371 then do; 372 dname = bv_wsid; /* setup for error msg printer. */ 373 ename = ""; 374 return; 375 end; 376 377 if ws_info.restrict_load_directory 378 then if dname ^= get_wdir_ () 379 then do; 380 bv_code = apl_error_table_$ws_dir_restricted; 381 return; 382 end; 383 384 call msf_manager_$get_ptr (fcbp, 0, "0"b, ws_segment (0), (0), bv_code); 385 if ws_segment (0) = null 386 then return; 387 388 saved_ws_info_pointer = ws_segment (0); 389 390 do component = 1 to saved_ws_info.highest_segment; 391 call msf_manager_$get_ptr (fcbp, component, "0"b, ws_segment (component), (0), bv_code); 392 if ws_segment (component) = null 393 then return; 394 end; 395 396 if saved_ws_info.save_version < 3 | saved_ws_info.save_version > 4 397 then do; 398 bv_code = apl_error_table_$ws_wrong_version; 399 return; 400 end; 401 402 if saved_ws_info.lock ^= bv_lock 403 then do; 404 bv_code = apl_error_table_$ws_locked; 405 return; 406 end; 407 408 call ioa_$ioa_switch (apl_static_$apl_output, "saved ^a", apl_date_time_ (saved_ws_info.time_saved)); 409 410 bead_description_pointer = un_pseudo_pointer (saved_ws_info.bead_table_pointer); 411 412 loaded_bead_table_pointer = apl_segment_manager_$get (); 413 temporary_bead_pointer = addrel (loaded_bead_table_pointer, saved_ws_info.total_beads); 414 415 bv_code = 0; 416 417 do bead_number = 1 to saved_ws_info.total_beads; 418 loaded_bead_pointer (bead_number) = null; 419 end; 420 421 return; 422 423 end /* initialize_load_command */; 424 425 clean_up: 426 procedure; 427 428 if loaded_bead_table_pointer ^= null 429 then do; 430 call apl_segment_manager_$free (loaded_bead_table_pointer); 431 loaded_bead_table_pointer = null; 432 end; 433 434 if fcbp ^= null 435 then do; 436 call msf_manager_$close (fcbp); 437 fcbp = null; 438 end; 439 return; 440 441 end clean_up; 442 443 not_copied_: 444 procedure (name); 445 446 /* parameters */ 447 448 declare name char (*) parameter; 449 450 /* program */ 451 452 if length (not_copied) = 0 453 then not_copied = "not copied: "; 454 455 if length (not_copied) + length (name) + 1 > ws_info.width 456 then do; 457 not_copied = not_copied || nl; 458 call iox_$put_chars (apl_static_$apl_output, addrel (addr (not_copied), 1), length (not_copied), code); 459 not_copied = "not copied: "; 460 end; 461 462 not_copied = not_copied || " "; 463 464 not_copied = not_copied || name; 465 466 return; 467 468 end not_copied_; 469 470 not_found_: 471 procedure (name); 472 473 /* parameters */ 474 475 declare name char (*) parameter; 476 477 /* program */ 478 479 if length (not_found) = 0 480 then not_found = "not found: "; 481 482 if length (not_found) + length (name) + 1 > ws_info.width 483 then do; 484 not_found = not_found || nl; 485 call iox_$put_chars (apl_static_$apl_output, addrel (addr (not_found), 1), length (not_found), code); 486 not_found = "not found: "; 487 end; 488 489 not_found = not_found || " "; 490 491 not_found = not_found || name; 492 493 return; 494 495 end not_found_; 496 497 copy: 498 procedure (bv_symbol_pointer); 499 500 /* parameters */ 501 502 declare bv_symbol_pointer pointer unaligned parameter; 503 504 /* automatic */ 505 506 declare symbol_pointer pointer unaligned; 507 508 /* program */ 509 510 call apl_get_symbol_ (bv_symbol_pointer -> saved_sb.name, symbol_pointer, (0)); 511 512 if symbol_pointer -> symbol_bead.meaning_pointer ^= null 513 then do; 514 if bv_protected 515 then do; 516 call not_copied_ (bv_symbol_pointer -> saved_sb.name); 517 return; 518 end; 519 520 if symbol_pointer -> symbol_bead.meaning_pointer -> general_bead.function 521 then if apl_pendant_function_check_ (symbol_pointer -> symbol_bead.meaning_pointer) 522 then do; 523 call not_copied_ (bv_symbol_pointer -> saved_sb.name); 524 call apl_system_error_ (apl_error_table_$pendent_function_copied); 525 end; 526 527 call wash (symbol_pointer -> symbol_bead.meaning_pointer); 528 end; 529 530 symbol_pointer -> symbol_bead.meaning_pointer = copy_bead (bv_symbol_pointer -> saved_sb.meaning_pointer); 531 532 /* Don't flush this symbol if this reference created it; otherwise be transparent & restore ref. ct. */ 533 534 if symbol_pointer -> general_bead.reference_count > 1 535 then call wash (symbol_pointer); 536 537 return; 538 539 end copy; 540 541 wash: 542 procedure (bv_bead_pointer); 543 544 /* parameters */ 545 546 declare bv_bead_pointer pointer unaligned parameter; 547 548 /* automatic */ 549 550 declare bead_pointer pointer unaligned; 551 552 /* program */ 553 554 bead_pointer = bv_bead_pointer; 555 556 bead_pointer -> general_bead.reference_count = bead_pointer -> general_bead.reference_count - 1; 557 558 if bead_pointer -> general_bead.reference_count < 1 559 then call apl_free_bead_ (bead_pointer); 560 561 return; 562 563 end wash; 564 565 un_pseudo_pointer: 566 procedure (bv_bead_pointer) returns (pointer unaligned); 567 568 bead_pointer = bv_bead_pointer; 569 570 if bead_pointer = null 571 then return (null); 572 else return (addrel (ws_segment (fixed (baseno (bead_pointer), 18)), rel (bead_pointer))); 573 574 declare (bv_bead_pointer, bead_pointer) 575 pointer unaligned; 576 577 end un_pseudo_pointer; 578 579 load_symbol: 580 procedure (bv_bead_number); 581 582 bead_number = bv_bead_number; 583 584 if bead_number = 0 585 then return; 586 587 if loaded_bead_pointer (bead_number) ^= null 588 then do; 589 loaded_bead_pointer (bead_number) -> general_bead.reference_count = 590 loaded_bead_pointer (bead_number) -> general_bead.reference_count + 1; 591 return; 592 end; 593 594 saved_bead_pointer = un_pseudo_pointer (bead_description_table (bead_number).bead_pointer); 595 596 if ^saved_bead_pointer -> saved_general_bead.symbol 597 then do; 598 call apl_system_error_ (apl_error_table_$cant_load_ws); 599 go to non_local_return; 600 end; 601 602 call apl_get_symbol_ (saved_bead_pointer -> saved_sb.name, bead_pointer, (0)); 603 604 bead_pointer -> symbol_bead.meaning_pointer = saved_bead_pointer; 605 loaded_bead_pointer (bead_number) = bead_pointer; 606 return; 607 608 declare (bead_pointer, saved_bead_pointer) 609 pointer unaligned; 610 declare (bv_bead_number, bead_number) 611 fixed binary (21); 612 613 end load_symbol; 614 615 copy_bead: 616 load_bead: 617 procedure (bv_bead_number) returns (pointer unaligned); 618 619 /* parameters */ 620 621 declare bv_bead_number fixed bin (21); 622 623 /* automatic */ 624 625 declare loading_on_stack bit (1) aligned; 626 declare bead_pointer ptr unaligned; 627 declare (saved_data_pointer, into_pointer, sb) 628 ptr; 629 declare bead_number fixed bin (21), 630 (symbol_number, member_number) 631 fixed bin, 632 datum_number fixed bin (24); 633 634 /* program */ 635 636 loading_on_stack = "0"b; 637 go to common; 638 639 load_bead_on_stack: 640 entry (bv_bead_number) returns (pointer unaligned); 641 642 loading_on_stack = "1"b; 643 644 common: 645 bead_number = bv_bead_number; 646 647 if bead_number <= 0 /* <0 means system error, actually. */ 648 then return (null); 649 650 if loaded_bead_pointer (bead_number) ^= null 651 then do; 652 loaded_bead_pointer (bead_number) -> general_bead.reference_count = 653 loaded_bead_pointer (bead_number) -> general_bead.reference_count + 1; 654 return (loaded_bead_pointer (bead_number)); 655 end; 656 657 sb = un_pseudo_pointer (bead_description_table (bead_number).bead_pointer); 658 go to copy_in_bead (index (string (sb -> saved_general_bead.type), "1"b)); 659 660 copy_in_bead (5): /* GROUP BEAD */ 661 call allocate; 662 663 bead_pointer -> group_bead.number_of_members = sb -> saved_gb.number_of_members; 664 665 do symbol_number = 1 to bead_pointer -> group_bead.number_of_members; 666 bead_pointer -> group_bead.member (symbol_number) = load_bead (sb -> saved_gb.member (symbol_number)); 667 end; 668 go to end_case; 669 670 copy_in_bead (2): /* SYMBOL BEAD */ 671 call load_symbol (bead_number); 672 loaded_bead_pointer (bead_number) -> symbol_bead.meaning_pointer = 673 load_bead (loaded_bead_pointer (bead_number) -> symbol_bead.meaning_pointer -> saved_sb.meaning_pointer); 674 return (loaded_bead_pointer (bead_number)); 675 676 copy_in_bead (4): /* FUNCTION BEAD */ 677 call allocate; 678 679 bead_pointer -> function_bead.class = sb -> saved_fb.class; 680 bead_pointer -> function_bead.text_length = sb -> saved_fb.text_length; 681 bead_pointer -> function_bead.stop_control_pointer = load_bead (sb -> saved_fb.stop_control_pointer); 682 bead_pointer -> function_bead.trace_control_pointer = load_bead (sb -> saved_fb.trace_control_pointer); 683 bead_pointer -> function_bead.text = sb -> saved_fb.text; 684 bead_pointer -> function_bead.lexed_function_bead_pointer = null; 685 go to end_case; 686 687 copy_in_bead (9): /* LIST BEAD */ 688 call stack_allocate; 689 690 bead_pointer -> list_bead.number_of_members = sb -> saved_lb.number_of_members; 691 692 do member_number = 1 to bead_pointer -> list_bead.number_of_members; 693 unspec (bead_pointer -> list_bead.bits (member_number)) = unspec (sb -> saved_lb.bits (member_number)); 694 695 if bead_pointer -> list_bead.bits (member_number).semantics_on_stack 696 then bead_pointer -> list_bead.member_ptr (member_number) = 697 load_bead_on_stack (sb -> saved_lb.member_ptr (member_number)); 698 else bead_pointer -> list_bead.member_ptr (member_number) = 699 load_bead (sb -> saved_lb.member_ptr (member_number)); 700 end; 701 go to end_case; 702 703 copy_in_bead (3): /* VALUE BEADS */ 704 call allocate; 705 706 number_of_dimensions, bead_pointer -> value_bead.rhorho = sb -> saved_value_bead.rhorho; 707 708 if bead_pointer -> value_bead.rhorho > 0 709 then bead_pointer -> value_bead.rho (*) = sb -> saved_value_bead.rho (*); 710 711 data_elements, bead_pointer -> value_bead.total_data_elements = sb -> saved_value_bead.total_data_elements; 712 713 into_pointer = addrel (bead_pointer, size (value_bead)); 714 715 if bead_pointer -> value_bead.numeric_value 716 then if substr (rel (into_pointer), 18, 1) 717 then into_pointer = addrel (into_pointer, 1); 718 719 bead_pointer -> value_bead.data_pointer = into_pointer; 720 721 saved_data_pointer = pointer (sb, rel (sb -> saved_value_bead.data_pointer)); 722 723 if bead_pointer -> value_bead.character_value 724 then into_pointer -> character_string_overlay = saved_data_pointer -> character_string_overlay; 725 else if string (bead_pointer -> value_bead.type) = zero_or_one_value_type 726 then do; 727 do datum_number = 0 by 1 while (datum_number < data_elements); 728 if substr (saved_data_pointer -> saved_boolean_datum, datum_number + 1, 1) = "1"b 729 then into_pointer -> numeric_datum (datum_number) = 1e0; 730 else into_pointer -> numeric_datum (datum_number) = 0e0; 731 end; 732 end; 733 else into_pointer -> numeric_datum (*) = saved_data_pointer -> numeric_datum (*); 734 735 end_case: 736 loaded_bead_pointer (bead_number) = bead_pointer; 737 return (bead_pointer); 738 739 copy_in_bead (0): 740 copy_in_bead (1): 741 copy_in_bead (6): 742 copy_in_bead (7): 743 copy_in_bead (8): 744 copy_in_bead (10): 745 copy_in_bead (11): 746 copy_in_bead (12): 747 copy_in_bead (13): 748 copy_in_bead (14): 749 copy_in_bead (15): 750 copy_in_bead (16): 751 copy_in_bead (17): 752 copy_in_bead (18): 753 call apl_system_error_ (apl_error_table_$cant_load_ws); 754 go to non_local_return; 755 756 /* pseudo-function used by load_bead to allocate space for each bead in either the stack or heap. */ 757 758 allocate: 759 procedure; 760 761 declare allocate_on_stack bit (1) aligned; 762 763 allocate_on_stack = loading_on_stack; 764 go to common; 765 766 stack_allocate: 767 entry; 768 769 allocate_on_stack = "1"b; 770 771 common: 772 n_words = fixed (sb -> saved_general_bead.size, 18, 0); 773 774 /* the size was normalized to eleminate any padding words for value beads...add 1 back so we 775* can safely double-word align the numbers. */ 776 777 if sb -> saved_general_bead.value 778 then n_words = n_words + 1; 779 780 if allocate_on_stack 781 then bead_pointer = apl_push_stack_ (n_words); 782 else call apl_allocate_words_ (n_words, bead_pointer); 783 784 string (bead_pointer -> general_bead.type) = string (sb -> saved_general_bead.type); 785 bead_pointer -> general_bead.reference_count = 1; 786 return; 787 1 1 /* ====== BEGIN INCLUDE SEGMENT apl_push_stack_fcn.incl.pl1 =============================== */ 1 2 1 3 /* format: style3 */ 1 4 apl_push_stack_: 1 5 procedure (P_n_words) returns (ptr); 1 6 1 7 /* Function to (1) double-word align ws_info.value_stack_ptr, and 1 8* (2) make sure allocation request will fit on current value stack. 1 9* 1 10* Written 770413 by PG 1 11* Modified 780210 by PG to round allocations up to an even number of words. 1 12**/ 1 13 1 14 /* parameters */ 1 15 1 16 declare P_n_words fixed bin (19) parameter; 1 17 1 18 /* automatic */ 1 19 1 20 declare block_ptr ptr, 1 21 num_words fixed bin (19); 1 22 1 23 /* builtins */ 1 24 1 25 declare (addrel, binary, rel, substr, unspec) 1 26 builtin; 1 27 1 28 /* entries */ 1 29 1 30 declare apl_get_value_stack_ 1 31 entry (fixed bin (19)); 1 32 1 33 /* program */ 1 34 1 35 num_words = P_n_words; 1 36 1 37 if substr (unspec (num_words), 36, 1) = "1"b /* num_words odd */ 1 38 then num_words = num_words + 1; 1 39 1 40 if binary (rel (ws_info.value_stack_ptr), 18) + num_words > ws_info.maximum_value_stack_size 1 41 then call apl_get_value_stack_ (num_words); 1 42 1 43 block_ptr = ws_info.value_stack_ptr; 1 44 ws_info.value_stack_ptr = addrel (ws_info.value_stack_ptr, num_words); 1 45 return (block_ptr); 1 46 1 47 end apl_push_stack_; 1 48 1 49 /* ------ END INCLUDE SEGMENT apl_push_stack_fcn.incl.pl1 ------------------------------- */ 788 789 end allocate; 790 791 end load_bead; 792 793 /* builtins */ 794 795 declare (addr, addrel, baseno, before, divide, fixed, index, length, null, pointer, substr, rel, size, string, unspec) 796 builtin; 797 798 /* entries */ 799 800 declare apl_date_time_ entry (fixed bin (71)) returns (char (17)); 801 declare apl_pendant_function_check_ 802 entry (ptr unal) returns (bit (1) aligned); 803 declare apl_system_error_ entry (fixed bin (35)); 804 declare apl_allocate_words_ entry (fixed bin (19), pointer unaligned); 805 declare apl_get_symbol_ entry (char (*), pointer unaligned, fixed bin); 806 declare apl_create_save_frame_ 807 entry (); 808 declare (apl_destroy_save_frame_, apl_destroy_save_frame_update_) 809 entry (); 810 declare apl_free_bead_ entry (pointer unaligned); 811 declare apl_translate_pathname_$use_search_paths 812 entry (char (*), char (*), char (*), pointer, fixed bin (35)); 813 declare apl_segment_manager_$get 814 entry () returns (pointer); 815 declare apl_segment_manager_$free 816 entry (pointer); 817 declare (apl_line_lex_, apl_function_lex_, apl_execute_lex_) 818 entry (char (*) aligned, pointer unaligned, bit (1) aligned, fixed bin, pointer); 819 declare apl_clear_workspace_ 820 entry (); 821 declare convert_status_code_ 822 entry (fixed bin (35), char (8), char (100)); 823 declare get_wdir_ entry () returns (char (168) aligned); 824 declare ioa_$ioa_switch entry options (variable); 825 declare iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 826 declare msf_manager_$close entry (ptr); 827 declare msf_manager_$get_ptr 828 entry (pointer, fixed bin, bit (1) aligned, pointer, fixed bin (24), fixed bin (35)); 829 830 /* conditions */ 831 832 declare cleanup condition; 833 834 /* automatic */ 835 836 declare autoload bit (1) aligned; 837 declare code fixed bin (35); 838 declare dname char (168), 839 ename char (32); 840 declare long_msg char (100), 841 short_msg char (8); 842 declare (not_found, not_copied) 843 char (150) aligned varying; 844 declare (errors_occurred, found, load_this_one) 845 bit (1) aligned; 846 declare ( 847 temporary_bead_pointer 848 unaligned, 849 loaded_bead_table_pointer 850 ) pointer; 851 declare ws_segment dimension (0:63) pointer aligned; 852 declare (previous_frame_pointer, parse_frame_ptr, bead_pointer, symbol_pointer) 853 pointer unaligned; 854 declare fcbp pointer; 855 declare (saved_symbol_count, frame_type, symbol_count, source_length, symbol_index, copy_index, data_elements, 856 parseme_count, reduction_number, reduction_type, component) 857 fixed bin; 858 declare n_words fixed bin (19); 859 declare (bead_number, symbol_number, temp_symbol) 860 fixed bin (21); 861 862 /* internal static initial */ 863 864 declare nl char (1) aligned internal static initial (" 865 "); 866 867 /* based */ 868 869 declare loaded_bead_pointer dimension (1) pointer unaligned based (loaded_bead_table_pointer); 870 declare suspended_source_length 871 fixed binary (29) aligned based; 872 declare suspended_source character (source_length) based aligned; 873 874 /* parameters */ 875 876 declare (bv_wsid, bv_lock) char (*) unaligned; 877 declare bv_code fixed bin (35); 878 879 /* external static */ 880 881 declare (apl_error_table_$cant_autoload, apl_error_table_$cant_load_ws, apl_error_table_$pendent_function_copied, 882 apl_error_table_$ws_dir_restricted, apl_error_table_$ws_locked, apl_error_table_$ws_wrong_version, 883 error_table_$noentry) 884 fixed bin (35) external static; 885 886 declare apl_static_$apl_output 887 ptr external static; 888 889 /* include files */ 890 2 1 /* ====== BEGIN INCLUDE SEGMENT apl_number_data.incl.pl1 ================================== */ 2 2 2 3 /* 2 4* This include file contains information about the machine representation of numbers. 2 5* In all programs numbers should simply be declared 'float'. 2 6* All default statements should be in this include file. 2 7* 2 8* This is the binary version. The manifest constant Binary should be used by programs 2 9* that need to know whether we are using binary or decimal. 2 10* */ 2 11 2 12 /* format: style3,initlm0,idind30 */ 2 13 2 14 default (float & ^decimal & ^binary & ^precision & ^constant) float binary (63); 2 15 2 16 declare ( 2 17 TheBiggestNumberWeveGot float initial (0.1701411834604692317e+39), 2 18 TheSmallestNumberWeveGot float initial (.1469367938527859385e-38), 2 19 Binary bit (1) aligned initial ("1"b) 2 20 ) internal static options (constant); 2 21 2 22 /* Number of characters in a number datum entry; used for copying float number arrays as strings. 2 23* (Obsolete! use array copies!) */ 2 24 2 25 declare NumberSize fixed binary precision (4) internal static initial (8); 2 26 2 27 /* ------ END INCLUDE SEGMENT apl_number_data.incl.pl1 ---------------------------------- */ 891 3 1 /* ====== BEGIN INCLUDE SEGMENT apl_ws_info.incl.pl1 ====================================== */ 3 2 3 3 /* This structure contains all of the global data (or pointers to it) for the APL subsystem */ 3 4 3 5 /* automatic */ 3 6 3 7 declare ws_info_ptr ptr initial (apl_static_$ws_info_ptr.static_ws_info_ptr); 3 8 3 9 /* external static */ 3 10 3 11 declare 1 apl_static_$ws_info_ptr external static aligned structure, 3 12 2 static_ws_info_ptr unaligned pointer; 3 13 3 14 /* based */ 3 15 3 16 declare 1 ws_info aligned based (ws_info_ptr), 3 17 2 version_number fixed bin, /* version of this structure (3) */ 3 18 2 switches unaligned, /* mainly ws parameters */ 3 19 3 long_error_mode bit, /* if 1, long Multics format, else APL/360 format */ 3 20 3 debug_mode bit, /* if 1, system error causes escape to command level */ 3 21 3 canonicalize_mode bit, /* if 1, the editor canonicalizes user input */ 3 22 3 restrict_exec_command bit, /* if 1, the )EXEC command may not be used */ 3 23 3 restrict_debug_command bit, /* if 1, the )DEBUG command may not be used */ 3 24 3 restrict_external_functions 3 25 bit, /* if 1, the )ZFN, )MFN, and )DFN commands may not be used */ 3 26 3 restrict_load bit, /* if 1, the )LOAD and )COPY commands may not be used */ 3 27 3 restrict_load_directory bit, /* if 1, no directory allowed in )LOAD or )COPY pathnames */ 3 28 3 restrict_save bit, /* if 1, the )SAVE command may not be used */ 3 29 3 restrict_save_directory bit, /* if 1, no directory allowed in )SAVE pathnames */ 3 30 3 off_hold bit, /* if 1, )OFF HOLD was typed, else just )OFF */ 3 31 3 transparent_to_signals bit, /* if 1, any conditions slip right past APL */ 3 32 3 meter_mode bit, /* if 1, metering may be done, else speed is all-important */ 3 33 3 restrict_msg_command bit, /* if 1, the )MSG command may not be used. */ 3 34 3 compatibility_check_mode 3 35 bit, /* if 1, check for incompatible operators */ 3 36 3 no_quit_handler bit, /* if 1, do not trap QUITs. */ 3 37 /* remaining 20 bits not presently used */ 3 38 3 39 2 values, /* attributes of the workspace */ 3 40 3 digits fixed bin, /* number of digits of precision printed on output */ 3 41 3 width fixed bin, /* line length for formatted output */ 3 42 3 index_origin fixed bin, /* the index origin (0 or 1) */ 3 43 3 random_link fixed bin(35), /* seed for random number generator */ 3 44 3 fuzz float, /* comparison tolerance (relative fuzz) */ 3 45 3 float_index_origin float, /* the index origin in floating point */ 3 46 3 number_of_symbols fixed bin, /* the number of symbol_beads currently in existence */ 3 47 3 maximum_value_stack_size 3 48 fixed bin (18), /* maximum number of words in one segment of value stack */ 3 49 3 50 2 pointers, /* pointers to various internal tables */ 3 51 3 symbol_table_ptr unaligned pointer, /* -> symbol_table (apl_symbol_table.incl.pl1) */ 3 52 3 current_parse_frame_ptr unaligned pointer, /* -> topmost parse frame */ 3 53 3 value_stack_ptr unaligned pointer, /* -> next free location on value stack */ 3 54 3 alloc_free_info_ptr unaligned pointer, /* -> apl_storage_mngr_ data (apl_storage_system_data.incl.pl1) */ 3 55 3 56 2 time_invoked fixed bin(71), /* clock time that APL was entered */ 3 57 2 integer_fuzz float, /* the absolute fuzz used in checking for integers */ 3 58 2 user_number fixed bin(35), /* number under which the user is signed on */ 3 59 2 latent_expression unaligned pointer, /* -> value_bead for QuadLX */ 3 60 2 lock char(32), /* the lock currently set on this workspace (password) */ 3 61 2 wsid char(100), /* the workspace identification: name, number name, or clear ws */ 3 62 2 last_error_code fixed bin(35), /* last code passed to apl_error_ */ 3 63 2 signoff_lock character (32), 3 64 3 65 2 interrupt_info aligned, /* bits used by apl_interpreter_ to tell when to abort */ 3 66 3 dont_interrupt_parse bit, /* if 1, don't do a dirty stop because the parser is running */ 3 67 3 dont_interrupt_operator bit, /* if 1, don't do a dirty stop because an operator is running */ 3 68 3 dont_interrupt_storage_manager /* if 1, don't stop because apl_storage_mngr_ is */ 3 69 bit, /* munging his tables */ 3 70 3 unused_interrupt_bit bit, /* not presently used */ 3 71 3 dont_interrupt_command bit, 3 72 3 can_be_interrupted bit, /* if 1, OK to do a clean stop (we are between lines, reading) */ 3 73 3 clean_interrupt_pending bit, /* interrupt occured, break cleanly (between lines) */ 3 74 3 dirty_interrupt_pending bit, /* interrupt occured, break as soon as not inhibited */ 3 75 3 76 2 user_name char (32), /* process group id of user */ 3 77 2 immediate_input_prompt char (32) varying, /* normal input */ 3 78 2 evaluated_input_prompt char (32) varying, /* quad input */ 3 79 2 character_input_prompt char (32) varying, /* quad-quote input */ 3 80 2 vcpu_time aligned, 3 81 3 total fixed bin (71), 3 82 3 setup fixed bin (71), 3 83 3 parse fixed bin (71), 3 84 3 lex fixed bin (71), 3 85 3 operator fixed bin (71), 3 86 3 storage_manager fixed bin (71), 3 87 2 output_info aligned, /* data pertaining to output buffer */ 3 88 3 output_buffer_ptr unal ptr, /* ptr to output buffer */ 3 89 3 output_buffer_len fixed bin (21), /* length (bytes) of output buffer */ 3 90 3 output_buffer_pos fixed bin (21), /* index of next byte to write in */ 3 91 3 output_buffer_ll fixed bin (21), /* print positions used up so far */ 3 92 2 tab_width fixed bin (21); /* number of columns a tabs moves cursor */ 3 93 3 94 declare output_buffer char (ws_info.output_buffer_len) based (ws_info.output_buffer_ptr); 3 95 3 96 /* internal static */ 3 97 3 98 declare max_parse_stack_depth fixed bin int static init(64536); 3 99 3 100 /* ------ END INCLUDE SEGMENT apl_ws_info.incl.pl1 -------------------------------------- */ 892 4 1 /* ====== BEGIN INCLUDE SEGMENT apl_bead_format.incl.pl1 ================================== */ 4 2 4 3 declare 1 general_bead aligned based, /* The Venerable Bead */ 4 4 2 type unaligned, 4 5 3 bead_type unaligned, 4 6 4 operator bit (1), /* ON if operator bead */ 4 7 4 symbol bit (1), /* ON if symbol bead */ 4 8 4 value bit (1), /* ON if value bead */ 4 9 4 function bit (1), /* ON if function bead */ 4 10 4 group bit (1), /* ON if group bead */ 4 11 4 label bit (1), /* ON if label bead */ 4 12 4 shared_variable bit (1), /* ON if shared variable bead */ 4 13 4 lexed_function bit (1), /* ON if lexed function bead */ 4 14 3 data_type unaligned, 4 15 4 list_value bit (1), /* ON if a list value bead */ 4 16 4 character_value bit (1), /* ON if a character value bead */ 4 17 4 numeric_value bit (1), /* ON if a numeric value bead */ 4 18 4 integral_value bit (1), /* ON if an integral value bead */ 4 19 4 zero_or_one_value bit (1), /* ON if a boolean value bead */ 4 20 4 complex_value bit (1), /* ON if a complex, numeric value bead */ 4 21 3 unused_bits bit (4) unaligned, /* pad to 18 bits (for future use) */ 4 22 2 size bit (18) unaligned, /* Number of words this bead occupies 4 23* (used by bead storage manager) */ 4 24 2 reference_count fixed binary (29); /* Number of pointers which point 4 25* to this bead (used by bead manager) */ 4 26 4 27 4 28 /* constant strings for initing type field in various beads */ 4 29 4 30 declare ( 4 31 operator_type init("100000000000000000"b), 4 32 symbol_type init("010000000000000000"b), 4 33 value_type init("001000000000000000"b), 4 34 function_type init("000100000000000000"b), 4 35 group_type init("000010000000000000"b), 4 36 label_type init("001001000011000000"b), 4 37 shared_variable_type init("001000100000000000"b), 4 38 lexed_function_type init("000000010000000000"b), 4 39 4 40 list_value_type init("000000001000000000"b), 4 41 character_value_type init("001000000100000000"b), 4 42 numeric_value_type init("001000000010000000"b), 4 43 integral_value_type init("001000000011000000"b), 4 44 zero_or_one_value_type init("001000000011100000"b), 4 45 complex_value_type init("001000000000010000"b), 4 46 4 47 not_integer_mask init("111111111110011111"b), /* to clear integral, zero_or_one bits */ 4 48 not_zero_or_one_mask init("111111111111011111"b) /* to clear zero_or_one bit */ 4 49 ) bit(18) internal static; 4 50 4 51 /* ------ END INCLUDE SEGMENT apl_bead_format.incl.pl1 ---------------------------------- */ 893 5 1 /* ====== BEGIN INCLUDE SEGMENT apl_operator_bead.incl.pl1 ================================ */ 5 2 5 3 declare 5 4 1 operator_bead aligned based, 5 5 5 6 2 type unaligned like general_bead.type, 5 7 5 8 2 bits_for_lex unaligned, 5 9 3 allow_brackets bit(1), /* operator may have dimension info in brackets */ 5 10 3 allow_product bit(1), /* operator may be used in inner and outer product */ 5 11 3 allow_reduction bit(1), /* operator may be used in reduction and scan */ 5 12 3 special_assignment bit(1), /* doesn't use standard assignment operator */ 5 13 3 ignores_assignment bit(1), /* assignment has no effect */ 5 14 3 allow_subscripted_assignment 5 15 bit(1), /* system variable that can be subscripted assigned */ 5 16 3 pad bit(12), 5 17 5 18 2 bits_for_parse unaligned, 5 19 3 stop_trace_control bit(1), /* next lexeme is function being stopped/traced 5 20* (op1 tells which) */ 5 21 3 quad bit(1), /* this is a quad type */ 5 22 3 system_variable bit(1), /* this is a system variable, not an op */ 5 23 3 dyadic bit(1), /* operator may be dyadic */ 5 24 3 monadic bit(1), /* operator may be monadic */ 5 25 3 function bit(1), /* operator is a user defined function */ 5 26 3 semantics_valid bit(1), /* if semantics has been set */ 5 27 3 has_list bit(1), /* semantics is a list */ 5 28 3 inner_product bit(1), /* op2 is valid */ 5 29 3 semantics_on_stack bit(1), /* semantics points to value stack */ 5 30 3 is_external_function bit(1), /* semantics points to function bead for ext function */ 5 31 3 pad bit(7), 5 32 3 op2 fixed bin(8) unaligned, /* secondary operator code */ 5 33 3 op1 fixed bin(8) unaligned, /* primary operator code */ 5 34 2 type_code fixed bin; /* for parse */ 5 35 5 36 /* ------ END INCLUDE SEGMENT apl_operator_bead.incl.pl1 -------------------------------- */ 894 6 1 /* ====== BEGIN INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ================================== */ 6 2 6 3 /* Explanation of fields: 6 4* symbol_bead.hash_link_pointer points to next symbol in same hash bucket in the symbol table. 6 5* symbol_bead.meaning_pointer points to current "value" of this name: 6 6* = null => unused (e.g. undefined variable) 6 7* -> group bead => group name 6 8* -> value bead => variable with a value 6 9* -> function bead => function name 6 10* -> label bead => localized label value 6 11* -> shared var bead => shared variable */ 6 12 6 13 declare 1 symbol_bead aligned based, 6 14 2 header aligned like general_bead, 6 15 2 hash_link_pointer pointer unaligned, 6 16 2 meaning_pointer pointer unaligned, 6 17 2 name_length fixed binary, 6 18 2 name character (0 refer (symbol_bead.name_length)) unaligned; 6 19 6 20 /* ------ END INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ---------------------------------- */ 895 7 1 /* ====== BEGIN INCLUDE SEGMENT apl_value_bead.incl.pl1 =================================== */ 7 2 7 3 declare 7 4 number_of_dimensions fixed bin, 7 5 7 6 1 value_bead aligned based, 7 7 2 header aligned like general_bead, 7 8 2 total_data_elements fixed binary (21), /* length of ,[value] in APL */ 7 9 2 rhorho fixed binary, /* number of dimensions of value */ 7 10 2 data_pointer pointer unaligned, /* packed pointer to the data in value */ 7 11 2 rho fixed binary (21) dimension (number_of_dimensions refer (value_bead.rhorho)); 7 12 /* dimensions of value (zero-origin) */ 7 13 7 14 7 15 declare 1 character_data_structure aligned based, /* alignment trick for PL/I compiler */ 7 16 2 character_datum character (1) unaligned dimension (0:data_elements - 1); 7 17 /* actual elements of character array */ 7 18 7 19 declare character_string_overlay character (data_elements) aligned based; 7 20 /* to overlay on above structure */ 7 21 7 22 7 23 declare numeric_datum float aligned dimension (0:data_elements - 1) based; 7 24 /* actual elements of numeric array */ 7 25 7 26 declare complex_datum complex float aligned dimension (0:data_elements -1) based; 7 27 7 28 declare MAX_VALUE_BEAD_SIZE fixed bin (19) init (261120) int static options (constant); 7 29 7 30 /* ------ END INCLUDE SEGMENT apl_value_bead.incl.pl1 ----------------------------------- */ 896 8 1 /* ====== BEGIN INCLUDE SEGMENT apl_list_bead.incl.pl1 ==================================== */ 8 2 8 3 declare n_members fixed bin, 8 4 8 5 1 list_bead aligned based, 8 6 2 header aligned like general_bead, 8 7 2 number_of_members fixed bin, 8 8 2 members dimension (n_members refer (list_bead.number_of_members)) aligned, 8 9 3 member_ptr unaligned pointer, 8 10 3 bits unaligned like operator_bead.bits_for_parse; 8 11 8 12 /* ------ END INCLUDE SEGMENT apl_list_bead.incl.pl1 ------------------------------------ */ 897 9 1 /* ====== BEGIN INCLUDE SEGMENT apl_function_bead.incl.pl1 ================================ */ 9 2 9 3 /* This bead is used by apl to store the source code for user-defined functions */ 9 4 9 5 declare 1 function_bead aligned based, 9 6 9 7 2 header aligned like general_bead, 9 8 9 9 2 lexed_function_bead_pointer unaligned pointer, /* null if unlexed or has errors, else -> lexed code */ 9 10 2 class fixed bin, /* 0=normal, 1=locked, 2=external zfn, 3=mfn, 4=dfn */ 9 11 2 stop_control_pointer unaligned ptr, /* points to stop value bead, or null (no stop control) */ 9 12 2 trace_control_pointer unaligned ptr, /* points to trace value bead, or null (no trace control) */ 9 13 2 text_length fixed bin(21), /* length of function text */ 9 14 2 text aligned char(data_elements refer (function_bead.text_length)); 9 15 /* the user's code exactly as typed in */ 9 16 9 17 /* ------ END INCLUDE SEGMENT apl_function_bead.incl.pl1 -------------------------------- */ 898 10 1 /* ====== BEGIN INCLUDE SEGMENT apl_lexed_function_bead.incl.pl1 ========================== */ 10 2 10 3 /* this is the format of a user-defined function after it has been run 10 4* through apl_lex_, the first (left to right) parsing phase. */ 10 5 10 6 dcl 1 lexed_function_bead based aligned, 10 7 2 header like general_bead, /* type bits, etc. */ 10 8 10 9 2 name pointer unaligned, /* -> symbol bead which names the function */ 10 10 2 bits_for_parse unaligned like operator_bead.bits_for_parse, /* so can treat like system function */ 10 11 2 number_of_statements fixed bin, 10 12 2 number_of_localized_symbols fixed bin, /* including labels and parameter variables, return var */ 10 13 /* even if they aren't there, thus >_ 3 */ 10 14 2 number_of_labels fixed bin, 10 15 2 label_values_ptr pointer unaligned, /* -> label_values below */ 10 16 2 statement_map_ptr pointer unaligned, /* -> statement_map below */ 10 17 2 lexeme_array_ptr pointer unaligned, /* -> lexeme_array below */ 10 18 10 19 /* the first 3 localized symbols are always reserved for ReturnSymbol, LeftArgSymbol, RighArgSymbol respectively. 10 20* If some of these symbols are not present (e.g. monadic or value-less function), null pointers are used. 10 21* So beware!, there can be null ptrs in the localized_symbols array. */ 10 22 10 23 2 localized_symbols( (0) refer (lexed_function_bead.number_of_localized_symbols)) pointer unaligned, 10 24 /* first localized vars from header line, then labels */ 10 25 2 label_values ( (0) refer (lexed_function_bead.number_of_labels)) pointer unaligned, 10 26 /* ptrs to label-value beads for labels */ 10 27 2 statement_map ( (0) refer (lexed_function_bead.number_of_statements)) fixed bin(18), 10 28 /* index in lexeme_array of rightmost lexeme of each stmt */ 10 29 2 lexeme_array ( (0) refer (lexed_function_bead.number_of_labels) /* not really, but fake out compiler */ ) pointer unaligned; 10 30 /* the actual lexemes. Length of array is 10 31* statement_map(number_of_statements) */ 10 32 10 33 10 34 /* manifest constants for first 3 localized symbols */ 10 35 10 36 dcl (ReturnSymbol init(1), 10 37 LeftArgSymbol init(2), 10 38 RightArgSymbol init(3) 10 39 ) fixed binary static; 10 40 10 41 10 42 /* the last three parts of this bead are referenced separately, though ptrs earlier in the bead. 10 43* Here are declarations for them as level-1 structures */ 10 44 10 45 dcl 1 lexed_function_label_values_structure based aligned, 10 46 2 lexed_function_label_values ( 500 /* or so */ ) pointer unaligned, 10 47 10 48 statement_count fixed bin, 10 49 lexed_function_statement_map (statement_count) fixed bin(18) aligned based, 10 50 10 51 1 lexed_function_lexemes_structure based aligned, 10 52 2 lexed_function_lexeme_array ( 500 /* or so */ ) pointer unaligned; 10 53 10 54 /* ------ END INCLUDE SEGMENT apl_lexed_function_bead.incl.pl1 -------------------------- */ 899 11 1 /* BEGIN INCLUDE FILE: apl_group_bead.incl.pl1 */ 11 2 11 3 /* Initial Version: 1973.06.18 11 4* Typed in by: Richard S. Lamson */ 11 5 11 6 11 7 declare 1 group_bead aligned based, /* Group: bead_type.group = "1"b */ 11 8 11 9 2 header aligned like general_bead, 11 10 11 11 2 number_of_members fixed binary, 11 12 11 13 2 member pointer unaligned dimension (0 refer (group_bead.number_of_members)); 11 14 /* Pointer to the symbol bead for each 11 15* member of the group */ 11 16 11 17 /* END INCLUDE FILE apl_group_bead.incl.pl1 */ 900 12 1 /* ====== BEGIN INCLUDE SEGMENT apl_parse_frame.incl.pl1 ================================== */ 12 2 12 3 declare 1 parse_frame aligned based (parse_frame_ptr), 12 4 2 last_parse_frame_ptr ptr unaligned, /* pointer to last parse frame, or null */ 12 5 2 parse_frame_type fixed bin, /* suspended, function, eval input, etc. */ 12 6 2 function_bead_ptr ptr unaligned, /* ptr to function bead */ 12 7 2 lexed_function_bead_ptr ptr unaligned, /* ptr to lexed function bead */ 12 8 2 reduction_stack_ptr ptr unaligned, /* ptr to reduction stack for this frame */ 12 9 2 current_parseme fixed bin, /* element of reduction stack that is top of stack */ 12 10 2 current_lexeme fixed bin, /* element number of current lexeme */ 12 11 2 current_line_number fixed bin, /* line number being executed */ 12 12 2 return_point fixed bin, /* where to join the reductions on return */ 12 13 2 put_result fixed bin, /* where to put the value when returning to this frame */ 12 14 2 print_final_value bit(1) aligned, /* if true, print final value on line */ 12 15 2 initial_value_stack_ptr ptr unaligned, /* for cleaning up the value stack */ 12 16 2 number_of_ptrs fixed bin, /* number of old meaning ptrs */ 12 17 2 old_meaning_ptrs dim (number_of_ptrs refer (parse_frame.number_of_ptrs)) ptr unaligned; 12 18 /* old meanings for local variables. */ 12 19 12 20 declare number_of_ptrs fixed bin; 12 21 12 22 declare (suspended_frame_type init (1), /* for comparison with parse frame type */ 12 23 function_frame_type init (2), 12 24 evaluated_frame_type init (3), 12 25 execute_frame_type init (4), 12 26 save_frame_type init (5) 12 27 ) fixed bin internal static options (constant); 12 28 12 29 declare reductions_pointer pointer; 12 30 12 31 declare 12 32 1 reduction_stack aligned dim (1000) based (reductions_pointer), 12 33 2 type fixed bin, /* type of parseme */ 12 34 2 bits unaligned like operator_bead.bits_for_parse, 12 35 2 semantics ptr unaligned, 12 36 2 lexeme fixed bin, 12 37 12 38 1 reduction_stack_for_op aligned dim (1000) based (reductions_pointer), 12 39 2 type fixed bin, 12 40 2 bits unaligned like operator_bead.bits_for_parse, 12 41 2 semantics fixed bin, 12 42 2 lexeme fixed bin, 12 43 12 44 (eol_type init(0), /* parseme types - end of line */ 12 45 bol_type init(1), /* begining of line */ 12 46 val_type init(2), /* value */ 12 47 op_type init(3), /* op */ 12 48 open_paren_type init(4), 12 49 close_paren_type init(5), 12 50 open_bracket_type init(6), 12 51 close_subscript_type init(7), 12 52 close_rank_type init(8), 12 53 semi_colon_type init(9), 12 54 diamond_type init (10), 12 55 subscript_type init (11)) fixed bin internal static options (constant); 12 56 12 57 /* ------ END INCLUDE SEGMENT apl_parse_frame.incl.pl1 ---------------------------------- */ 901 13 1 /* ====== BEGIN INCLUDE FILE apl_save_frame.incl.pl1 =================================== */ 13 2 13 3 declare save_frame_pointer pointer unaligned; 13 4 13 5 declare 1 save_frame aligned based (save_frame_pointer), 13 6 2 last_frame_pointer ptr unal, /* pointer to last parse frame */ 13 7 2 frame_type fixed bin, /* = save_frame_type */ 13 8 2 saved_symbol_count fixed bin (29), /* number of symbols in saved frame */ 13 9 2 symbol_list aligned dimension (total_symbols refer (save_frame.saved_symbol_count)), 13 10 3 symbol_pointer ptr unal, /* pointer to each symbol bead (never null) */ 13 11 3 saved_meaning_pointer ptr unal, /* ptr to local meaning at time save_frame is created */ 13 12 /* (if null, local meaning is null) */ 13 13 3 global_meaning_pointer_pointer /* pointer to the meaning pointer which */ 13 14 ptr unal; /* represents the global meaning of this symbol */ 13 15 /* (if null, either symbol was never localized, */ 13 16 /* or save_frame was created by apl_load_command_,*/ 13 17 /* and saved_meaning_ptr determines whether it */ 13 18 /* was localized) */ 13 19 13 20 /* ------ END INCLUDE FILE apl_save_frame.incl.pl1 ----------------------------------- */ 902 14 1 /* ====== BEGIN INCLUDE SEGMENT apl_saved_ws.incl.pl1 ===================================== */ 14 2 14 3 /* This include file describes the format of a saved workspace. */ 14 4 14 5 /* all packed pointer items are "pseudo-pointers" to other data items within the saved ws, identifying 14 6* the component and word offset within the MSF. 14 7* all fixed binary (21) items are "bead numbers", representing indicies into the bead_description_table. */ 14 8 14 9 declare current_save_version fixed binary internal static initial (4), 14 10 saved_ws_info_pointer pointer; 14 11 14 12 declare 1 saved_ws_info aligned based (saved_ws_info_pointer), 14 13 2 save_version fixed binary, /* Version number of this declaration. */ 14 14 2 highest_segment fixed binary, /* number of internal segments in ws. */ 14 15 2 bead_table_pointer pointer unaligned, /* pointer to bead_description_table */ 14 16 2 total_beads fixed binary (24), /* size of bead_description_table */ 14 17 2 padding fixed binary (35) dimension (4), /* reserved just in case. */ 14 18 2 other_ws_info aligned, 14 19 3 digits fixed bin, 14 20 3 width fixed bin, 14 21 3 index_origin fixed bin, 14 22 3 random_link fixed bin (35), 14 23 3 fuzz float, 14 24 3 float_index_origin float, 14 25 3 number_of_symbols fixed bin, 14 26 3 current_parse_frame_ptr pointer unaligned, 14 27 3 time_saved fixed binary (71), 14 28 3 integer_fuzz float, 14 29 3 user_number fixed bin (35), 14 30 3 latent_expression fixed bin (21), /* bead number of latent expression */ 14 31 3 lock char (32), 14 32 3 wsid char (100), 14 33 3 user_name char (32); 14 34 14 35 declare saved_bead_count fixed bin, 14 36 bead_description_pointer pointer; 14 37 14 38 declare 1 bead_description_table aligned based (bead_description_pointer) dimension (saved_bead_count), 14 39 2 bead_pointer pointer unaligned; /* pseudo pointer to bead */ 14 40 14 41 declare saved_bead_pointer pointer, 14 42 (symbol_name_length, total_members) fixed binary; 14 43 14 44 declare 1 saved_general_bead aligned based (saved_bead_pointer), 14 45 2 type unaligned like general_bead.type, 14 46 2 size unaligned bit (18); /* N.B.: this is the # of words in the original bead, */ 14 47 /* not the saved bead. */ 14 48 14 49 declare 1 saved_value_bead aligned based (saved_bead_pointer), 14 50 2 header aligned like saved_general_bead, 14 51 2 total_data_elements fixed binary (21), 14 52 2 rhorho fixed binary, 14 53 2 data_pointer unaligned pointer, 14 54 2 rho fixed binary (21) dimension (number_of_dimensions refer (saved_value_bead.rhorho)); 14 55 14 56 declare saved_boolean_datum bit (data_elements) aligned based; 14 57 14 58 14 59 declare 1 saved_sb aligned based (saved_bead_pointer), 14 60 2 header aligned like saved_general_bead, 14 61 2 meaning_pointer fixed binary (21), 14 62 2 name_length fixed binary, 14 63 2 name character (symbol_name_length refer (saved_sb.name_length)) unaligned; 14 64 14 65 14 66 14 67 declare 1 saved_lb aligned based (saved_bead_pointer), 14 68 2 header aligned like saved_general_bead, 14 69 2 number_of_members fixed bin, 14 70 2 members dim (total_members refer (saved_lb.number_of_members)) aligned, 14 71 3 member_ptr fixed binary (21), 14 72 3 bits unaligned like operator_bead.bits_for_parse; 14 73 14 74 14 75 14 76 declare 1 saved_gb aligned based (saved_bead_pointer), 14 77 2 header aligned like saved_general_bead, 14 78 2 number_of_members fixed binary, 14 79 2 member fixed binary (21) dimension (total_members refer (saved_gb.number_of_members)); 14 80 14 81 14 82 declare 1 saved_fb aligned based (saved_bead_pointer), 14 83 2 header aligned like saved_general_bead, 14 84 2 class fixed bin, 14 85 2 stop_control_pointer fixed bin (21), 14 86 2 trace_control_pointer fixed bin (21), 14 87 2 text_length fixed bin, 14 88 2 text aligned char (data_elements refer (saved_fb.text_length)); 14 89 14 90 declare (saved_frame_pointer, saved_reductions_pointer) pointer; 14 91 14 92 declare 14 93 1 saved_pf based(saved_frame_pointer) aligned, 14 94 2 last_parse_frame_ptr ptr unaligned, /* pseudo-pointer to last parse frame, or null */ 14 95 2 parse_frame_type fixed bin, 14 96 2 function_bead_ptr fixed bin (21), /* pseudo-pointer to function bead */ 14 97 2 current_parseme unal fixed bin (17), 14 98 2 current_lexeme unal fixed bin (17), 14 99 2 current_line_number unal fixed bin (17), 14 100 2 return_point unal fixed bin (17), 14 101 2 put_result unal fixed bin (17), 14 102 2 print_final_value unal bit, 14 103 2 re_lex_source unal bit, /* if 1, re-lex the source for this frame */ 14 104 2 pad unal bit (16), 14 105 2 number_of_ptrs fixed bin, 14 106 2 old_meaning_ptrs dim (number_of_ptrs refer (saved_pf.number_of_ptrs)) fixed bin (21); 14 107 /* old meanings for local variables */ 14 108 14 109 declare 14 110 1 v3_saved_pf based (saved_frame_pointer) aligned, 14 111 2 last_parse_frame_ptr ptr unaligned, /* pseudo-pointer to last parse frame, or null */ 14 112 2 parse_frame_type fixed bin, 14 113 2 function_bead_ptr fixed bin (21), /* pseudo-pointer to function bead */ 14 114 2 current_parseme unal fixed bin (17), 14 115 2 current_lexeme unal fixed bin (17), 14 116 2 current_line_number unal fixed bin (17), 14 117 2 return_point unal fixed bin (17), 14 118 2 put_result unal fixed bin (17), 14 119 2 print_final_value unal bit, 14 120 2 re_lex_source unal bit, /* if 1, re-lex the source for this frame */ 14 121 2 pad unal bit (16), 14 122 2 old_meaning_ptrs dim (number_of_ptrs) fixed bin (21); 14 123 /* old meanings for local variables */ 14 124 14 125 declare 14 126 1 saved_rs dim(1000) aligned based(saved_reductions_pointer), 14 127 2 type fixed bin, /* type of parseme */ 14 128 2 bits unaligned like operator_bead.bits_for_parse, 14 129 2 semantics fixed bin (21), /* pseudo-pointer */ 14 130 2 lexeme fixed bin, 14 131 14 132 1 saved_rs_for_op dim(1000) aligned based(saved_reductions_pointer), 14 133 2 type fixed bin, 14 134 2 bits unaligned like operator_bead.bits_for_parse, 14 135 2 semantics fixed bin, 14 136 2 lexeme fixed bin; 14 137 14 138 14 139 declare 1 saved_sf aligned based (saved_frame_pointer), 14 140 2 last_frame_pointer pointer unaligned, /* pointer to last parse frame, or null */ 14 141 2 frame_type fixed binary, /* = save_frame_type */ 14 142 2 saved_symbol_count fixed binary (29), 14 143 2 symbol_list aligned dimension (total_symbols refer (saved_sf.saved_symbol_count)), 14 144 3 symbol_pointer fixed binary (21), /* bead number of each symbol bead */ 14 145 3 saved_meaning_pointer fixed binary (21); /* bead number of meaning at the time frame is created */ 14 146 14 147 /* ------ END INCLUDE SEGMENT apl_saved_ws.incl.pl1 ------------------------------------- */ 903 904 end /* apl_load_command_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/29/83 1346.6 apl_load_command_.pl1 >special_ldd>on>apl.1129>apl_load_command_.pl1 788 1 03/27/82 0429.8 apl_push_stack_fcn.incl.pl1 >ldd>include>apl_push_stack_fcn.incl.pl1 891 2 03/27/82 0429.8 apl_number_data.incl.pl1 >ldd>include>apl_number_data.incl.pl1 892 3 03/27/82 0439.2 apl_ws_info.incl.pl1 >ldd>include>apl_ws_info.incl.pl1 893 4 03/27/82 0438.5 apl_bead_format.incl.pl1 >ldd>include>apl_bead_format.incl.pl1 894 5 03/27/82 0439.0 apl_operator_bead.incl.pl1 >ldd>include>apl_operator_bead.incl.pl1 895 6 03/27/82 0439.2 apl_symbol_bead.incl.pl1 >ldd>include>apl_symbol_bead.incl.pl1 896 7 03/27/82 0439.2 apl_value_bead.incl.pl1 >ldd>include>apl_value_bead.incl.pl1 897 8 03/27/82 0438.7 apl_list_bead.incl.pl1 >ldd>include>apl_list_bead.incl.pl1 898 9 03/27/82 0438.7 apl_function_bead.incl.pl1 >ldd>include>apl_function_bead.incl.pl1 899 10 03/27/82 0438.7 apl_lexed_function_bead.incl.pl1 >ldd>include>apl_lexed_function_bead.incl.pl1 900 11 03/27/82 0438.7 apl_group_bead.incl.pl1 >ldd>include>apl_group_bead.incl.pl1 901 12 03/27/82 0439.0 apl_parse_frame.incl.pl1 >ldd>include>apl_parse_frame.incl.pl1 902 13 03/27/82 0439.1 apl_save_frame.incl.pl1 >ldd>include>apl_save_frame.incl.pl1 903 14 03/27/82 0439.1 apl_saved_ws.incl.pl1 >ldd>include>apl_saved_ws.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. P_n_words parameter fixed bin(19,0) dcl 1-16 ref 1-4 1-35 addr builtin function dcl 795 ref 125 132 132 136 136 140 140 144 144 161 207 209 255 347 347 353 353 458 458 485 485 addrel builtin function dcl 1-25 in procedure "apl_push_stack_" ref 1-44 addrel builtin function dcl 795 in procedure "apl_load_command_" ref 205 347 347 353 353 413 458 458 485 485 572 713 715 allocate_on_stack 000126 automatic bit(1) dcl 761 set ref 763* 769* 780 apl_allocate_words_ 000016 constant entry external dcl 804 ref 782 apl_clear_workspace_ 000046 constant entry external dcl 819 ref 75 apl_create_save_frame_ 000022 constant entry external dcl 806 ref 305 apl_date_time_ 000010 constant entry external dcl 800 ref 408 408 apl_destroy_save_frame_ 000024 constant entry external dcl 808 ref 262 apl_destroy_save_frame_update_ 000026 constant entry external dcl 808 ref 356 apl_error_table_$cant_autoload 000064 external static fixed bin(35,0) dcl 881 ref 64 apl_error_table_$cant_load_ws 000066 external static fixed bin(35,0) dcl 881 set ref 270* 598* 739* apl_error_table_$pendent_function_copied 000070 external static fixed bin(35,0) dcl 881 set ref 524* apl_error_table_$ws_dir_restricted 000072 external static fixed bin(35,0) dcl 881 ref 380 apl_error_table_$ws_locked 000074 external static fixed bin(35,0) dcl 881 ref 404 apl_error_table_$ws_wrong_version 000076 external static fixed bin(35,0) dcl 881 ref 398 apl_execute_lex_ 000044 constant entry external dcl 817 ref 197 apl_free_bead_ 000030 constant entry external dcl 810 ref 558 apl_function_lex_ 000042 constant entry external dcl 817 ref 172 apl_get_symbol_ 000020 constant entry external dcl 805 ref 510 602 apl_get_value_stack_ 000106 constant entry external dcl 1-30 ref 1-40 apl_line_lex_ 000040 constant entry external dcl 817 ref 161 apl_pendant_function_check_ 000012 constant entry external dcl 801 ref 520 apl_segment_manager_$free 000036 constant entry external dcl 815 ref 430 apl_segment_manager_$get 000034 constant entry external dcl 813 ref 412 apl_static_$apl_output 000102 external static pointer dcl 886 set ref 60* 299* 347* 353* 408* 458* 485* apl_static_$ws_info_ptr 000104 external static structure level 1 dcl 3-11 apl_system_error_ 000014 constant entry external dcl 803 ref 270 524 598 739 apl_translate_pathname_$use_search_paths 000032 constant entry external dcl 811 ref 369 autoload 000106 automatic bit(1) dcl 836 set ref 39* 45* 57 64 290* baseno builtin function dcl 795 ref 572 bead_description_pointer 000610 automatic pointer dcl 14-35 set ref 314 328 410* 594 657 bead_description_table based structure array level 1 dcl 14-38 bead_number 000102 automatic fixed bin(21,0) dcl 610 in procedure "load_symbol" set ref 582* 584 587 589 589 594 605 bead_number 000574 automatic fixed bin(21,0) dcl 859 in procedure "apl_load_command_" set ref 417* 418* bead_number 000110 automatic fixed bin(21,0) dcl 629 in procedure "load_bead" set ref 644* 647 650 652 652 654 657 670* 672 672 674 735 bead_pointer 000100 automatic pointer unaligned dcl 608 in procedure "load_symbol" set ref 602* 604 605 bead_pointer 000664 automatic pointer unaligned dcl 550 in procedure "wash" set ref 554* 556 556 558 558* bead_pointer 000100 automatic pointer unaligned dcl 574 in procedure "un_pseudo_pointer" set ref 568* 570 572 572 bead_pointer based pointer array level 2 in structure "bead_description_table" packed unaligned dcl 14-38 in procedure "apl_load_command_" set ref 314* 328* 594* 657* bead_pointer 000554 automatic pointer unaligned dcl 852 in procedure "apl_load_command_" set ref 172* 178 179 180 180 192* 195 197 bead_pointer 000101 automatic pointer unaligned dcl 626 in procedure "load_bead" set ref 663 665 666 679 680 681 682 683 684 690 692 693 695 695 698 706 708 708 711 713 715 719 723 725 735 737 780* 782* 784 785 bead_table_pointer 2 based pointer level 2 packed unaligned dcl 14-12 set ref 410* bead_type based structure level 3 in structure "general_bead" packed unaligned dcl 4-3 in procedure "apl_load_command_" bead_type based structure level 3 in structure "saved_general_bead" packed unaligned dcl 14-44 in procedure "apl_load_command_" before builtin function dcl 795 ref 339 339 binary builtin function dcl 1-25 ref 1-40 bits 1 based structure array level 2 in structure "reduction_stack" packed unaligned dcl 12-31 in procedure "apl_load_command_" set ref 228* bits 3 based structure array level 3 in structure "saved_lb" packed unaligned dcl 14-67 in procedure "apl_load_command_" ref 693 bits 4 based structure array level 3 in structure "list_bead" packed unaligned dcl 8-3 in procedure "apl_load_command_" set ref 693* bits 1 based structure array level 2 in structure "saved_rs" packed unaligned dcl 14-125 in procedure "apl_load_command_" ref 228 bits_for_parse 1 based structure level 2 packed unaligned dcl 5-3 block_ptr 000136 automatic pointer dcl 1-20 set ref 1-43* 1-45 bv_bead_number parameter fixed bin(21,0) dcl 610 in procedure "load_symbol" ref 579 582 bv_bead_number parameter fixed bin(21,0) dcl 621 in procedure "load_bead" ref 615 615 639 644 bv_bead_pointer parameter pointer unaligned dcl 574 in procedure "un_pseudo_pointer" ref 565 568 bv_bead_pointer parameter pointer unaligned dcl 546 in procedure "wash" ref 541 554 bv_code parameter fixed bin(35,0) dcl 877 in procedure "apl_load_command_" set ref 34 42 54* 55 57 59* 64* 273 295* 296 298* bv_code parameter fixed bin(35,0) dcl 365 in procedure "initialize_load_command" set ref 360 369* 370 380* 384* 391* 398* 404* 415* bv_lock parameter char unaligned dcl 876 ref 34 42 273 402 bv_names parameter char array unaligned dcl 278 ref 273 329 339 339 bv_number_of_names parameter fixed bin(17,0) dcl 278 ref 273 309 325 bv_protected parameter bit(1) dcl 278 ref 273 514 bv_symbol_pointer parameter pointer unaligned dcl 502 ref 497 510 516 523 530 bv_wsid parameter char unaligned dcl 876 set ref 34 42 57 84 273 369* 372 character_string_overlay based char dcl 7-19 set ref 197* 723* 723 character_value 0(09) based bit(1) level 5 packed unaligned dcl 7-3 ref 723 class 3 based fixed bin(17,0) level 2 in structure "function_bead" dcl 9-5 in procedure "apl_load_command_" set ref 679* class 1 based fixed bin(17,0) level 2 in structure "saved_fb" dcl 14-82 in procedure "apl_load_command_" ref 679 cleanup 000100 stack reference condition dcl 832 ref 51 292 code 000107 automatic fixed bin(35,0) dcl 837 set ref 347* 353* 458* 485* component 000572 automatic fixed bin(17,0) dcl 855 set ref 390* 391* 391 392* convert_status_code_ 000050 constant entry external dcl 821 ref 59 298 copy_index 000565 automatic fixed bin(17,0) dcl 855 set ref 325* 329 339 339* current_lexeme 3(18) based fixed bin(17,0) level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_load_command_" ref 213 current_lexeme 6 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 12-3 in procedure "apl_load_command_" set ref 213* current_line_number 4 based fixed bin(17,0) level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_load_command_" ref 214 current_line_number 7 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 12-3 in procedure "apl_load_command_" set ref 214* current_parse_frame_ptr 15 based pointer level 3 in structure "ws_info" packed unaligned dcl 3-16 in procedure "apl_load_command_" set ref 100 260* current_parse_frame_ptr 21 based pointer level 3 in structure "saved_ws_info" packed unaligned dcl 14-12 in procedure "apl_load_command_" set ref 103* current_parseme 3 based fixed bin(17,0) level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_load_command_" ref 212 current_parseme 5 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 12-3 in procedure "apl_load_command_" set ref 212* data_elements 000566 automatic fixed bin(17,0) dcl 855 set ref 195* 197 197 711* 723 723 727 728 733 data_pointer 4 based pointer level 2 in structure "value_bead" packed unaligned dcl 7-3 in procedure "apl_load_command_" set ref 197 719* data_pointer 3 based pointer level 2 in structure "saved_value_bead" packed unaligned dcl 14-49 in procedure "apl_load_command_" ref 721 data_type 0(08) based structure level 4 packed unaligned dcl 7-3 datum_number 000113 automatic fixed bin(24,0) dcl 629 set ref 727* 727* 728 728 730* digits 10 based fixed bin(17,0) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_load_command_" ref 77 digits 2 based fixed bin(17,0) level 3 in structure "ws_info" dcl 3-16 in procedure "apl_load_command_" set ref 77* divide builtin function dcl 795 ref 148 dname 000110 automatic char(168) unaligned dcl 838 set ref 60* 60 299* 299 369* 372* 377 ename 000162 automatic char(32) unaligned dcl 838 set ref 60 60* 299 299* 369* 373* error_table_$noentry 000100 external static fixed bin(35,0) dcl 881 ref 57 errors_occurred 000344 automatic bit(1) dcl 844 set ref 161* 164 172* 175 197* 200 fcbp 000556 automatic pointer dcl 854 set ref 47* 288* 369* 384* 391* 434 436* 437* fixed builtin function dcl 795 ref 572 771 float_index_origin 16 based float bin(63) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_load_command_" ref 81 float_index_origin 10 based float bin(63) level 3 in structure "ws_info" dcl 3-16 in procedure "apl_load_command_" set ref 81* found 000345 automatic bit(1) dcl 844 set ref 326* 327 335* 339 frame_type 000561 automatic fixed bin(17,0) dcl 855 set ref 107* 109 function 1(05) based bit(1) array level 3 in structure "reduction_stack" packed unaligned dcl 12-31 in procedure "apl_load_command_" set ref 232 function 0(03) based bit(1) level 4 in structure "general_bead" packed unaligned dcl 4-3 in procedure "apl_load_command_" set ref 520 function_bead based structure level 1 dcl 9-5 function_bead_ptr 2 based pointer level 2 in structure "parse_frame" packed unaligned dcl 12-3 in procedure "apl_load_command_" set ref 157* 169* 172 179 function_bead_ptr 2 based fixed bin(21,0) level 2 in structure "saved_pf" dcl 14-92 in procedure "apl_load_command_" set ref 169* fuzz 14 based float bin(63) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_load_command_" ref 80 fuzz 6 based float bin(63) level 3 in structure "ws_info" dcl 3-16 in procedure "apl_load_command_" set ref 80* general_bead based structure level 1 dcl 4-3 get_wdir_ 000052 constant entry external dcl 823 ref 377 global_meaning_pointer_pointer 5 based pointer array level 3 packed unaligned dcl 13-5 set ref 121* group_bead based structure level 1 dcl 11-7 has_list 1(07) based bit(1) array level 3 packed unaligned dcl 12-31 set ref 232 header based structure level 2 in structure "value_bead" dcl 7-3 in procedure "apl_load_command_" header based structure level 2 in structure "lexed_function_bead" dcl 10-6 in procedure "apl_load_command_" highest_segment 1 based fixed bin(17,0) level 2 dcl 14-12 ref 390 index builtin function dcl 795 ref 658 index_origin 4 based fixed bin(17,0) level 3 in structure "ws_info" dcl 3-16 in procedure "apl_load_command_" set ref 78* index_origin 12 based fixed bin(17,0) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_load_command_" ref 78 initial_value_stack_ptr 13 based pointer level 2 packed unaligned dcl 12-3 set ref 222* integer_fuzz 24 based float bin(63) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_load_command_" ref 82 integer_fuzz 22 based float bin(63) level 2 in structure "ws_info" dcl 3-16 in procedure "apl_load_command_" set ref 82* into_pointer 000104 automatic pointer dcl 627 set ref 713* 715 715* 715 719 723 728 730 733 ioa_$ioa_switch 000054 constant entry external dcl 824 ref 60 299 408 iox_$put_chars 000056 constant entry external dcl 825 ref 347 353 458 485 last_parse_frame_ptr based pointer level 2 in structure "parse_frame" packed unaligned dcl 12-3 in procedure "apl_load_command_" set ref 106* last_parse_frame_ptr based pointer level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_load_command_" set ref 257* latent_expression 25 based pointer level 2 in structure "ws_info" packed unaligned dcl 3-16 in procedure "apl_load_command_" set ref 98* latent_expression 27 based fixed bin(21,0) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_load_command_" set ref 98* length builtin function dcl 795 ref 344 347 347 350 353 353 452 455 455 458 458 479 482 482 485 485 lexed_function_bead based structure level 1 dcl 10-6 lexed_function_bead_pointer 2 based pointer level 2 packed unaligned dcl 9-5 set ref 179* 684* lexed_function_bead_ptr 3 based pointer level 2 packed unaligned dcl 12-3 set ref 156* 161* 178* 182 197* lexeme 3 based fixed bin(17,0) array level 2 in structure "reduction_stack" dcl 12-31 in procedure "apl_load_command_" set ref 251* lexeme 3 based fixed bin(17,0) array level 2 in structure "saved_rs" dcl 14-125 in procedure "apl_load_command_" ref 251 list_bead based structure level 1 dcl 8-3 load_this_one 000346 automatic bit(1) dcl 844 set ref 230* 232* 239* 241 loaded_bead_pointer based pointer array unaligned dcl 869 set ref 93 93 418* 587 589 589 605* 650 652 652 654 672 672 674 735* loaded_bead_table_pointer 000350 automatic pointer dcl 846 set ref 49* 93 93 289* 412* 413 418 428 430* 431* 587 589 589 605 650 652 652 654 672 672 674 735 loading_on_stack 000100 automatic bit(1) dcl 625 set ref 636* 642* 763 lock 30 based char(32) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_load_command_" ref 83 402 lock 26 based char(32) level 2 in structure "ws_info" dcl 3-16 in procedure "apl_load_command_" set ref 83* long_msg 000172 automatic char(100) unaligned dcl 840 set ref 59* 60* 298* 299* maximum_value_stack_size 13 based fixed bin(18,0) level 3 dcl 3-16 ref 1-40 meaning_pointer 1 based fixed bin(21,0) level 2 in structure "saved_sb" dcl 14-59 in procedure "apl_load_command_" set ref 93* 316 329 530* 672* meaning_pointer 3 based pointer level 2 in structure "symbol_bead" packed unaligned dcl 6-13 in procedure "apl_load_command_" set ref 93* 93 512 520 520* 527* 530* 604* 672* 672 member 2 based fixed bin(21,0) array level 2 in structure "saved_gb" dcl 14-76 in procedure "apl_load_command_" set ref 666* member 3 based pointer array level 2 in structure "group_bead" packed unaligned dcl 11-7 in procedure "apl_load_command_" set ref 666* member_number 000112 automatic fixed bin(17,0) dcl 629 set ref 692* 693 693 695 695 695 698 698* member_ptr 2 based fixed bin(21,0) array level 3 in structure "saved_lb" dcl 14-67 in procedure "apl_load_command_" set ref 695* 698* member_ptr 3 based pointer array level 3 in structure "list_bead" packed unaligned dcl 8-3 in procedure "apl_load_command_" set ref 695* 698* members 3 based structure array level 2 in structure "list_bead" dcl 8-3 in procedure "apl_load_command_" members 2 based structure array level 2 in structure "saved_lb" dcl 14-67 in procedure "apl_load_command_" msf_manager_$close 000060 constant entry external dcl 826 ref 436 msf_manager_$get_ptr 000062 constant entry external dcl 827 ref 384 391 n_words 000573 automatic fixed bin(19,0) dcl 858 set ref 771* 777* 777 780* 782* name 3 based char level 2 in structure "saved_sb" packed unaligned dcl 14-59 in procedure "apl_load_command_" set ref 329 510* 516* 523* 602* name parameter char unaligned dcl 448 in procedure "not_copied_" ref 443 455 464 name parameter char unaligned dcl 475 in procedure "not_found_" ref 470 482 491 name_length 2 based fixed bin(17,0) level 2 dcl 14-59 ref 329 510 510 516 516 523 523 602 602 nl 004177 constant char(1) initial dcl 864 ref 346 352 457 484 not_copied 000275 automatic varying char(150) dcl 842 set ref 287* 350 352* 352 353 353 353 353 452 452* 455 457* 457 458 458 458 458 459* 462* 462 464* 464 not_found 000226 automatic varying char(150) dcl 842 set ref 286* 344 346* 346 347 347 347 347 479 479* 482 484* 484 485 485 485 485 486* 489* 489 491* 491 null builtin function dcl 795 ref 47 49 101 103 121 156 157 288 289 385 392 418 428 431 434 437 512 570 570 587 647 650 684 num_words 000140 automatic fixed bin(19,0) dcl 1-20 set ref 1-35* 1-37 1-37* 1-37 1-40 1-40* 1-44 number_of_dimensions 000602 automatic fixed bin(17,0) dcl 7-3 set ref 706* 713 number_of_localized_symbols 5 based fixed bin(17,0) level 2 dcl 10-6 ref 182 number_of_members 2 based fixed bin(17,0) level 2 in structure "list_bead" dcl 8-3 in procedure "apl_load_command_" set ref 690* 692 number_of_members 1 based fixed bin(17,0) level 2 in structure "saved_gb" dcl 14-76 in procedure "apl_load_command_" ref 663 number_of_members 2 based fixed bin(17,0) level 2 in structure "group_bead" dcl 11-7 in procedure "apl_load_command_" set ref 663* 665 number_of_members 1 based fixed bin(17,0) level 2 in structure "saved_lb" dcl 14-67 in procedure "apl_load_command_" ref 690 number_of_ptrs 14 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 12-3 in procedure "apl_load_command_" set ref 223* number_of_ptrs 000603 automatic fixed bin(17,0) dcl 12-20 in procedure "apl_load_command_" set ref 148* 182* 183 203* 205 207 209 223 number_of_symbols 20 based fixed bin(17,0) level 3 dcl 14-12 ref 86 307 numeric_datum based float bin(63) array dcl 7-23 set ref 728* 730* 733* 733 numeric_value 0(10) based bit(1) level 5 packed unaligned dcl 7-3 ref 715 old_meaning_ptrs 15 based pointer array level 2 in structure "parse_frame" packed unaligned dcl 12-3 in procedure "apl_load_command_" set ref 132 136 140 144 161 188* old_meaning_ptrs 7 based fixed bin(21,0) array level 2 in structure "saved_pf" dcl 14-92 in procedure "apl_load_command_" set ref 140 144 186 209 old_meaning_ptrs 6 based fixed bin(21,0) array level 2 in structure "v3_saved_pf" dcl 14-109 in procedure "apl_load_command_" set ref 132 136 184 207 op_type constant fixed bin(17,0) initial dcl 12-31 ref 232 operator_bead based structure level 1 dcl 5-3 other_ws_info 10 based structure level 2 dcl 14-12 parse_frame based structure level 1 dcl 12-3 set ref 205 parse_frame_ptr 000553 automatic pointer unaligned dcl 852 set ref 100* 106 107 111 115 118 121 124 125* 125 132 136 140 144 156 157 161 161 169 172 178 179 182 188 197 205 205 211 212 213 214 216 218 220 221 222 223 254 255* parse_frame_type 1 based fixed bin(17,0) level 2 in structure "saved_pf" dcl 14-92 in procedure "apl_load_command_" ref 107 parse_frame_type 1 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 12-3 in procedure "apl_load_command_" set ref 107* parseme_count 000567 automatic fixed bin(17,0) dcl 855 set ref 192 212* 225 255 pointer builtin function dcl 795 ref 721 pointers 14 based structure level 2 dcl 3-16 previous_frame_pointer 000552 automatic pointer unaligned dcl 852 set ref 101* 106 124* 254* 260 print_final_value 12 based bit(1) level 2 in structure "parse_frame" dcl 12-3 in procedure "apl_load_command_" set ref 221* print_final_value 5(18) based bit(1) level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_load_command_" ref 221 put_result 11 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 12-3 in procedure "apl_load_command_" set ref 220* put_result 5 based fixed bin(17,0) level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_load_command_" ref 220 random_link 5 based fixed bin(35,0) level 3 in structure "ws_info" dcl 3-16 in procedure "apl_load_command_" set ref 79* random_link 13 based fixed bin(35,0) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_load_command_" ref 79 re_lex_source 5(19) based bit(1) level 2 packed unaligned dcl 14-92 ref 154 reduction_number 000570 automatic fixed bin(17,0) dcl 855 set ref 225* 226 226 228 228 232 232 235 235 235 243 243 243 243 247 247 251 251* reduction_stack based structure array level 1 dcl 12-31 set ref 255 reduction_stack_for_op based structure array level 1 dcl 12-31 reduction_stack_ptr 4 based pointer level 2 packed unaligned dcl 12-3 set ref 211* reduction_type 000571 automatic fixed bin(17,0) dcl 855 set ref 226* 232 reductions_pointer 000604 automatic pointer dcl 12-29 set ref 192 205* 211 226 228 232 232 235 235 243 243 243 247 251 255 reference_count 1 based fixed bin(29,0) level 2 in structure "general_bead" dcl 4-3 in procedure "apl_load_command_" set ref 534 556* 556 558 589* 589 652* 652 785* reference_count 1 based fixed bin(29,0) level 3 in structure "lexed_function_bead" dcl 10-6 in procedure "apl_load_command_" set ref 180* 180 rel builtin function dcl 795 in procedure "apl_load_command_" ref 572 715 721 rel builtin function dcl 1-25 in procedure "apl_push_stack_" ref 1-40 restrict_load_directory 1(07) based bit(1) level 3 packed unaligned dcl 3-16 ref 377 return_point 10 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 12-3 in procedure "apl_load_command_" set ref 216* 218* return_point 4(18) based fixed bin(17,0) level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_load_command_" ref 216 218 rho 5 based fixed bin(21,0) array level 2 in structure "value_bead" dcl 7-3 in procedure "apl_load_command_" set ref 708* rho 4 based fixed bin(21,0) array level 2 in structure "saved_value_bead" dcl 14-49 in procedure "apl_load_command_" ref 708 rhorho 3 based fixed bin(17,0) level 2 in structure "value_bead" dcl 7-3 in procedure "apl_load_command_" set ref 706* 708 708 rhorho 2 based fixed bin(17,0) level 2 in structure "saved_value_bead" dcl 14-49 in procedure "apl_load_command_" ref 706 708 save_frame based structure level 1 dcl 13-5 save_version based fixed bin(17,0) level 2 dcl 14-12 ref 128 184 207 396 396 saved_bead_pointer 000101 automatic pointer unaligned dcl 608 set ref 594* 596 602 604 saved_boolean_datum based bit dcl 14-56 ref 728 saved_data_pointer 000102 automatic pointer dcl 627 set ref 721* 723 728 733 saved_fb based structure level 1 dcl 14-82 saved_frame_pointer 000612 automatic pointer dcl 14-90 set ref 103* 103* 107 111 115 118 132 136 140 144 154 169 184 186 207 209 212 213 214 216 218 220 221* 257 saved_gb based structure level 1 dcl 14-76 saved_general_bead based structure level 1 dcl 14-44 saved_lb based structure level 1 dcl 14-67 saved_meaning_pointer 4 based pointer array level 3 in structure "save_frame" packed unaligned dcl 13-5 in procedure "apl_load_command_" set ref 118* saved_meaning_pointer 4 based fixed bin(21,0) array level 3 in structure "saved_sf" dcl 14-139 in procedure "apl_load_command_" set ref 118* saved_pf based structure level 1 dcl 14-92 saved_reductions_pointer 000614 automatic pointer dcl 14-90 set ref 207* 209* 226 228 235 243 247 251 saved_rs based structure array level 1 dcl 14-125 saved_rs_for_op based structure array level 1 dcl 14-125 saved_sb based structure level 1 dcl 14-59 saved_sf based structure level 1 dcl 14-139 saved_symbol_count 2 based fixed bin(29,0) level 2 in structure "save_frame" dcl 13-5 in procedure "apl_load_command_" set ref 111* saved_symbol_count 000560 automatic fixed bin(17,0) dcl 855 in procedure "apl_load_command_" set ref 86* 88 92 307* 313 327 saved_symbol_count 2 based fixed bin(29,0) level 2 in structure "saved_sf" dcl 14-139 in procedure "apl_load_command_" ref 111 saved_value_bead based structure level 1 dcl 14-49 saved_ws_info based structure level 1 dcl 14-12 saved_ws_info_pointer 000606 automatic pointer dcl 14-9 set ref 77 78 79 80 81 82 83 86 98 103 128 184 207 307 388* 390 396 396 402 408 408 410 413 417 sb 000106 automatic pointer dcl 627 set ref 657* 658 663 666 679 680 681 682 683 690 693 695 698 706 708 711 721 721 771 777 784 semantics 2 based fixed bin(17,0) array level 2 in structure "saved_rs_for_op" dcl 14-125 in procedure "apl_load_command_" ref 235 semantics 2 based fixed bin(17,0) array level 2 in structure "reduction_stack_for_op" dcl 12-31 in procedure "apl_load_command_" set ref 235* semantics 2 based fixed bin(21,0) array level 2 in structure "saved_rs" dcl 14-125 in procedure "apl_load_command_" set ref 243* 247* semantics 2 based pointer array level 2 in structure "reduction_stack" packed unaligned dcl 12-31 in procedure "apl_load_command_" set ref 192 243* 247* semantics_on_stack 4(09) based bit(1) array level 4 in structure "list_bead" packed unaligned dcl 8-3 in procedure "apl_load_command_" set ref 695 semantics_on_stack 1(09) based bit(1) array level 3 in structure "reduction_stack" packed unaligned dcl 12-31 in procedure "apl_load_command_" set ref 243 semantics_valid 1(06) based bit(1) array level 3 packed unaligned dcl 12-31 set ref 235 243 short_msg 000224 automatic char(8) unaligned dcl 840 set ref 59* 298* size 0(18) based bit(18) level 2 in structure "saved_general_bead" packed unaligned dcl 14-44 in procedure "apl_load_command_" ref 771 size builtin function dcl 795 in procedure "apl_load_command_" ref 205 713 source_length 000563 automatic fixed bin(17,0) dcl 855 set ref 132* 136 136 140* 144 144 148 161 161 static_ws_info_ptr 000104 external static pointer level 2 packed unaligned dcl 3-11 ref 3-7 stop_control_pointer 4 based pointer level 2 in structure "function_bead" packed unaligned dcl 9-5 in procedure "apl_load_command_" set ref 681* stop_control_pointer 2 based fixed bin(21,0) level 2 in structure "saved_fb" dcl 14-82 in procedure "apl_load_command_" set ref 681* string builtin function dcl 795 set ref 658 725 784* 784 substr builtin function dcl 795 in procedure "apl_load_command_" ref 715 728 substr builtin function dcl 1-25 in procedure "apl_push_stack_" ref 1-37 suspended_source based char dcl 872 set ref 136* 136 144* 144 161* suspended_source_length based fixed bin(29,0) dcl 870 set ref 132 132* 140 140* switches 1 based structure level 2 packed unaligned dcl 3-16 symbol 0(01) based bit(1) level 4 packed unaligned dcl 14-44 ref 316 329 596 symbol_bead based structure level 1 dcl 6-13 symbol_count 000562 automatic fixed bin(17,0) dcl 855 set ref 111* 114 125 symbol_index 000564 automatic fixed bin(17,0) dcl 855 set ref 313* 314* 327* 328* symbol_list 3 based structure array level 2 in structure "saved_sf" dcl 14-139 in procedure "apl_load_command_" symbol_list 3 based structure array level 2 in structure "save_frame" dcl 13-5 in procedure "apl_load_command_" symbol_number 000111 automatic fixed bin(17,0) dcl 629 in procedure "load_bead" set ref 665* 666 666* symbol_number 000575 automatic fixed bin(21,0) dcl 859 in procedure "apl_load_command_" set ref 88* 89* 92* 93 93* 114* 115 115 118 118 121* 183* 184 186 188* symbol_pointer 000555 automatic pointer unaligned dcl 852 in procedure "apl_load_command_" set ref 314* 316 316 316* 328* 329 329 329 334* symbol_pointer 000654 automatic pointer unaligned dcl 506 in procedure "copy" set ref 510* 512 520 520 527 530 534 534* symbol_pointer 3 based pointer array level 3 in structure "save_frame" packed unaligned dcl 13-5 in procedure "apl_load_command_" set ref 115* 125 symbol_pointer 3 based fixed bin(21,0) array level 3 in structure "saved_sf" dcl 14-139 in procedure "apl_load_command_" set ref 115* temp_symbol 000576 automatic fixed bin(21,0) dcl 859 set ref 184* 186* 188* temporary_bead_pointer 000347 automatic pointer unaligned dcl 846 set ref 161 172 197 413* text 7 based char level 2 in structure "function_bead" dcl 9-5 in procedure "apl_load_command_" set ref 172* 683* text 5 based char level 2 in structure "saved_fb" dcl 14-82 in procedure "apl_load_command_" ref 683 text_length 6 based fixed bin(21,0) level 2 in structure "function_bead" dcl 9-5 in procedure "apl_load_command_" set ref 172 172 680* 683 text_length 4 based fixed bin(17,0) level 2 in structure "saved_fb" dcl 14-82 in procedure "apl_load_command_" ref 680 683 time_saved 22 based fixed bin(71,0) level 3 dcl 14-12 set ref 408* 408* total_beads 3 based fixed bin(24,0) level 2 dcl 14-12 ref 413 417 total_data_elements 1 based fixed bin(21,0) level 2 in structure "saved_value_bead" dcl 14-49 in procedure "apl_load_command_" ref 711 total_data_elements 2 based fixed bin(21,0) level 2 in structure "value_bead" dcl 7-3 in procedure "apl_load_command_" set ref 195 711* trace_control_pointer 3 based fixed bin(21,0) level 2 in structure "saved_fb" dcl 14-82 in procedure "apl_load_command_" set ref 682* trace_control_pointer 5 based pointer level 2 in structure "function_bead" packed unaligned dcl 9-5 in procedure "apl_load_command_" set ref 682* type based structure level 3 in structure "value_bead" packed unaligned dcl 7-3 in procedure "apl_load_command_" ref 725 type based structure level 3 in structure "list_bead" packed unaligned dcl 8-3 in procedure "apl_load_command_" type based structure level 3 in structure "lexed_function_bead" packed unaligned dcl 10-6 in procedure "apl_load_command_" type based structure level 2 in structure "general_bead" packed unaligned dcl 4-3 in procedure "apl_load_command_" set ref 784* type based structure level 2 in structure "saved_general_bead" packed unaligned dcl 14-44 in procedure "apl_load_command_" ref 658 784 type based fixed bin(17,0) array level 2 in structure "saved_rs" dcl 14-125 in procedure "apl_load_command_" ref 226 type based structure level 3 in structure "group_bead" packed unaligned dcl 11-7 in procedure "apl_load_command_" type based fixed bin(17,0) array level 2 in structure "reduction_stack" dcl 12-31 in procedure "apl_load_command_" set ref 226* type based structure level 3 in structure "function_bead" packed unaligned dcl 9-5 in procedure "apl_load_command_" type based structure level 3 in structure "symbol_bead" packed unaligned dcl 6-13 in procedure "apl_load_command_" unspec builtin function dcl 795 in procedure "apl_load_command_" set ref 228* 228 693* 693 unspec builtin function dcl 1-25 in procedure "apl_push_stack_" ref 1-37 v3_saved_pf based structure level 1 dcl 14-109 value 0(02) based bit(1) level 4 packed unaligned dcl 14-44 ref 777 value_bead based structure level 1 dcl 7-3 set ref 713 value_stack_ptr 16 based pointer level 3 packed unaligned dcl 3-16 set ref 222 1-40 1-43 1-44* 1-44 values 2 based structure level 2 dcl 3-16 width 3 based fixed bin(17,0) level 3 dcl 3-16 ref 455 482 ws_info based structure level 1 dcl 3-16 ws_info_ptr 000600 automatic pointer initial dcl 3-7 set ref 77 78 79 80 81 82 83 84 98 100 222 260 3-7* 377 455 482 1-40 1-40 1-43 1-44 1-44 ws_segment 000352 automatic pointer array dcl 851 set ref 384* 385 388 391* 392 572 wsid 36 based char(100) level 2 dcl 3-16 set ref 84* zero_or_one_value_type constant bit(18) initial unaligned dcl 4-30 ref 725 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Binary internal static bit(1) initial dcl 2-16 LeftArgSymbol internal static fixed bin(17,0) initial dcl 10-36 MAX_VALUE_BEAD_SIZE internal static fixed bin(19,0) initial dcl 7-28 NumberSize internal static fixed bin(4,0) initial dcl 2-25 ReturnSymbol internal static fixed bin(17,0) initial dcl 10-36 RightArgSymbol internal static fixed bin(17,0) initial dcl 10-36 TheBiggestNumberWeveGot internal static float bin(63) initial dcl 2-16 TheSmallestNumberWeveGot internal static float bin(63) initial dcl 2-16 bol_type internal static fixed bin(17,0) initial dcl 12-31 character_data_structure based structure level 1 dcl 7-15 character_value_type internal static bit(18) initial unaligned dcl 4-30 close_paren_type internal static fixed bin(17,0) initial dcl 12-31 close_rank_type internal static fixed bin(17,0) initial dcl 12-31 close_subscript_type internal static fixed bin(17,0) initial dcl 12-31 complex_datum based complex float bin(63) array dcl 7-26 complex_value_type internal static bit(18) initial unaligned dcl 4-30 current_save_version internal static fixed bin(17,0) initial dcl 14-9 diamond_type internal static fixed bin(17,0) initial dcl 12-31 eol_type internal static fixed bin(17,0) initial dcl 12-31 evaluated_frame_type internal static fixed bin(17,0) initial dcl 12-22 execute_frame_type internal static fixed bin(17,0) initial dcl 12-22 function_frame_type internal static fixed bin(17,0) initial dcl 12-22 function_type internal static bit(18) initial unaligned dcl 4-30 group_type internal static bit(18) initial unaligned dcl 4-30 integral_value_type internal static bit(18) initial unaligned dcl 4-30 label_type internal static bit(18) initial unaligned dcl 4-30 lexed_function_label_values_structure based structure level 1 dcl 10-45 lexed_function_lexemes_structure based structure level 1 dcl 10-45 lexed_function_statement_map based fixed bin(18,0) array dcl 10-45 lexed_function_type internal static bit(18) initial unaligned dcl 4-30 list_value_type internal static bit(18) initial unaligned dcl 4-30 max_parse_stack_depth internal static fixed bin(17,0) initial dcl 3-98 n_members automatic fixed bin(17,0) dcl 8-3 not_integer_mask internal static bit(18) initial unaligned dcl 4-30 not_zero_or_one_mask internal static bit(18) initial unaligned dcl 4-30 numeric_value_type internal static bit(18) initial unaligned dcl 4-30 open_bracket_type internal static fixed bin(17,0) initial dcl 12-31 open_paren_type internal static fixed bin(17,0) initial dcl 12-31 operator_type internal static bit(18) initial unaligned dcl 4-30 output_buffer based char unaligned dcl 3-94 save_frame_pointer automatic pointer unaligned dcl 13-3 save_frame_type internal static fixed bin(17,0) initial dcl 12-22 saved_bead_count automatic fixed bin(17,0) dcl 14-35 saved_bead_pointer automatic pointer dcl 14-41 semi_colon_type internal static fixed bin(17,0) initial dcl 12-31 shared_variable_type internal static bit(18) initial unaligned dcl 4-30 statement_count automatic fixed bin(17,0) dcl 10-45 subscript_type internal static fixed bin(17,0) initial dcl 12-31 suspended_frame_type internal static fixed bin(17,0) initial dcl 12-22 symbol_name_length automatic fixed bin(17,0) dcl 14-41 symbol_type internal static bit(18) initial unaligned dcl 4-30 total_members automatic fixed bin(17,0) dcl 14-41 val_type internal static fixed bin(17,0) initial dcl 12-31 value_type internal static bit(18) initial unaligned dcl 4-30 NAMES DECLARED BY EXPLICIT CONTEXT. allocate 004050 constant entry internal dcl 758 ref 660 676 703 apl_copy_command_ 001361 constant entry external dcl 273 apl_load_command_ 000120 constant entry external dcl 34 apl_load_command_$autoload 000150 constant entry external dcl 42 apl_push_stack_ 004123 constant entry internal dcl 1-4 ref 780 clean_up 002420 constant entry internal dcl 425 ref 51 67 263 268 292 301 357 common 003357 constant label dcl 644 in procedure "load_bead" ref 637 common 004057 constant label dcl 771 in procedure "allocate" ref 764 copy 002713 constant entry internal dcl 497 ref 316 334 copy_bead 003340 constant entry internal dcl 615 ref 530 copy_in_bead 000005 constant label array(0:18) dcl 660 ref 658 copy_other_stuff 001106 constant label dcl 205 ref 158 167 190 end_case 004016 constant label dcl 735 ref 668 685 701 fatal_error 001337 constant label dcl 268 set ref 164 175 200 initialize_load_command 002054 constant entry internal dcl 360 ref 54 295 join 000176 constant label dcl 47 ref 40 load_bead 003331 constant entry internal dcl 615 ref 93 98 115 118 169 188 247 666 672 681 682 698 load_bead_on_stack 003350 constant entry internal dcl 639 ref 243 695 load_frame 000000 constant label array(5) dcl 111 ref 109 load_symbol 003206 constant entry internal dcl 579 ref 89 670 next_frame 001306 constant label dcl 257 ref 126 non_local_return 001336 constant label dcl 265 set ref 599 754 not_copied_ 002462 constant entry internal dcl 443 ref 516 523 not_found_ 002575 constant entry internal dcl 470 ref 339 stack_allocate 004054 constant entry internal dcl 766 ref 687 un_pseudo_pointer 003140 constant entry internal dcl 565 ref 103 257 314 328 410 594 657 wash 003110 constant entry internal dcl 541 ref 527 534 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4764 5074 4203 4774 Length 5662 4203 110 552 561 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME apl_load_command_ 622 external procedure is an external procedure. on unit on line 51 64 on unit on unit on line 292 64 on unit initialize_load_command internal procedure shares stack frame of external procedure apl_load_command_. clean_up 68 internal procedure is called by several nonquick procedures. not_copied_ internal procedure shares stack frame of external procedure apl_load_command_. not_found_ 80 internal procedure is called during a stack extension. copy internal procedure shares stack frame of external procedure apl_load_command_. wash internal procedure shares stack frame of external procedure apl_load_command_. un_pseudo_pointer 65 internal procedure is called by several nonquick procedures. load_symbol 94 internal procedure is called by several nonquick procedures. load_bead 124 internal procedure calls itself recursively. allocate internal procedure shares stack frame of internal procedure load_bead. apl_push_stack_ internal procedure shares stack frame of internal procedure load_bead. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME apl_load_command_ 000106 autoload apl_load_command_ 000107 code apl_load_command_ 000110 dname apl_load_command_ 000162 ename apl_load_command_ 000172 long_msg apl_load_command_ 000224 short_msg apl_load_command_ 000226 not_found apl_load_command_ 000275 not_copied apl_load_command_ 000344 errors_occurred apl_load_command_ 000345 found apl_load_command_ 000346 load_this_one apl_load_command_ 000347 temporary_bead_pointer apl_load_command_ 000350 loaded_bead_table_pointer apl_load_command_ 000352 ws_segment apl_load_command_ 000552 previous_frame_pointer apl_load_command_ 000553 parse_frame_ptr apl_load_command_ 000554 bead_pointer apl_load_command_ 000555 symbol_pointer apl_load_command_ 000556 fcbp apl_load_command_ 000560 saved_symbol_count apl_load_command_ 000561 frame_type apl_load_command_ 000562 symbol_count apl_load_command_ 000563 source_length apl_load_command_ 000564 symbol_index apl_load_command_ 000565 copy_index apl_load_command_ 000566 data_elements apl_load_command_ 000567 parseme_count apl_load_command_ 000570 reduction_number apl_load_command_ 000571 reduction_type apl_load_command_ 000572 component apl_load_command_ 000573 n_words apl_load_command_ 000574 bead_number apl_load_command_ 000575 symbol_number apl_load_command_ 000576 temp_symbol apl_load_command_ 000600 ws_info_ptr apl_load_command_ 000602 number_of_dimensions apl_load_command_ 000603 number_of_ptrs apl_load_command_ 000604 reductions_pointer apl_load_command_ 000606 saved_ws_info_pointer apl_load_command_ 000610 bead_description_pointer apl_load_command_ 000612 saved_frame_pointer apl_load_command_ 000614 saved_reductions_pointer apl_load_command_ 000654 symbol_pointer copy 000664 bead_pointer wash load_bead 000100 loading_on_stack load_bead 000101 bead_pointer load_bead 000102 saved_data_pointer load_bead 000104 into_pointer load_bead 000106 sb load_bead 000110 bead_number load_bead 000111 symbol_number load_bead 000112 member_number load_bead 000113 datum_number load_bead 000126 allocate_on_stack allocate 000136 block_ptr apl_push_stack_ 000140 num_words apl_push_stack_ load_symbol 000100 bead_pointer load_symbol 000101 saved_bead_pointer load_symbol 000102 bead_number load_symbol un_pseudo_pointer 000100 bead_pointer un_pseudo_pointer THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_ne_as alloc_cs call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other return tra_ext bound_check_signal enable shorten_stack ext_entry_desc int_entry int_entry_desc index_bs_1_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. apl_allocate_words_ apl_clear_workspace_ apl_create_save_frame_ apl_date_time_ apl_destroy_save_frame_ apl_destroy_save_frame_update_ apl_execute_lex_ apl_free_bead_ apl_function_lex_ apl_get_symbol_ apl_get_value_stack_ apl_line_lex_ apl_pendant_function_check_ apl_segment_manager_$free apl_segment_manager_$get apl_system_error_ apl_translate_pathname_$use_search_paths convert_status_code_ get_wdir_ ioa_$ioa_switch iox_$put_chars msf_manager_$close msf_manager_$get_ptr THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. apl_error_table_$cant_autoload apl_error_table_$cant_load_ws apl_error_table_$pendent_function_copied apl_error_table_$ws_dir_restricted apl_error_table_$ws_locked apl_error_table_$ws_wrong_version apl_static_$apl_output apl_static_$ws_info_ptr error_table_$noentry LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 3 7 000107 34 000114 39 000144 40 000145 42 000146 45 000174 47 000176 49 000200 51 000201 54 000223 55 000231 57 000233 59 000247 60 000262 64 000335 67 000342 68 000346 75 000347 77 000354 78 000360 79 000362 80 000364 81 000366 82 000370 83 000372 84 000375 86 000403 88 000405 89 000413 90 000421 92 000423 93 000433 96 000452 98 000454 100 000466 101 000471 103 000473 106 000512 107 000515 109 000521 111 000523 114 000526 115 000535 118 000555 121 000572 122 000576 124 000600 125 000602 126 000607 128 000610 132 000613 136 000616 138 000621 140 000622 144 000625 148 000630 154 000634 156 000637 157 000641 158 000642 161 000643 164 000702 167 000705 169 000706 172 000716 175 000757 178 000762 179 000765 180 000767 182 000771 183 000774 184 001003 186 001013 188 001017 189 001030 190 001032 192 001033 195 001040 197 001043 200 001102 203 001105 205 001106 207 001114 209 001125 211 001131 212 001132 213 001137 214 001143 216 001146 218 001156 220 001157 221 001162 222 001166 223 001171 225 001173 226 001203 228 001212 230 001214 232 001215 235 001230 238 001235 239 001236 241 001240 243 001242 247 001261 251 001271 252 001276 254 001300 255 001302 257 001306 260 001322 262 001325 263 001332 265 001336 268 001337 270 001343 271 001352 273 001353 286 001412 287 001413 288 001414 289 001416 290 001417 292 001420 295 001442 296 001450 298 001452 299 001465 301 001540 302 001544 305 001545 307 001552 309 001555 313 001560 314 001567 316 001600 320 001610 321 001612 325 001613 326 001621 327 001622 328 001633 329 001644 334 001673 335 001675 337 001677 339 001701 341 001745 344 001750 346 001752 347 001761 350 002005 352 002007 353 002016 356 002042 357 002047 358 002053 360 002054 369 002056 370 002112 372 002115 373 002123 374 002126 377 002127 380 002146 381 002152 384 002153 385 002201 388 002206 390 002210 391 002217 392 002245 394 002254 396 002256 398 002263 399 002267 402 002270 404 002300 405 002304 408 002305 410 002343 412 002356 413 002365 415 002372 417 002374 418 002404 419 002414 421 002416 425 002417 428 002425 430 002432 431 002440 434 002443 436 002447 437 002456 439 002461 443 002462 452 002473 455 002502 457 002510 458 002517 459 002543 462 002550 464 002557 466 002573 470 002574 479 002610 482 002620 484 002626 485 002635 486 002660 489 002666 491 002676 493 002712 497 002713 510 002715 512 002747 514 002753 516 002760 517 003001 520 003002 523 003022 524 003043 527 003052 530 003061 534 003101 537 003107 541 003110 554 003112 556 003121 558 003124 561 003136 565 003137 568 003145 570 003155 572 003166 579 003205 582 003213 584 003216 587 003217 589 003230 591 003232 594 003233 596 003247 598 003254 599 003263 602 003266 604 003313 605 003316 606 003327 615 003330 636 003345 637 003346 639 003347 642 003355 644 003357 647 003362 650 003372 652 003403 654 003405 657 003413 658 003431 660 003436 663 003437 665 003443 666 003451 667 003464 668 003466 670 003467 672 003476 674 003520 676 003540 679 003541 680 003545 681 003547 682 003561 683 003574 684 003603 685 003605 687 003606 690 003607 692 003613 693 003621 695 003626 698 003645 700 003656 701 003660 703 003661 706 003662 708 003670 711 003715 713 003723 715 003730 719 003741 721 003742 723 003747 725 003757 727 003763 728 003770 730 004002 731 004006 732 004010 733 004011 735 004016 737 004027 739 004036 754 004045 758 004050 763 004051 764 004053 766 004054 769 004055 771 004057 777 004063 780 004067 782 004104 784 004115 785 004120 786 004122 1 4 004123 1 35 004125 1 37 004127 1 40 004134 1 43 004152 1 44 004156 1 45 004163 ----------------------------------------------------------- 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