COMPILATION LISTING OF SEGMENT apl_save_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 1615.9 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 /* Program to )SAVE an APL workspace. 11* R. Lamson and P. Green, August 1973. 12* 13* Modified for Version 3 saved workspace by PG on 12/04/73 14* Modified 740624 by PG to fix saving of boolean values and size of saved numeric value beads. 15* Modified 741016 by PG to fix bugs 178 (throwing away old ws before quota calc), 176 (checking 16* for write permission), and 173 (catching no_dir code from apl_translate_pathname_). 17* Modified 741108 by PG for saving function frames correctly, printing a better "not enough quota" message, 18* and adding error check to translate_pointer. 19* Modified 761011 by PG for new parse_frame declaration, and to save version 4 workspaces. 20* Modified 780104 by PG to fix bug 300 (truncating old ws too soon). 21**/ 22 23 apl_save_command_: 24 procedure (a_wsid, a_lock, a_code); 25 26 a_code = 0; 27 28 if a_wsid = "" 29 then wsid = ws_info.wsid; 30 else wsid = a_wsid; 31 32 if a_lock = "" 33 then if wsid ^= ws_info.wsid 34 then lock = ""; 35 else lock = ws_info.lock; 36 else lock = a_lock; 37 38 if wsid = "clear ws" 39 then do; 40 bitch: 41 call ioa_$ioa_stream (output_stream, "not saved, this ws is ^a", ws_info.wsid); 42 a_code = apl_error_table_$cant_save_ws; 43 return; 44 end; 45 46 call apl_translate_pathname_ (wsid, dname, ename, fcbp, code); 47 48 if code = 0 /* a zero code means that the ws already exists. */ 49 then if wsid ^= ws_info.wsid 50 then if wsid ^= "continue" 51 then go to bitch; 52 53 if code ^= 0 54 then if code ^= error_table_$noentry /* this one is ok - ws will be created. */ 55 then do; 56 call com_err_ (code, "apl", "^a>^a", dname, ename); 57 a_code = code; 58 return; 59 end; 60 61 bead_table_pointer = apl_segment_manager_$get (); 62 stack_frame_table_pointer = addrel (bead_table_pointer, 49152); 63 64 saved_bead_count, 65 max_component_number, 66 current_segment_length, 67 current_component_number = 0; 68 69 current_pseudo_baseptr = baseptr (0); 70 BeadBase = baseptr (0); 71 72 on record_quota_overflow go to unwind_and_abort; 73 on cleanup call cleaner_upper; 74 75 call apl_create_save_frame_; 76 77 n_words = size (saved_ws_info); 78 call save_allocate; 79 saved_ws_info_pseudo_pointer = save_pseudo_pointer; 80 81 do bucket_number = 1 to symbol_table.table_size; 82 83 do symbol_bead_ptr = symbol_table.hash_bucket_ptr (bucket_number) 84 repeat (symbol_bead_ptr -> symbol_bead.hash_link_pointer) 85 while (symbol_bead_ptr ^= null); 86 87 call save_bead (symbol_bead_ptr); 88 end; 89 end; 90 91 92 do symbol_number = 1 to saved_bead_count; 93 call save_bead (saved_bead_table (symbol_number).active_bead_pointer -> symbol_bead.meaning_pointer); 94 end; 95 96 call save_bead (ws_info.latent_expression); 97 98 this_frame = 0; 99 previous_frame_pointer = null; 100 101 do parse_frame_ptr = ws_info.current_parse_frame_ptr 102 repeat (parse_frame_ptr -> parse_frame.last_parse_frame_ptr) 103 while (parse_frame_ptr ^= null); 104 105 this_frame = this_frame + 1; 106 107 if parse_frame.parse_frame_type = save_frame_type 108 then do; 109 110 total_symbols = parse_frame_ptr -> save_frame.saved_symbol_count; 111 n_words = size (saved_sf); 112 call save_allocate; 113 saved_stack_frame_table (this_frame).active_frame_pointer = parse_frame_ptr; 114 saved_stack_frame_table (this_frame).pseudo_pointer = save_pseudo_pointer; 115 saved_stack_frame_table (this_frame).previous_pseudo_pointer = previous_frame_pointer; 116 previous_frame_pointer = save_pseudo_pointer; 117 118 do symbol_number = 1 to parse_frame_ptr -> save_frame.saved_symbol_count; 119 call save_bead (parse_frame_ptr -> save_frame.saved_meaning_pointer (symbol_number)); 120 end; 121 122 end; 123 else do; /* all parse frame types (save frame is not really a parse frame.) */ 124 125 if parse_frame.parse_frame_type = function_frame_type 126 then do; 127 call save_bead (parse_frame.function_bead_ptr); 128 number_of_ptrs = parse_frame.lexed_function_bead_ptr -> 129 lexed_function_bead.number_of_localized_symbols; 130 n_words = size (saved_pf); 131 end; 132 133 else if parse_frame.parse_frame_type = execute_frame_type 134 then do; 135 number_of_ptrs = 0; 136 n_words = size (saved_pf); 137 end; 138 else do; 139 number_of_ptrs = divide(addr(parse_frame.old_meaning_ptrs(1)) -> 140 suspended_source_length + 3, 4, 21, 0) + 1; 141 n_words = size (saved_pf); 142 number_of_ptrs = 0; 143 end; 144 145 call save_allocate; 146 147 saved_stack_frame_table (this_frame).pseudo_pointer = save_pseudo_pointer; 148 saved_stack_frame_table (this_frame).active_frame_pointer = parse_frame_ptr; 149 saved_stack_frame_table (this_frame).previous_pseudo_pointer = previous_frame_pointer; 150 previous_frame_pointer = save_pseudo_pointer; 151 152 reduction_stack_size = parse_frame.current_parseme; 153 n_words = reduction_stack_size * size (single_rs_element); 154 call save_allocate; 155 156 saved_stack_frame_table (this_frame).reduction_stack_pointer = save_pseudo_pointer; 157 158 do symbol_number = 1 to number_of_ptrs; 159 call save_bead (parse_frame.old_meaning_ptrs (symbol_number)); 160 end; 161 162 reductions_pointer = parse_frame.reduction_stack_ptr; 163 164 do parseme = 1 to reduction_stack_size; 165 save_this_one = "0"b; 166 167 if reduction_stack (parseme).type = op_type 168 then if reduction_stack (parseme).function 169 then save_this_one = "1"b; 170 else if reduction_stack (parseme).has_list 171 then save_this_one = "1"b; 172 else; /* rs_for_op */ 173 else save_this_one = "1"b; 174 175 if save_this_one 176 then do; 177 if reduction_stack (parseme).semantics_valid 178 then if reduction_stack (parseme).semantics_on_stack 179 then call save_bead_on_stack (reduction_stack (parseme).semantics); 180 else call save_bead (reduction_stack (parseme).semantics); 181 else; 182 end; 183 end; 184 end; 185 end; 186 187 n_words = size (bead_description_table); 188 call save_allocate; 189 bead_description_pseudo_pointer = save_pseudo_pointer; 190 191 segment_length (current_component_number) = current_segment_length; 192 193 total_length = 0; 194 195 do component = 0 to max_component_number; 196 total_length = total_length + divide (segment_length (component) + 1023, 1024, 18, 0); 197 end; 198 199 if max_component_number > 0 200 then total_length = total_length + 2; 201 202 /* Get pointers to, and check the access on, all workspace components. */ 203 204 old_workspace_length = 0; 205 do component = 0 to max_component_number; 206 call msf_manager_$get_ptr (fcbp, component, "1"b, ws_segment (component), (0), code); 207 if ws_segment (component) = null 208 then do; 209 call com_err_ (code, "apl", "^a>^a", dname, ename); 210 go to return_code; 211 end; 212 else do; 213 call hcs_$fs_get_path_name (ws_segment (component), directory, (0), entryname, code); 214 215 if code = 0 216 then call hcs_$status_ (directory, entryname, 1b, addr (branch), null, code); 217 218 if code ^= 0 219 then do; 220 call com_err_ (code, "apl", "^a>^a", dname, ename); 221 go to return_code; 222 end; 223 224 if (bit (branch.mode, 5) & "01010"b) ^= "01010"b /* don't have RW access */ 225 then do; 226 call ioa_$ioa_stream (output_stream, "not saved, need rw access on entry."); 227 go to return_code; 228 end; 229 230 old_workspace_length = old_workspace_length + branch.records; 231 end; 232 end; 233 234 directory = dname; 235 236 calculate_remaining_quota: 237 call hcs_$quota_get (directory, total_quota, (0), (""b), (0), terminal_account, quota_used, code); 238 if code ^= 0 239 then do; 240 /* Make up some numbers. It's possible we just don't have status & modify permission to 241* the directory in which we're saving. We might still have append permission. 242* Our record_quota_overflow handler will save us. */ 243 244 code = 0; 245 terminal_account = 1; 246 total_quota = 1000000; 247 quota_used = 0; 248 end; 249 250 if terminal_account = 0 251 then do; 252 previous_greater_than_position = length (directory) - index (reverse (directory), ">"); 253 directory = substr (directory, 1, previous_greater_than_position); 254 go to calculate_remaining_quota; 255 end; 256 257 quota_used = quota_used - old_workspace_length; /* Pretend we have truncated old workspace */ 258 quota_remaining = total_quota - quota_used; /* Figure how much quota remains. */ 259 260 if quota_remaining < total_length /* Does the new workspace fit? */ 261 then do; /* No. */ 262 call ioa_$ioa_stream (output_stream, "can't save ^a (^d record^[^;s^]); need ^d more record^[^;s^]", 263 wsid, total_length, (total_length = 1), total_length - quota_remaining, 264 (total_length - quota_remaining = 1)); 265 go to return_code; 266 end; 267 268 /* At this point we know we are going to save the workspace. But we don't truncate 269* the old workspace first because of the NSS-76 truncating rule...truncate after 270* write, not before, or you may get a segment full of zeros if a crash occurs after the 271* truncate but before the VTOC is updated to reflect the new pages. */ 272 273 /* Begin actual )save operation, now that we know we've got room. */ 274 275 saved_ws_info_pointer = un_pseudo_pointer (saved_ws_info_pseudo_pointer); 276 bead_description_pointer = un_pseudo_pointer (bead_description_pseudo_pointer); 277 278 saved_ws_info.save_version = current_save_version; 279 saved_ws_info.highest_segment = max_component_number; 280 saved_ws_info.bead_table_pointer = bead_description_pseudo_pointer; 281 saved_ws_info.total_beads = saved_bead_count; 282 283 saved_ws_info.digits = ws_info.digits; 284 saved_ws_info.width = ws_info.width; 285 saved_ws_info.index_origin = ws_info.index_origin; 286 saved_ws_info.random_link = ws_info.random_link; 287 saved_ws_info.fuzz = ws_info.fuzz; 288 saved_ws_info.float_index_origin = ws_info.float_index_origin; 289 saved_ws_info.number_of_symbols = ws_info.number_of_symbols; 290 saved_ws_info.current_parse_frame_ptr = previous_frame_pointer; 291 saved_ws_info.integer_fuzz = ws_info.integer_fuzz; 292 saved_ws_info.user_number = ws_info.user_number; 293 saved_ws_info.latent_expression = translate_pointer (ws_info.latent_expression); 294 saved_ws_info.user_name = ws_info.user_name; 295 296 saved_ws_info.lock = lock; 297 ws_info.lock = lock; 298 299 saved_ws_info.wsid = wsid; 300 ws_info.wsid = wsid; 301 302 do bead_number = 1 to saved_bead_count; 303 304 bead_pointer = saved_bead_table (bead_number).active_bead_pointer; 305 saved_bead_pointer = un_pseudo_pointer (saved_bead_table (bead_number).pseudo_pointer); 306 bead_description_table (bead_number).bead_pointer = saved_bead_table (bead_number).pseudo_pointer; 307 308 go to copy_bead (saved_bead_table (bead_number).bead_type); 309 310 copy_bead (1): /* group bead */ 311 312 unspec (saved_general_bead) = unspec (bead_pointer -> general_bead); 313 314 element_count, 315 saved_gb.number_of_members = bead_pointer -> group_bead.number_of_members; 316 317 do symbol_number = 1 to element_count; 318 saved_gb.member (symbol_number) = 319 translate_pointer (bead_pointer -> group_bead.member (symbol_number)); 320 end; 321 322 go to next_bead; 323 324 copy_bead (2): /* symbol bead */ 325 326 unspec (saved_general_bead) = unspec (bead_pointer -> general_bead); 327 328 saved_sb.name_length = bead_pointer -> symbol_bead.name_length; 329 330 saved_sb.name = bead_pointer -> symbol_bead.name; 331 332 saved_sb.meaning_pointer = translate_pointer (bead_pointer -> symbol_bead.meaning_pointer); 333 334 go to next_bead; 335 336 copy_bead (3): /* function bead */ 337 338 unspec (saved_general_bead) = unspec (bead_pointer -> general_bead); 339 340 saved_fb.class = bead_pointer -> function_bead.class; 341 342 saved_fb.text_length = bead_pointer -> function_bead.text_length; 343 344 saved_fb.text = bead_pointer -> function_bead.text; 345 346 saved_fb.stop_control_pointer = 347 translate_pointer (bead_pointer -> function_bead.stop_control_pointer); 348 349 saved_fb.trace_control_pointer = 350 translate_pointer (bead_pointer -> function_bead.trace_control_pointer); 351 352 go to next_bead; 353 354 copy_bead (4): /* list bead */ 355 356 unspec (saved_general_bead) = unspec (bead_pointer -> general_bead); 357 358 element_count, 359 saved_lb.number_of_members = bead_pointer -> list_bead.number_of_members; 360 361 do member_number = 1 to element_count; 362 unspec (saved_lb.bits (member_number)) = 363 unspec (bead_pointer -> list_bead.bits (member_number)); 364 365 saved_lb.member_ptr (member_number) = 366 translate_pointer (bead_pointer -> list_bead.member_ptr (member_number)); 367 end; 368 369 go to next_bead; 370 371 copy_bead (5): /* numeric value bead */ 372 373 call copy_value_bead_header; 374 375 if data_elements ^= 0 376 then do; 377 copy_to_pointer -> numeric_datum (*) = 378 copy_from_pointer -> numeric_datum (*); 379 end; 380 381 go to next_bead; 382 383 copy_bead (6): /* character value bead */ 384 385 call copy_value_bead_header; 386 387 if data_elements ^= 0 388 then copy_to_pointer -> character_string_overlay = 389 copy_from_pointer -> character_string_overlay; 390 391 go to next_bead; 392 393 copy_bead (7): /* boolean value bead */ 394 395 call copy_value_bead_header; 396 397 copy_to_pointer -> saved_boolean_datum = ""b; 398 399 do datum_number = 0 by 1 while (datum_number < data_elements); 400 if copy_from_pointer -> numeric_datum (datum_number) = 1e0 401 then substr (copy_to_pointer -> saved_boolean_datum, datum_number + 1, 1) = "1"b; 402 end; 403 next_bead: 404 end; 405 406 do frame_number = 1 to this_frame; 407 408 parse_frame_ptr = saved_stack_frame_table (frame_number).active_frame_pointer; 409 saved_frame_pointer = un_pseudo_pointer (saved_stack_frame_table (frame_number).pseudo_pointer); 410 411 saved_pf.parse_frame_type = parse_frame.parse_frame_type; 412 saved_pf.last_parse_frame_ptr = saved_stack_frame_table (frame_number).previous_pseudo_pointer; 413 414 if parse_frame.parse_frame_type = save_frame_type 415 then do; 416 saved_sf.saved_symbol_count = parse_frame_ptr -> save_frame.saved_symbol_count; 417 418 do symbol_number = 1 to parse_frame_ptr -> save_frame.saved_symbol_count; 419 saved_sf.symbol_pointer (symbol_number) = 420 translate_pointer (parse_frame_ptr -> save_frame.symbol_pointer (symbol_number)); 421 422 saved_sf.saved_meaning_pointer (symbol_number) = 423 translate_pointer (parse_frame_ptr -> save_frame.saved_meaning_pointer (symbol_number)); 424 end; 425 end; 426 else do; 427 saved_pf.current_parseme = parse_frame.current_parseme; 428 saved_pf.current_lexeme = parse_frame.current_lexeme; 429 saved_pf.current_line_number = parse_frame.current_line_number; 430 saved_pf.return_point = parse_frame.return_point; 431 saved_pf.put_result = parse_frame.put_result; 432 saved_pf.print_final_value = parse_frame.print_final_value; 433 saved_pf.number_of_ptrs = parse_frame.number_of_ptrs; 434 435 /* parse_frame.initial_value_stack_ptr will be re-created by load, 436* when it re-creates the value stacks, so it is not saved. */ 437 438 go to copy_frame_header (parse_frame.parse_frame_type); 439 440 copy_frame_header (1): /* suspended frame */ 441 copy_frame_header (3): /* evaluated frame */ 442 443 source_length, 444 addr (saved_pf.old_meaning_ptrs (1)) -> suspended_source_length = 445 addr (parse_frame.old_meaning_ptrs (1)) -> suspended_source_length; 446 447 addr (saved_pf.old_meaning_ptrs (2)) -> suspended_source = 448 addr (parse_frame.old_meaning_ptrs (2)) -> suspended_source; 449 450 /* Tell load command whether or not to re-lex the source. 451* 0=don't re-lex, 1=re-lex. */ 452 453 if parse_frame.lexed_function_bead_ptr = null 454 then saved_pf.re_lex_source = "0"b; 455 else saved_pf.re_lex_source = "1"b; 456 457 go to copy_rest_of_frame; 458 459 copy_frame_header (2): /* function frame */ 460 461 do symbol_number = 1 to parse_frame.lexed_function_bead_ptr -> 462 lexed_function_bead.number_of_localized_symbols; 463 saved_pf.old_meaning_ptrs (symbol_number) = 464 translate_pointer (parse_frame.old_meaning_ptrs (symbol_number)); 465 end; 466 saved_pf.function_bead_ptr = translate_pointer (parse_frame.function_bead_ptr); 467 468 copy_frame_header (4): /* execute frame */ 469 /* We will copy the source for this frame in the next frame. */ 470 copy_rest_of_frame: 471 472 saved_reductions_pointer = 473 un_pseudo_pointer (saved_stack_frame_table (frame_number).reduction_stack_pointer); 474 reductions_pointer = parse_frame.reduction_stack_ptr; 475 476 do parseme_number = 1 to parse_frame.current_parseme; 477 saved_rs (parseme_number).type, 478 my_type = reduction_stack (parseme_number).type; 479 copy_this_one = "0"b; 480 481 if my_type = op_type 482 then if reduction_stack (parseme_number).function 483 then copy_this_one = "1"b; 484 else if reduction_stack (parseme_number).has_list 485 then copy_this_one = "1"b; 486 else if reduction_stack (parseme_number).semantics_valid 487 then saved_rs_for_op (parseme_number).semantics = 488 reduction_stack_for_op (parseme_number).semantics; 489 else; 490 else copy_this_one = "1"b; 491 492 if copy_this_one 493 then do; 494 if reduction_stack(parseme_number).semantics_valid 495 then saved_rs (parseme_number).semantics 496 = translate_pointer (reduction_stack(parseme_number).semantics); 497 end; 498 499 unspec (saved_rs (parseme_number).bits) = unspec (reduction_stack (parseme_number).bits); 500 501 saved_rs (parseme_number).lexeme = reduction_stack (parseme_number).lexeme; 502 end; 503 end; 504 end; 505 506 current_time, 507 saved_ws_info.time_saved = clock (); 508 509 call msf_manager_$adjust (fcbp, max_component_number, 36 * segment_length (max_component_number), 510 "111"b /* set bc, truncate, terminate */, code); 511 512 /* (we don't care about the code, since we can re-load it even if the bc is bad... */ 513 514 call cleaner_upper; 515 516 if a_wsid = "" | a_wsid = "continue" 517 then call ioa_$ioa_stream (output_stream, "saved ^a ^a", apl_date_time_ (current_time), ws_info.wsid); 518 else call ioa_$ioa_stream (output_stream, "saved ^a", apl_date_time_ (current_time)); 519 520 return; 521 522 /* Record quota overflow handler comes here. Clean up the mess and tell loser. */ 523 524 unwind_and_abort: 525 /* must delete partial saved ws here */ 526 call ioa_$ioa_stream(output_stream, "not saved, not enough quota"); 527 528 return_code: 529 call cleaner_upper; 530 a_code = apl_error_table_$cant_save_ws; 531 return; 532 533 cleaner_upper: 534 procedure; 535 536 do bead_number = 1 to saved_bead_count; 537 538 if saved_bead_table (bead_number).active_bead_pointer -> general_bead.reference_count < 0 539 then saved_bead_table (bead_number).active_bead_pointer -> general_bead.reference_count = 540 saved_bead_table (bead_number).active_reference_count; 541 542 end; 543 544 call apl_destroy_save_frame_; 545 call apl_segment_manager_$free (bead_table_pointer); 546 call msf_manager_$close (fcbp); 547 548 end cleaner_upper; 549 550 /* subroutine used by copy_bead loop to do just what it says... */ 551 552 copy_value_bead_header: 553 procedure; 554 555 data_elements, 556 saved_value_bead.total_data_elements = bead_pointer -> value_bead.total_data_elements; 557 558 number_of_dimensions, 559 saved_value_bead.rhorho = bead_pointer -> value_bead.rhorho; 560 561 string (saved_general_bead.type) = string (bead_pointer -> general_bead.type); 562 563 /* recompute size to eliminate counting the padding word, if any. apl_load_command_ will 564* always re-pad value beads by adding 1 to this saved size. */ 565 566 saved_general_bead.size = bit (add (size (value_bead), size (numeric_datum), 18, 0), 18); 567 568 if saved_value_bead.rhorho ^= 0 569 then saved_value_bead.rho (*) = bead_pointer -> value_bead.rho (*); 570 571 copy_from_pointer = bead_pointer -> value_bead.data_pointer; 572 573 copy_to_pointer = addr (saved_bead_pointer -> saved_value_bead.rho (number_of_dimensions + 1)); 574 575 if saved_value_bead.numeric_value & ^saved_value_bead.zero_or_one_value 576 then if substr (rel (copy_to_pointer), 18, 1) 577 then copy_to_pointer = addrel (copy_to_pointer, 1); 578 579 saved_value_bead.data_pointer = copy_to_pointer; 580 581 end copy_value_bead_header; 582 583 /* subroutine used by first pass to reserve space for each item in the saved ws. */ 584 585 save_allocate: 586 procedure; 587 588 if n_words + current_segment_length > sys_info$max_seg_size 589 then do; 590 591 segment_length (current_component_number) = current_segment_length; 592 593 do component = 0 to max_component_number; 594 if segment_length (component) + n_words <= sys_info$max_seg_size 595 then go to found_component; 596 end; 597 598 max_component_number, component = max_component_number + 1; 599 segment_length (component) = 0; 600 found_component: 601 segment_length (current_component_number) = current_segment_length; 602 current_segment_length = segment_length (component); 603 current_component_number = component; 604 current_pseudo_baseptr = baseptr (component); 605 end; 606 607 save_pseudo_pointer = addrel (current_pseudo_baseptr, current_segment_length); 608 current_segment_length = current_segment_length + n_words; 609 610 end save_allocate; 611 612 save_bead_on_stack: 613 save_bead: 614 procedure (bv_bead_pointer); 615 616 declare bead_type fixed bin, 617 element_number fixed bin (24), 618 (bead_pointer, control_pointer) pointer unaligned; 619 620 declare bv_bead_pointer pointer unaligned parameter; 621 622 bead_pointer = bv_bead_pointer; 623 624 if bead_pointer = null 625 then return; 626 627 if bead_pointer -> general_bead.reference_count < 0 628 then return; 629 630 go to compute_size (index (string (bead_pointer -> general_bead.type), "1"b)); 631 632 compute_size (1): /* OPERATOR BEAD */ 633 634 return; 635 636 compute_size (2): /* SYMBOL BEAD */ 637 638 symbol_name_length = bead_pointer -> symbol_bead.name_length; 639 640 n_words = size (saved_sb); 641 642 bead_type = symbol_bead_type; 643 go to allocate; 644 645 compute_size (3): /* VALUE BEAD */ 646 647 call save_value_bead (bead_pointer); 648 return; 649 650 compute_size (4): /* FUNCTION BEAD */ 651 652 control_pointer = bead_pointer -> function_bead.stop_control_pointer; 653 654 if control_pointer ^= null 655 then call save_value_bead (control_pointer); 656 657 control_pointer = bead_pointer -> function_bead.trace_control_pointer; 658 659 if control_pointer ^= null 660 then call save_value_bead (control_pointer); 661 662 data_elements = bead_pointer -> function_bead.text_length; 663 664 n_words = size (saved_fb); 665 666 bead_type = function_bead_type; 667 668 go to allocate; 669 670 compute_size (5): /* GROUP BEAD */ 671 672 total_members = bead_pointer -> group_bead.number_of_members; 673 674 n_words = size (saved_gb); 675 676 bead_type = group_bead_type; 677 678 go to allocate; 679 680 compute_size (9): /* LIST BEAD */ 681 682 total_members = bead_pointer -> list_bead.number_of_members; 683 684 n_words = size (saved_lb); 685 686 bead_type = list_value_bead_type; 687 688 go to allocate; 689 690 allocate: 691 call save_allocate; 692 693 /* Set active_bead_pointer before updating saved_bead_count, so our clean_up procedure will always work. */ 694 695 saved_bead_table (saved_bead_count + 1).active_bead_pointer = bead_pointer; 696 saved_bead_count = saved_bead_count + 1; 697 698 saved_bead_table (saved_bead_count).active_reference_count = bead_pointer -> general_bead.reference_count; 699 saved_bead_table (saved_bead_count).pseudo_pointer = save_pseudo_pointer; 700 saved_bead_table (saved_bead_count).bead_type = bead_type; 701 bead_pointer -> general_bead.reference_count = - saved_bead_count; 702 703 return; 704 705 compute_size (0): 706 compute_size (6): /* LABEL BEAD */ 707 compute_size (7): /* SHARED VARIABLE BEAD */ 708 compute_size (8): /* LEXED FUNCTION BEAD */ 709 compute_size (10): 710 compute_size (11): 711 compute_size (12): 712 compute_size (13): 713 compute_size (14): 714 compute_size (15): 715 compute_size (16): 716 compute_size (17): 717 compute_size (18): 718 719 call apl_system_error_ (apl_error_table_$cant_save_ws); 720 go to unwind_and_abort; 721 722 /* This procedure is separate so that save_bead (and save_value_bead) can be quick blocks. */ 723 724 save_value_bead: 725 procedure (bv_bead_pointer); 726 727 declare bv_bead_pointer pointer unaligned parameter, 728 bead_pointer pointer unaligned; 729 730 bead_pointer = bv_bead_pointer; 731 732 if bead_pointer -> general_bead.reference_count < 0 /* already saved */ 733 then return; 734 735 data_elements = bead_pointer -> value_bead.total_data_elements; 736 number_of_dimensions = bead_pointer -> value_bead.rhorho; 737 738 if bead_pointer -> value_bead.character_value 739 then do; 740 n_words = size (character_string_overlay); 741 bead_type = character_value_bead_type; 742 end; 743 else if string(bead_pointer -> value_bead.type) = zero_or_one_value_type 744 then do; 745 n_words = size (saved_boolean_datum); 746 bead_type = boolean_value_bead_type; 747 end; 748 else do; 749 n_words = size (numeric_datum (*)) + 1; 750 bead_type = numeric_value_bead_type; 751 end; 752 753 n_words = n_words + size (saved_value_bead); 754 755 call save_allocate; 756 757 /* Set active_bead_pointer before updating saved_bead_count, so our clean_up procedure will always work. */ 758 759 saved_bead_table (saved_bead_count + 1).active_bead_pointer = bead_pointer; 760 saved_bead_count = saved_bead_count + 1; 761 762 saved_bead_table (saved_bead_count).active_reference_count = bead_pointer -> general_bead.reference_count; 763 saved_bead_table (saved_bead_count).pseudo_pointer = save_pseudo_pointer; 764 saved_bead_table (saved_bead_count).bead_type = bead_type; 765 bead_pointer -> general_bead.reference_count = - saved_bead_count; 766 767 return; 768 769 end save_value_bead; 770 771 end save_bead; 772 773 /* function to convert saved bead location in MSF to ITS pointer */ 774 775 un_pseudo_pointer: 776 procedure (bv_pseudo_pointer) returns (pointer unaligned); 777 778 declare bv_pseudo_pointer pointer unaligned parameter, 779 pseudo_pointer pointer unaligned; 780 781 pseudo_pointer = bv_pseudo_pointer; 782 783 return (addrel (ws_segment (fixed (baseno (pseudo_pointer), 18, 0)), rel (pseudo_pointer))); 784 785 end un_pseudo_pointer; 786 787 788 789 /* function to convert ITS pointer to bead number */ 790 791 translate_pointer: 792 procedure (bv_bead_pointer) returns (fixed binary (21)); 793 794 declare bv_bead_pointer pointer unaligned parameter, 795 bead_pointer pointer unaligned; 796 797 bead_pointer = bv_bead_pointer; 798 799 if bead_pointer = null 800 then return (0); 801 else if bead_pointer -> general_bead.reference_count > 0 /* bead was never "saved"! */ 802 then call apl_system_error_ (apl_error_table_$cant_save_ws); 803 else return (- bead_pointer -> general_bead.reference_count); 804 805 end translate_pointer; 806 807 /* parameters */ 808 809 declare ((a_wsid, a_lock) char (*), 810 a_code fixed bin (35)) parameter; 811 812 /* automatic */ 813 814 declare (n_words, bucket_number, this_frame, reduction_stack_size, symbol_number, parseme, 815 total_length, component, current_component_number, datum_number, 816 total_quota, quota_used, quota_remaining, bead_number, element_count, 817 member_number, data_elements, current_segment_length, parseme_number, 818 terminal_account, previous_greater_than_position, 819 my_type, frame_number, source_length, total_symbols, old_workspace_length 820 ) fixed binary (24) automatic; 821 822 declare max_component_number fixed bin; 823 824 declare code fixed binary (35); 825 826 declare current_time fixed binary (71) automatic; 827 828 declare segment_length fixed binary (24) automatic dimension (0:63); 829 830 declare (current_pseudo_baseptr, saved_ws_info_pseudo_pointer, symbol_bead_ptr, 831 save_pseudo_pointer, previous_frame_pointer, parse_frame_ptr, 832 copy_from_pointer, copy_to_pointer, bead_pointer, 833 BeadBase, bead_description_pseudo_pointer 834 ) pointer unaligned automatic; 835 836 declare (fcbp, ws_segment (0:63) 837 ) pointer aligned automatic; 838 839 declare (bead_table_pointer, stack_frame_table_pointer 840 ) pointer aligned; 841 842 declare (dname, directory 843 ) character (168) automatic; 844 845 declare (ename, entryname, lock 846 ) character (32) automatic; 847 848 declare wsid character (100) automatic; 849 850 declare (copy_this_one, save_this_one) bit(1) aligned; 851 852 declare 1 branch aligned, 853 2 type bit (2) unal, 854 2 n_names fixed bin (15) unal, 855 2 nrp bit (18) unal, 856 2 dtm bit (36) unal, 857 2 dtu bit (36) unal, 858 2 mode bit (5) unal, 859 2 pad bit (13) unal, 860 2 records fixed bin (17) unal; 861 862 /* internal static initial */ 863 864 declare output_stream character (32) internal static initial ("apl_output_"); 865 866 declare (group_bead_type initial (1), 867 symbol_bead_type initial (2), 868 function_bead_type initial (3), 869 list_value_bead_type initial (4), 870 numeric_value_bead_type initial (5), 871 character_value_bead_type initial (6), 872 boolean_value_bead_type initial (7) 873 ) fixed binary internal static; 874 875 /* based */ 876 877 declare suspended_source character (source_length) based; 878 declare suspended_source_length fixed binary (29) aligned based; 879 880 declare 1 saved_bead_table aligned based (bead_table_pointer) dimension (1), 881 2 active_bead_pointer pointer unaligned, 882 2 active_reference_count fixed binary (29), 883 2 pseudo_pointer pointer unaligned, 884 2 bead_type fixed binary; 885 886 declare 1 saved_stack_frame_table aligned based (stack_frame_table_pointer) dimension (1), 887 2 active_frame_pointer pointer unaligned, 888 2 pseudo_pointer pointer unaligned, 889 2 reduction_stack_pointer unaligned pointer, 890 2 previous_pseudo_pointer pointer unaligned; 891 892 declare 1 single_rs_element aligned based like reduction_stack; 893 894 /* conditions */ 895 896 declare (cleanup, record_quota_overflow) condition; 897 898 /* external static */ 899 900 declare ( error_table_$noentry fixed bin (35), 901 apl_error_table_$cant_save_ws fixed bin (35), 902 sys_info$max_seg_size fixed bin (19) 903 ) external static; 904 905 /* entries */ 906 907 declare com_err_ entry options (variable); 908 declare ioa_$ioa_stream entry options (variable); 909 declare apl_create_save_frame_ entry; 910 declare apl_date_time_ entry (fixed binary (71)) returns (character (17)); 911 declare apl_destroy_save_frame_ entry; 912 declare apl_system_error_ entry (fixed bin(35)); 913 declare apl_translate_pathname_ entry (char (*), char (*), char (*), pointer, fixed binary (35)); 914 declare hcs_$fs_get_path_name entry (ptr, char (*), fixed bin (21), char (*), fixed bin (35)); 915 declare hcs_$quota_get entry (char (*), fixed bin (24), fixed bin (24), bit (36) aligned, fixed bin (24), fixed bin (24), 916 fixed bin (24), fixed bin (35)); 917 declare hcs_$status_ entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); 918 declare hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35)); 919 declare msf_manager_$get_ptr entry (pointer, fixed bin (24), bit (1) aligned, pointer, fixed bin (24), fixed bin (35)); 920 declare msf_manager_$adjust entry (pointer, fixed bin, fixed bin (24), bit (3), fixed bin (35)); 921 declare msf_manager_$close entry (pointer); 922 declare apl_segment_manager_$get entry () returns (pointer); 923 declare apl_segment_manager_$free entry (pointer); 924 925 /* builtins */ 926 927 declare (add, addr, addrel, bit, baseno, baseptr, clock, divide, fixed, index, length) builtin; 928 declare (null, rel, reverse, size, string, substr, unspec) builtin; 929 930 /* include files */ 931 1 1 /* ====== BEGIN INCLUDE SEGMENT apl_number_data.incl.pl1 ================================== */ 1 2 1 3 /* 1 4* This include file contains information about the machine representation of numbers. 1 5* In all programs numbers should simply be declared 'float'. 1 6* All default statements should be in this include file. 1 7* 1 8* This is the binary version. The manifest constant Binary should be used by programs 1 9* that need to know whether we are using binary or decimal. 1 10* */ 1 11 1 12 /* format: style3,initlm0,idind30 */ 1 13 1 14 default (float & ^decimal & ^binary & ^precision & ^constant) float binary (63); 1 15 1 16 declare ( 1 17 TheBiggestNumberWeveGot float initial (0.1701411834604692317e+39), 1 18 TheSmallestNumberWeveGot float initial (.1469367938527859385e-38), 1 19 Binary bit (1) aligned initial ("1"b) 1 20 ) internal static options (constant); 1 21 1 22 /* Number of characters in a number datum entry; used for copying float number arrays as strings. 1 23* (Obsolete! use array copies!) */ 1 24 1 25 declare NumberSize fixed binary precision (4) internal static initial (8); 1 26 1 27 /* ------ END INCLUDE SEGMENT apl_number_data.incl.pl1 ---------------------------------- */ 932 2 1 /* ====== BEGIN INCLUDE SEGMENT apl_ws_info.incl.pl1 ====================================== */ 2 2 2 3 /* This structure contains all of the global data (or pointers to it) for the APL subsystem */ 2 4 2 5 /* automatic */ 2 6 2 7 declare ws_info_ptr ptr initial (apl_static_$ws_info_ptr.static_ws_info_ptr); 2 8 2 9 /* external static */ 2 10 2 11 declare 1 apl_static_$ws_info_ptr external static aligned structure, 2 12 2 static_ws_info_ptr unaligned pointer; 2 13 2 14 /* based */ 2 15 2 16 declare 1 ws_info aligned based (ws_info_ptr), 2 17 2 version_number fixed bin, /* version of this structure (3) */ 2 18 2 switches unaligned, /* mainly ws parameters */ 2 19 3 long_error_mode bit, /* if 1, long Multics format, else APL/360 format */ 2 20 3 debug_mode bit, /* if 1, system error causes escape to command level */ 2 21 3 canonicalize_mode bit, /* if 1, the editor canonicalizes user input */ 2 22 3 restrict_exec_command bit, /* if 1, the )EXEC command may not be used */ 2 23 3 restrict_debug_command bit, /* if 1, the )DEBUG command may not be used */ 2 24 3 restrict_external_functions 2 25 bit, /* if 1, the )ZFN, )MFN, and )DFN commands may not be used */ 2 26 3 restrict_load bit, /* if 1, the )LOAD and )COPY commands may not be used */ 2 27 3 restrict_load_directory bit, /* if 1, no directory allowed in )LOAD or )COPY pathnames */ 2 28 3 restrict_save bit, /* if 1, the )SAVE command may not be used */ 2 29 3 restrict_save_directory bit, /* if 1, no directory allowed in )SAVE pathnames */ 2 30 3 off_hold bit, /* if 1, )OFF HOLD was typed, else just )OFF */ 2 31 3 transparent_to_signals bit, /* if 1, any conditions slip right past APL */ 2 32 3 meter_mode bit, /* if 1, metering may be done, else speed is all-important */ 2 33 3 restrict_msg_command bit, /* if 1, the )MSG command may not be used. */ 2 34 3 compatibility_check_mode 2 35 bit, /* if 1, check for incompatible operators */ 2 36 3 no_quit_handler bit, /* if 1, do not trap QUITs. */ 2 37 /* remaining 20 bits not presently used */ 2 38 2 39 2 values, /* attributes of the workspace */ 2 40 3 digits fixed bin, /* number of digits of precision printed on output */ 2 41 3 width fixed bin, /* line length for formatted output */ 2 42 3 index_origin fixed bin, /* the index origin (0 or 1) */ 2 43 3 random_link fixed bin(35), /* seed for random number generator */ 2 44 3 fuzz float, /* comparison tolerance (relative fuzz) */ 2 45 3 float_index_origin float, /* the index origin in floating point */ 2 46 3 number_of_symbols fixed bin, /* the number of symbol_beads currently in existence */ 2 47 3 maximum_value_stack_size 2 48 fixed bin (18), /* maximum number of words in one segment of value stack */ 2 49 2 50 2 pointers, /* pointers to various internal tables */ 2 51 3 symbol_table_ptr unaligned pointer, /* -> symbol_table (apl_symbol_table.incl.pl1) */ 2 52 3 current_parse_frame_ptr unaligned pointer, /* -> topmost parse frame */ 2 53 3 value_stack_ptr unaligned pointer, /* -> next free location on value stack */ 2 54 3 alloc_free_info_ptr unaligned pointer, /* -> apl_storage_mngr_ data (apl_storage_system_data.incl.pl1) */ 2 55 2 56 2 time_invoked fixed bin(71), /* clock time that APL was entered */ 2 57 2 integer_fuzz float, /* the absolute fuzz used in checking for integers */ 2 58 2 user_number fixed bin(35), /* number under which the user is signed on */ 2 59 2 latent_expression unaligned pointer, /* -> value_bead for QuadLX */ 2 60 2 lock char(32), /* the lock currently set on this workspace (password) */ 2 61 2 wsid char(100), /* the workspace identification: name, number name, or clear ws */ 2 62 2 last_error_code fixed bin(35), /* last code passed to apl_error_ */ 2 63 2 signoff_lock character (32), 2 64 2 65 2 interrupt_info aligned, /* bits used by apl_interpreter_ to tell when to abort */ 2 66 3 dont_interrupt_parse bit, /* if 1, don't do a dirty stop because the parser is running */ 2 67 3 dont_interrupt_operator bit, /* if 1, don't do a dirty stop because an operator is running */ 2 68 3 dont_interrupt_storage_manager /* if 1, don't stop because apl_storage_mngr_ is */ 2 69 bit, /* munging his tables */ 2 70 3 unused_interrupt_bit bit, /* not presently used */ 2 71 3 dont_interrupt_command bit, 2 72 3 can_be_interrupted bit, /* if 1, OK to do a clean stop (we are between lines, reading) */ 2 73 3 clean_interrupt_pending bit, /* interrupt occured, break cleanly (between lines) */ 2 74 3 dirty_interrupt_pending bit, /* interrupt occured, break as soon as not inhibited */ 2 75 2 76 2 user_name char (32), /* process group id of user */ 2 77 2 immediate_input_prompt char (32) varying, /* normal input */ 2 78 2 evaluated_input_prompt char (32) varying, /* quad input */ 2 79 2 character_input_prompt char (32) varying, /* quad-quote input */ 2 80 2 vcpu_time aligned, 2 81 3 total fixed bin (71), 2 82 3 setup fixed bin (71), 2 83 3 parse fixed bin (71), 2 84 3 lex fixed bin (71), 2 85 3 operator fixed bin (71), 2 86 3 storage_manager fixed bin (71), 2 87 2 output_info aligned, /* data pertaining to output buffer */ 2 88 3 output_buffer_ptr unal ptr, /* ptr to output buffer */ 2 89 3 output_buffer_len fixed bin (21), /* length (bytes) of output buffer */ 2 90 3 output_buffer_pos fixed bin (21), /* index of next byte to write in */ 2 91 3 output_buffer_ll fixed bin (21), /* print positions used up so far */ 2 92 2 tab_width fixed bin (21); /* number of columns a tabs moves cursor */ 2 93 2 94 declare output_buffer char (ws_info.output_buffer_len) based (ws_info.output_buffer_ptr); 2 95 2 96 /* internal static */ 2 97 2 98 declare max_parse_stack_depth fixed bin int static init(64536); 2 99 2 100 /* ------ END INCLUDE SEGMENT apl_ws_info.incl.pl1 -------------------------------------- */ 933 3 1 /* ====== BEGIN INCLUDE SEGMENT apl_bead_format.incl.pl1 ================================== */ 3 2 3 3 declare 1 general_bead aligned based, /* The Venerable Bead */ 3 4 2 type unaligned, 3 5 3 bead_type unaligned, 3 6 4 operator bit (1), /* ON if operator bead */ 3 7 4 symbol bit (1), /* ON if symbol bead */ 3 8 4 value bit (1), /* ON if value bead */ 3 9 4 function bit (1), /* ON if function bead */ 3 10 4 group bit (1), /* ON if group bead */ 3 11 4 label bit (1), /* ON if label bead */ 3 12 4 shared_variable bit (1), /* ON if shared variable bead */ 3 13 4 lexed_function bit (1), /* ON if lexed function bead */ 3 14 3 data_type unaligned, 3 15 4 list_value bit (1), /* ON if a list value bead */ 3 16 4 character_value bit (1), /* ON if a character value bead */ 3 17 4 numeric_value bit (1), /* ON if a numeric value bead */ 3 18 4 integral_value bit (1), /* ON if an integral value bead */ 3 19 4 zero_or_one_value bit (1), /* ON if a boolean value bead */ 3 20 4 complex_value bit (1), /* ON if a complex, numeric value bead */ 3 21 3 unused_bits bit (4) unaligned, /* pad to 18 bits (for future use) */ 3 22 2 size bit (18) unaligned, /* Number of words this bead occupies 3 23* (used by bead storage manager) */ 3 24 2 reference_count fixed binary (29); /* Number of pointers which point 3 25* to this bead (used by bead manager) */ 3 26 3 27 3 28 /* constant strings for initing type field in various beads */ 3 29 3 30 declare ( 3 31 operator_type init("100000000000000000"b), 3 32 symbol_type init("010000000000000000"b), 3 33 value_type init("001000000000000000"b), 3 34 function_type init("000100000000000000"b), 3 35 group_type init("000010000000000000"b), 3 36 label_type init("001001000011000000"b), 3 37 shared_variable_type init("001000100000000000"b), 3 38 lexed_function_type init("000000010000000000"b), 3 39 3 40 list_value_type init("000000001000000000"b), 3 41 character_value_type init("001000000100000000"b), 3 42 numeric_value_type init("001000000010000000"b), 3 43 integral_value_type init("001000000011000000"b), 3 44 zero_or_one_value_type init("001000000011100000"b), 3 45 complex_value_type init("001000000000010000"b), 3 46 3 47 not_integer_mask init("111111111110011111"b), /* to clear integral, zero_or_one bits */ 3 48 not_zero_or_one_mask init("111111111111011111"b) /* to clear zero_or_one bit */ 3 49 ) bit(18) internal static; 3 50 3 51 /* ------ END INCLUDE SEGMENT apl_bead_format.incl.pl1 ---------------------------------- */ 934 4 1 /* ====== BEGIN INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ================================== */ 4 2 4 3 /* Explanation of fields: 4 4* symbol_bead.hash_link_pointer points to next symbol in same hash bucket in the symbol table. 4 5* symbol_bead.meaning_pointer points to current "value" of this name: 4 6* = null => unused (e.g. undefined variable) 4 7* -> group bead => group name 4 8* -> value bead => variable with a value 4 9* -> function bead => function name 4 10* -> label bead => localized label value 4 11* -> shared var bead => shared variable */ 4 12 4 13 declare 1 symbol_bead aligned based, 4 14 2 header aligned like general_bead, 4 15 2 hash_link_pointer pointer unaligned, 4 16 2 meaning_pointer pointer unaligned, 4 17 2 name_length fixed binary, 4 18 2 name character (0 refer (symbol_bead.name_length)) unaligned; 4 19 4 20 /* ------ END INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ---------------------------------- */ 935 5 1 /* ====== BEGIN INCLUDE SEGMENT apl_value_bead.incl.pl1 =================================== */ 5 2 5 3 declare 5 4 number_of_dimensions fixed bin, 5 5 5 6 1 value_bead aligned based, 5 7 2 header aligned like general_bead, 5 8 2 total_data_elements fixed binary (21), /* length of ,[value] in APL */ 5 9 2 rhorho fixed binary, /* number of dimensions of value */ 5 10 2 data_pointer pointer unaligned, /* packed pointer to the data in value */ 5 11 2 rho fixed binary (21) dimension (number_of_dimensions refer (value_bead.rhorho)); 5 12 /* dimensions of value (zero-origin) */ 5 13 5 14 5 15 declare 1 character_data_structure aligned based, /* alignment trick for PL/I compiler */ 5 16 2 character_datum character (1) unaligned dimension (0:data_elements - 1); 5 17 /* actual elements of character array */ 5 18 5 19 declare character_string_overlay character (data_elements) aligned based; 5 20 /* to overlay on above structure */ 5 21 5 22 5 23 declare numeric_datum float aligned dimension (0:data_elements - 1) based; 5 24 /* actual elements of numeric array */ 5 25 5 26 declare complex_datum complex float aligned dimension (0:data_elements -1) based; 5 27 5 28 declare MAX_VALUE_BEAD_SIZE fixed bin (19) init (261120) int static options (constant); 5 29 5 30 /* ------ END INCLUDE SEGMENT apl_value_bead.incl.pl1 ----------------------------------- */ 936 6 1 /* ====== BEGIN INCLUDE SEGMENT apl_list_bead.incl.pl1 ==================================== */ 6 2 6 3 declare n_members fixed bin, 6 4 6 5 1 list_bead aligned based, 6 6 2 header aligned like general_bead, 6 7 2 number_of_members fixed bin, 6 8 2 members dimension (n_members refer (list_bead.number_of_members)) aligned, 6 9 3 member_ptr unaligned pointer, 6 10 3 bits unaligned like operator_bead.bits_for_parse; 6 11 6 12 /* ------ END INCLUDE SEGMENT apl_list_bead.incl.pl1 ------------------------------------ */ 937 7 1 /* ====== BEGIN INCLUDE SEGMENT apl_function_bead.incl.pl1 ================================ */ 7 2 7 3 /* This bead is used by apl to store the source code for user-defined functions */ 7 4 7 5 declare 1 function_bead aligned based, 7 6 7 7 2 header aligned like general_bead, 7 8 7 9 2 lexed_function_bead_pointer unaligned pointer, /* null if unlexed or has errors, else -> lexed code */ 7 10 2 class fixed bin, /* 0=normal, 1=locked, 2=external zfn, 3=mfn, 4=dfn */ 7 11 2 stop_control_pointer unaligned ptr, /* points to stop value bead, or null (no stop control) */ 7 12 2 trace_control_pointer unaligned ptr, /* points to trace value bead, or null (no trace control) */ 7 13 2 text_length fixed bin(21), /* length of function text */ 7 14 2 text aligned char(data_elements refer (function_bead.text_length)); 7 15 /* the user's code exactly as typed in */ 7 16 7 17 /* ------ END INCLUDE SEGMENT apl_function_bead.incl.pl1 -------------------------------- */ 938 8 1 /* ====== BEGIN INCLUDE SEGMENT apl_lexed_function_bead.incl.pl1 ========================== */ 8 2 8 3 /* this is the format of a user-defined function after it has been run 8 4* through apl_lex_, the first (left to right) parsing phase. */ 8 5 8 6 dcl 1 lexed_function_bead based aligned, 8 7 2 header like general_bead, /* type bits, etc. */ 8 8 8 9 2 name pointer unaligned, /* -> symbol bead which names the function */ 8 10 2 bits_for_parse unaligned like operator_bead.bits_for_parse, /* so can treat like system function */ 8 11 2 number_of_statements fixed bin, 8 12 2 number_of_localized_symbols fixed bin, /* including labels and parameter variables, return var */ 8 13 /* even if they aren't there, thus >_ 3 */ 8 14 2 number_of_labels fixed bin, 8 15 2 label_values_ptr pointer unaligned, /* -> label_values below */ 8 16 2 statement_map_ptr pointer unaligned, /* -> statement_map below */ 8 17 2 lexeme_array_ptr pointer unaligned, /* -> lexeme_array below */ 8 18 8 19 /* the first 3 localized symbols are always reserved for ReturnSymbol, LeftArgSymbol, RighArgSymbol respectively. 8 20* If some of these symbols are not present (e.g. monadic or value-less function), null pointers are used. 8 21* So beware!, there can be null ptrs in the localized_symbols array. */ 8 22 8 23 2 localized_symbols( (0) refer (lexed_function_bead.number_of_localized_symbols)) pointer unaligned, 8 24 /* first localized vars from header line, then labels */ 8 25 2 label_values ( (0) refer (lexed_function_bead.number_of_labels)) pointer unaligned, 8 26 /* ptrs to label-value beads for labels */ 8 27 2 statement_map ( (0) refer (lexed_function_bead.number_of_statements)) fixed bin(18), 8 28 /* index in lexeme_array of rightmost lexeme of each stmt */ 8 29 2 lexeme_array ( (0) refer (lexed_function_bead.number_of_labels) /* not really, but fake out compiler */ ) pointer unaligned; 8 30 /* the actual lexemes. Length of array is 8 31* statement_map(number_of_statements) */ 8 32 8 33 8 34 /* manifest constants for first 3 localized symbols */ 8 35 8 36 dcl (ReturnSymbol init(1), 8 37 LeftArgSymbol init(2), 8 38 RightArgSymbol init(3) 8 39 ) fixed binary static; 8 40 8 41 8 42 /* the last three parts of this bead are referenced separately, though ptrs earlier in the bead. 8 43* Here are declarations for them as level-1 structures */ 8 44 8 45 dcl 1 lexed_function_label_values_structure based aligned, 8 46 2 lexed_function_label_values ( 500 /* or so */ ) pointer unaligned, 8 47 8 48 statement_count fixed bin, 8 49 lexed_function_statement_map (statement_count) fixed bin(18) aligned based, 8 50 8 51 1 lexed_function_lexemes_structure based aligned, 8 52 2 lexed_function_lexeme_array ( 500 /* or so */ ) pointer unaligned; 8 53 8 54 /* ------ END INCLUDE SEGMENT apl_lexed_function_bead.incl.pl1 -------------------------- */ 939 9 1 /* BEGIN INCLUDE FILE: apl_group_bead.incl.pl1 */ 9 2 9 3 /* Initial Version: 1973.06.18 9 4* Typed in by: Richard S. Lamson */ 9 5 9 6 9 7 declare 1 group_bead aligned based, /* Group: bead_type.group = "1"b */ 9 8 9 9 2 header aligned like general_bead, 9 10 9 11 2 number_of_members fixed binary, 9 12 9 13 2 member pointer unaligned dimension (0 refer (group_bead.number_of_members)); 9 14 /* Pointer to the symbol bead for each 9 15* member of the group */ 9 16 9 17 /* END INCLUDE FILE apl_group_bead.incl.pl1 */ 940 10 1 /* ====== BEGIN INCLUDE SEGMENT apl_operator_bead.incl.pl1 ================================ */ 10 2 10 3 declare 10 4 1 operator_bead aligned based, 10 5 10 6 2 type unaligned like general_bead.type, 10 7 10 8 2 bits_for_lex unaligned, 10 9 3 allow_brackets bit(1), /* operator may have dimension info in brackets */ 10 10 3 allow_product bit(1), /* operator may be used in inner and outer product */ 10 11 3 allow_reduction bit(1), /* operator may be used in reduction and scan */ 10 12 3 special_assignment bit(1), /* doesn't use standard assignment operator */ 10 13 3 ignores_assignment bit(1), /* assignment has no effect */ 10 14 3 allow_subscripted_assignment 10 15 bit(1), /* system variable that can be subscripted assigned */ 10 16 3 pad bit(12), 10 17 10 18 2 bits_for_parse unaligned, 10 19 3 stop_trace_control bit(1), /* next lexeme is function being stopped/traced 10 20* (op1 tells which) */ 10 21 3 quad bit(1), /* this is a quad type */ 10 22 3 system_variable bit(1), /* this is a system variable, not an op */ 10 23 3 dyadic bit(1), /* operator may be dyadic */ 10 24 3 monadic bit(1), /* operator may be monadic */ 10 25 3 function bit(1), /* operator is a user defined function */ 10 26 3 semantics_valid bit(1), /* if semantics has been set */ 10 27 3 has_list bit(1), /* semantics is a list */ 10 28 3 inner_product bit(1), /* op2 is valid */ 10 29 3 semantics_on_stack bit(1), /* semantics points to value stack */ 10 30 3 is_external_function bit(1), /* semantics points to function bead for ext function */ 10 31 3 pad bit(7), 10 32 3 op2 fixed bin(8) unaligned, /* secondary operator code */ 10 33 3 op1 fixed bin(8) unaligned, /* primary operator code */ 10 34 2 type_code fixed bin; /* for parse */ 10 35 10 36 /* ------ END INCLUDE SEGMENT apl_operator_bead.incl.pl1 -------------------------------- */ 941 11 1 /* ====== BEGIN INCLUDE SEGMENT apl_parse_frame.incl.pl1 ================================== */ 11 2 11 3 declare 1 parse_frame aligned based (parse_frame_ptr), 11 4 2 last_parse_frame_ptr ptr unaligned, /* pointer to last parse frame, or null */ 11 5 2 parse_frame_type fixed bin, /* suspended, function, eval input, etc. */ 11 6 2 function_bead_ptr ptr unaligned, /* ptr to function bead */ 11 7 2 lexed_function_bead_ptr ptr unaligned, /* ptr to lexed function bead */ 11 8 2 reduction_stack_ptr ptr unaligned, /* ptr to reduction stack for this frame */ 11 9 2 current_parseme fixed bin, /* element of reduction stack that is top of stack */ 11 10 2 current_lexeme fixed bin, /* element number of current lexeme */ 11 11 2 current_line_number fixed bin, /* line number being executed */ 11 12 2 return_point fixed bin, /* where to join the reductions on return */ 11 13 2 put_result fixed bin, /* where to put the value when returning to this frame */ 11 14 2 print_final_value bit(1) aligned, /* if true, print final value on line */ 11 15 2 initial_value_stack_ptr ptr unaligned, /* for cleaning up the value stack */ 11 16 2 number_of_ptrs fixed bin, /* number of old meaning ptrs */ 11 17 2 old_meaning_ptrs dim (number_of_ptrs refer (parse_frame.number_of_ptrs)) ptr unaligned; 11 18 /* old meanings for local variables. */ 11 19 11 20 declare number_of_ptrs fixed bin; 11 21 11 22 declare (suspended_frame_type init (1), /* for comparison with parse frame type */ 11 23 function_frame_type init (2), 11 24 evaluated_frame_type init (3), 11 25 execute_frame_type init (4), 11 26 save_frame_type init (5) 11 27 ) fixed bin internal static options (constant); 11 28 11 29 declare reductions_pointer pointer; 11 30 11 31 declare 11 32 1 reduction_stack aligned dim (1000) based (reductions_pointer), 11 33 2 type fixed bin, /* type of parseme */ 11 34 2 bits unaligned like operator_bead.bits_for_parse, 11 35 2 semantics ptr unaligned, 11 36 2 lexeme fixed bin, 11 37 11 38 1 reduction_stack_for_op aligned dim (1000) based (reductions_pointer), 11 39 2 type fixed bin, 11 40 2 bits unaligned like operator_bead.bits_for_parse, 11 41 2 semantics fixed bin, 11 42 2 lexeme fixed bin, 11 43 11 44 (eol_type init(0), /* parseme types - end of line */ 11 45 bol_type init(1), /* begining of line */ 11 46 val_type init(2), /* value */ 11 47 op_type init(3), /* op */ 11 48 open_paren_type init(4), 11 49 close_paren_type init(5), 11 50 open_bracket_type init(6), 11 51 close_subscript_type init(7), 11 52 close_rank_type init(8), 11 53 semi_colon_type init(9), 11 54 diamond_type init (10), 11 55 subscript_type init (11)) fixed bin internal static options (constant); 11 56 11 57 /* ------ END INCLUDE SEGMENT apl_parse_frame.incl.pl1 ---------------------------------- */ 942 12 1 /* BEGIN INCLUDE FILE apl_symbol_table.incl.pl1 12 2* 12 3* initially written 20 June 1973 by Dan Bricklin */ 12 4 12 5 declare 12 6 initial_size fixed bin int static init(17), /* initial size of hash table */ 12 7 12 8 1 symbol_table aligned based(ws_info.symbol_table_ptr), 12 9 2 table_size fixed bin, /* how many buckets */ 12 10 2 hash_bucket_ptr(initial_size refer(table_size)) ptr unaligned; /* the buckets */ 12 11 12 12 /* END INCLUDE FILE apl_symbol_table.incl.pl1 */ 943 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 ----------------------------------- */ 944 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 ------------------------------------- */ 945 946 end apl_save_command_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/29/83 1347.2 apl_save_command_.pl1 >special_ldd>on>apl.1129>apl_save_command_.pl1 932 1 03/27/82 0429.8 apl_number_data.incl.pl1 >ldd>include>apl_number_data.incl.pl1 933 2 03/27/82 0439.2 apl_ws_info.incl.pl1 >ldd>include>apl_ws_info.incl.pl1 934 3 03/27/82 0438.5 apl_bead_format.incl.pl1 >ldd>include>apl_bead_format.incl.pl1 935 4 03/27/82 0439.2 apl_symbol_bead.incl.pl1 >ldd>include>apl_symbol_bead.incl.pl1 936 5 03/27/82 0439.2 apl_value_bead.incl.pl1 >ldd>include>apl_value_bead.incl.pl1 937 6 03/27/82 0438.7 apl_list_bead.incl.pl1 >ldd>include>apl_list_bead.incl.pl1 938 7 03/27/82 0438.7 apl_function_bead.incl.pl1 >ldd>include>apl_function_bead.incl.pl1 939 8 03/27/82 0438.7 apl_lexed_function_bead.incl.pl1 >ldd>include>apl_lexed_function_bead.incl.pl1 940 9 03/27/82 0438.7 apl_group_bead.incl.pl1 >ldd>include>apl_group_bead.incl.pl1 941 10 03/27/82 0439.0 apl_operator_bead.incl.pl1 >ldd>include>apl_operator_bead.incl.pl1 942 11 03/27/82 0439.0 apl_parse_frame.incl.pl1 >ldd>include>apl_parse_frame.incl.pl1 943 12 03/27/82 0439.2 apl_symbol_table.incl.pl1 >ldd>include>apl_symbol_table.incl.pl1 944 13 03/27/82 0439.1 apl_save_frame.incl.pl1 >ldd>include>apl_save_frame.incl.pl1 945 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. BeadBase 000247 automatic pointer unaligned dcl 830 set ref 70* a_code parameter fixed bin(35,0) dcl 809 set ref 23 26* 42* 57* 530* a_lock parameter char unaligned dcl 809 ref 23 32 36 a_wsid parameter char unaligned dcl 809 ref 23 28 30 516 516 active_bead_pointer based pointer array level 2 packed unaligned dcl 880 set ref 93 304 538 538 695* 759* active_frame_pointer based pointer array level 2 packed unaligned dcl 886 set ref 113* 148* 408 active_reference_count 1 based fixed bin(29,0) array level 2 dcl 880 set ref 538 698* 762* add builtin function dcl 927 ref 566 addr builtin function dcl 927 ref 139 215 215 440 440 447 447 573 addrel builtin function dcl 927 ref 62 575 607 783 apl_create_save_frame_ 000032 constant entry external dcl 909 ref 75 apl_date_time_ 000034 constant entry external dcl 910 ref 516 516 518 518 apl_destroy_save_frame_ 000036 constant entry external dcl 911 ref 544 apl_error_table_$cant_save_ws 000022 external static fixed bin(35,0) dcl 900 set ref 42 530 705* 801* apl_segment_manager_$free 000062 constant entry external dcl 923 ref 545 apl_segment_manager_$get 000060 constant entry external dcl 922 ref 61 apl_static_$ws_info_ptr 000064 external static structure level 1 dcl 2-11 apl_system_error_ 000040 constant entry external dcl 912 ref 705 801 apl_translate_pathname_ 000042 constant entry external dcl 913 ref 46 baseno builtin function dcl 927 ref 783 baseptr builtin function dcl 927 ref 69 70 604 bead_description_pointer 000722 automatic pointer dcl 14-35 set ref 187 276* 306 bead_description_pseudo_pointer 000250 automatic pointer unaligned dcl 830 set ref 189* 276* 280 bead_description_table based structure array level 1 dcl 14-38 set ref 187 bead_number 000115 automatic fixed bin(24,0) dcl 814 set ref 302* 304 305 306 306 308* 536* 538 538 538* bead_pointer based pointer array level 2 in structure "bead_description_table" packed unaligned dcl 14-38 in procedure "apl_save_command_" set ref 306* bead_pointer 001032 automatic pointer unaligned dcl 794 in procedure "translate_pointer" set ref 797* 799 801 803 bead_pointer 001001 automatic pointer unaligned dcl 616 in procedure "save_bead" set ref 622* 624 627 630 636 645* 650 657 662 670 680 695 698 701 bead_pointer 000246 automatic pointer unaligned dcl 830 in procedure "apl_save_command_" set ref 304* 310 314 318 324 328 330 332 336 340 342 344 346 349 354 358 362 365 555 558 561 568 571 bead_pointer 001012 automatic pointer unaligned dcl 727 in procedure "save_value_bead" set ref 730* 732 735 736 738 743 759 762 765 bead_table_pointer 000454 automatic pointer dcl 839 in procedure "apl_save_command_" set ref 61* 62 93 304 305 306 308 538 538 538 545* 695 698 699 700 759 762 763 764 bead_table_pointer 2 based pointer level 2 in structure "saved_ws_info" packed unaligned dcl 14-12 in procedure "apl_save_command_" set ref 280* bead_type 3 based fixed bin(17,0) array level 2 in structure "saved_bead_table" dcl 880 in procedure "apl_save_command_" set ref 308 700* 764* bead_type 001000 automatic fixed bin(17,0) dcl 616 in procedure "save_bead" set ref 642* 666* 676* 686* 700 741* 746* 750* 764 bit builtin function dcl 927 ref 224 566 bits 1 based structure array level 2 in structure "reduction_stack" packed unaligned dcl 11-31 in procedure "apl_save_command_" ref 499 bits 4 based structure array level 3 in structure "list_bead" packed unaligned dcl 6-3 in procedure "apl_save_command_" ref 362 bits 1 based structure array level 2 in structure "saved_rs" packed unaligned dcl 14-125 in procedure "apl_save_command_" set ref 499* bits 3 based structure array level 3 in structure "saved_lb" packed unaligned dcl 14-67 in procedure "apl_save_command_" set ref 362* bits_for_parse 1 based structure level 2 packed unaligned dcl 10-3 boolean_value_bead_type constant fixed bin(17,0) initial dcl 866 ref 746 branch 000667 automatic structure level 1 dcl 852 set ref 215 215 bucket_number 000101 automatic fixed bin(24,0) dcl 814 set ref 81* 83* bv_bead_pointer parameter pointer unaligned dcl 794 in procedure "translate_pointer" ref 791 797 bv_bead_pointer parameter pointer unaligned dcl 620 in procedure "save_bead" ref 612 612 622 bv_bead_pointer parameter pointer unaligned dcl 727 in procedure "save_value_bead" ref 724 730 bv_pseudo_pointer parameter pointer unaligned dcl 778 ref 775 781 character_string_overlay based char dcl 5-19 set ref 387* 387 740 character_value 0(09) based bit(1) level 5 packed unaligned dcl 5-3 ref 738 character_value_bead_type constant fixed bin(17,0) initial dcl 866 ref 741 class 3 based fixed bin(17,0) level 2 in structure "function_bead" dcl 7-5 in procedure "apl_save_command_" ref 340 class 1 based fixed bin(17,0) level 2 in structure "saved_fb" dcl 14-82 in procedure "apl_save_command_" set ref 340* cleanup 000674 stack reference condition dcl 896 ref 73 clock builtin function dcl 927 ref 506 code 000133 automatic fixed bin(35,0) dcl 824 set ref 46* 48 53 53 56* 57 206* 209* 213* 215 215* 218 220* 236* 238 244* 509* com_err_ 000026 constant entry external dcl 907 ref 56 209 220 component 000107 automatic fixed bin(24,0) dcl 814 set ref 195* 196* 205* 206* 206 207 213* 593* 594* 598* 599 602 603 604 control_pointer 001002 automatic pointer unaligned dcl 616 set ref 650* 654 654* 657* 659 659* copy_from_pointer 000244 automatic pointer unaligned dcl 830 set ref 377 387 400 571* copy_this_one 000665 automatic bit(1) dcl 850 set ref 479* 481* 484* 490* 492 copy_to_pointer 000245 automatic pointer unaligned dcl 830 set ref 377 387 397 400 573* 575 575* 575 579 current_component_number 000110 automatic fixed bin(24,0) dcl 814 set ref 64* 191 591 600 603* current_lexeme 3(18) based fixed bin(17,0) level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_save_command_" set ref 428* current_lexeme 6 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 11-3 in procedure "apl_save_command_" ref 428 current_line_number 4 based fixed bin(17,0) level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_save_command_" set ref 429* current_line_number 7 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 11-3 in procedure "apl_save_command_" ref 429 current_parse_frame_ptr 15 based pointer level 3 in structure "ws_info" packed unaligned dcl 2-16 in procedure "apl_save_command_" ref 101 current_parse_frame_ptr 21 based pointer level 3 in structure "saved_ws_info" packed unaligned dcl 14-12 in procedure "apl_save_command_" set ref 290* current_parseme 5 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 11-3 in procedure "apl_save_command_" ref 152 427 476 current_parseme 3 based fixed bin(17,0) level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_save_command_" set ref 427* current_pseudo_baseptr 000236 automatic pointer unaligned dcl 830 set ref 69* 604* 607 current_save_version constant fixed bin(17,0) initial dcl 14-9 ref 278 current_segment_length 000121 automatic fixed bin(24,0) dcl 814 set ref 64* 191 588 591 600 602* 607 608* 608 current_time 000134 automatic fixed bin(71,0) dcl 826 set ref 506* 516* 516* 518* 518* data_elements 000120 automatic fixed bin(24,0) dcl 814 set ref 375 377 387 387 387 397 399 400 555* 566 662* 664 735* 740 740 745 745 749 data_pointer 3 based pointer level 2 in structure "saved_value_bead" packed unaligned dcl 14-49 in procedure "apl_save_command_" set ref 579* data_pointer 4 based pointer level 2 in structure "value_bead" packed unaligned dcl 5-3 in procedure "apl_save_command_" ref 571 data_type 0(08) based structure level 4 in structure "saved_value_bead" packed unaligned dcl 14-49 in procedure "apl_save_command_" data_type 0(08) based structure level 4 in structure "value_bead" packed unaligned dcl 5-3 in procedure "apl_save_command_" datum_number 000111 automatic fixed bin(24,0) dcl 814 set ref 399* 399* 400 400* digits 2 based fixed bin(17,0) level 3 in structure "ws_info" dcl 2-16 in procedure "apl_save_command_" ref 283 digits 10 based fixed bin(17,0) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_save_command_" set ref 283* directory 000532 automatic char(168) unaligned dcl 842 set ref 213* 215* 234* 236* 252 252 253* 253 divide builtin function dcl 927 ref 139 196 dname 000460 automatic char(168) unaligned dcl 842 set ref 46* 56* 209* 220* 234 element_count 000116 automatic fixed bin(24,0) dcl 814 set ref 314* 317 358* 361 ename 000604 automatic char(32) unaligned dcl 845 set ref 46* 56* 209* 220* entryname 000614 automatic char(32) unaligned dcl 845 set ref 213* 215* error_table_$noentry 000020 external static fixed bin(35,0) dcl 900 ref 53 execute_frame_type constant fixed bin(17,0) initial dcl 11-22 ref 133 fcbp 000252 automatic pointer dcl 836 set ref 46* 206* 509* 546* fixed builtin function dcl 927 ref 783 float_index_origin 10 based float bin(63) level 3 in structure "ws_info" dcl 2-16 in procedure "apl_save_command_" ref 288 float_index_origin 16 based float bin(63) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_save_command_" set ref 288* frame_number 000126 automatic fixed bin(24,0) dcl 814 set ref 406* 408 409 412 468* function 1(05) based bit(1) array level 3 packed unaligned dcl 11-31 ref 167 481 function_bead based structure level 1 dcl 7-5 function_bead_ptr 2 based pointer level 2 in structure "parse_frame" packed unaligned dcl 11-3 in procedure "apl_save_command_" set ref 127* 466* function_bead_ptr 2 based fixed bin(21,0) level 2 in structure "saved_pf" dcl 14-92 in procedure "apl_save_command_" set ref 466* function_bead_type constant fixed bin(17,0) initial dcl 866 ref 666 function_frame_type constant fixed bin(17,0) initial dcl 11-22 ref 125 fuzz 6 based float bin(63) level 3 in structure "ws_info" dcl 2-16 in procedure "apl_save_command_" ref 287 fuzz 14 based float bin(63) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_save_command_" set ref 287* general_bead based structure level 1 dcl 3-3 set ref 310 324 336 354 group_bead based structure level 1 dcl 9-7 group_bead_type constant fixed bin(17,0) initial dcl 866 ref 676 has_list 1(07) based bit(1) array level 3 packed unaligned dcl 11-31 ref 170 484 hash_bucket_ptr 1 based pointer array level 2 packed unaligned dcl 12-5 ref 83 hash_link_pointer 2 based pointer level 2 packed unaligned dcl 4-13 ref 88 hcs_$fs_get_path_name 000044 constant entry external dcl 914 ref 213 hcs_$quota_get 000046 constant entry external dcl 915 ref 236 hcs_$status_ 000050 constant entry external dcl 917 ref 215 header based structure level 2 in structure "value_bead" dcl 5-3 in procedure "apl_save_command_" header based structure level 2 in structure "saved_value_bead" dcl 14-49 in procedure "apl_save_command_" highest_segment 1 based fixed bin(17,0) level 2 dcl 14-12 set ref 279* index builtin function dcl 927 ref 252 630 index_origin 4 based fixed bin(17,0) level 3 in structure "ws_info" dcl 2-16 in procedure "apl_save_command_" ref 285 index_origin 12 based fixed bin(17,0) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_save_command_" set ref 285* integer_fuzz 22 based float bin(63) level 2 in structure "ws_info" dcl 2-16 in procedure "apl_save_command_" ref 291 integer_fuzz 24 based float bin(63) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_save_command_" set ref 291* ioa_$ioa_stream 000030 constant entry external dcl 908 ref 40 226 262 516 518 524 last_parse_frame_ptr based pointer level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_save_command_" set ref 412* last_parse_frame_ptr based pointer level 2 in structure "parse_frame" packed unaligned dcl 11-3 in procedure "apl_save_command_" ref 185 latent_expression 27 based fixed bin(21,0) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_save_command_" set ref 293* latent_expression 25 based pointer level 2 in structure "ws_info" packed unaligned dcl 2-16 in procedure "apl_save_command_" set ref 96* 293* length builtin function dcl 927 ref 252 lexed_function_bead based structure level 1 dcl 8-6 lexed_function_bead_ptr 3 based pointer level 2 packed unaligned dcl 11-3 ref 128 453 459 lexeme 3 based fixed bin(17,0) array level 2 in structure "saved_rs" dcl 14-125 in procedure "apl_save_command_" set ref 501* lexeme 3 based fixed bin(17,0) array level 2 in structure "reduction_stack" dcl 11-31 in procedure "apl_save_command_" ref 501 list_bead based structure level 1 dcl 6-3 list_value_bead_type constant fixed bin(17,0) initial dcl 866 ref 686 lock 26 based char(32) level 2 in structure "ws_info" dcl 2-16 in procedure "apl_save_command_" set ref 35 297* lock 000624 automatic char(32) unaligned dcl 845 in procedure "apl_save_command_" set ref 32* 35* 36* 296 297 lock 30 based char(32) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_save_command_" set ref 296* max_component_number 000132 automatic fixed bin(17,0) dcl 822 set ref 64* 195 199 205 279 509* 509 593 598 598* meaning_pointer 3 based pointer level 2 in structure "symbol_bead" packed unaligned dcl 4-13 in procedure "apl_save_command_" set ref 93* 332* meaning_pointer 1 based fixed bin(21,0) level 2 in structure "saved_sb" dcl 14-59 in procedure "apl_save_command_" set ref 332* member 2 based fixed bin(21,0) array level 2 in structure "saved_gb" dcl 14-76 in procedure "apl_save_command_" set ref 318* member 3 based pointer array level 2 in structure "group_bead" packed unaligned dcl 9-7 in procedure "apl_save_command_" set ref 318* member_number 000117 automatic fixed bin(24,0) dcl 814 set ref 361* 362 362 365 365* member_ptr 2 based fixed bin(21,0) array level 3 in structure "saved_lb" dcl 14-67 in procedure "apl_save_command_" set ref 365* member_ptr 3 based pointer array level 3 in structure "list_bead" packed unaligned dcl 6-3 in procedure "apl_save_command_" set ref 365* members 3 based structure array level 2 in structure "list_bead" dcl 6-3 in procedure "apl_save_command_" members 2 based structure array level 2 in structure "saved_lb" dcl 14-67 in procedure "apl_save_command_" mode 3 000667 automatic bit(5) level 2 packed unaligned dcl 852 set ref 224 msf_manager_$adjust 000054 constant entry external dcl 920 ref 509 msf_manager_$close 000056 constant entry external dcl 921 ref 546 msf_manager_$get_ptr 000052 constant entry external dcl 919 ref 206 my_type 000125 automatic fixed bin(24,0) dcl 814 set ref 477* 481 n_words 000100 automatic fixed bin(24,0) dcl 814 set ref 77* 111* 130* 136* 141* 153* 187* 588 594 608 640* 664* 674* 684* 740* 745* 749* 753* 753 name 3 based char level 2 in structure "saved_sb" packed unaligned dcl 14-59 in procedure "apl_save_command_" set ref 330* name 5 based char level 2 in structure "symbol_bead" packed unaligned dcl 4-13 in procedure "apl_save_command_" ref 330 name_length 4 based fixed bin(17,0) level 2 in structure "symbol_bead" dcl 4-13 in procedure "apl_save_command_" ref 328 330 636 name_length 2 based fixed bin(17,0) level 2 in structure "saved_sb" dcl 14-59 in procedure "apl_save_command_" set ref 328* 330 null builtin function dcl 928 ref 83 99 101 207 215 215 453 624 654 659 799 number_of_dimensions 000712 automatic fixed bin(17,0) dcl 5-3 set ref 558* 566 573 736* 753 number_of_localized_symbols 5 based fixed bin(17,0) level 2 dcl 8-6 ref 128 459 number_of_members 2 based fixed bin(17,0) level 2 in structure "list_bead" dcl 6-3 in procedure "apl_save_command_" ref 358 680 number_of_members 1 based fixed bin(17,0) level 2 in structure "saved_gb" dcl 14-76 in procedure "apl_save_command_" set ref 314* number_of_members 1 based fixed bin(17,0) level 2 in structure "saved_lb" dcl 14-67 in procedure "apl_save_command_" set ref 358* number_of_members 2 based fixed bin(17,0) level 2 in structure "group_bead" dcl 9-7 in procedure "apl_save_command_" ref 314 670 number_of_ptrs 6 based fixed bin(17,0) level 2 in structure "saved_pf" dcl 14-92 in procedure "apl_save_command_" set ref 433* number_of_ptrs 000713 automatic fixed bin(17,0) dcl 11-20 in procedure "apl_save_command_" set ref 128* 130 135* 136 139* 141 142* 158 number_of_ptrs 14 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 11-3 in procedure "apl_save_command_" ref 433 number_of_symbols 20 based fixed bin(17,0) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_save_command_" set ref 289* number_of_symbols 12 based fixed bin(17,0) level 3 in structure "ws_info" dcl 2-16 in procedure "apl_save_command_" ref 289 numeric_datum based float bin(63) array dcl 5-23 set ref 377* 377 400 566 749 numeric_value 0(10) based bit(1) level 5 packed unaligned dcl 14-49 ref 575 numeric_value_bead_type constant fixed bin(17,0) initial dcl 866 ref 750 old_meaning_ptrs 15 based pointer array level 2 in structure "parse_frame" packed unaligned dcl 11-3 in procedure "apl_save_command_" set ref 139 159* 440 447 463* old_meaning_ptrs 7 based fixed bin(21,0) array level 2 in structure "saved_pf" dcl 14-92 in procedure "apl_save_command_" set ref 440 447 463* old_workspace_length 000131 automatic fixed bin(24,0) dcl 814 set ref 204* 230* 230 257 op_type constant fixed bin(17,0) initial dcl 11-31 ref 167 481 operator_bead based structure level 1 dcl 10-3 other_ws_info 10 based structure level 2 dcl 14-12 output_stream 000010 internal static char(32) initial unaligned dcl 864 set ref 40* 226* 262* 516* 518* 524* parse_frame based structure level 1 dcl 11-3 parse_frame_ptr 000243 automatic pointer unaligned dcl 830 set ref 101* 101* 107 110 113 118 119 125 127 128 133 139 148 152 159 162* 185 408* 411 414 416 418 419 422 427 428 429 430 431 432 433 438 440 447 453 459 463 466 474 476 parse_frame_type 1 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 11-3 in procedure "apl_save_command_" ref 107 125 133 411 414 438 parse_frame_type 1 based fixed bin(17,0) level 2 in structure "saved_pf" dcl 14-92 in procedure "apl_save_command_" set ref 411* parseme 000105 automatic fixed bin(24,0) dcl 814 set ref 164* 167 167 170 177 177 177 180* parseme_number 000122 automatic fixed bin(24,0) dcl 814 set ref 476* 477 477 481 484 486 486 486 494 494 494 499 499 501 501* pointers 14 based structure level 2 dcl 2-16 previous_frame_pointer 000242 automatic pointer unaligned dcl 830 set ref 99* 115 116* 149 150* 290 previous_greater_than_position 000124 automatic fixed bin(24,0) dcl 814 set ref 252* 253 previous_pseudo_pointer 3 based pointer array level 2 packed unaligned dcl 886 set ref 115* 149* 412 print_final_value 5(18) based bit(1) level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_save_command_" set ref 432* print_final_value 12 based bit(1) level 2 in structure "parse_frame" dcl 11-3 in procedure "apl_save_command_" ref 432 pseudo_pointer 2 based pointer array level 2 in structure "saved_bead_table" packed unaligned dcl 880 in procedure "apl_save_command_" set ref 305* 306 699* 763* pseudo_pointer 001022 automatic pointer unaligned dcl 778 in procedure "un_pseudo_pointer" set ref 781* 783 783 pseudo_pointer 1 based pointer array level 2 in structure "saved_stack_frame_table" packed unaligned dcl 886 in procedure "apl_save_command_" set ref 114* 147* 409* put_result 11 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 11-3 in procedure "apl_save_command_" ref 431 put_result 5 based fixed bin(17,0) level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_save_command_" set ref 431* quota_remaining 000114 automatic fixed bin(24,0) dcl 814 set ref 258* 260 262 262 quota_used 000113 automatic fixed bin(24,0) dcl 814 set ref 236* 247* 257* 257 258 random_link 5 based fixed bin(35,0) level 3 in structure "ws_info" dcl 2-16 in procedure "apl_save_command_" ref 286 random_link 13 based fixed bin(35,0) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_save_command_" set ref 286* re_lex_source 5(19) based bit(1) level 2 packed unaligned dcl 14-92 set ref 453* 455* record_quota_overflow 000702 stack reference condition dcl 896 ref 72 records 3(18) 000667 automatic fixed bin(17,0) level 2 packed unaligned dcl 852 set ref 230 reduction_stack based structure array level 1 dcl 11-31 reduction_stack_for_op based structure array level 1 dcl 11-31 reduction_stack_pointer 2 based pointer array level 2 packed unaligned dcl 886 set ref 156* 468* reduction_stack_ptr 4 based pointer level 2 packed unaligned dcl 11-3 ref 162 474 reduction_stack_size 000103 automatic fixed bin(24,0) dcl 814 set ref 152* 153 164 reductions_pointer 000714 automatic pointer dcl 11-29 set ref 162* 167 167 170 177 177 177 180 474* 477 481 484 486 486 494 494 499 501 reference_count 1 based fixed bin(29,0) level 2 dcl 3-3 set ref 538 538* 627 698 701* 732 762 765* 801 803 rel builtin function dcl 928 ref 575 783 return_point 10 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 11-3 in procedure "apl_save_command_" ref 430 return_point 4(18) based fixed bin(17,0) level 2 in structure "saved_pf" packed unaligned dcl 14-92 in procedure "apl_save_command_" set ref 430* reverse builtin function dcl 928 ref 252 rho 4 based fixed bin(21,0) array level 2 in structure "saved_value_bead" dcl 14-49 in procedure "apl_save_command_" set ref 568* 573 rho 5 based fixed bin(21,0) array level 2 in structure "value_bead" dcl 5-3 in procedure "apl_save_command_" ref 568 rhorho 2 based fixed bin(17,0) level 2 in structure "saved_value_bead" dcl 14-49 in procedure "apl_save_command_" set ref 558* 568 568 rhorho 3 based fixed bin(17,0) level 2 in structure "value_bead" dcl 5-3 in procedure "apl_save_command_" ref 558 568 736 save_frame based structure level 1 dcl 13-5 save_frame_type constant fixed bin(17,0) initial dcl 11-22 ref 107 414 save_pseudo_pointer 000241 automatic pointer unaligned dcl 830 set ref 79 114 116 147 150 156 189 607* 699 763 save_this_one 000666 automatic bit(1) dcl 850 set ref 165* 167* 170* 173* 175 save_version based fixed bin(17,0) level 2 dcl 14-12 set ref 278* saved_bead_count 000720 automatic fixed bin(17,0) dcl 14-35 set ref 64* 92 187 281 302 536 695 696* 696 698 699 700 701 759 760* 760 762 763 764 765 saved_bead_pointer 000724 automatic pointer dcl 14-41 set ref 305* 310 314 318 324 328 330 332 336 340 342 344 346 349 354 358 362 365 555 558 561 566 568 568 573 575 575 579 640 664 674 684 753 saved_bead_table based structure array level 1 dcl 880 saved_boolean_datum based bit dcl 14-56 set ref 397* 400* 745 saved_fb based structure level 1 dcl 14-82 set ref 664 saved_frame_pointer 000730 automatic pointer dcl 14-90 set ref 111 130 136 141 409* 411 412 416 419 422 427 428 429 430 431 432 433 440 447 453 455 463 466 saved_gb based structure level 1 dcl 14-76 set ref 674 saved_general_bead based structure level 1 dcl 14-44 set ref 310* 324* 336* 354* saved_lb based structure level 1 dcl 14-67 set ref 684 saved_meaning_pointer 4 based pointer array level 3 in structure "save_frame" packed unaligned dcl 13-5 in procedure "apl_save_command_" set ref 119* 422* saved_meaning_pointer 4 based fixed bin(21,0) array level 3 in structure "saved_sf" dcl 14-139 in procedure "apl_save_command_" set ref 422* saved_pf based structure level 1 dcl 14-92 set ref 130 136 141 saved_reductions_pointer 000732 automatic pointer dcl 14-90 set ref 468* 477 486 494 499 501 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 set ref 640 saved_sf based structure level 1 dcl 14-139 set ref 111 saved_stack_frame_table based structure array level 1 dcl 886 saved_symbol_count 2 based fixed bin(29,0) level 2 in structure "save_frame" dcl 13-5 in procedure "apl_save_command_" ref 110 118 416 418 saved_symbol_count 2 based fixed bin(29,0) level 2 in structure "saved_sf" dcl 14-139 in procedure "apl_save_command_" set ref 416* saved_value_bead based structure level 1 dcl 14-49 set ref 753 saved_ws_info based structure level 1 dcl 14-12 set ref 77 saved_ws_info_pointer 000716 automatic pointer dcl 14-9 set ref 77 275* 278 279 280 281 283 284 285 286 287 288 289 290 291 292 293 294 296 299 506 saved_ws_info_pseudo_pointer 000237 automatic pointer unaligned dcl 830 set ref 79* 275* segment_length 000136 automatic fixed bin(24,0) array dcl 828 set ref 191* 196 509 591* 594 599* 600* 602 semantics 2 based fixed bin(21,0) array level 2 in structure "saved_rs" dcl 14-125 in procedure "apl_save_command_" set ref 494* semantics 2 based fixed bin(17,0) array level 2 in structure "reduction_stack_for_op" dcl 11-31 in procedure "apl_save_command_" ref 486 semantics 2 based pointer array level 2 in structure "reduction_stack" packed unaligned dcl 11-31 in procedure "apl_save_command_" set ref 177* 180* 494* semantics 2 based fixed bin(17,0) array level 2 in structure "saved_rs_for_op" dcl 14-125 in procedure "apl_save_command_" set ref 486* semantics_on_stack 1(09) based bit(1) array level 3 packed unaligned dcl 11-31 ref 177 semantics_valid 1(06) based bit(1) array level 3 packed unaligned dcl 11-31 ref 177 486 494 single_rs_element based structure level 1 dcl 892 ref 153 size 0(18) based bit(18) level 2 in structure "saved_general_bead" packed unaligned dcl 14-44 in procedure "apl_save_command_" set ref 566* size builtin function dcl 928 in procedure "apl_save_command_" ref 77 111 130 136 141 153 187 566 566 640 664 674 684 740 745 749 753 source_length 000127 automatic fixed bin(24,0) dcl 814 set ref 440* 447 447 stack_frame_table_pointer 000456 automatic pointer dcl 839 set ref 62* 113 114 115 147 148 149 156 408 409 412 468 static_ws_info_ptr 000064 external static pointer level 2 packed unaligned dcl 2-11 ref 2-7 stop_control_pointer 4 based pointer level 2 in structure "function_bead" packed unaligned dcl 7-5 in procedure "apl_save_command_" set ref 346* 650 stop_control_pointer 2 based fixed bin(21,0) level 2 in structure "saved_fb" dcl 14-82 in procedure "apl_save_command_" set ref 346* string builtin function dcl 928 set ref 561* 561 630 743 substr builtin function dcl 928 set ref 253 400* 575 suspended_source based char unaligned dcl 877 set ref 447* 447 suspended_source_length based fixed bin(29,0) dcl 878 set ref 139 440 440* symbol_bead based structure level 1 dcl 4-13 symbol_bead_ptr 000240 automatic pointer unaligned dcl 830 set ref 83* 83* 87* 88 symbol_bead_type constant fixed bin(17,0) initial dcl 866 ref 642 symbol_list 3 based structure array level 2 in structure "saved_sf" dcl 14-139 in procedure "apl_save_command_" symbol_list 3 based structure array level 2 in structure "save_frame" dcl 13-5 in procedure "apl_save_command_" symbol_name_length 000726 automatic fixed bin(17,0) dcl 14-41 set ref 636* 640 symbol_number 000104 automatic fixed bin(24,0) dcl 814 set ref 92* 93* 118* 119* 158* 159* 317* 318 318* 418* 419 419 422 422* 459* 463 463* symbol_pointer 3 based pointer array level 3 in structure "save_frame" packed unaligned dcl 13-5 in procedure "apl_save_command_" set ref 419* symbol_pointer 3 based fixed bin(21,0) array level 3 in structure "saved_sf" dcl 14-139 in procedure "apl_save_command_" set ref 419* symbol_table based structure level 1 dcl 12-5 symbol_table_ptr 14 based pointer level 3 packed unaligned dcl 2-16 ref 81 83 sys_info$max_seg_size 000024 external static fixed bin(19,0) dcl 900 ref 588 594 table_size based fixed bin(17,0) level 2 dcl 12-5 ref 81 terminal_account 000123 automatic fixed bin(24,0) dcl 814 set ref 236* 245* 250 text 7 based char level 2 in structure "function_bead" dcl 7-5 in procedure "apl_save_command_" ref 344 text 5 based char level 2 in structure "saved_fb" dcl 14-82 in procedure "apl_save_command_" set ref 344* text_length 6 based fixed bin(21,0) level 2 in structure "function_bead" dcl 7-5 in procedure "apl_save_command_" ref 342 344 662 text_length 4 based fixed bin(17,0) level 2 in structure "saved_fb" dcl 14-82 in procedure "apl_save_command_" set ref 342* 344 this_frame 000102 automatic fixed bin(24,0) dcl 814 set ref 98* 105* 105 113 114 115 147 148 149 156 406 time_saved 22 based fixed bin(71,0) level 3 dcl 14-12 set ref 506* total_beads 3 based fixed bin(24,0) level 2 dcl 14-12 set ref 281* total_data_elements 2 based fixed bin(21,0) level 2 in structure "value_bead" dcl 5-3 in procedure "apl_save_command_" ref 555 735 total_data_elements 1 based fixed bin(21,0) level 2 in structure "saved_value_bead" dcl 14-49 in procedure "apl_save_command_" set ref 555* total_length 000106 automatic fixed bin(24,0) dcl 814 set ref 193* 196* 196 199* 199 260 262* 262 262 262 total_members 000727 automatic fixed bin(17,0) dcl 14-41 set ref 670* 674 680* 684 total_quota 000112 automatic fixed bin(24,0) dcl 814 set ref 236* 246* 258 total_symbols 000130 automatic fixed bin(24,0) dcl 814 set ref 110* 111 trace_control_pointer 5 based pointer level 2 in structure "function_bead" packed unaligned dcl 7-5 in procedure "apl_save_command_" set ref 349* 657 trace_control_pointer 3 based fixed bin(21,0) level 2 in structure "saved_fb" dcl 14-82 in procedure "apl_save_command_" set ref 349* type based structure level 2 in structure "general_bead" packed unaligned dcl 3-3 in procedure "apl_save_command_" ref 561 630 type based structure level 3 in structure "lexed_function_bead" packed unaligned dcl 8-6 in procedure "apl_save_command_" type based structure level 3 in structure "function_bead" packed unaligned dcl 7-5 in procedure "apl_save_command_" type based structure level 3 in structure "symbol_bead" packed unaligned dcl 4-13 in procedure "apl_save_command_" type based fixed bin(17,0) array level 2 in structure "reduction_stack" dcl 11-31 in procedure "apl_save_command_" ref 167 477 type based structure level 3 in structure "value_bead" packed unaligned dcl 5-3 in procedure "apl_save_command_" ref 743 type based structure level 3 in structure "list_bead" packed unaligned dcl 6-3 in procedure "apl_save_command_" type based structure level 3 in structure "saved_value_bead" packed unaligned dcl 14-49 in procedure "apl_save_command_" type based structure level 2 in structure "saved_general_bead" packed unaligned dcl 14-44 in procedure "apl_save_command_" set ref 561* type based fixed bin(17,0) array level 2 in structure "saved_rs" dcl 14-125 in procedure "apl_save_command_" set ref 477* type based structure level 3 in structure "group_bead" packed unaligned dcl 9-7 in procedure "apl_save_command_" unspec builtin function dcl 928 set ref 310* 310 324* 324 336* 336 354* 354 362* 362 499* 499 user_name 110 based char(32) level 2 in structure "ws_info" dcl 2-16 in procedure "apl_save_command_" ref 294 user_name 71 based char(32) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_save_command_" set ref 294* user_number 24 based fixed bin(35,0) level 2 in structure "ws_info" dcl 2-16 in procedure "apl_save_command_" ref 292 user_number 26 based fixed bin(35,0) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_save_command_" set ref 292* value_bead based structure level 1 dcl 5-3 ref 566 values 2 based structure level 2 dcl 2-16 width 3 based fixed bin(17,0) level 3 in structure "ws_info" dcl 2-16 in procedure "apl_save_command_" ref 284 width 11 based fixed bin(17,0) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_save_command_" set ref 284* ws_info based structure level 1 dcl 2-16 ws_info_ptr 000710 automatic pointer initial dcl 2-7 set ref 28 32 35 40 48 81 83 96 101 283 284 285 286 287 288 289 291 292 293 294 297 300 516 2-7* ws_segment 000254 automatic pointer array dcl 836 set ref 206* 207 213* 783 wsid 40 based char(100) level 3 in structure "saved_ws_info" dcl 14-12 in procedure "apl_save_command_" set ref 299* wsid 000634 automatic char(100) unaligned dcl 848 in procedure "apl_save_command_" set ref 28* 30* 32 38 46* 48 48 262* 299 300 wsid 36 based char(100) level 2 in structure "ws_info" dcl 2-16 in procedure "apl_save_command_" set ref 28 32 40* 48 300* 516* zero_or_one_value 0(12) based bit(1) level 5 packed unaligned dcl 14-49 ref 575 zero_or_one_value_type constant bit(18) initial unaligned dcl 3-30 ref 743 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Binary internal static bit(1) initial dcl 1-16 LeftArgSymbol internal static fixed bin(17,0) initial dcl 8-36 MAX_VALUE_BEAD_SIZE internal static fixed bin(19,0) initial dcl 5-28 NumberSize internal static fixed bin(4,0) initial dcl 1-25 ReturnSymbol internal static fixed bin(17,0) initial dcl 8-36 RightArgSymbol internal static fixed bin(17,0) initial dcl 8-36 TheBiggestNumberWeveGot internal static float bin(63) initial dcl 1-16 TheSmallestNumberWeveGot internal static float bin(63) initial dcl 1-16 bol_type internal static fixed bin(17,0) initial dcl 11-31 character_data_structure based structure level 1 dcl 5-15 character_value_type internal static bit(18) initial unaligned dcl 3-30 close_paren_type internal static fixed bin(17,0) initial dcl 11-31 close_rank_type internal static fixed bin(17,0) initial dcl 11-31 close_subscript_type internal static fixed bin(17,0) initial dcl 11-31 complex_datum based complex float bin(63) array dcl 5-26 complex_value_type internal static bit(18) initial unaligned dcl 3-30 diamond_type internal static fixed bin(17,0) initial dcl 11-31 element_number automatic fixed bin(24,0) dcl 616 eol_type internal static fixed bin(17,0) initial dcl 11-31 evaluated_frame_type internal static fixed bin(17,0) initial dcl 11-22 function_type internal static bit(18) initial unaligned dcl 3-30 group_type internal static bit(18) initial unaligned dcl 3-30 hcs_$truncate_seg 000000 constant entry external dcl 918 initial_size internal static fixed bin(17,0) initial dcl 12-5 integral_value_type internal static bit(18) initial unaligned dcl 3-30 label_type internal static bit(18) initial unaligned dcl 3-30 lexed_function_label_values_structure based structure level 1 dcl 8-45 lexed_function_lexemes_structure based structure level 1 dcl 8-45 lexed_function_statement_map based fixed bin(18,0) array dcl 8-45 lexed_function_type internal static bit(18) initial unaligned dcl 3-30 list_value_type internal static bit(18) initial unaligned dcl 3-30 max_parse_stack_depth internal static fixed bin(17,0) initial dcl 2-98 n_members automatic fixed bin(17,0) dcl 6-3 not_integer_mask internal static bit(18) initial unaligned dcl 3-30 not_zero_or_one_mask internal static bit(18) initial unaligned dcl 3-30 numeric_value_type internal static bit(18) initial unaligned dcl 3-30 open_bracket_type internal static fixed bin(17,0) initial dcl 11-31 open_paren_type internal static fixed bin(17,0) initial dcl 11-31 operator_type internal static bit(18) initial unaligned dcl 3-30 output_buffer based char unaligned dcl 2-94 save_frame_pointer automatic pointer unaligned dcl 13-3 semi_colon_type internal static fixed bin(17,0) initial dcl 11-31 shared_variable_type internal static bit(18) initial unaligned dcl 3-30 statement_count automatic fixed bin(17,0) dcl 8-45 subscript_type internal static fixed bin(17,0) initial dcl 11-31 suspended_frame_type internal static fixed bin(17,0) initial dcl 11-22 symbol_type internal static bit(18) initial unaligned dcl 3-30 v3_saved_pf based structure level 1 dcl 14-109 val_type internal static fixed bin(17,0) initial dcl 11-31 value_type internal static bit(18) initial unaligned dcl 3-30 NAMES DECLARED BY EXPLICIT CONTEXT. allocate 003337 constant label dcl 690 ref 643 668 678 688 apl_save_command_ 000175 constant entry external dcl 23 bitch 000266 constant label dcl 40 set ref 48 calculate_remaining_quota 001441 constant label dcl 236 ref 254 cleaner_upper 002754 constant entry internal dcl 533 ref 73 514 528 compute_size 000013 constant label array(0:18) dcl 632 set ref 630 copy_bead 000000 constant label array(7) dcl 310 set ref 308 copy_frame_header 000007 constant label array(4) dcl 440 ref 438 copy_rest_of_frame 002427 constant label dcl 468 ref 457 copy_value_bead_header 003035 constant entry internal dcl 552 ref 371 383 393 found_component 003177 constant label dcl 600 ref 594 next_bead 002210 constant label dcl 403 ref 322 334 352 369 381 391 return_code 002742 constant label dcl 528 ref 210 221 227 265 save_allocate 003144 constant entry internal dcl 585 ref 78 112 145 154 188 690 755 save_bead 003223 constant entry internal dcl 612 ref 87 93 96 119 127 159 180 save_bead_on_stack 003226 constant entry internal dcl 612 ref 177 save_value_bead 003374 constant entry internal dcl 724 ref 645 654 659 translate_pointer 003530 constant entry internal dcl 791 ref 293 318 332 346 349 365 419 422 463 466 494 un_pseudo_pointer 003501 constant entry internal dcl 775 ref 275 276 305 409 468 unwind_and_abort 002722 constant label dcl 524 ref 72 720 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4126 4214 3623 4136 Length 4740 3623 66 507 303 10 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME apl_save_command_ 682 external procedure is an external procedure. on unit on line 72 64 on unit on unit on line 73 64 on unit cleaner_upper 72 internal procedure is called by several nonquick procedures. copy_value_bead_header internal procedure shares stack frame of external procedure apl_save_command_. save_allocate internal procedure shares stack frame of external procedure apl_save_command_. save_bead internal procedure shares stack frame of external procedure apl_save_command_. save_value_bead internal procedure shares stack frame of external procedure apl_save_command_. un_pseudo_pointer internal procedure shares stack frame of external procedure apl_save_command_. translate_pointer internal procedure shares stack frame of external procedure apl_save_command_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 output_stream apl_save_command_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME apl_save_command_ 000100 n_words apl_save_command_ 000101 bucket_number apl_save_command_ 000102 this_frame apl_save_command_ 000103 reduction_stack_size apl_save_command_ 000104 symbol_number apl_save_command_ 000105 parseme apl_save_command_ 000106 total_length apl_save_command_ 000107 component apl_save_command_ 000110 current_component_number apl_save_command_ 000111 datum_number apl_save_command_ 000112 total_quota apl_save_command_ 000113 quota_used apl_save_command_ 000114 quota_remaining apl_save_command_ 000115 bead_number apl_save_command_ 000116 element_count apl_save_command_ 000117 member_number apl_save_command_ 000120 data_elements apl_save_command_ 000121 current_segment_length apl_save_command_ 000122 parseme_number apl_save_command_ 000123 terminal_account apl_save_command_ 000124 previous_greater_than_position apl_save_command_ 000125 my_type apl_save_command_ 000126 frame_number apl_save_command_ 000127 source_length apl_save_command_ 000130 total_symbols apl_save_command_ 000131 old_workspace_length apl_save_command_ 000132 max_component_number apl_save_command_ 000133 code apl_save_command_ 000134 current_time apl_save_command_ 000136 segment_length apl_save_command_ 000236 current_pseudo_baseptr apl_save_command_ 000237 saved_ws_info_pseudo_pointer apl_save_command_ 000240 symbol_bead_ptr apl_save_command_ 000241 save_pseudo_pointer apl_save_command_ 000242 previous_frame_pointer apl_save_command_ 000243 parse_frame_ptr apl_save_command_ 000244 copy_from_pointer apl_save_command_ 000245 copy_to_pointer apl_save_command_ 000246 bead_pointer apl_save_command_ 000247 BeadBase apl_save_command_ 000250 bead_description_pseudo_pointer apl_save_command_ 000252 fcbp apl_save_command_ 000254 ws_segment apl_save_command_ 000454 bead_table_pointer apl_save_command_ 000456 stack_frame_table_pointer apl_save_command_ 000460 dname apl_save_command_ 000532 directory apl_save_command_ 000604 ename apl_save_command_ 000614 entryname apl_save_command_ 000624 lock apl_save_command_ 000634 wsid apl_save_command_ 000665 copy_this_one apl_save_command_ 000666 save_this_one apl_save_command_ 000667 branch apl_save_command_ 000710 ws_info_ptr apl_save_command_ 000712 number_of_dimensions apl_save_command_ 000713 number_of_ptrs apl_save_command_ 000714 reductions_pointer apl_save_command_ 000716 saved_ws_info_pointer apl_save_command_ 000720 saved_bead_count apl_save_command_ 000722 bead_description_pointer apl_save_command_ 000724 saved_bead_pointer apl_save_command_ 000726 symbol_name_length apl_save_command_ 000727 total_members apl_save_command_ 000730 saved_frame_pointer apl_save_command_ 000732 saved_reductions_pointer apl_save_command_ 001000 bead_type save_bead 001001 bead_pointer save_bead 001002 control_pointer save_bead 001012 bead_pointer save_value_bead 001022 pseudo_pointer un_pseudo_pointer 001032 bead_pointer translate_pointer THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as call_ext_out_desc call_ext_out call_int_this call_int_other return tra_ext bound_check_signal signal enable ext_entry_desc int_entry index_bs_1_eis clock THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. apl_create_save_frame_ apl_date_time_ apl_destroy_save_frame_ apl_segment_manager_$free apl_segment_manager_$get apl_system_error_ apl_translate_pathname_ com_err_ hcs_$fs_get_path_name hcs_$quota_get hcs_$status_ ioa_$ioa_stream msf_manager_$adjust msf_manager_$close msf_manager_$get_ptr THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. apl_error_table_$cant_save_ws apl_static_$ws_info_ptr error_table_$noentry sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 23 000171 2 7 000215 26 000217 28 000221 30 000233 32 000236 35 000253 36 000257 38 000262 40 000266 42 000316 43 000322 46 000323 48 000353 53 000366 56 000373 57 000427 58 000432 61 000433 62 000442 64 000445 69 000451 70 000455 72 000456 73 000475 75 000517 77 000524 78 000526 79 000527 81 000531 83 000543 87 000553 88 000555 89 000561 92 000563 93 000573 94 000604 96 000606 98 000615 99 000616 101 000620 105 000627 107 000630 110 000635 111 000637 112 000642 113 000643 114 000651 115 000653 116 000655 118 000657 119 000667 120 000677 122 000701 125 000702 127 000704 128 000712 130 000716 131 000720 133 000721 135 000723 136 000724 137 000727 139 000730 141 000735 142 000737 145 000740 147 000741 148 000747 149 000751 150 000753 152 000755 153 000760 154 000762 156 000763 158 000771 159 001001 160 001010 162 001012 164 001015 165 001025 167 001026 170 001043 172 001050 173 001051 175 001053 177 001055 180 001073 183 001101 185 001103 187 001107 188 001111 189 001112 191 001114 193 001117 195 001120 196 001127 197 001133 199 001135 204 001141 205 001142 206 001151 207 001176 209 001205 210 001242 213 001243 215 001276 218 001342 220 001344 221 001401 224 001402 226 001407 227 001427 230 001430 232 001434 234 001436 236 001441 238 001506 244 001510 245 001511 246 001513 247 001515 250 001516 252 001520 253 001534 254 001537 257 001540 258 001542 260 001545 262 001547 265 001625 275 001626 276 001632 278 001636 279 001640 280 001643 281 001645 283 001647 284 001652 285 001654 286 001656 287 001660 288 001662 289 001664 290 001666 291 001670 292 001672 293 001674 294 001704 296 001711 297 001714 299 001717 300 001722 302 001725 304 001735 305 001742 306 001754 308 001764 310 001766 314 001771 317 001774 318 002003 320 002015 322 002017 324 002020 328 002023 330 002025 332 002031 334 002041 336 002042 340 002045 342 002047 344 002051 346 002054 349 002064 352 002076 354 002077 358 002102 361 002105 362 002113 365 002120 367 002130 369 002132 371 002133 375 002134 377 002136 381 002144 383 002145 387 002146 391 002155 393 002156 397 002157 399 002166 400 002173 402 002206 403 002210 406 002212 408 002221 409 002226 411 002240 412 002243 414 002250 416 002254 418 002256 419 002265 422 002304 424 002321 425 002323 427 002324 428 002327 429 002331 430 002334 431 002336 432 002341 433 002346 438 002350 440 002352 447 002355 453 002360 455 002366 457 002370 459 002371 463 002401 465 002413 466 002415 468 002427 474 002444 476 002447 477 002457 479 002466 481 002467 484 002500 486 002506 489 002513 490 002514 492 002516 494 002520 499 002533 501 002540 502 002542 504 002544 506 002546 509 002552 514 002577 516 002603 518 002663 520 002721 524 002722 528 002742 530 002746 531 002752 533 002753 536 002761 538 002772 542 003005 544 003007 545 003014 546 003024 548 003034 552 003035 555 003036 558 003043 561 003046 566 003050 568 003064 571 003111 573 003114 575 003117 579 003141 581 003143 585 003144 588 003145 591 003152 593 003155 594 003163 596 003170 598 003172 599 003176 600 003177 602 003202 603 003205 604 003207 605 003212 607 003213 608 003220 610 003222 612 003223 622 003230 624 003237 627 003242 630 003247 632 003254 636 003255 640 003257 642 003263 643 003265 645 003266 648 003270 650 003271 654 003273 657 003277 659 003302 662 003306 664 003311 666 003315 668 003317 670 003320 674 003322 676 003324 678 003326 680 003327 684 003331 686 003334 688 003336 690 003337 695 003340 696 003345 698 003346 699 003355 700 003357 701 003361 703 003363 705 003364 720 003373 724 003374 730 003376 732 003405 735 003412 736 003414 738 003416 740 003421 741 003425 742 003427 743 003430 745 003434 746 003440 747 003442 749 003443 750 003447 753 003451 755 003454 759 003455 760 003462 762 003463 763 003472 764 003474 765 003476 767 003500 775 003501 781 003503 783 003512 791 003530 797 003532 799 003541 801 003545 803 003561 805 003564 ----------------------------------------------------------- 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