COMPILATION LISTING OF SEGMENT basic_ Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 01/17/89 1244.4 mst Tue Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 /****^ HISTORY COMMENTS: 15* 1) change(88-04-05,Huen), approve(88-04-05,MCR7868), 16* audit(88-04-13,RWaters), install(88-04-19,MR12.2-1040): 17* Implement SCP_6356: The basic compiler can now associate severity levels 18* with error messages.The severity command will now work with basic. 19* 2) change(89-01-03,Huen), approve(89-01-03,MCR8034), 20* audit(89-01-13,RWaters), install(89-01-17,MR12.3-1001): 21* Fix Basic_109: Print out the variable name when reporting error message 8. 22* END HISTORY COMMENTS */ 23 24 25 /* format: style2 */ 26 27 basic_: 28 proc (source_p, source_l, output_pointer, info_p, mp, err_count); 29 30 /* eventually the calling sequence may be 31* proc (source_info_pointer, output_pointer, output_length, go_mode, mp, err_count); 32**/ 33 34 /* modified 10 July 1975 by M. Weaver to fix subprogram array processing */ 35 /* modified September 1975 by M. Weaver to recognize to s step */ 36 /* modified 12/75 by M. Weaver to add new entries for (DTSS) FAST 37* and to implement library and chain statements */ 38 /* modified 12/76 by M. Weaver to use version 2 compiler_source_info structure */ 39 /* modified 5/77 by M. Weaver to fix bugs 068 annd 069 */ 40 /* modified 6/77 and 7/77 by M. Weaver fo fix bug 071 */ 41 /* modified 6/77 by M. Weaver to fix bug 072 (bad addressing of file parameters in extended precision) */ 42 /* modified 6/77 by M. Weaver to fix bug 073 (multiple file parameters compiled incorrectly) */ 43 /* modified 5/78 by M. Weaver to fix bug 082 (table overflow bug in double precision) */ 44 /* modified 7/80 by M. Weaver to fix bugs 080, 086, 087 (expression parsing) */ 45 /* modified 7/80 by M. Weaver to fix bug 085 (improper copying of constant tables) */ 46 /* modified 8/80 by M. Weaver to allow missing let */ 47 /* modified 11/80 by M. Weaver to fix bug 090 and to handle multiple statements per line */ 48 /* modified 4/81 by M. Weaver to change the way constants and strings are allocated */ 49 /* modified 7/81 by M. Weaver to fix bug 097 (bad source map name) */ 50 /* modified 9/81 by M. Weaver to fix bugs in program header data offsets */ 51 /* modified 24 Apr 1984 by A. Hussein, 105: Fix so that a multi_line user function 52* can return a value without the use of the 'LET' statement. */ 53 /* modified 24 Apr 1984 by A. Hussein, 106: Allow the use of a single double 54* quote (") or an odd number of double quotes in a 'REM' statement. */ 55 /* modified 20 May 1984 by D. Leskiw to change lexical_analyser to add new 56* string function, left$ */ 57 /* modified 23 May 1984 by D. Leskiw to change lexical_analyser to add new 58* string function, right$ */ 59 /* modified 23 May 1984 by D. Leskiw to change function: to handle optional 60* number of args for 'pos' */ 61 /* modified 28 May 1984 by D. Leskiw to allow left$ and right to be passed 62* as subprogram arguments */ 63 /* modified 29 May 1984 by D. Leskiw to allow '+' to be used for concatenation */ 64 /* modified 30 May 1984 by D. Leskiw to fix pos in ep */ 65 /* modified 08 March 1988 by S. Huen to implement SCP6356 and fix line_number problem */ 66 /* modified 03 Jan 1989 by S Huen to fix Basic_109 - print out the variable 67* name when reporting error message 8 */ 68 69 which = 1; 70 main_pt = null; 71 source_info_pt = addr (auto_source_info); 72 73 /* must convert from old to new info structure */ 74 if info_p = null 75 then do; /* standard object not generated */ 76 generate_object = "0"b; 77 source_info.dirname, source_info.segname, source_info.given_ename = ""; 78 source_info.date_time_modified = 0; 79 source_info.unique_id = "0"b; 80 end; 81 else do; 82 generate_object = "1"b; 83 source_info.given_ename = old_source_info.segname; 84 source_info.date_time_modified = old_source_info.date_time_modified; 85 source_info.unique_id = old_source_info.unique_id; 86 call hcs_$fs_get_path_name (source_p, temp_dir, i, temp_ent, code); 87 source_info.dirname = substr (temp_dir, 1, i); 88 source_info.segname = rtrim (source_info.given_ename) || ".basic"; 89 end; 90 source_info.version = compiler_source_info_version_2; 91 source_info.input_pointer = source_p; 92 source_info.input_lng = source_l; 93 94 add_lib_name = build_lib_list; 95 go to join; 96 97 98 compile: 99 entry (source_info_pointer, output_pointer, output_length, a_code); 100 101 /* this entry is called by FAST only to compile a basic program */ 102 103 which = 2; 104 generate_object = "1"b; 105 source_info_pt = source_info_pointer; 106 output_length = 0; 107 add_lib_name = build_lib_list; /* will store lib names in object seg */ 108 go to join; 109 110 111 run_unit_compiler: 112 entry (source_info_pointer, output_pointer, output_length, debug_sw, get_next_source_seg_, add_to_lib_list_, a_code); 113 114 /* this entry is called by the FAST run command to generate an object segment */ 115 116 which = 3; 117 generate_object = "1"b; 118 source_info_pt = source_info_pointer; 119 output_length = 0; 120 add_lib_name = add_to_lib_list_; 121 go to join; 122 123 /* this entry is called to perform syntax checking on one line */ 124 125 check_line: 126 entry (source_p, source_l); 127 128 which = 4; 129 source_info_pt = addr (auto_source_info); 130 generate_object = "0"b; 131 source_info.input_pointer = source_p; 132 source_info.input_lng = source_l; 133 134 dcl source_info_pointer ptr, /* points at source info structure */ 135 output_pointer ptr, /* points at output (must be 0 mod 2) */ 136 output_length fixed bin, /* length of output in words */ 137 source_p ptr, /* points at source program */ 138 source_l fixed bin, /* length of source (chars) */ 139 info_p ptr, /* points at old format source info structure */ 140 mp ptr, /* set to point at entry of main program */ 141 err_count fixed bin; /* set to number of errors in compilation */ 142 143 dcl debug_sw bit (1) aligned, /* "1"b->running in debug mode */ 144 a_code fixed bin (35), 145 get_next_source_seg_ entry (ptr) variable, 146 /* entry to call to get more source */ 147 add_to_lib_list_ entry (char (*)) variable; 148 /* entry to call with lib names */ 149 150 /* External Procedures */ 151 152 dcl ioa_ entry options (variable), 153 basic_next_line entry (ptr), 154 clock_ entry returns (fixed bin (71)), 155 get_temp_segment_ entry (char (*), ptr, fixed bin (35)), 156 release_temp_segment_ entry (char (*), ptr, fixed bin (35)), 157 add_lib_name entry (char (*), fixed bin (35)) variable, 158 hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)), 159 hcs_$truncate_seg entry (ptr, fixed bin (19), fixed bin (35)), 160 get_group_id_ entry (char (32)); 161 162 /* Builtin Functions */ 163 164 dcl (abs, addr, addrel, bit, convert, dim, fixed, float, hbound, index, ptr, lbound, null, string, length, 165 search, substr, unspec, binary, verify, max, min, mod, divide, sign, reverse, bin, rel, rtrim) 166 builtin; 167 168 /* Conditions */ 169 170 dcl (cleanup, size, conversion, overflow, underflow) 171 condition; 172 173 /* Global Automatic Variables */ 174 175 dcl ( 176 main_pt, 177 source_info_pt, 178 output_pt, 179 instruction_temp_ptr, 180 constant_ptr, 181 program_header_pt, 182 entry_pt, 183 token_pt, 184 temps_pt, 185 local_pt, 186 inst_pt, 187 table_pt (4), 188 basic_temp_ptr, 189 array_p, 190 lib_name_pt, 191 missing_pt 192 ) ptr; 193 194 dcl ( 195 number_of_errors, 196 program_number, 197 statement_type, 198 current_token, 199 number_of_tokens, 200 number_of_assigns, 201 number_of_dims, 202 address_register_loaded, 203 matrix_type, 204 npars, 205 fn_start, 206 fn_name, 207 operand_level, 208 operator_level, 209 for_level, 210 current_line_number, 211 precision_lng, 212 odd_available (0:1), 213 operand_type (32), 214 operand_in_register (0:2), 215 operator (32), 216 i, 217 err, 218 which, 219 lib_count, 220 source_number, 221 for_type (8) 222 ) fixed bin; 223 224 dcl code fixed bin (35); 225 dcl auto_ctr (0:1) fixed bin (35); 226 dcl error_table_$translation_failed 227 ext fixed bin (35); 228 229 dcl dec_num float dec (22); 230 231 dcl small_numeric_data (100) float bin (63); 232 dcl small_string_data (100) fixed bin; 233 dcl small_line (200) fixed bin; 234 235 dcl ( 236 output_pos, 237 local_ctr, 238 al_count, 239 block_size, 240 first_code_word, 241 last_instruction, 242 for_location (8), 243 large_table_offset (3), 244 table_pos (3), 245 table_max (3) 246 ) fixed bin (18); 247 248 dcl number_of_constants fixed bin (19); 249 250 dcl seg_name char (32) varying; 251 dcl temp_dir char (168); 252 dcl temp_ent char (32); 253 254 dcl ( 255 numeric_data_count def table_pos (1), 256 string_data_count def table_pos (2), 257 number_of_lines def table_pos (3) 258 ) fixed bin (18); 259 260 dcl ( 261 max_numeric_data_count def table_max (1), 262 max_string_data_count def table_max (2), 263 max_number_of_lines def table_max (3) 264 ) fixed bin (18); 265 266 dcl single bit (1) aligned; 267 268 dcl ( 269 first_statement, 270 last_statement, 271 generate_object, 272 sub_ok, 273 small_table (3) 274 ) bit (1) aligned; 275 276 dcl (loc, next_loc) bit (18) aligned; 277 278 dcl ( 279 modifier, 280 operand (32), 281 for_variable (8) 282 ) bit (36) aligned; 283 284 dcl 1 subprogram (50) aligned, 285 2 name char (32) varying, 286 2 header_pos fixed bin (18), 287 2 entry_pos fixed bin (18); 288 289 dcl 1 d_tokens (250) aligned, 290 2 type bit (18), 291 2 name char (8), 292 2 number fixed bin, 293 2 value float bin (63); 294 295 dcl 1 symbol_table aligned, 296 2 scalars (-286:286) bit (36), 297 2 dim_not_allowed (-26:26) bit (1) unaligned, 298 2 arrays (-26:26), 299 3 address bit (36), 300 3 dimensions fixed bin, 301 3 bounds (2) fixed bin; 302 303 dcl 1 normal_temps (0:2), 304 2 next fixed bin, 305 2 address (20) bit (36) aligned; 306 307 dcl 1 local_temps (0:2), 308 2 next fixed bin, 309 2 address (20) bit (36) aligned; 310 311 dcl 1 fn_table (-26:26) aligned, 312 2 address bit (36), 313 2 usage bit (18); 314 315 dcl 1 save aligned, 316 2 number (60) fixed bin, 317 2 address (60) bit (36); 318 319 dcl 1 missing_table (0:1) aligned, 320 2 count fixed bin, 321 2 missing_lines (100) unaligned, 322 3 chain bit (18), 323 3 number fixed bin (17); 324 325 dcl 1 fn_call_word, 326 2 number bit (5) unaligned, 327 2 mode bit (1) unaligned, 328 2 arg (30) bit (1) unaligned; 329 330 dcl 1 next_line_storage, 331 2 input_pt ptr, 332 2 input_length fixed bin, 333 2 input_pos fixed bin, 334 2 line_number fixed bin init (0), 335 2 error_number fixed bin, 336 2 class_tally fixed bin, 337 2 original_class_tally 338 fixed bin, 339 2 ch_tally fixed bin, 340 2 original_ch_tally fixed bin, 341 2 save_ch_tally fixed bin, 342 2 char fixed bin, 343 2 statement_number fixed bin, 344 2 statement_ending fixed bin, 345 2 temp_ch fixed bin, 346 2 skip (9) fixed bin, 347 2 ch_class (256) fixed bin, 348 2 ch (256) char (1) aligned; 349 350 dcl 1 source_map_info (20) aligned, /* holds info from all source_info structures */ 351 2 pathname char (168) var, 352 2 uid bit (36) aligned, 353 2 dtm fixed bin (71); 354 355 /* External Variables */ 356 357 358 dcl basic_data$precision_length 359 fixed bin (35) ext static; 360 361 dcl 1 basic_error_messages_$ 362 aligned ext, 363 2 index_block (0:500), 364 3 loc fixed bin, 365 3 sev fixed bin, 366 3 len fixed bin, 367 2 message_block char (248000); 368 369 dcl ( 370 basic_data$array_prototype, 371 basic_data$constant_prototype, 372 basic_data$function_dummy, 373 basic_data$param_prototype, 374 basic_data$scalar_prototype 375 (0:1) 376 ) bit (36) aligned ext; 377 378 dcl 1 basic_data$instruction_sequences 379 (1:2) ext aligned like instructions; 380 381 dcl basic_severity_ fixed bin ext static; 382 383 dcl 1 instructions aligned based (inst_pt), 384 ( 2 add, 385 2 change (2), 386 2 check_eof, 387 2 compare, 388 2 data_read (0:1), 389 2 divide, 390 2 divide_inv, 391 2 end_input, 392 2 end_print, 393 2 enter_main, 394 2 enter_proc, 395 2 error (4), 396 2 file, 397 2 fneg, 398 2 fszn, 399 2 function_arg (5), 400 2 function_call (0:2), 401 2 function_return (0:1), 402 2 get_fcb_pt, 403 2 gosub, 404 2 inner_product, 405 2 input (0:1), 406 2 linput (0:1), 407 2 load (0:4), 408 2 margin, 409 2 mat_data_read (0:1), 410 2 mat_input (0:1), 411 2 mat_linput (0:1), 412 2 mat_print (0:1), 413 2 mat_print_using (0:1), 414 2 mat_read (0:1), 415 2 mat_write (0:1), 416 2 matrix_add_sub (2), 417 2 matrix_assign_numeric, 418 2 matrix_assign_string, 419 2 matrix_mult (3), 420 2 matrix_scalar_mult, 421 2 multiply, 422 2 on, 423 2 on_gosub, 424 2 power, 425 2 power_inverse, 426 2 print (0:1), 427 2 print_new_line, 428 2 print_using (0:1), 429 2 print_using_start, 430 2 print_using_end, 431 2 randomize, 432 2 read (0:1), 433 2 redimension (3), 434 2 reset_ascii, 435 2 reset_data, 436 2 reset_random, 437 2 return, 438 2 save_fcb_pt, 439 2 scratch, 440 2 setdigits, 441 2 stop, 442 2 store (0:2), 443 2 string_assign (0:1), 444 2 string_compare (0:1), 445 2 string_concatenate (0:1), 446 2 subend, 447 2 subprogram_call, 448 2 subscript (3), 449 2 subtract, 450 2 tab_for_comma, 451 2 tmi, 452 2 tnz, 453 2 tpl, 454 2 tpnz, 455 2 tra, 456 2 tze, 457 2 use_fcb, 458 2 use_file, 459 2 use_tty, 460 2 write (0:1) 461 ) bit (36) aligned; 462 463 dcl 1 basic_data$ascii_table 464 (1) aligned external, 465 2 val char (1), 466 2 abbreviation char (4); 467 468 dcl basic_data$ascii_table_length 469 fixed bin ext; 470 471 dcl 1 basic_data$statement_list 472 (34) aligned ext static, 473 2 first char (4), /* first 3 characters of name */ 474 2 rest char (8), /* remaining chars (if any) in name */ 475 2 number fixed bin; /* number of chars to check for rest */ 476 477 dcl 1 basic_data$statement_spelling 478 (26) external aligned, 479 2 (start, finish) fixed binary; 480 481 dcl 1 basic_data$functions (1) external aligned, 482 2 name char (4), 483 2 class fixed binary, 484 2 run_time bit (36) aligned; 485 486 dcl 1 basic_data$numeric_spelling 487 (26) external aligned, 488 2 (start, finish) fixed binary; 489 490 dcl 1 basic_data$string_spelling 491 (26) external aligned like basic_data$numeric_spelling; 492 493 /* add additional places for new classes, s.ssn, pos_args */ 494 495 dcl basic_data$function_templates 496 (34) bit (18) aligned external; 497 498 dcl 1 basic_data$relational_table 499 (1) aligned external, 500 2 name char (4); 501 502 dcl basic_data$relational_table_length 503 fixed bin ext; 504 505 dcl ( 506 basic_data$normal_relational, 507 basic_data$inverse_relational 508 ) dim (1) bit (36) aligned external; 509 510 dcl basic_$symbol_table fixed bin ext; 511 512 dcl basic_version_$ char (132) ext; 513 514 /* Based Variables */ 515 516 dcl output_word (0:65536) bit (36) aligned based (output_pt); 517 518 dcl fixed_output_word (0:65536) fixed bin aligned based (output_pt); 519 520 dcl 1 half (0:8) aligned based, 521 2 (left, right) bit (18) unaligned; 522 523 dcl block (block_size) bit (36) aligned based; 524 525 dcl 1 missing aligned like missing_table based (missing_pt); 526 527 dcl missing_lines_word (100) fixed bin based (addr (missing.missing_lines)); 528 529 dcl 1 tokens (250) aligned based (addr (d_tokens)), 530 2 type bit (18), 531 2 name char (8), 532 2 number fixed bin, 533 2 value float bin, 534 2 pad bit (36) aligned; 535 536 dcl 1 this_token like tokens aligned based (token_pt); 537 538 dcl 1 d_this_token like d_tokens aligned based (token_pt); 539 540 dcl scalar bit (36) aligned based; 541 542 dcl 1 array like arrays aligned based; 543 544 dcl 1 temps (0:2) like normal_temps aligned based (temps_pt); 545 1 1 dcl 1 array_dope aligned based, 1 2 2 data ptr, 1 3 2 original_bounds(2) fixed bin, 1 4 2 current_bounds(2) fixed bin; 1 5 1 6 dcl 1 scalar_symbol aligned based, 1 7 2 name char(2) unaligned, 1 8 2 parameter bit(1) unaligned, 1 9 2 location bit(17) unaligned; 1 10 1 11 dcl 1 array_symbol aligned based, 1 12 2 name char(1) unaligned, 1 13 2 skip bit(9) unaligned, 1 14 2 parameter bit(1) unaligned, 1 15 2 location bit(17) unaligned, 1 16 2 offset fixed bin, 1 17 2 bounds(2) fixed bin(17) unaligned; 546 547 2 1 dcl 1 basic_program_header aligned based(program_header_pt), 2 2 2 version_number fixed binary, 2 3 2 numeric_storage like loc_number, 2 4 2 string_storage like loc_number, 2 5 2 numeric_data like loc_number, 2 6 2 string_data like loc_number, 2 7 2 incoming_args like loc_number, 2 8 2 time_limit float bin, 2 9 2 numeric_scalars like loc_number, 2 10 2 string_scalars like loc_number, 2 11 2 numeric_arrays like loc_number, 2 12 2 string_arrays like loc_number, 2 13 2 functions like loc_number, 2 14 2 statement_map like loc_number, 2 15 2 precision_ind fixed bin(17) unaligned, 2 16 2 definitions fixed bin(17) unaligned; 2 17 2 18 dcl 1 loc_number based, 2 19 2 location bit(18) unaligned, 2 20 2 number bit(18) unaligned; 548 549 550 dcl 1 basic_entry aligned based, 551 2 word_0 unaligned, 552 3 descriptor bit (18), /* offset of entry descriptor */ 553 3 flag bit (1), 554 3 skip bit (17), 555 2 word_1 unaligned, 556 3 stack_size bit (18), /* size of stack frame */ 557 3 eax_7 bit (18), /* an eax 7 instruction */ 558 2 word_2 bit (36), /* eapbp sb|28,* */ 559 2 word_3 bit (36), /* tsbbp bp|0,* */ 560 2 header fixed binary; /* -offset of header */ 561 562 dcl 1 source_info aligned based (source_info_pt) like compiler_source_info; 563 3 1 /* BEGIN INCLUDE FILE ... compiler_source_info.incl.pl1 */ 3 2 /* coded in 1973 by B. Wolman */ 3 3 /* modified 12/75 by M. Weaver to include more source info */ 3 4 /* modified 12/76 by M. Weaver to include still more source info (version 2) */ 3 5 3 6 dcl 1 compiler_source_info aligned based, 3 7 2 version fixed bin, 3 8 2 given_ename char (32) var, 3 9 2 dirname char (168) var, 3 10 2 segname char (32) var, 3 11 2 date_time_modified fixed bin (71), 3 12 2 unique_id bit (36), 3 13 2 input_lng fixed bin (21), 3 14 2 input_pointer ptr; 3 15 3 16 dcl compiler_source_info_version_2 fixed bin static init (2) options (constant); 3 17 3 18 /* END INCLUDE FILE ... compiler_source_info.incl.pl1 */ 564 565 566 dcl 1 auto_source_info aligned like compiler_source_info; 567 568 dcl 1 old_source_info aligned based (info_p), 4 1 2 dirname char(168) varying, 4 2 2 segname char(32) varying, 4 3 2 date_time_modified fixed bin(71), 4 4 2 unique_id bit(36), 4 5 2 word_count fixed bin; 569 570 571 dcl lib_names (20) char (168) var; 572 573 dcl 1 based_lib_name aligned based (lib_name_pt), 574 2 count fixed bin, 575 2 next_lib_name char (0 refer (based_lib_name.count)) unaligned; 576 577 dcl numeric_data (100) float bin based (table_pt (1)); 578 579 dcl d_numeric_data (100) float bin (63) based (table_pt (1)); 580 581 dcl string_data (100) fixed bin based (table_pt (2)); 582 583 dcl constants (16383) float bin based (constant_ptr); 584 585 dcl d_constants (8191) float bin (63) based (constant_ptr); 586 587 dcl 1 line (100) aligned based (table_pt (3)), 588 2 in_function bit (1) unaligned, 589 2 location bit (17) unaligned, 590 2 number fixed bin (17) unaligned; 591 592 dcl 1 instruction aligned based, 593 2 base bit (3) unaligned, 594 2 offset bit (15) unaligned, 595 2 opcode bit (10) unaligned, 596 2 string bit (1) unaligned, 597 2 ext_base bit (1) unaligned, 598 2 tag bit (6) unaligned; 599 600 dcl based_vs char (32) varying based; 601 602 dcl 1 param_info_aligned aligned based, 603 2 param_info (npars) bit (9) unaligned; 604 605 dcl 1 itp aligned based, 606 2 base unal bit (3), 607 2 skip1 unal bit (6), 608 2 type unal bit (9), 609 2 skip2 unal bit (10), 610 2 string unal bit (1), 611 2 skip3 unal bit (1), 612 2 flag unal bit (6), 613 2 offset unal bit (18), 614 2 skip5 unal bit (12), 615 2 tag unal bit (6); 616 617 dcl 1 rand (32) aligned based (addr (operand)), 618 2 base unal bit (3), 619 2 offset unal bit (15), 620 2 opcode unal bit (10), 621 2 string unal bit (1), 622 2 ext_base unal bit (1), 623 2 tag unal bit (6); 624 625 dcl whole (11) aligned bit (36) based; 626 627 dcl 1 fn_local_word aligned based (local_pt), 628 2 number bit (5) unaligned, 629 2 skip bit (1) unaligned, 630 2 local (30) bit (1) unaligned; 631 632 dcl symbol_string char (300) varying; 633 634 /* Bit Constants */ 635 636 dcl ( 637 floating_zero init ("100000000000000000000000000000000011"b), 638 floating_nine init ("000001000100100000000000000000000011"b), 639 normal_modifier init ("000000000000000000000000000000000000"b), 640 function_modifier init ("000000000000000000000000000000001100"b), 641 prototype_mask init ("111000000000000000111111111111111111"b), 642 ptr_register_mask init ("000111111111111111111111111111111111"b), 643 arg_prototype init ("110000000000000000000000000001001110"b) 644 ) bit (36) int static; 645 646 dcl ic (0:4) bit (36) aligned static 647 init ("000000000000000000000000000000000100"b, 648 "000000000000000001000000000000000100"b, "000000000000000010000000000000000100"b, 649 "000000000000000011000000000000000100"b, "000000000000000100000000000000000100"b) 650 ; 651 652 dcl ( 653 end_token init ("000000000000000000"b), 654 numeric_variable_token init ("101000000000000000"b), 655 string_variable_token init ("011000000000000000"b), 656 user_string_fun_token init ("010011000000000000"b), 657 user_numeric_fun_token init ("100011000000000000"b), 658 numeric_constant_token init ("100100000000000000"b), 659 integer_constant_token init ("100100000000100000"b), 660 string_constant_token init ("010100000000000000"b), 661 basic_numeric_fun_token 662 init ("100010100000000000"b), 663 basic_string_fun_token init ("010010100000000000"b), 664 secondary_token init ("000000000001000000"b), 665 integer_token init ("100100000000100000"b), 666 numeric_operator_token init ("100000010000000000"b), 667 string_operator_token init ("010000010000000000"b), 668 relational_token init ("000000000100000000"b), 669 assign_token init ("000000001000000000"b), 670 punctuation_token init ("000000000010000000"b) 671 ) bit (18) int static; 672 673 dcl ( 674 is_numeric init ("100000000000000000"b), 675 is_string init ("010000000000000000"b), 676 is_variable init ("001000000000000000"b), 677 is_constant init ("000100000000000000"b), 678 is_function init ("000010000000000000"b), 679 is_user init ("000001000000000000"b), 680 is_basic init ("000000100000000000"b), 681 is_operator init ("000000010000000000"b), 682 is_assign init ("000000001000000000"b), 683 is_relational init ("000000000100000000"b), 684 is_punctuation init ("000000000010000000"b), 685 is_secondary init ("000000000001000000"b), 686 is_integer init ("000000000000100000"b) 687 ) bit (18) int static; 688 689 /* Numeric Constants */ 690 691 dcl ( 692 call_statement init (1), 693 chain_statement init (2), 694 change_statement init (3), 695 data_statement init (4), 696 def_statement init (5), 697 dim_statement init (6), 698 end_statement init (7), 699 file_statement init (8), 700 fnend_statement init (9), 701 for_statement init (10), 702 goto_statement init (11), 703 gosub_statement init (12), 704 if_statement init (13), 705 input_statement init (14), 706 let_statement init (15), 707 library_statement init (16), 708 linput_statement init (17), 709 margin_statement init (18), 710 mat_statement init (19), 711 next_statement init (20), 712 on_statement init (21), 713 print_statement init (22), 714 randomize_statement init (23), 715 read_statement init (24), 716 remark_statement init (25), 717 reset_statement init (26), 718 return_statement init (27), 719 scratch_statement init (28), 720 setdigits_statement init (29), 721 stop_statement init (30), 722 sub_statement init (31), 723 subend_statement init (32), 724 teach_statement init (33), 725 time_statement init (34), 726 write_statement init (35) 727 ) fixed bin int static; 728 729 dcl ( 730 plus init (1), 731 minus init (2), 732 times init (3), 733 quotient init (4), 734 power init (5), 735 concat init (6), 736 letter init (7), 737 digit init (8), 738 decimal init (9), 739 dollar init (10), 740 punctuation init (11), 741 relational init (12), 742 assign init (13), 743 new_line init (14), 744 quote init (15), 745 illegal init (16), 746 remark init (17), 747 backslash init (18) 748 ) fixed bin int static; 749 750 dcl ( 751 plus_op init (1), 752 minus_op init (2), 753 times_op init (3), 754 divide_op init (4), 755 power_op init (5), 756 string_op init (6), 757 unary_minus_op init (7), 758 open_paren init (8), 759 close_paren init (9), 760 comma init (10) 761 ) fixed bin int static; 762 763 dcl ( 764 n_0_fun init (1), 765 n_n_fun init (2), 766 n_s_fun init (3), 767 n_f_fun init (4), 768 s_0_fun init (5), 769 s_n_fun init (6), 770 s_nn_fun init (7), 771 n_nn_fun init (8), 772 n_fs_fun init (9), 773 n_ssn_fun init (10), 774 s_ssn_fun init (11), 775 n_var_fun init (12), 776 matrix_fun init (13), 777 print_fun init (14), 778 matrix_constant init (15), 779 s_snn_fun init (16), 780 pos_args init (17) 781 ) fixed bin static; 782 783 dcl one init (1) float bin (27) static; 784 785 /* pos (17) doesn't require 1 arg; however, this is 786* necessary to convince 'expression:' that pos returns a value */ 787 788 789 dcl number_of_args_required 790 (17) fixed bin static init (0, 1, 1, 1, 0, 1, 2, 2, 2, 3, 3, -1, 0, 1, 0, 2, 1); 791 5 1 dcl ( numeric_scalar_param init(2), 5 2 string_scalar_param init(3), 5 3 numeric_list_param init(4), 5 4 string_list_param init(5), 5 5 numeric_table_param init(6), 5 6 string_table_param init(7), 5 7 numeric_function_param init(8), 5 8 string_function_param init(9), 5 9 file_param init(10)) fixed bin static; 792 793 794 dcl ( 795 numeric_data_table init (1), 796 string_data_table init (2), 797 line_table init (3) 798 ) fixed bin static; 799 800 dcl first_auto_loc init (128) fixed bin static; 801 802 dcl max_temp init (20) fixed bin static; 803 804 dcl table_limit init (261120) fixed bin (18) static; 805 806 dcl large_table_size (3) init (2048, 1024, 1024) fixed bin static; 807 808 dcl table_increment (3) init (2048, 1024, 1024) fixed bin static; 809 810 dcl number_of_tables init (3) fixed bin static; 811 812 dcl table_full (3) init (-47, -47, -84) fixed bin static; 813 814 dcl table_element_size (2, 3) init (1, 1, 1, 2, 1, 1) fixed bin static options (constant); 815 816 dcl letter_a init (97) fixed bin static; 817 818 dcl digit_0 init (48) fixed bin static; 819 820 dcl max_line_number init (99999) fixed bin static; 821 822 dcl next_line_err (-5:-1) init (4, 12, 11, 10, 9) fixed bin static; 823 824 dcl max_number_of_errors init (10) fixed bin static; 825 826 dcl max_number_of_constants 827 init (16382) fixed bin static; 828 /* (2**16)-2 */ 829 830 dcl max_subprogram_name_length 831 init (32) fixed bin static; 832 833 dcl max_string_constant_length 834 init (250) fixed bin static; 835 836 dcl max_number_of_digits init (22) fixed bin static; 837 838 dcl max_storage_amount init (261120) fixed bin (20) static; 839 /* (2**18)-1024 */ 840 841 /* Character Constants */ 842 843 dcl alphanumeric char (65) static 844 init ("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_.-"); 845 846 dcl digits char (10) static init ("0123456789"); 847 848 dcl NL char (1) static init (" 849 "); 850 851 dcl matrix_secondary (5) char (8) static init ("input", "linput", "print", "read", "write"); 852 853 join: /* Per compilation initialization */ 854 on conversion goto invalid_constant; 855 on size goto size_error; 856 on overflow goto overflow_error; 857 on underflow goto underflow_error; 858 859 next_line_storage.input_pt = source_info.input_pointer; 860 next_line_storage.input_length = source_info.input_lng; 861 next_line_storage.input_pos = 0; 862 next_line_storage.statement_number = 0; 863 next_line_storage.statement_ending = 0; 864 next_line_storage.temp_ch = 0; 865 source_number = 0; 866 867 output_pt = output_pointer; 868 output_pos = 0; 869 870 precision_lng = basic_data$precision_length; 871 if precision_lng = 1 872 then single = "1"b; 873 else single = "0"b; 874 inst_pt = addr (basic_data$instruction_sequences (precision_lng)); 875 876 if generate_object 877 then do; 878 seg_name = source_info_pt -> source_info.given_ename; 879 /* use the original info */ 880 i = index (seg_name, ".basic"); 881 if i > 0 882 then seg_name = substr (seg_name, 1, i - 1); 883 end; 884 else seg_name = "{main_program}"; 885 886 basic_temp_ptr = null; 887 instruction_temp_ptr = null; 888 number_of_errors = 0; 889 program_number = 0; 890 lib_count = 0; 891 892 on cleanup 893 begin; 894 if instruction_temp_ptr ^= null 895 then call release_temp_segment_ ("basic", instruction_temp_ptr, code); 896 897 if basic_temp_ptr ^= null 898 then call release_temp_segment_ ("basic", basic_temp_ptr, code); 899 end; 900 901 call get_temp_segment_ ("basic", instruction_temp_ptr, code); 902 if code ^= 0 903 then do; 904 call ioa_ ("Unable to get temporary segment."); 905 number_of_errors = 1; 906 return; 907 end; 908 909 first_statement = "1"b; 910 sub_ok = "0"b; 911 912 process_source: 913 source_number = source_number + 1; 914 source_map_info (source_number).pathname = source_info.dirname || ">" || source_info.segname; 915 source_map_info (source_number).uid = source_info.unique_id; 916 source_map_info (source_number).dtm = source_info.date_time_modified; 917 918 do while (input_pos < input_length); 919 920 /* Per subprogram initialization */ 921 922 for_level = 0; 923 fn_name = 0; 924 current_line_number = -1; 925 modifier = "0"b; 926 927 /* Use small tables to start with */ 928 929 table_pt (1) = addr (small_numeric_data); 930 table_max (1) = hbound (small_numeric_data, 1); 931 table_pos (1) = 0; 932 large_table_offset (1) = 0; 933 small_table (1) = "1"b; 934 935 table_pt (2) = addr (small_string_data); 936 table_max (2) = hbound (small_string_data, 1); 937 table_pos (2) = 0; 938 large_table_offset (2) = 2048; 939 small_table (2) = "1"b; 940 941 table_pt (3) = addr (small_line); 942 table_max (3) = hbound (small_line, 1); 943 table_pos (3) = 0; 944 large_table_offset (3) = 3072; 945 small_table (3) = "1"b; 946 947 if mod (output_pos, 2) ^= 0 948 then output_pos = output_pos + 1; 949 950 number_of_constants = 0; 951 begin; /* this is just to use size as a builtin */ 952 dcl size builtin; 953 954 constant_ptr = addrel (output_pointer, output_pos + size (basic_program_header)); 955 956 end; 957 958 missing_pt = addr (missing_table (0)); 959 missing.count = 0; 960 961 temps_pt = addr (normal_temps); 962 963 last_statement = "0"b; 964 965 do i = 1 to max_temp; /* hbound(temps(0).address,1) */ 966 normal_temps (0).address (i), normal_temps (1).address (i), normal_temps (2).address (i) = (36)"0"b; 967 end; 968 969 do i = lbound (scalars, 1) to hbound (scalars, 1); 970 scalars (i) = (36)"0"b; 971 end; 972 973 string (dim_not_allowed) = "0"b; 974 975 do i = lbound (arrays, 1) to hbound (arrays, 1); 976 arrays (i).address = (36)"0"b; 977 arrays (i).dimensions = 0; 978 arrays (i).bounds (1), arrays (i).bounds (2) = -1; 979 end; 980 981 do i = lbound (fn_table, 1) to hbound (fn_table, 1); 982 string (fn_table (i)) = "0"b; 983 end; 984 985 auto_ctr (0) = first_auto_loc; 986 auto_ctr (1) = 0; 987 988 odd_available (0) = 0; 989 odd_available (1) = 0; 990 991 init: 992 operand_level = 0; 993 operator_level = 0; 994 995 /* Compile the subprogram */ 996 997 if which = 4 998 then do; /* syntax check of one line only */ 999 call lexical_analyzer; 1000 return; 1001 end; 1002 else ; 1003 1004 do while (^last_statement); 1005 call lexical_analyzer; 1006 call compile_statement; 1007 1008 if operator_level + operand_level ^= 0 1009 then call error (12); 1010 end; 1011 1012 /* Finish up the subprogram */ 1013 1014 call finish_subprogram; 1015 end; 1016 1017 if which = 3 1018 then do; /* get more source from run unit manager */ 1019 source_info_pt = addr (auto_source_info); 1020 call get_next_source_seg_ (source_info_pt); 1021 if source_info.input_pointer ^= null 1022 then do; 1023 input_pt = source_info.input_pointer; 1024 input_length = source_info.input_lng; 1025 input_pos = 0; 1026 go to process_source; 1027 end; 1028 end; 1029 1030 /* Finish up the object segment */ 1031 1032 finish: 1033 call finish_object; 1034 1035 1036 /* Return pointer to main program and number of errors */ 1037 1038 abort_compilation: 1039 if basic_temp_ptr ^= null 1040 then call release_temp_segment_ ("basic", basic_temp_ptr, code); 1041 1042 if instruction_temp_ptr ^= null 1043 then call release_temp_segment_ ("basic", instruction_temp_ptr, code); 1044 1045 if which = 1 1046 then do; 1047 mp = main_pt; 1048 err_count = number_of_errors; 1049 end; 1050 else do; 1051 if number_of_errors = 0 1052 then a_code = 0; 1053 else a_code = error_table_$translation_failed; 1054 end; 1055 return; 1056 1057 /* Control reaches here when an error is found, plant jump to 1058* special operator as code for statement containing error */ 1059 1060 abort_statement: 1061 output_word (output_pos) = instructions.error (1); 1062 output_pos = output_pos + 1; 1063 1064 if input_pos < input_length 1065 then goto init; 1066 else goto abort_compilation; 1067 1068 /* Find the appropriate error number */ 1069 1070 size_error: 1071 overflow_error: 1072 call error (1); 1073 1074 incorrect_format: 1075 call error (2); 1076 1077 line_number_too_large: 1078 call error (3); 1079 1080 no_line_number: 1081 call error (4); 1082 1083 invalid_function: 1084 call error_name (6, this_token.name); 1085 1086 invalid_statement: 1087 call error (7); 1088 1089 invalid_variable: 1090 call error_name (8, this_token.name); 1091 1092 line_too_long: 1093 call error (9); 1094 1095 program_out_of_order: 1096 call error (14); 1097 1098 invalid_asc: 1099 call error (15); 1100 1101 invalid_operator: 1102 call error_name (16, this_token.name); 1103 1104 invalid_character: 1105 call error (17); 1106 1107 invalid_constant: 1108 call error (18); 1109 1110 relational_required: 1111 call error (20); 1112 1113 mixed_expression: 1114 call error (21); 1115 1116 then_goto_missing: 1117 call error (22); 1118 1119 mixed_let: 1120 call error (23); 1121 1122 assign_missing: 1123 call error (24); 1124 1125 not_yet: 1126 call error (25); 1127 1128 numeric_expression_required: 1129 expression_required (0): 1130 call error (26); 1131 1132 string_expression_required: 1133 expression_required (1): 1134 call error (27); 1135 1136 file_expression_required: 1137 call error (28); 1138 1139 wrong_number_of_args: 1140 call error_name (29, this_token.name); 1141 1142 parenthesis_mismatch: 1143 call error (30); 1144 1145 punctuation_not_allowed: 1146 call error (31); 1147 1148 too_deep: 1149 call error (32); 1150 1151 invalid_array: 1152 call error_name (33, this_token.name); 1153 1154 invalid_line_number: 1155 call error (34); 1156 1157 line_number_required: 1158 call error (35); 1159 1160 too_many_missing_lines: 1161 call error (36); 1162 1163 then_goto_gosub_missing: 1164 call error (37); 1165 1166 wrong_number_of_subs: 1167 call error_name (38, this_token.name); 1168 1169 missing_colon: 1170 call error (39); 1171 1172 string_reference_required: 1173 call error (40); 1174 1175 function_not_allowed: 1176 call error_name (41, this_token.name); 1177 1178 numeric_variable_required: 1179 call error (42); 1180 1181 next_without_for: 1182 call error (43); 1183 1184 for_next_mismatch: 1185 call error (44); 1186 1187 for_too_deep: 1188 call error (46); 1189 1190 multiple_commas: 1191 call error (48); 1192 1193 operation_not_allowed: 1194 call error (49); 1195 1196 integer_constant_required: 1197 call error (50); 1198 1199 fnend_without_def: 1200 call error (52); 1201 1202 nested_def: 1203 call error (53); 1204 1205 multiple_def: 1206 call error (54); 1207 1208 invalid_arg_list: 1209 call error (55); 1210 1211 invalid_def: 1212 call error (56); 1213 1214 redim_not_allowed: 1215 call error (57); 1216 1217 some_matrix_required: 1218 call error (58); 1219 1220 numeric_matrix_required: 1221 matrix_required (0): 1222 call error (59); 1223 1224 string_matrix_required: 1225 matrix_required (1): 1226 call error (60); 1227 1228 numeric_list_required: 1229 call error (61); 1230 1231 too_many_locals: 1232 call error (62); 1233 1234 array_occurs_twice: 1235 call error (63); 1236 1237 end_or_subend_must_be_last: 1238 call error (64); 1239 1240 end_not_allowed: 1241 call error (65); 1242 1243 file_occurs_twice: 1244 call error (66); 1245 1246 statement_outside_program: 1247 call error (68); 1248 1249 sub_not_allowed: 1250 call error (69); 1251 1252 subprogram_defined_twice: 1253 call error (70); 1254 1255 variable_occurs_twice: 1256 call error (71); 1257 1258 string_constant_required: 1259 call error (72); 1260 1261 invalid_subprogram_name: 1262 call error (73); 1263 1264 invalid_subprogram_parameter: 1265 call error (74); 1266 1267 subend_not_allowed: 1268 call error (75); 1269 1270 array_defined_twice: 1271 call error_name (76, this_token.name); 1272 1273 too_many_subprograms: 1274 call error (77); 1275 1276 function_occurs_twice: 1277 call error (78); 1278 1279 fun_cannot_be_passed: 1280 call error_name (82, this_token.name); 1281 1282 assign_out_of_order: 1283 call error (83); 1284 1285 underflow_error: 1286 call error (85); 1287 1288 /* Lexical analysis procedure for basic compiler 1289* 1290* Initial Version: 12 February 1973 by BLW 1291* Modified: 18 March 1974 by BLW to fix bug 016 1292* Modified: 18 July 1974 by BLW to fix bugs 032 and 043 */ 1293 1294 lexical_analyzer: 1295 proc; 1296 1297 dcl (i, j, k, ip, token_length) 1298 fixed bin, 1299 numsign float bin, 1300 p ptr, 1301 integer bit (1), 1302 abbrev char (4), 1303 cs1 char (1), 1304 stm char (4), 1305 rest char (8); 1306 1307 dcl (size, string) builtin; 1308 1309 /* initialize */ 1310 1311 loop: 1312 if input_pos >= input_length 1313 then do; 1314 call error (-13); 1315 statement_type = end_statement; 1316 1317 current_token = 1; 1318 number_of_tokens = 1; 1319 tokens (1).type = end_token; 1320 1321 return; 1322 end; 1323 1324 call basic_next_line (addr (next_line_storage)); 1325 1326 if error_number = -3 1327 then if (ch (1) = "r") & (ch (2) = "e") & (ch (3) = "m") 1328 then error_number = 6; 1329 1330 if error_number < 0 1331 then do; 1332 if current_line_number = -1 /* would begin subprogram */ & (error_number = -2 | error_number = -4) 1333 then do; 1334 input_pos = input_length; /* force to end to skip garbage */ 1335 go to finish; /* pretend this didn't happen */ 1336 end; 1337 call error (next_line_err (error_number)); 1338 end; 1339 1340 if next_line_storage.statement_number = 0 1341 then do; /* first statement on the line */ 1342 1343 1344 /* make sure line number is OK */ 1345 1346 if line_number > max_line_number 1347 then goto line_number_too_large; 1348 1349 if line_number <= current_line_number 1350 then goto program_out_of_order; 1351 1352 /* add to list of defined line numbers */ 1353 1354 number_of_lines = number_of_lines + 1; 1355 1356 if number_of_lines = max_number_of_lines 1357 then call table_overflow (line_table); 1358 1359 current_line_number, line (number_of_lines).number = line_number; 1360 1361 line (number_of_lines).location = bit (fixed (output_pos, 17), 17); 1362 1363 in_function (number_of_lines) = fn_name ^= 0; 1364 1365 /* check to see if line was used before, if so fill in usages */ 1366 1367 do i = 1 to missing.count; 1368 if missing.number (i) = line_number 1369 then do; 1370 1371 do loc = missing.chain (i) repeat (next_loc) while (loc); 1372 1373 p = addrel (output_pt, loc); 1374 next_loc = p -> half (0).left; 1375 1376 p -> half (0).left = bit (fixed (output_pos - fixed (loc, 18), 18), 18); 1377 end; 1378 1379 /* now erase entry from missing list */ 1380 1381 do j = i + 1 to missing.count; 1382 missing_lines_word (j - 1) = missing_lines_word (j); 1383 end; 1384 1385 missing.count = missing.count - 1; 1386 end; 1387 end; 1388 end; /* of line number processing */ 1389 1390 /* determine statement type */ 1391 1392 if ch_class (1) = new_line | ch_class (1) = backslash 1393 then goto loop; 1394 1395 if ch_class (1) ^= letter 1396 then goto invalid_statement; 1397 1398 stm = ch (1); 1399 1400 j = fixed (unspec (ch (1)), 9) - letter_a + 1; 1401 1402 if ch_class (2) ^= letter 1403 then do; 1404 statement_type = let_statement; 1405 ip = 0; 1406 go to have_statement_type; 1407 end; 1408 1409 substr (stm, 2, 1) = ch (2); 1410 1411 if (stm = "fn ") & (ch (4) ^= "n") 1412 then do; 1413 statement_type = let_statement; 1414 ip = 0; 1415 goto have_statement_type; 1416 end; 1417 1418 1419 ip = 2; 1420 1421 if stm = "if " 1422 then statement_type = if_statement; 1423 else if stm = "on " 1424 then statement_type = on_statement; 1425 else do; 1426 ip = ip + 1; 1427 1428 if ch_class (3) ^= letter 1429 then goto invalid_statement; 1430 1431 substr (stm, 3, 1) = ch (3); 1432 1433 do statement_type = basic_data$statement_spelling.start (j) 1434 to basic_data$statement_spelling.finish (j); 1435 if stm = basic_data$statement_list.first (statement_type) 1436 then goto have_statement_type; 1437 end; 1438 1439 goto invalid_statement; 1440 end; 1441 1442 have_statement_type: 1443 if statement_type = sub_statement 1444 then if ch_class (ip + 1) ^= quote 1445 then statement_type = subend_statement; 1446 1447 k = basic_data$statement_list.number (statement_type); 1448 1449 if k > 0 1450 then do; 1451 1452 /* check rest of spelling */ 1453 1454 rest = ""; 1455 do i = 1 to k; 1456 ip = ip + 1; 1457 1458 if ch_class (ip) ^= letter 1459 then goto invalid_statement; 1460 1461 substr (rest, i, 1) = ch (ip); 1462 end; 1463 1464 if rest ^= basic_data$statement_list.rest (statement_type) 1465 then do; 1466 if statement_type ^= chain_statement 1467 then goto invalid_statement; 1468 1469 /* "chain" and "change" start out the same, more checking needed */ 1470 1471 ip = ip + 1; 1472 1473 if ch_class (ip) ^= letter 1474 then goto invalid_statement; 1475 1476 substr (rest, 3, 1) = ch (ip); 1477 1478 if substr (rest, 1, 4) ^= "nge " 1479 then goto invalid_statement; 1480 1481 statement_type = change_statement; 1482 end; 1483 end; 1484 1485 if statement_type = remark_statement 1486 then goto loop; 1487 if statement_type = data_statement 1488 then goto next_data_value; 1489 1490 number_of_assigns = 0; 1491 current_token = 0; 1492 1493 next_token: 1494 current_token = current_token + 1; 1495 if current_token >= hbound (tokens, 1) 1496 then goto line_too_long; 1497 1498 token_pt = addr (tokens (current_token)); 1499 this_token.name = (8)" "; 1500 1501 ip = ip + 1; 1502 goto sw (ch_class (ip)); 1503 1504 /* new line character means end of line reached */ 1505 /* backslash character means end of statement reached */ 1506 1507 sw (14): 1508 sw (18): 1509 this_token.type = end_token; 1510 number_of_tokens = current_token; 1511 current_token = 1; 1512 1513 return; 1514 1515 /* have a letter, could be start of variable name */ 1516 1517 sw (7): 1518 substr (this_token.name, 1, 1) = ch (ip); 1519 this_token.number = fixed (unspec (ch (ip)), 9) - letter_a + 1; 1520 1521 ip = ip + 1; 1522 1523 if ch_class (ip) = digit 1524 then do; 1525 1526 /* have two character variable name */ 1527 1528 substr (this_token.name, 2, 1) = ch (ip); 1529 this_token.number = this_token.number + 26 * (fixed (unspec (ch (ip)), 9) - digit_0 + 1); 1530 1531 ip = ip + 1; 1532 1533 /* if this character is a $ we have completed a two character 1534* string variable token; otherwise, we have a two character 1535* numeric variable token and we put back the character */ 1536 1537 if ch_class (ip) = dollar 1538 then do; 1539 this_token.type = string_variable_token; 1540 this_token.number = -this_token.number; 1541 end; 1542 else do; 1543 this_token.type = numeric_variable_token; 1544 ip = ip - 1; 1545 end; 1546 1547 goto next_token; 1548 end; 1549 1550 if ch_class (ip) = dollar 1551 then do; 1552 1553 /* this is a single character string variable */ 1554 1555 this_token.type = string_variable_token; 1556 this_token.number = -this_token.number; 1557 goto next_token; 1558 end; 1559 1560 if ch_class (ip) ^= letter 1561 then do; 1562 1563 /* have a single character numeric variable */ 1564 1565 this_token.type = numeric_variable_token; 1566 ip = ip - 1; 1567 goto next_token; 1568 end; 1569 1570 /* we have two consecutive letters */ 1571 1572 substr (this_token.name, 2, 1) = ch (ip); 1573 1574 if substr (this_token.name, 1, 4) = "to " 1575 then do; 1576 is_secondary: 1577 this_token.type = secondary_token; 1578 goto next_token; 1579 end; 1580 1581 ip = ip + 1; 1582 1583 if ch_class (ip) ^= letter 1584 then goto invalid_variable; 1585 1586 /* we have three letters */ 1587 1588 substr (this_token.name, 3, 1) = ch (ip); 1589 1590 if substr (this_token.name, 1, 4) = "bit " 1591 then goto is_secondary; 1592 if substr (this_token.name, 1, 4) = "end " 1593 then goto is_secondary; 1594 1595 /* check for sequence "v to" where v is variable name */ 1596 1597 if substr (this_token.name, 2, 2) = "to" 1598 then do; 1599 1600 /* split string into two tokens; variable followed by secondary */ 1601 1602 split: 1603 if current_token = hbound (tokens, 1) 1604 then goto line_too_long; 1605 1606 current_token = current_token + 1; 1607 tokens (current_token).type = secondary_token; 1608 tokens (current_token).name = substr (this_token.name, 2); 1609 1610 substr (this_token.name, 2) = (7)" "; 1611 this_token.type = numeric_variable_token; 1612 this_token.number = fixed (unspec (substr (this_token.name, 1, 1)), 9) - letter_a + 1; 1613 1614 goto next_token; 1615 end; 1616 1617 /* check for function name */ 1618 1619 if substr (this_token.name, 1, 2) = "fn" 1620 then do; 1621 1622 /* we have a user defined function */ 1623 1624 this_token.number = fixed (unspec (ch (ip)), 9) - letter_a + 1; 1625 1626 ip = ip + 1; 1627 1628 if ch_class (ip) = dollar 1629 then do; 1630 this_token.type = user_string_fun_token; 1631 this_token.number = -this_token.number; 1632 end; 1633 else do; 1634 this_token.type = user_numeric_fun_token; 1635 ip = ip - 1; 1636 end; 1637 1638 goto next_token; 1639 end; 1640 1641 if substr (this_token.name, 1, 3) = "asc" 1642 then do; 1643 1644 /* ASC function requires special handling */ 1645 1646 ip = ip + 1; 1647 1648 if ch (ip) ^= "(" 1649 then goto invalid_asc; 1650 1651 token_length = 0; 1652 abbrev = (4)" "; 1653 1654 asc_loop: 1655 ip = ip + 1; 1656 1657 if token_length > 3 1658 then goto invalid_asc; 1659 1660 if ch_class (ip) = new_line 1661 then goto invalid_asc; 1662 1663 if token_length = 0 | ch (ip) ^= ")" 1664 then do; 1665 token_length = token_length + 1; 1666 substr (abbrev, token_length, 1) = ch (ip); 1667 goto asc_loop; 1668 end; 1669 1670 if token_length = 1 1671 then cs1 = substr (abbrev, 1, 1); 1672 else do; 1673 1674 /* abbreviations of form "lcx" & "ucx" are easy */ 1675 1676 if token_length = 3 1677 then do; 1678 if substr (abbrev, 1, 2) = "lc" 1679 then if ch_class (ip - 1) = letter 1680 then do; 1681 cs1 = ch (ip - 1); 1682 goto asc_ok; 1683 end; 1684 else goto invalid_asc; 1685 1686 if substr (abbrev, 1, 2) = "uc" 1687 then if ch_class (ip - 1) ^= letter 1688 then goto invalid_asc; 1689 else do; 1690 unspec (cs1) = unspec (ch (ip - 1)) & "111011111"b; 1691 goto asc_ok; 1692 end; 1693 end; 1694 1695 /* have to look up the abbreviaton */ 1696 1697 do i = 1 to basic_data$ascii_table_length; 1698 if abbrev = basic_data$ascii_table (i).abbreviation 1699 then do; 1700 cs1 = basic_data$ascii_table (i).val; 1701 goto asc_ok; 1702 end; 1703 end; 1704 1705 goto invalid_asc; 1706 end; 1707 1708 asc_ok: 1709 this_token.type = numeric_constant_token; 1710 if single 1711 then this_token.value = float (fixed (unspec (cs1), 9), 27); 1712 else d_this_token.value = float (fixed (unspec (cs1), 9), 63); 1713 goto next_token; 1714 end; 1715 1716 /* we don't have ASC function, check for predefined basic function */ 1717 1718 j = fixed (unspec (substr (this_token.name, 1, 1)), 9) - letter_a + 1; 1719 1720 do i = basic_data$numeric_spelling.start (j) to basic_data$numeric_spelling.finish (j); 1721 if substr (this_token.name, 1, 4) = basic_data$functions (i).name 1722 then do; 1723 1724 /* we have a numeric function, make sure it isn't followed by $ */ 1725 1726 if ch_class (ip + 1) = dollar 1727 then goto invalid_function; 1728 1729 /* make sure a function that requires an arg list is followed 1730* by a "("; this keeps us from getting fooled by lines such as 1731* 1732* for i = 0 to t step ... */ 1733 1734 /* check removed because it does not allow numeric 1735* functions to be passed as arguments 1736* 1737* j = basic_data$functions(i).class; 1738* if j < matrix_fun 1739* then if number_of_args_required(j) ^= 0 1740* then if ch(ip+1) ^= "(" 1741* then goto not_a_function; 1742* */ 1743 1744 /* must special case lines such as 1745* for i = 0 to t step ... */ 1746 1747 if substr (this_token.name, 1, 4) = "tst " 1748 then if ch (ip + 1) = "e" 1749 then if ch (ip + 2) = "p" 1750 then goto not_a_function; 1751 1752 this_token.type = basic_numeric_fun_token; 1753 this_token.number = i; 1754 goto next_token; 1755 end; 1756 end; 1757 1758 call id_string_function; 1759 1760 1761 /* not a function, keep looking */ 1762 1763 not_a_function: 1764 ip = ip + 1; 1765 1766 if ch_class (ip) ^= letter 1767 then goto invalid_variable; 1768 1769 /* have four letters in a row */ 1770 1771 substr (this_token.name, 4, 1) = ch (ip); 1772 1773 /* Check for four letter function left$ but avoid right$ */ 1774 1775 if substr(this_token.name,1,4) ^= "righ" then 1776 call id_string_function; 1777 1778 if substr (this_token.name, 1, 4) = "step" 1779 then goto is_secondary; 1780 if substr (this_token.name, 1, 4) = "goto" 1781 then goto is_secondary; 1782 if substr (this_token.name, 1, 4) = "then" 1783 then goto is_secondary; 1784 if substr (this_token.name, 1, 4) = "more" 1785 then goto is_secondary; 1786 if substr (this_token.name, 1, 4) = "read" 1787 then goto is_secondary; 1788 1789 if substr (this_token.name, 2, 3) = "bit" 1790 then goto split; 1791 1792 ip = ip + 1; 1793 1794 if ch_class (ip) ^= letter 1795 then goto invalid_variable; 1796 1797 /* have five letters in a row */ 1798 1799 substr (this_token.name, 5, 1) = ch (ip); 1800 1801 /* Check for five letter function right$ */ 1802 1803 call id_string_function; 1804 1805 if this_token.name = "gosub " 1806 then goto is_secondary; 1807 if this_token.name = "using " 1808 then goto is_secondary; 1809 1810 if statement_type = mat_statement 1811 then do; 1812 if this_token.name = "input " 1813 then goto is_secondary; 1814 if this_token.name = "print " 1815 then goto is_secondary; 1816 if this_token.name = "write " 1817 then goto is_secondary; 1818 end; 1819 1820 if substr (this_token.name, 2, 4) = "then" 1821 then goto split; 1822 if substr (this_token.name, 2, 4) = "goto" 1823 then goto split; 1824 if substr (this_token.name, 2, 4) = "step" 1825 then goto split; 1826 1827 ip = ip + 1; 1828 1829 if ch_class (ip) = letter 1830 then do; 1831 1832 /* six letters, last chance */ 1833 1834 substr (this_token.name, 6, 1) = ch (ip); 1835 1836 if statement_type = mat_statement 1837 then if this_token.name = "linput " 1838 then goto is_secondary; 1839 1840 if substr (this_token.name, 2, 5) = "gosub" 1841 then goto split; 1842 end; 1843 1844 /* definitely have an error */ 1845 1846 goto invalid_variable; 1847 1848 id_string_function: 1849 proc (); 1850 1851 do i = basic_data$string_spelling.start (j) to basic_data$string_spelling.finish (j); 1852 if substr (this_token.name, 1, 4) = basic_data$functions (i).name 1853 then do; 1854 1855 /* we have a string function, make sure it is followed by a $ */ 1856 1857 ip = ip + 1; 1858 1859 if ch_class (ip) ^= dollar 1860 then if substr (this_token.name, 1, 3) = "sst" 1861 then do; /* see if we have to s step */ 1862 if (ch_class (ip) = letter) & (ch_class (ip + 1) = letter) 1863 then do; 1864 substr (this_token.name, 4, 2) = ch (ip) || ch (ip + 1); 1865 ip = ip + 1; 1866 if substr (this_token.name, 1, 5) = "sstep" 1867 then go to split; 1868 end; 1869 go to invalid_function; 1870 end; 1871 1872 this_token.type = basic_string_fun_token; 1873 this_token.number = i; 1874 goto next_token; 1875 end; 1876 end; 1877 end id_string_function; 1878 1879 /* have digit or decimal point, pick up number */ 1880 1881 sw (8): 1882 sw (9): 1883 if single 1884 then this_token.value = s_convert_number (); 1885 else d_this_token.value = d_convert_number (); 1886 1887 if integer 1888 then this_token.type = integer_token; 1889 else this_token.type = numeric_constant_token; 1890 1891 goto next_token; 1892 1893 /* have arithmetic operator */ 1894 1895 sw (1): 1896 sw (2): 1897 sw (3): 1898 sw (4): 1899 sw (5): 1900 this_token.type = numeric_operator_token; 1901 1902 is_op: 1903 this_token.number = ch_class (ip); 1904 substr (this_token.name, 1, 1) = ch (ip); 1905 goto next_token; 1906 1907 /* have string operator */ 1908 1909 sw (6): 1910 this_token.type = string_operator_token; 1911 goto is_op; 1912 1913 /* have equal sign */ 1914 1915 sw (13): 1916 if statement_type ^= if_statement 1917 then do; 1918 1919 this_token.type = assign_token; 1920 number_of_assigns = number_of_assigns + 1; 1921 1922 substr (this_token.name, 1, 1) = ch (ip); 1923 goto next_token; 1924 end; 1925 1926 /* have < or > or = */ 1927 1928 sw (12): 1929 substr (this_token.name, 1, 1) = ch (ip); 1930 1931 ip = ip + 1; 1932 1933 if ch_class (ip) = new_line | ch_class (ip) = backslash 1934 then goto next_token; 1935 1936 if ch_class (ip) = relational | ch_class (ip) = assign 1937 then substr (this_token.name, 2, 1) = ch (ip); 1938 else ip = ip - 1; 1939 1940 do i = 1 to basic_data$relational_table_length; 1941 if substr (this_token.name, 1, 4) = basic_data$relational_table (i).name 1942 then do; 1943 this_token.type = relational_token; 1944 this_token.number = i; 1945 goto next_token; 1946 end; 1947 end; 1948 1949 /* we have unknown relational, what to do ? */ 1950 1951 goto invalid_operator; 1952 1953 /* have start of quoted string */ 1954 1955 sw (15): 1956 this_token.type = string_constant_token; 1957 this_token.number = quoted_string (); 1958 goto next_token; 1959 1960 /* have miscellaneous punctuation character */ 1961 1962 sw (11): 1963 this_token.type = punctuation_token; 1964 substr (this_token.name, 1, 1) = ch (ip); 1965 1966 goto next_token; 1967 1968 /* errors */ 1969 1970 sw (10): 1971 this_token.name = "$"; 1972 goto invalid_variable; 1973 1974 sw (16): 1975 data (16): 1976 goto invalid_character; 1977 1978 /* process data statement */ 1979 1980 next_data_value: 1981 numsign = +1.0e0; 1982 1983 ip = ip + 1; 1984 goto data (ch_class (ip)); 1985 1986 /* start negative numeric constant */ 1987 1988 data (2): 1989 numsign = -1.0e0; 1990 1991 /* start positive numeric constant */ 1992 1993 data (1): 1994 ip = ip + 1; 1995 1996 if ch_class (ip) ^= digit 1997 then if ch_class (ip) ^= decimal 1998 then goto invalid_constant; 1999 2000 /* pick up numeric constant */ 2001 2002 data (8): 2003 data (9): 2004 if numeric_data_count = max_numeric_data_count 2005 then call table_overflow (numeric_data_table); 2006 2007 numeric_data_count = numeric_data_count + 1; 2008 2009 if single 2010 then numeric_data (numeric_data_count) = numsign * s_convert_number (); 2011 else d_numeric_data (numeric_data_count) = numsign * d_convert_number (); 2012 2013 /* make sure data item followed by comma */ 2014 2015 comma_check: 2016 ip = ip + 1; 2017 2018 if ch (ip) = "," 2019 then goto next_data_value; 2020 2021 if ch_class (ip) = new_line | ch_class (ip) = backslash 2022 then goto loop; 2023 2024 if ch_class (ip) <= 6 2025 then goto operation_not_allowed; 2026 else goto incorrect_format; 2027 2028 /* pick up quoted string */ 2029 2030 data (15): 2031 if string_data_count = max_string_data_count 2032 then call table_overflow (string_data_table); 2033 2034 string_data_count = string_data_count + 1; 2035 2036 /* quoted_string() returns 1 more than it should here; 2037* can't find cause, so fix symptom (MBW 5/20/81) */ 2038 2039 string_data (string_data_count) = quoted_string () - 1; 2040 2041 goto comma_check; 2042 2043 /* have start of non-quoted string */ 2044 2045 data (3): 2046 data (4): 2047 data (5): 2048 data (6): 2049 data (7): 2050 data (10): 2051 data (12): 2052 data (13): 2053 if string_data_count = max_string_data_count 2054 then call table_overflow (string_data_table); 2055 2056 string_data_count = string_data_count + 1; 2057 2058 string_data (string_data_count) = non_quoted_string () - 1; 2059 2060 goto comma_check; 2061 2062 /* have punctuation, check for multiple commas */ 2063 2064 data (11): 2065 if ch (ip) = "," 2066 then goto multiple_commas; 2067 else goto data (3); 2068 2069 /* new line or backslash means end of data statement */ 2070 2071 data (14): 2072 data (18): 2073 goto loop; 2074 2075 s_convert_number: 2076 proc returns (float bin (27)); 2077 2078 dcl int fixed bin, 2079 value float bin (27); 2080 2081 call convert_number (); /* get number in decimal form */ 2082 2083 if ^integer 2084 then value = convert (value, dec_num); 2085 else do; /* if have integer, conversion can be done in line */ 2086 int = convert (int, dec_num); 2087 value = convert (value, int); 2088 end; 2089 2090 return (value); 2091 end; 2092 2093 d_convert_number: 2094 proc returns (float bin (63)); 2095 2096 dcl int fixed bin (71), 2097 value float bin (63); 2098 2099 call convert_number (); /* get number in decimal form */ 2100 2101 if ^integer 2102 then value = convert (value, dec_num); 2103 else do; /* if have integer, conversion can be done in line */ 2104 int = convert (int, dec_num); 2105 value = convert (value, int); 2106 end; 2107 2108 return (value); 2109 end; 2110 2111 convert_number: 2112 proc; 2113 2114 dcl (exp, prec, scale, exp_sign) 2115 fixed bin, 2116 no_digits bit (1); 2117 2118 dcl 1 num_overlay aligned based (addr (dec_num)), 2119 2 sign unal char (1), 2120 2 digits (22) unal char (1), 2121 2 skip unal bit (1), 2122 2 exponent unal fixed bin (7); 2123 2124 /* This routine is called when a digit is found; it scans over a floating 2125* point number and returns its internal representation. The flag 2126* "integer" is turned on if the number has an integer value */ 2127 2128 exp = 0; 2129 prec = 0; 2130 scale = 0; 2131 2132 dec_num = 0.0e0; 2133 2134 integer = ch_class (ip) = digit; 2135 2136 /* pick up integer part */ 2137 2138 do while (ch_class (ip) = digit); 2139 prec = prec + 1; 2140 num_overlay.digits (prec) = ch (ip); 2141 ip = ip + 1; 2142 end; 2143 2144 /* if we have decimal point, pick up fractional part */ 2145 2146 if ch (ip) = "." 2147 then do; 2148 integer = "0"b; 2149 2150 ip = ip + 1; 2151 do while (ch_class (ip) = digit); 2152 prec = prec + 1; 2153 scale = scale + 1; 2154 num_overlay.digits (prec) = ch (ip); 2155 ip = ip + 1; 2156 end; 2157 end; 2158 2159 /* check for exponent part */ 2160 2161 if ch (ip) = "e" 2162 then do; 2163 integer = "0"b; 2164 2165 ip = ip + 1; 2166 2167 if ch (ip) = "-" 2168 then do; 2169 exp_sign = -1; 2170 ip = ip + 1; 2171 end; 2172 else do; 2173 exp_sign = +1; 2174 if ch (ip) = "+" 2175 then ip = ip + 1; 2176 end; 2177 2178 no_digits = "1"b; 2179 2180 do while (ch_class (ip) = digit); 2181 no_digits = "0"b; 2182 exp = 10 * exp + fixed (unspec (ch (ip)), 9) - digit_0; 2183 ip = ip + 1; 2184 end; 2185 2186 if no_digits 2187 then goto invalid_constant; 2188 2189 exp = exp * exp_sign; 2190 end; 2191 2192 ip = ip - 1; 2193 2194 if prec = 0 2195 then goto invalid_constant; 2196 if prec > max_number_of_digits 2197 then goto invalid_constant; 2198 2199 num_overlay.exponent = exp - scale + prec - max_number_of_digits; 2200 2201 end; 2202 2203 quoted_string: 2204 proc returns (fixed bin); 2205 2206 dcl string_constant char (250), 2207 p ptr, 2208 (i, k, nwords, constant_loc) 2209 fixed bin; 2210 2211 dcl 1 basic_string_constant 2212 aligned based, 2213 2 constant_length fixed bin, 2214 2 constant_value char (k refer (constant_length)); 2215 2216 /* get number of characters in quoted string */ 2217 2218 k = fixed (unspec (ch (ip)), 9); 2219 2220 if k > max_string_constant_length 2221 then call error (22); 2222 2223 /* pick up the string */ 2224 2225 do i = 1 to k; 2226 ip = ip + 1; 2227 substr (string_constant, i, 1) = ch (ip); 2228 end; 2229 2230 /* place constant at end of constant pool */ 2231 2232 place: 2233 nwords = size (basic_string_constant); 2234 2235 /* check for max_number_of_constants only at end */ 2236 2237 2238 /* Place zeros in last word of constant */ 2239 2240 unspec (constants (number_of_constants + nwords)) = (36)"0"b; 2241 2242 /* Move in the constant */ 2243 2244 constant_loc = number_of_constants + 1; 2245 p = addr (constants (constant_loc)); 2246 p -> constant_length = k; 2247 if k ^= 0 2248 then p -> constant_value = substr (string_constant, 1, k); 2249 2250 number_of_constants = number_of_constants + nwords; 2251 return (constant_loc + size (basic_program_header)); 2252 2253 non_quoted_string: 2254 entry returns (fixed bin); 2255 2256 k = 0; 2257 do while (ch (ip) ^= "," & ch_class (ip) ^= new_line & ch_class (ip) ^= backslash); 2258 k = k + 1; 2259 substr (string_constant, k, 1) = ch (ip); 2260 2261 ip = ip + 1; 2262 end; 2263 2264 ip = ip - 1; 2265 goto place; 2266 end; 2267 2268 end; 2269 2270 /* This procedure compiles a single BASIC statement 2271* 2272* Initial Version: Spring 1973 by BLW 2273* Modified: 7 January 1974 by BLW to fix bug 008 2274* Modified: 28 February 1974 by BLW to fix bug 011 2275* Modified: 7 March 1974 by BLW to fix bug 012 2276* Modified: 14 March 1974 by BLW to fix bug 014 2277* Modified: 18 March 1974 by BLW to fix bug 017 2278* Modified: 2 April 1974 by BLW to fix bug 023 2279* Modified: 18 July 1974 by BLW to fix bugs 033, 036, and 039 2280* Modified: 29 July 1974 by BLW to fix bug 044 2281* Modified: 08 March 1988 by SH to implement SCP6356 */ 2282 2283 compile_statement: 2284 proc; 2285 2286 dcl ( 2287 i, 2288 j, 2289 ft, 2290 ndims, 2291 b1, 2292 b2, 2293 array_type, 2294 fn_type, 2295 sv, 2296 nv, 2297 mop (3), 2298 mult_type, 2299 bl 2300 ) fixed bin, 2301 ( 2302 p, 2303 array_pt, 2304 ap (3) 2305 ) ptr, 2306 (inst, val, word, fnloc) 2307 bit (36) aligned, 2308 (have_redim, function_is_parameter) 2309 bit (1) aligned, 2310 (n_args, n_locals) fixed bin (5); 2311 2312 dcl (buffer1, buffer2) (32) bit (36) aligned; 2313 2314 dcl (size, string) builtin; 2315 2316 /* Reset temporary allocation mechanism */ 2317 2318 temps (0).next, temps (1).next, temps (2).next = 0; 2319 2320 /* Clear register data base */ 2321 2322 operand_in_register (0), operand_in_register (1), operand_in_register (2) = 0; 2323 2324 if statement_type ^= sub_statement 2325 then do; 2326 if sub_ok 2327 then goto statement_outside_program; 2328 2329 if first_statement 2330 then do; 2331 2332 /* have first statement of main program */ 2333 2334 program_number = 1; 2335 if which = 1 2336 then subprogram.name (1) = ""; 2337 else subprogram.name (1) = "main_"; 2338 2339 header_pos (1) = output_pos; 2340 program_header_pt = addrel (output_pt, output_pos); 2341 2342 output_pos = output_pos + size (basic_program_header); 2343 first_code_word = output_pos; 2344 entry_pos (1) = output_pos; 2345 2346 addrel (instruction_temp_ptr, output_pos) -> basic_entry.word_3 = instructions.enter_main; 2347 output_pos = output_pos + size (basic_entry); 2348 output_pt = instruction_temp_ptr; 2349 /* generate instructions in temp seg */ 2350 2351 string (basic_program_header.incoming_args) = "0"b; 2352 basic_program_header.time_limit = 0.0e0; 2353 2354 /* Redefine the location of all lines that preceded this line 2355* (they must all be remarks) so that the program header 2356* and entry sequence are not counted as part of the code for 2357* the line. */ 2358 2359 do i = 1 to number_of_lines; 2360 line (i).location = bit (fixed (output_pos, 17), 18); 2361 end; 2362 2363 first_statement = "0"b; 2364 end; 2365 end; 2366 2367 goto stm (statement_type); 2368 2369 /* CALL */ 2370 2371 stm (1): 2372 call expression; 2373 2374 if operand_type (1) = 0 2375 then goto string_expression_required; 2376 2377 if operand_in_register (1) ^= 0 2378 then call save_register (1); 2379 2380 if substr (tokens (current_token).name, 1, 4) = ": " 2381 then do; 2382 2383 /* process arguments of call */ 2384 2385 call_list: 2386 current_token = current_token + 1; 2387 if current_token >= number_of_tokens 2388 then goto incorrect_format; 2389 2390 token_pt = addr (tokens (current_token)); 2391 2392 if substr (this_token.name, 1, 4) = "# " 2393 then do; 2394 2395 /* file being passed */ 2396 2397 current_token = current_token + 1; 2398 call expression_in_register (0); 2399 2400 /* generate sequence to store packed ptr to appropriate FCB */ 2401 2402 operand (operand_level) = allocate_temp (0) | modifier; 2403 2404 output_word (output_pos) = instructions.use_file; 2405 output_word (output_pos + 1) = instructions.save_fcb_pt | operand (operand_level); 2406 output_pos = output_pos + 2; 2407 2408 operand_in_register (0) = 0; 2409 operand_type (operand_level) = file_param; 2410 2411 goto next_arg; 2412 end; 2413 2414 if ((this_token.type & is_function) ^= "0"b) 2415 & (substr (tokens (current_token + 1).name, 1, 4) = ", " 2416 | tokens (current_token + 1).type = end_token) 2417 then do; 2418 2419 /* function (user | system) being passed */ 2420 2421 if this_token.type & is_user 2422 then fnloc = user_function_loc (); 2423 else do; 2424 2425 /* have to generate dummy function which does nothing but 2426* jump to operator; check if template exists for this 2427* class of system function */ 2428 2429 i = basic_data$functions (this_token.number).class; 2430 2431 if basic_data$function_templates (i) = "0"b 2432 then goto fun_cannot_be_passed; 2433 2434 /* get ptr to body of template and copy it into output replacing 2435* the dummy word with jump into runtime to do function */ 2436 2437 p = ptr (addr (basic_data$function_templates), 2438 basic_data$function_templates (i + (17 * (precision_lng - 1)))); 2439 2440 j = fixed (p -> half.left (0), 18); 2441 fnloc = bit (fixed (262145 - j, 18), 18) | ic (0); 2442 2443 do i = 1 to j; 2444 if p -> whole (i) = basic_data$function_dummy 2445 then output_word (output_pos) = 2446 basic_data$functions (this_token.number).run_time; 2447 else output_word (output_pos) = p -> whole (i); 2448 2449 output_pos = output_pos + 1; 2450 end; 2451 2452 function_is_parameter = "0"b; 2453 end; 2454 2455 /* we'll actually pass a packed ptr to function body and 2456* packed ptr to proper stack frame */ 2457 2458 operand_level = operand_level + 1; 2459 if operand_level > hbound (operand, 1) 2460 then goto too_deep; 2461 2462 word = allocate_temp (2) | modifier; 2463 operand (operand_level) = word; 2464 2465 if function_is_parameter 2466 then do; 2467 2468 /* pass copy of our argument packed ptr pair, generate 2469* ldaq fnloc 2470* staq temp */ 2471 2472 output_word (output_pos) = instructions.function_arg (4) | fnloc; 2473 output_word (output_pos + 1) = instructions.function_arg (5) | word; 2474 output_pos = output_pos + 2; 2475 end; 2476 else do; 2477 2478 /* function is local, generate 2479* epp2 fnloc 2480* sprpbp temp 2481* sprpsp temp+1 */ 2482 2483 output_word (output_pos) = instructions.function_arg (1) | fnloc; 2484 output_word (output_pos + 1) = instructions.function_arg (2) | word; 2485 substr (word, 1, 18) = bit (fixed (fixed (substr (word, 1, 18), 18) + 1, 18), 18); 2486 2487 output_word (output_pos + 2) = instructions.function_arg (3) | word; 2488 output_pos = output_pos + 3; 2489 end; 2490 2491 operand_type (operand_level) = 2492 numeric_function_param + fixed (substr (this_token.type, 2, 1), 1); 2493 2494 current_token = current_token + 1; 2495 2496 goto next_arg; 2497 end; 2498 2499 if this_token.type & is_variable 2500 then if abs (this_token.number) <= 26 2501 then if substr (tokens (current_token + 1).name, 1, 4) = "( " 2502 then if substr (tokens (current_token + 2).name, 1, 4) = ") " 2503 | substr (tokens (current_token + 2).name, 1, 4) = ", " 2504 then do; 2505 2506 /* array passed by reference */ 2507 2508 j = 1; 2509 i = numeric_list_param; 2510 2511 current_token = current_token + 2; 2512 2513 if substr (tokens (current_token).name, 1, 4) = ", " 2514 then do; 2515 j = j + 1; 2516 i = numeric_table_param; 2517 current_token = current_token + 1; 2518 end; 2519 2520 if substr (tokens (current_token).name, 1, 4) ^= ") " 2521 then goto incorrect_format; 2522 2523 call dimension_array (j, 11, 11); 2524 2525 if this_token.type & is_string 2526 then i = i + 1; 2527 2528 operand_level = operand_level + 1; 2529 if operand_level > hbound (operand, 1) 2530 then goto too_deep; 2531 2532 operand (operand_level) = array_pt -> array.address; 2533 operand_type (operand_level) = i; 2534 2535 current_token = current_token + 1; 2536 goto next_arg; 2537 end; 2538 2539 /* If none of the above, the argument must be an expression. If 2540* the expression is a reference to a constant, we must copy it into a temporary. */ 2541 2542 call expression; 2543 2544 if operand_is_constant (operand_level) 2545 then call load_register (operand_type (operand_level), operand_level); 2546 2547 if operand_in_register (operand_type (operand_level)) ^= 0 2548 then call save_register (operand_type (operand_level)); 2549 2550 operand_type (operand_level) = numeric_scalar_param + operand_type (operand_level); 2551 2552 next_arg: 2553 if substr (tokens (current_token).name, 1, 4) = ", " 2554 then goto call_list; 2555 2556 if operand_in_register (2) ^= 0 2557 then call save_register (2); 2558 end; 2559 2560 /* generate sequence of form 2561* even 2562* epp1 name 2563* tsx7 call_op 2564* vfd 18/2*n_args,54/0 2565* itp arg1 2566* itp arg2 2567* ... 2568* itp argn 2569* 2570* where byte 1 of itp gives type of argument */ 2571 2572 if mod (output_pos, 2) ^= 0 2573 then do; 2574 output_word (output_pos) = instructions.tra | ic (1); 2575 output_pos = output_pos + 1; 2576 end; 2577 2578 call load_register (1, 1); 2579 2580 output_word (output_pos) = instructions.subprogram_call; 2581 output_word (output_pos + 1) = bit (fixed (operand_level - 1, 17), 18); 2582 output_word (output_pos + 2) = "0"b; 2583 output_pos = output_pos + 3; 2584 2585 do i = 2 to operand_level; 2586 p = addr (output_word (output_pos)); 2587 string (p -> itp) = "0"b; 2588 p -> itp.base = rand (i).base; 2589 p -> itp.flag = "100001"b; /* p -> itp */ 2590 p -> itp.type = bit (fixed (operand_type (i), 9), 9); 2591 p -> itp.string = rand (i).string; 2592 p -> itp.offset = "000"b || rand (i).offset; 2593 p -> itp.tag = rand (i).tag; 2594 output_pos = output_pos + 2; 2595 end; 2596 2597 operand_level = 0; 2598 goto done; 2599 2600 /* CHAIN */ 2601 2602 stm (2): 2603 goto not_yet; 2604 2605 /* CHANGE */ 2606 2607 stm (3): 2608 if tokens (1).type & is_string 2609 then do; 2610 2611 /* change string to array */ 2612 2613 call expression; 2614 2615 if substr (tokens (current_token).name, 1, 4) ^= "to " 2616 then goto incorrect_format; 2617 2618 current_token = current_token + 1; 2619 2620 call numeric_list_reference; 2621 2622 sv = 1; 2623 nv = 2; 2624 end; 2625 else do; 2626 2627 /* change array to string */ 2628 2629 call numeric_list_reference; 2630 2631 if substr (tokens (current_token).name, 1, 4) ^= "to " 2632 then goto incorrect_format; 2633 2634 current_token = current_token + 1; 2635 2636 call reference; 2637 2638 if operand_type (2) ^= 1 2639 then goto string_reference_required; 2640 2641 sv = 2; 2642 nv = 1; 2643 end; 2644 2645 if substr (tokens (current_token).name, 1, 4) = "bit " 2646 then do; 2647 current_token = current_token + 1; 2648 call expression_in_register (0); 2649 end; 2650 else do; 2651 output_word (output_pos) = instructions.load (0) | floating_nine; 2652 output_pos = output_pos + 1; 2653 end; 2654 2655 call load_register (1, sv); 2656 2657 output_word (output_pos) = instructions.load (2) | operand (nv); 2658 output_word (output_pos + 1) = instructions.change (sv); 2659 output_pos = output_pos + 2; 2660 2661 operand_level = 0; 2662 goto done; 2663 2664 /* DATA */ 2665 2666 stm (4): 2667 return; 2668 2669 /* DEF */ 2670 2671 stm (5): 2672 if fn_name ^= 0 2673 then goto nested_def; 2674 2675 if (tokens (1).type & is_user) = "0"b 2676 then goto invalid_def; 2677 2678 fn_name = tokens (1).number; 2679 if fn_table.address (fn_name) 2680 then goto multiple_def; 2681 2682 /* generate jump around function body */ 2683 2684 output_word (output_pos) = instructions.tra | ic (0); 2685 output_pos = output_pos + 1; 2686 2687 /* fill in any usage string */ 2688 2689 do loc = fn_table.usage (fn_name) repeat (next_loc) while (loc); 2690 p = addrel (output_pt, loc); 2691 next_loc = p -> half (0).left; 2692 p -> half (0).left = bit (fixed (output_pos - fixed (loc, 18), 18), 18); 2693 end; 2694 2695 /* define entry point */ 2696 2697 fn_table.address (fn_name) = bit (output_pos, 18); 2698 fn_table.usage (fn_name) = (18)"0"b; 2699 2700 string (fn_call_word) = "0"b; 2701 fn_call_word.mode = substr (tokens (1).type, 2, 1); 2702 fn_type = fixed (substr (tokens (1).type, 2, 1), 1); 2703 2704 al_count = 0; 2705 2706 current_token = 2; 2707 2708 if substr (tokens (2).name, 1, 4) ^= "( " 2709 then n_args = 0; 2710 else do; 2711 current_token = current_token + 1; 2712 2713 if substr (tokens (3).name, 1, 4) ^= ") " 2714 then do; 2715 call arg_or_local; 2716 if substr (tokens (current_token).name, 1, 4) ^= ") " 2717 then goto invalid_arg_list; 2718 end; 2719 2720 n_args = al_count; 2721 if n_args > hbound (fn_call_word.arg, 1) 2722 then goto invalid_arg_list; 2723 2724 fn_call_word.number = bit (n_args, 5); 2725 2726 /* set arg mode bits in function call word */ 2727 2728 do i = 1 to n_args; 2729 if save.number (i) < 0 2730 then fn_call_word.arg (i) = "1"b; 2731 end; 2732 2733 current_token = current_token + 1; 2734 end; 2735 2736 /* put out function call word */ 2737 2738 output_word (output_pos) = string (fn_call_word); 2739 output_pos = output_pos + 1; 2740 2741 /* switch missing lines table */ 2742 2743 missing_pt = addr (missing_table (1)); 2744 missing.count = 0; 2745 2746 /* switch temporaries table */ 2747 2748 temps_pt = addr (local_temps); 2749 2750 do i = 1 to max_temp; 2751 local_temps (0).address (i), local_temps (1).address (i), local_temps (2).address (i) = (36)"0"b; 2752 end; 2753 2754 local_temps (0).next, local_temps (1).next, local_temps (2).next = 0; 2755 2756 modifier = function_modifier; 2757 2758 /* reserve space for local word */ 2759 2760 local_pt = addr (output_word (output_pos)); 2761 output_pos = output_pos + 1; 2762 2763 if substr (tokens (current_token).name, 1, 4) = "= " 2764 then do; 2765 2766 /* this is 1 line form of function, there are no locals (except temps) */ 2767 2768 string (fn_local_word) = "0"b; 2769 2770 current_token = current_token + 1; 2771 2772 local_ctr = (al_count + 1) * precision_lng; 2773 2774 /* evaluate value of function */ 2775 2776 call expression_in_register (fn_type); 2777 operand_level = operand_level - 1; 2778 2779 /* store value of function in return argument */ 2780 2781 if fn_type = 0 2782 then do; 2783 output_word (output_pos) = instructions.store (0) | arg_prototype; 2784 output_pos = output_pos + 1; 2785 end; 2786 else do; 2787 output_word (output_pos) = instructions.string_assign (0) | arg_prototype; 2788 output_word (output_pos + 1) = instructions.string_assign (1); 2789 output_pos = output_pos + 2; 2790 end; 2791 2792 call fn_cleanup; 2793 end; 2794 2795 else do; 2796 2797 /* have multi-line function, define locals */ 2798 2799 if current_token ^= number_of_tokens 2800 then do; 2801 call arg_or_local; 2802 if current_token ^= number_of_tokens 2803 then goto invalid_arg_list; 2804 end; 2805 2806 n_locals = al_count - n_args; 2807 if n_locals > hbound (fn_local_word.local, 1) 2808 then goto too_many_locals; 2809 2810 string (fn_local_word) = bit (n_locals, 5); 2811 2812 do i = 1 to n_locals; 2813 if save.number (n_args + i) < 0 2814 then fn_local_word.local (i) = "1"b; 2815 end; 2816 2817 local_ctr = (al_count + 1) * precision_lng; 2818 2819 fn_start = current_line_number; 2820 end; 2821 2822 goto done; 2823 2824 /* DIM */ 2825 2826 stm (6): 2827 token_pt = addr (tokens (current_token)); 2828 2829 if (this_token.type & is_variable) = "0"b 2830 then goto invalid_variable; 2831 2832 if substr (tokens (current_token + 1).name, 1, 4) ^= "( " 2833 then goto incorrect_format; 2834 2835 if tokens (current_token + 2).type ^= integer_constant_token 2836 then goto integer_constant_required; 2837 2838 b1 = fixed (tokens (current_token + 2).value) + 1; 2839 2840 if substr (tokens (current_token + 3).name, 1, 4) = ") " 2841 then do; 2842 ndims = 1; 2843 current_token = current_token + 4; 2844 end; 2845 else do; 2846 if substr (tokens (current_token + 3).name, 1, 4) ^= ", " 2847 then goto incorrect_format; 2848 2849 if tokens (current_token + 4).type ^= integer_constant_token 2850 then goto integer_constant_required; 2851 2852 b2 = fixed (tokens (current_token + 4).value) + 1; 2853 2854 if substr (tokens (current_token + 5).name, 1, 4) ^= ") " 2855 then goto incorrect_format; 2856 2857 ndims = 2; 2858 current_token = current_token + 6; 2859 end; 2860 2861 call dimension_array (ndims, b1, b2); 2862 2863 if substr (tokens (current_token).name, 1, 4) = ", " 2864 then do; 2865 current_token = current_token + 1; 2866 goto stm (6); 2867 end; 2868 2869 goto done; 2870 2871 /* END */ 2872 2873 stm (7): 2874 if program_number > 1 2875 then goto end_not_allowed; 2876 2877 word = instructions.stop; 2878 2879 end: 2880 last_statement = "1"b; 2881 sub_ok = "1"b; 2882 2883 if fn_name ^= 0 2884 then do; 2885 call error (-51); 2886 call fn_cleanup; 2887 end; 2888 2889 output_word (output_pos) = word; 2890 output_pos = output_pos + 1; 2891 2892 done: 2893 if current_token ^= number_of_tokens 2894 then goto incorrect_format; 2895 2896 return; 2897 2898 /* FILE */ 2899 2900 stm (8): 2901 if substr (tokens (1).name, 1, 4) ^= "# " 2902 then goto file_expression_required; 2903 2904 current_token = current_token + 1; 2905 2906 call numeric_expression; 2907 2908 if substr (tokens (current_token).name, 1, 4) ^= ": " 2909 then goto missing_colon; 2910 2911 current_token = current_token + 1; 2912 2913 call expression_in_register (1); 2914 call load_register (0, 1); 2915 2916 output_word (output_pos) = instructions.file; 2917 output_pos = output_pos + 1; 2918 2919 operand_level = operand_level - 2; 2920 goto done; 2921 2922 /* FNEND */ 2923 2924 stm (9): 2925 if fn_name = 0 2926 then goto fnend_without_def; 2927 2928 call fn_cleanup; 2929 goto done; 2930 2931 /* FOR */ 2932 2933 stm (10): 2934 for_level = for_level + 1; 2935 2936 if for_level > hbound (for_type, 1) 2937 then goto for_too_deep; 2938 2939 token_pt = addr (tokens (1)); 2940 2941 if this_token.type ^= numeric_variable_token 2942 then goto numeric_variable_required; 2943 2944 call push_variable; 2945 2946 current_token = current_token + 1; 2947 2948 if substr (tokens (2).name, 1, 4) ^= "= " 2949 then goto incorrect_format; 2950 2951 current_token = current_token + 1; 2952 2953 call numeric_expression; 2954 2955 if substr (tokens (current_token).name, 1, 4) ^= "to " 2956 then goto incorrect_format; 2957 2958 current_token = current_token + 1; 2959 2960 call for_expression; 2961 2962 /* the step phrase is optional */ 2963 2964 if substr (tokens (current_token).name, 1, 4) ^= "step" 2965 then do; 2966 2967 /* step expression absent, use 1 as step */ 2968 2969 ft = 1; 2970 if single 2971 then operand (4) = unspec (binary (1.0e0)) | "000000000000000000000000000000000011"b; 2972 else do; /* can't use du mod with double prec */ 2973 operand_level = 4; 2974 call push_constant_dp_notok (1.0e0); 2975 end; 2976 end; 2977 else do; 2978 2979 /* pick up the step expression */ 2980 2981 current_token = current_token + 1; 2982 token_pt = addr (tokens (current_token)); 2983 2984 call for_expression; 2985 2986 /* if the step expression was constant, the value of the constant is in 2987* the previous token. */ 2988 2989 if operand_is_constant (operand_level) 2990 then if sign (tokens (current_token - 1).value) = -1 2991 then ft = -1; 2992 else ft = 1; 2993 else ft = 0; 2994 end; 2995 2996 /* when we reach this point 2997* operand(1) is address of control variable 2998* operand(2) is initial value 2999* operand(3) is final value 3000* operand(4) is step value 3001* 3002* ft is -1 for negative constant step 3003* 0 for variable step 3004* 1 for positive constant step 3005* 3006* */ 3007 3008 if operand_in_register (0) ^= 0 3009 then call save_register (0); 3010 3011 for_variable (for_level) = operand (1); 3012 for_type (for_level) = ft; 3013 3014 /* generate 3015* fld initial_value 3016* tra 2,ic */ 3017 3018 output_word (output_pos) = instructions.load (0) | operand (2); 3019 output_word (output_pos + 1) = instructions.tra | ic (2); 3020 output_pos = output_pos + 2; 3021 3022 /* define the loop point for the matching next statement 3023* and generate 3024* fad step_value 3025* fst variable */ 3026 3027 for_location (for_level) = output_pos; 3028 3029 output_word (output_pos) = instructions.add | operand (4); 3030 output_word (output_pos + 1) = instructions.store (0) | operand (1); 3031 output_pos = output_pos + 2; 3032 3033 goto step_type (ft); 3034 3035 /* step value is negative, generate 3036* fcmp final_value 3037* tmi exit */ 3038 3039 step_type (-1): 3040 output_word (output_pos) = instructions.compare | operand (3); 3041 output_word (output_pos + 1) = instructions.tmi | ic (0); 3042 3043 output_pos = output_pos + 2; 3044 3045 goto for_done; 3046 3047 /* step value is variable, generate 3048* fszn step_value 3049* tpl 4,ic 3050* fcmp final_value 3051* tmi exit 3052* tra 3,ic 3053* fcmp final_value 3054* tpnz exit */ 3055 3056 step_type (0): 3057 output_word (output_pos) = instructions.fszn | operand (4); 3058 output_word (output_pos + 1) = instructions.tpl | ic (4); 3059 output_word (output_pos + 2) = instructions.compare | operand (3); 3060 output_word (output_pos + 3) = instructions.tmi | ic (0); 3061 output_word (output_pos + 4) = instructions.tra | ic (3); 3062 output_word (output_pos + 5) = instructions.compare | operand (3); 3063 output_word (output_pos + 6) = instructions.tpnz | ic (0); 3064 3065 output_pos = output_pos + 7; 3066 goto for_done; 3067 3068 /* step value is positive, generate 3069* fcmp final_value 3070* tpnz exit */ 3071 3072 step_type (1): 3073 output_word (output_pos) = instructions.compare | operand (3); 3074 output_word (output_pos + 1) = instructions.tpnz | ic (0); 3075 3076 output_pos = output_pos + 2; 3077 3078 for_done: 3079 operand_level = 0; 3080 goto done; 3081 3082 /* GOTO */ 3083 3084 stm (11): 3085 call gen_xfer (instructions.tra); 3086 goto done; 3087 3088 /* GOSUB */ 3089 3090 stm (12): 3091 call gen_xfer (instructions.load (2)); 3092 3093 output_word (output_pos) = instructions.gosub; 3094 output_pos = output_pos + 1; 3095 3096 goto done; 3097 3098 /* IF */ 3099 3100 stm (13): 3101 if tokens (1).type = secondary_token 3102 then do; 3103 3104 /* have if more or if end */ 3105 3106 if substr (tokens (1).name, 1, 4) = "more" 3107 then inst = instructions.tze; 3108 else if substr (tokens (1).name, 1, 4) = "end " 3109 then inst = instructions.tnz; 3110 else goto incorrect_format; 3111 3112 if substr (tokens (2).name, 1, 4) ^= "# " 3113 then goto incorrect_format; 3114 3115 current_token = 3; 3116 3117 call expression_in_register (0); 3118 3119 output_word (output_pos) = instructions.check_eof; 3120 output_pos = output_pos + 1; 3121 3122 operand_level = operand_level - 1; 3123 end; 3124 else do; 3125 3126 /* have normal if */ 3127 3128 call expression; 3129 3130 token_pt = addr (tokens (current_token)); 3131 3132 if this_token.type ^= relational_token 3133 then goto relational_required; 3134 3135 i = this_token.number; 3136 3137 current_token = current_token + 1; 3138 3139 call expression; 3140 3141 /* at this point operand_level must be 2, 3142* operand(1) is left side of relational 3143* operand(2) is right side of relational */ 3144 3145 if operand_type (1) ^= operand_type (2) 3146 then goto mixed_expression; 3147 3148 if operand_in_register (operand_type (1)) = 2 3149 then do; 3150 if operand_type (1) = 0 3151 then if operand (1) ^= floating_zero 3152 then do; 3153 output_word (output_pos) = instructions.compare | operand (1); 3154 output_pos = output_pos + 1; 3155 end; 3156 else ; 3157 else do; 3158 output_word (output_pos) = instructions.string_compare (0) | operand (1); 3159 output_word (output_pos + 1) = instructions.string_compare (1); 3160 output_pos = output_pos + 2; 3161 end; 3162 3163 inst = basic_data$inverse_relational (i); 3164 end; 3165 else do; 3166 call load_register (operand_type (1), 1); 3167 3168 if operand_type (1) = 0 3169 then if operand (2) ^= floating_zero 3170 then do; 3171 output_word (output_pos) = instructions.compare | operand (2); 3172 output_pos = output_pos + 1; 3173 end; 3174 else ; 3175 else do; 3176 output_word (output_pos) = instructions.string_compare (0) | operand (2); 3177 output_word (output_pos + 1) = instructions.string_compare (1); 3178 output_pos = output_pos + 2; 3179 end; 3180 3181 inst = basic_data$normal_relational (i); 3182 end; 3183 3184 operand_level = operand_level - 2; 3185 end; 3186 3187 token_pt = addr (tokens (current_token)); 3188 3189 if this_token.type ^= secondary_token 3190 then goto then_goto_missing; 3191 3192 if substr (this_token.name, 1, 4) ^= "then" 3193 then if substr (this_token.name, 1, 4) ^= "goto" 3194 then goto then_goto_missing; 3195 3196 current_token = current_token + 1; 3197 3198 call gen_xfer (inst); 3199 goto done; 3200 3201 /* INPUT */ 3202 3203 stm (14): 3204 call optional_file; 3205 call input_list (0, instructions.input, "1"b); 3206 3207 goto done; 3208 3209 /* LET */ 3210 3211 stm (15): 3212 if number_of_assigns = 0 3213 then goto assign_missing; 3214 3215 do while (operand_level < number_of_assigns); 3216 call reference; 3217 3218 if operand_level > 1 3219 then if operand_type (1) ^= operand_type (operand_level) 3220 then goto mixed_let; 3221 3222 if tokens (current_token).type ^= assign_token 3223 then goto assign_out_of_order; 3224 3225 current_token = current_token + 1; 3226 end; 3227 3228 call expression_in_register ((operand_type (1))); 3229 3230 operand_level = operand_level - 1; 3231 3232 if operand_type (1) = 0 3233 then do while (operand_level > 0); 3234 output_word (output_pos) = instructions.store (0) | operand (operand_level); 3235 output_pos = output_pos + 1; 3236 operand_level = operand_level - 1; 3237 end; 3238 else do while (operand_level > 0); 3239 output_word (output_pos) = instructions.string_assign (0) | operand (operand_level); 3240 output_word (output_pos + 1) = instructions.string_assign (1); 3241 output_pos = output_pos + 2; 3242 operand_level = operand_level - 1; 3243 end; 3244 3245 goto done; 3246 3247 /* LIBRARY */ 3248 3249 stm (16): 3250 if which = 1 3251 then do; /* don't implement library statement for this entry */ 3252 call error (-167); /* warn user */ 3253 number_of_errors = number_of_errors - 1;/* don't let this keep us from running */ 3254 go to init; 3255 end; 3256 3257 else do; 3258 next_libe: 3259 token_pt = addr (tokens (current_token)); 3260 if this_token.type & is_constant 3261 then if this_token.type & is_string 3262 then do; 3263 lib_name_pt = addr (constants (this_token.number - size (basic_program_header))); 3264 call add_lib_name (next_lib_name, code); 3265 if code ^= 0 3266 then call error (-168); 3267 end; 3268 else go to string_reference_required; 3269 else go to string_reference_required; 3270 3271 current_token = current_token + 1; 3272 if current_token = number_of_tokens 3273 then go to done; 3274 if substr (tokens (current_token).name, 1, 4) ^= ", " 3275 then goto incorrect_format; 3276 current_token = current_token + 1; 3277 go to next_libe; 3278 end; 3279 3280 /* LINPUT */ 3281 3282 stm (17): 3283 call optional_file; 3284 call input_list (1, instructions.linput, "1"b); 3285 3286 goto done; 3287 3288 /* MARGIN */ 3289 3290 stm (18): 3291 call optional_file; 3292 3293 call expression_in_register (0); 3294 3295 output_word (output_pos) = instructions.margin; 3296 output_pos = output_pos + 1; 3297 3298 operand_level = operand_level - 1; 3299 goto done; 3300 3301 /* MAT */ 3302 3303 stm (19): 3304 if tokens (1).type = secondary_token 3305 then do; 3306 3307 /* have mat input|linput|print|read|write */ 3308 3309 current_token = 2; 3310 3311 do i = 1 to hbound (matrix_secondary, 1); 3312 if tokens (1).name = matrix_secondary (i) 3313 then goto mat (i); 3314 end; 3315 3316 goto incorrect_format; 3317 3318 /* input */ 3319 3320 mat (1): 3321 call optional_file; 3322 call mat_input_list (0, instructions.mat_input, "0"b); 3323 goto done; 3324 3325 /* linput */ 3326 3327 mat (2): 3328 call optional_file; 3329 call mat_input_list (1, instructions.mat_linput, "1"b); 3330 goto done; 3331 3332 /* print */ 3333 3334 mat (3): 3335 call optional_file; 3336 3337 if tokens (current_token).name = "using " 3338 then do; 3339 3340 /* mat print using statement */ 3341 3342 current_token = current_token + 1; 3343 3344 call expression_in_register (1); 3345 3346 output_word (output_pos) = instructions.print_using_start; 3347 output_pos = output_pos + 1; 3348 operand_level = 0; 3349 operand_in_register (1) = 0; 3350 3351 if substr (tokens (current_token).name, 1, 4) ^= ", " 3352 then goto incorrect_format; 3353 3354 mat_print_using_list: 3355 current_token = current_token + 1; 3356 call matrix_reference ("0"b); 3357 3358 output_word (output_pos) = instructions.mat_print_using (operand_type (1)); 3359 output_pos = output_pos + 1; 3360 operand_level = 0; 3361 3362 if substr (tokens (current_token).name, 1, 4) = ", " 3363 then goto mat_print_using_list; 3364 3365 output_word (output_pos) = instructions.print_using_end; 3366 output_word (output_pos + 1) = instructions.print_new_line; 3367 output_pos = output_pos + 2; 3368 end; 3369 else do; 3370 mat_print_list: 3371 call matrix_reference ("0"b); 3372 3373 output_word (output_pos) = instructions.mat_print (operand_type (1)); 3374 output_pos = output_pos + 1; 3375 3376 operand_level = 0; 3377 3378 i = index (",;", substr (tokens (current_token).name, 1, 1)); 3379 3380 if i ^= 0 3381 then do; 3382 output_word (output_pos) = unspec (i); 3383 output_pos = output_pos + 1; 3384 3385 current_token = current_token + 1; 3386 if current_token < number_of_tokens 3387 then goto mat_print_list; 3388 end; 3389 else do; 3390 output_word (output_pos) = "0"b; 3391 output_pos = output_pos + 1; 3392 end; 3393 end; 3394 3395 goto done; 3396 3397 /* read */ 3398 3399 mat (4): 3400 if substr (tokens (2).name, 1, 4) ^= "# " 3401 then call mat_input_list (0, instructions.mat_data_read, "0"b); 3402 else do; 3403 call optional_file; 3404 call mat_input_list (0, instructions.mat_read, "0"b); 3405 end; 3406 3407 goto done; 3408 3409 /* write */ 3410 3411 mat (5): 3412 call required_file; 3413 3414 mat_write_list: 3415 call matrix_reference ("0"b); 3416 3417 output_word (output_pos) = instructions.mat_write (operand_type (1)); 3418 output_pos = output_pos + 1; 3419 3420 operand_level = 0; 3421 3422 if substr (tokens (current_token).name, 1, 4) = ", " 3423 then do; 3424 current_token = current_token + 1; 3425 goto mat_write_list; 3426 end; 3427 3428 goto done; 3429 end; 3430 else do; 3431 3432 /* must be matrix assignment */ 3433 3434 mop (1) = 3; 3435 mop (2) = 1; 3436 mop (3) = 0; 3437 3438 token_pt = addr (tokens (1)); 3439 3440 if this_token.type & is_string 3441 then do; 3442 3443 /* string assignment */ 3444 3445 if substr (tokens (2).name, 1, 4) ^= "= " 3446 then goto incorrect_format; 3447 3448 if tokens (3).type = basic_string_fun_token 3449 then call matrix_function; 3450 else if tokens (4).type = end_token 3451 then do; 3452 matrix_type = 1; 3453 call matrix_op (instructions.matrix_assign_string); 3454 current_token = 4; 3455 end; 3456 else goto incorrect_format; 3457 3458 goto done; 3459 end; 3460 3461 /* numeric assignment */ 3462 3463 matrix_type = 0; 3464 3465 if this_token.number > 26 3466 then goto check_dot; 3467 3468 if substr (tokens (2).name, 1, 4) ^= "= " 3469 then goto check_dot; 3470 3471 if tokens (3).type = basic_numeric_fun_token 3472 then do; 3473 call matrix_function; 3474 goto done; 3475 end; 3476 3477 if tokens (4).type = end_token 3478 then do; 3479 call matrix_op (instructions.matrix_assign_numeric); 3480 current_token = 4; 3481 goto done; 3482 end; 3483 3484 if substr (tokens (3).name, 1, 4) = "( " 3485 then do; 3486 3487 /* must be 3488* mat a = (expression)*b */ 3489 3490 current_token = 4; 3491 call expression_in_register (0); 3492 3493 if substr (tokens (current_token).name, 1, 4) ^= ") " 3494 then goto incorrect_format; 3495 3496 current_token = current_token + 1; 3497 if substr (tokens (current_token).name, 1, 4) ^= "* " 3498 then goto incorrect_format; 3499 3500 current_token = current_token + 1; 3501 3502 mop (1) = current_token; 3503 3504 call matrix_op (instructions.matrix_scalar_mult); 3505 3506 current_token = current_token + 1; 3507 operand_level = operand_level - 1; 3508 goto done; 3509 end; 3510 3511 mop (3) = 5; 3512 3513 i = index ("+-", substr (tokens (4).name, 1, 1)); 3514 3515 if i ^= 0 3516 then do; 3517 3518 /* must be 3519* mat a = b +|- c */ 3520 3521 call matrix_op (instructions.matrix_add_sub (i)); 3522 3523 current_token = 6; 3524 goto done; 3525 end; 3526 3527 if substr (tokens (4).name, 1, 4) ^= "* " 3528 then goto incorrect_format; 3529 3530 /* has to be 3531* mat a = b * c */ 3532 3533 ap (1) = addr (arrays (tokens (3).number)); 3534 ap (2) = addr (arrays (tokens (1).number)); 3535 ap (3) = addr (arrays (tokens (5).number)); 3536 3537 if ap (1) -> array.dimensions = 1 3538 then if ap (3) -> array.dimensions = 1 3539 then goto check_dot; 3540 3541 call matrix_operand (1, -2); 3542 call matrix_operand (3, -2); 3543 3544 mult_type = 2 * (ap (1) -> array.dimensions - 1) + ap (3) -> array.dimensions - 1; 3545 3546 if mult_type = 3 3547 then number_of_dims = 2; 3548 else number_of_dims = 1; 3549 3550 call matrix_operand (2, number_of_dims); 3551 3552 output_word (output_pos) = instructions.matrix_mult (mult_type); 3553 output_pos = output_pos + 1; 3554 3555 current_token = 6; 3556 goto done; 3557 3558 /* must be 3559* mat numeric_ref = vector * vector */ 3560 3561 check_dot: 3562 current_token = 1; 3563 call reference; 3564 3565 if operand_type (1) ^= 0 3566 then goto numeric_variable_required; 3567 3568 if substr (tokens (current_token).name, 1, 4) ^= "= " 3569 then goto incorrect_format; 3570 3571 current_token = current_token + 1; 3572 call numeric_list_reference; 3573 3574 if substr (tokens (current_token).name, 1, 4) ^= "* " 3575 then goto incorrect_format; 3576 3577 current_token = current_token + 1; 3578 call numeric_list_reference; 3579 3580 /* at this point operand_level must be 3 */ 3581 3582 output_word (output_pos) = instructions.load (1) | operand (2); 3583 output_word (output_pos + 1) = instructions.load (3) | operand (3); 3584 output_word (output_pos + 2) = instructions.inner_product; 3585 output_word (output_pos + 3) = instructions.store (0) | operand (1); 3586 3587 output_pos = output_pos + 4; 3588 operand_level = operand_level - 3; 3589 end; 3590 3591 goto done; 3592 3593 /* NEXT */ 3594 3595 stm (20): 3596 if for_level = 0 3597 then goto next_without_for; 3598 3599 token_pt = addr (tokens (1)); 3600 3601 if this_token.type ^= numeric_variable_token 3602 then goto numeric_variable_required; 3603 3604 call push_variable; 3605 3606 if operand (1) ^= for_variable (for_level) 3607 then goto for_next_mismatch; 3608 3609 /* generate 3610* fld variable 3611* tra loop */ 3612 3613 output_word (output_pos) = instructions.load (0) | operand (1); 3614 output_pos = output_pos + 1; 3615 3616 i = for_location (for_level); 3617 3618 output_word (output_pos) = instructions.tra | bit (fixed (262144 + i - output_pos, 18), 18) | ic (0); 3619 output_pos = output_pos + 1; 3620 3621 /* fill in forward transfers in for section of code */ 3622 3623 p = addrel (output_pt, i); 3624 3625 if for_type (for_level) ^= 0 3626 then p -> half (3).left = bit (fixed (output_pos - (i + 3), 18), 18); 3627 else do; 3628 p -> half (5).left = bit (fixed (output_pos - (i + 5), 18), 18); 3629 p -> half (8).left = bit (fixed (output_pos - (i + 8), 18), 18); 3630 end; 3631 3632 operand_level = 0; 3633 for_level = for_level - 1; 3634 3635 current_token = current_token + 1; 3636 goto done; 3637 3638 /* ON */ 3639 3640 stm (21): 3641 call expression_in_register (0); 3642 3643 operand_level = operand_level - 1; 3644 3645 token_pt = addr (tokens (current_token)); 3646 3647 if this_token.type ^= secondary_token 3648 then goto then_goto_gosub_missing; 3649 3650 if substr (this_token.name, 1, 4) = "then" 3651 then inst = instructions.on; 3652 else if substr (this_token.name, 1, 4) = "goto" 3653 then inst = instructions.on; 3654 else if substr (this_token.name, 1, 4) = "gosu" 3655 then inst = instructions.on_gosub; 3656 else goto then_goto_gosub_missing; 3657 3658 output_word (output_pos) = inst; 3659 output_pos = output_pos + 2; 3660 3661 i = output_pos - 1; 3662 3663 on_list: 3664 current_token = current_token + 1; 3665 3666 call gen_xfer (instructions.tra); 3667 3668 if substr (tokens (current_token).name, 1, 4) = ", " 3669 then goto on_list; 3670 3671 fixed_output_word (i) = output_pos - i; 3672 goto done; 3673 3674 /* PRINT */ 3675 3676 stm (22): 3677 call optional_file; 3678 3679 if tokens (current_token).name = "using " 3680 then do; 3681 3682 /* print using statement */ 3683 3684 current_token = current_token + 1; 3685 3686 call expression_in_register (1); 3687 3688 output_word (output_pos) = instructions.print_using_start; 3689 output_pos = output_pos + 1; 3690 operand_level = 0; 3691 operand_in_register (1) = 0; 3692 3693 print_using_list: 3694 if current_token = number_of_tokens 3695 then do; 3696 output_word (output_pos) = instructions.print_using_end; 3697 output_word (output_pos + 1) = instructions.print_new_line; 3698 output_pos = output_pos + 2; 3699 goto done; 3700 end; 3701 3702 if substr (tokens (current_token).name, 1, 4) ^= ", " 3703 then goto incorrect_format; 3704 3705 current_token = current_token + 1; 3706 3707 call put_expression (instructions.print_using); 3708 3709 operand_in_register (0), operand_in_register (1), operand_in_register (2) = 0; 3710 3711 if substr (tokens (current_token).name, 1, 4) ^= "; " 3712 then goto print_using_list; 3713 3714 current_token = current_token + 1; 3715 3716 output_word (output_pos) = instructions.print_using_end; 3717 output_pos = output_pos + 1; 3718 goto done; 3719 end; 3720 3721 /* ordinary print statement */ 3722 3723 print_list: 3724 if current_token = number_of_tokens 3725 then do; 3726 3727 print_done: 3728 output_word (output_pos) = instructions.print_new_line; 3729 output_pos = output_pos + 1; 3730 3731 goto done; 3732 end; 3733 3734 token_pt = addr (tokens (current_token)); 3735 3736 if substr (this_token.name, 1, 4) = ", " 3737 then do; 3738 3739 print_comma: 3740 output_word (output_pos) = instructions.tab_for_comma; 3741 output_pos = output_pos + 1; 3742 3743 next_print: 3744 current_token = current_token + 1; 3745 3746 if current_token < number_of_tokens 3747 then goto print_list; 3748 3749 output_word (output_pos) = instructions.end_print; 3750 output_pos = output_pos + 1; 3751 3752 goto done; 3753 end; 3754 3755 if this_token.type = basic_numeric_fun_token 3756 then do; 3757 i = basic_data$functions (this_token.number).class; 3758 3759 if i = print_fun 3760 then do; 3761 3762 /* must be tab or spc */ 3763 3764 inst = basic_data$functions (this_token.number).run_time; 3765 3766 current_token = current_token + 1; 3767 3768 if substr (tokens (current_token).name, 1, 4) ^= "( " 3769 then goto wrong_number_of_args; 3770 3771 current_token = current_token + 1; 3772 3773 call expression_in_register (0); 3774 3775 if substr (tokens (current_token).name, 1, 4) ^= ") " 3776 then goto incorrect_format; 3777 3778 current_token = current_token + 1; 3779 3780 output_word (output_pos) = inst; 3781 output_pos = output_pos + 1; 3782 3783 operand_level = operand_level - 1; 3784 operand_in_register (0) = 0; 3785 goto comma_check; 3786 end; 3787 end; 3788 3789 call put_expression (instructions.print); 3790 operand_in_register (0), operand_in_register (1), operand_in_register (2) = 0; 3791 3792 comma_check: 3793 token_pt = addr (tokens (current_token)); 3794 3795 if substr (this_token.name, 1, 4) = ", " 3796 then goto print_comma; 3797 3798 if substr (this_token.name, 1, 4) = "; " 3799 then goto next_print; 3800 3801 3802 goto print_done; 3803 3804 /* RANDOMIZE */ 3805 3806 stm (23): 3807 output_word (output_pos) = instructions.randomize; 3808 output_pos = output_pos + 1; 3809 goto done; 3810 3811 /* READ */ 3812 3813 stm (24): 3814 if substr (tokens (1).name, 1, 4) ^= "# " 3815 then call input_list (0, instructions.data_read, "0"b); 3816 else do; 3817 call optional_file; 3818 call input_list (0, instructions.read, "0"b); 3819 end; 3820 3821 goto done; 3822 3823 /* REMARK */ 3824 3825 stm (25): 3826 return; 3827 3828 /* RESET */ 3829 3830 stm (26): 3831 if number_of_tokens = 1 3832 then do; 3833 output_word (output_pos) = instructions.reset_data; 3834 output_pos = output_pos + 1; 3835 goto done; 3836 end; 3837 3838 call required_file; 3839 3840 if current_token = number_of_tokens 3841 then do; 3842 output_word (output_pos) = instructions.reset_ascii; 3843 output_pos = output_pos + 1; 3844 goto done; 3845 end; 3846 3847 call expression_in_register (0); 3848 3849 output_word (output_pos) = instructions.reset_random; 3850 output_pos = output_pos + 1; 3851 3852 operand_level = operand_level - 1; 3853 goto done; 3854 3855 /* RETURN */ 3856 3857 stm (27): 3858 output_word (output_pos) = instructions.return; 3859 output_pos = output_pos + 1; 3860 3861 goto done; 3862 3863 /* SCRATCH */ 3864 3865 stm (28): 3866 call required_file; 3867 3868 output_word (output_pos) = instructions.scratch; 3869 output_pos = output_pos + 1; 3870 goto done; 3871 3872 /* SETDIGITS */ 3873 3874 stm (29): 3875 if tokens (1).type = end_token 3876 then go to numeric_expression_required; 3877 current_token = 1; 3878 call expression_in_register (0); 3879 output_word (output_pos) = instructions.setdigits; 3880 output_pos = output_pos + 1; 3881 operand_level = operand_level - 1; 3882 go to done; 3883 3884 /* STOP */ 3885 3886 stm (30): 3887 output_word (output_pos) = instructions.stop; 3888 output_pos = output_pos + 1; 3889 goto done; 3890 3891 /* SUB */ 3892 3893 stm (31): 3894 if first_statement 3895 then do; 3896 program_number = 0; 3897 first_statement = "0"b; 3898 end; 3899 else do; 3900 if ^sub_ok 3901 then goto sub_not_allowed; 3902 3903 if program_number >= hbound (subprogram, 1) 3904 then goto too_many_subprograms; 3905 end; 3906 3907 number_of_lines = number_of_lines - 1; 3908 3909 sub_ok = "0"b; 3910 3911 if tokens (1).type ^= string_constant_token 3912 then goto string_constant_required; 3913 3914 p = addr (constants (tokens (1).number - size (basic_program_header))); 3915 3916 do i = 1 to program_number; 3917 if subprogram.name (i) = p -> based_vs 3918 then goto subprogram_defined_twice; 3919 end; 3920 3921 program_number = program_number + 1; 3922 subprogram.name (program_number) = p -> based_vs; 3923 3924 header_pos (program_number) = output_pos; 3925 program_header_pt = addrel (output_pt, output_pos); 3926 3927 if length (p -> based_vs) = 0 3928 then goto invalid_subprogram_name; 3929 if length (p -> based_vs) > max_subprogram_name_length 3930 then goto invalid_subprogram_name; 3931 3932 if verify (p -> based_vs, alphanumeric) ^= 0 3933 then goto invalid_subprogram_name; 3934 3935 basic_program_header.time_limit = 0.0e0; 3936 3937 output_pos = output_pos + size (basic_program_header); 3938 first_code_word = output_pos; 3939 3940 current_token = 2; 3941 npars = 0; 3942 bl = 0; 3943 3944 /* process parameter list, if any */ 3945 3946 if substr (tokens (2).name, 1, 4) ^= ": " 3947 then string (basic_program_header.incoming_args) = "0"b; 3948 else do; 3949 if number_of_tokens <= 3 3950 then goto incorrect_format; 3951 3952 current_token = 3; 3953 basic_program_header.incoming_args.location = bit (fixed (size (basic_program_header), 18), 18); 3954 3955 p = addrel (instruction_temp_ptr, output_pos); 3956 3957 param_list: 3958 token_pt = addr (tokens (current_token)); 3959 3960 npars = npars + 1; 3961 3962 word = (allocate (0, 2) & ptr_register_mask) | basic_data$param_prototype; 3963 3964 if this_token.type & is_variable 3965 then if substr (tokens (current_token + 1).name, 1, 4) ^= "( " 3966 then do; 3967 3968 /* parameter is scalar */ 3969 3970 if scalars (this_token.number) 3971 then goto variable_occurs_twice; 3972 3973 scalars (this_token.number) = word; 3974 3975 i = numeric_scalar_param; 3976 end; 3977 else do; 3978 3979 /* parameter is an array */ 3980 3981 if abs (this_token.number) > 26 3982 then goto invalid_array; 3983 3984 array_pt = addr (arrays (this_token.number)); 3985 3986 if array_pt -> array.address 3987 then goto array_occurs_twice; 3988 3989 dim_not_allowed (this_token.number) = "1"b; 3990 3991 j = 1; 3992 i = numeric_list_param; 3993 current_token = current_token + 2; 3994 3995 if substr (tokens (current_token).name, 1, 4) = ", " 3996 then do; 3997 j = j + 1; 3998 i = numeric_table_param; 3999 current_token = current_token + 1; 4000 end; 4001 4002 if substr (tokens (current_token).name, 1, 4) ^= ") " 4003 then goto incorrect_format; 4004 4005 array_pt -> array.dimensions = j; 4006 array_pt -> array.address = word; 4007 end; 4008 else if (this_token.type = user_string_fun_token) | (this_token.type = user_numeric_fun_token) 4009 then do; 4010 4011 /* parameter is function */ 4012 4013 if fn_table (this_token.number).address 4014 then goto function_occurs_twice; 4015 4016 fn_table (this_token.number).address = word; 4017 i = numeric_function_param; 4018 end; 4019 else if substr (this_token.name, 1, 4) = "# " 4020 then do; 4021 4022 /* parameter is file */ 4023 4024 current_token = current_token + 1; 4025 token_pt = addr (tokens (current_token)); 4026 4027 if this_token.type ^= integer_constant_token 4028 then goto incorrect_format; 4029 4030 call push_constant; 4031 4032 /* generate code to extract fcb pt from param list and 4033* setup as indicated file. NOTE: we cannot place 4034* instructions directly into output segment 4035* because we have to reserve space for type encoding 4036* of variable length arg list, so we'll put them in a 4037* buffer and extract them later */ 4038 4039 bl = bl + 1; 4040 buffer1 (bl) = instructions.get_fcb_pt | word; 4041 buffer2 (bl) = instructions.load (0) | operand (1); 4042 4043 operand_level = 0; 4044 4045 i = file_param; 4046 end; 4047 else goto invalid_subprogram_parameter; 4048 4049 if this_token.type & is_string 4050 then i = i + 1; 4051 4052 p -> param_info (npars) = bit (fixed (i, 9), 9); 4053 4054 current_token = current_token + 1; 4055 if substr (tokens (current_token).name, 1, 4) = ", " 4056 then do; 4057 current_token = current_token + 1; 4058 goto param_list; 4059 end; 4060 4061 basic_program_header.incoming_args.number = bit (fixed (npars, 17), 18); 4062 /* number = 2*npars */ 4063 output_pos = output_pos + size (p -> param_info_aligned); 4064 end; 4065 4066 entry_pos (program_number) = output_pos; /* entry_pos is relocated and entry_pt set 4067* after the constants have been generated */ 4068 4069 addrel (instruction_temp_ptr, output_pos) -> basic_entry.word_3 = instructions.enter_proc; 4070 4071 output_pos = output_pos + size (basic_entry); 4072 output_pt = instruction_temp_ptr; 4073 4074 /* output any instructions which were buffered */ 4075 4076 do i = 1 to bl; 4077 output_word (output_pos) = buffer1 (i); 4078 output_word (output_pos + 1) = buffer2 (i); 4079 output_word (output_pos + 2) = instructions.use_fcb; 4080 output_pos = output_pos + 3; 4081 end; 4082 4083 goto done; 4084 4085 /* SUBEND */ 4086 4087 stm (32): 4088 if sub_ok 4089 then goto subend_not_allowed; 4090 4091 word = instructions.subend; 4092 goto end; 4093 4094 /* TEACH */ 4095 4096 stm (33): 4097 goto not_yet; 4098 4099 /* TIME */ 4100 4101 stm (34): 4102 if number_of_tokens ^= 2 4103 then goto incorrect_format; 4104 4105 if tokens (1).type ^= numeric_constant_token 4106 then if tokens (1).type ^= integer_constant_token 4107 then goto incorrect_format; 4108 4109 if tokens (1).value <= 0.0e0 4110 then goto incorrect_format; 4111 4112 program_header_pt = addrel (output_pt, header_pos (program_number)); 4113 4114 if time_limit = 0.0e0 4115 then time_limit = tokens (1).value; 4116 else time_limit = min (time_limit, tokens (1).value); 4117 4118 current_token = 2; 4119 goto done; 4120 4121 /* WRITE */ 4122 4123 stm (35): 4124 call required_file; 4125 4126 write_list: 4127 call put_expression (instructions.write); 4128 4129 if substr (tokens (current_token).name, 1, 4) = ", " 4130 then do; 4131 current_token = current_token + 1; 4132 goto write_list; 4133 end; 4134 4135 goto done; 4136 4137 /* This procedure is called to push a reference onto the operand stack. 4138* It is called with current_token pointing at start of reference, it 4139* returns with current_token pointing to token after the end of the 4140* reference. The reference can be either the name of the user function 4141* currently being defined, a scalar variable, or a subscripted array 4142* variable; any other name causes the invalid variable error. */ 4143 4144 reference: 4145 proc; 4146 4147 token_pt = addr (tokens (current_token)); 4148 4149 if this_token.type & is_user 4150 then do; 4151 if fn_name ^= this_token.number 4152 then goto invalid_variable; 4153 4154 if substr (tokens (current_token + 1).name, 1, 4) = "( " 4155 then goto invalid_variable; 4156 4157 /* have reference to return value of function being defined */ 4158 4159 call push_function; 4160 4161 current_token = current_token + 1; 4162 end; 4163 else do; 4164 if (this_token.type & is_variable) = "0"b 4165 then goto invalid_variable; 4166 4167 current_token = current_token + 1; 4168 4169 if substr (tokens (current_token).name, 1, 4) ^= "( " 4170 then call push_variable; 4171 else do; 4172 call subscript_list; 4173 call push_array (token_pt, number_of_dims); 4174 end; 4175 end; 4176 4177 end; 4178 4179 /* This procedure is called to process a list of subscripts. At 4180* entry current_token is pointing to the "(", at exit current_token 4181* is pointing to the token after the ")". The global variable 4182* "number_of_dims" is set to the number of subscript expressions 4183* found. The expressions are left on top of the operand stack */ 4184 4185 subscript_list: 4186 proc; 4187 4188 dcl tp ptr; 4189 4190 tp = token_pt; 4191 4192 current_token = current_token + 1; 4193 4194 call numeric_expression; 4195 4196 if substr (tokens (current_token).name, 1, 4) ^= ", " 4197 then number_of_dims = 1; 4198 else do; 4199 current_token = current_token + 1; 4200 call numeric_expression; 4201 number_of_dims = 2; 4202 end; 4203 4204 if substr (tokens (current_token).name, 1, 4) ^= ") " 4205 then goto incorrect_format; 4206 4207 current_token = current_token + 1; 4208 token_pt = tp; 4209 4210 end; 4211 4212 /* This procedure is called when a numeric expression is required. */ 4213 4214 numeric_expression: 4215 proc; 4216 4217 call expression; 4218 4219 if operand_type (operand_level) ^= 0 4220 then goto numeric_expression_required; 4221 4222 end; 4223 4224 /* This procedure is called to process an expression as the upper limit 4225* or step value in a for-statement. If the expression is not a constant, 4226* code is generated to load and then save the value of the numeric 4227* expression in an automatic variable. */ 4228 4229 for_expression: 4230 proc; 4231 4232 call numeric_expression; 4233 4234 if ^operand_is_constant (operand_level) 4235 then do; 4236 4237 /* expression is not constant, we have to save value in a temp */ 4238 4239 call load_register (0, operand_level); 4240 4241 operand (operand_level) = allocate (0, precision_lng); 4242 4243 output_word (output_pos) = operand (operand_level) | instructions.store (0); 4244 output_pos = output_pos + 1; 4245 4246 operand_in_register (0) = 0; 4247 end; 4248 4249 end; 4250 4251 /* This procedure is called to load an expression value into the 4252* indicated register: 0 = numeric, 1 = string, <0 means either 4253* type of expression is valid. */ 4254 4255 expression_in_register: 4256 proc (reg); 4257 4258 dcl reg fixed bin; 4259 4260 dcl m fixed bin; 4261 4262 call expression; 4263 4264 if reg < 0 4265 then m = operand_type (operand_level); 4266 else m = reg; 4267 4268 call register_load (m, operand_level); 4269 end; 4270 4271 /* This procedure is the principal expression parser. It uses a 4272* double precedence method so that parentheses can be handled without 4273* recursion and left-asscociativity or right-associativity can be 4274* obtained by changing precedence tables. Operators are pushed on to 4275* "operator_stack" and operands are pushed on to "operand_stack". A 4276* separate stack is used for recording information about the current 4277* parentheses nesting level. The precedences of the "(" and ")" 4278* are chosen so that "(" can be cleared off the stack only by a following 4279* ")" or ",". */ 4280 4281 expression: 4282 proc; 4283 4284 dcl (i, current_operator, current_precedence, opcode, optype, parens_level) 4285 fixed bin; 4286 4287 dcl (parens_type, parens_count, parens_token, starting_operator_level) 4288 dim (0:32) fixed bin; 4289 4290 dcl precedence (0:9) fixed bin static init (14, 4291 /* beginning of stack */ 4292 4, /* + */ 4293 4, /* - */ 4294 6, /* * */ 4295 6, /* / */ 4296 10, /* ^ */ 4297 4, /* & */ 4298 12, /* u- */ 4299 2, /* ( */ 4300 1); /* ) */ 4301 4302 dcl right_precedence (0:10) fixed bin static init (0, 4303 /* non-operator */ 4304 3, /* + */ 4305 3, /* - */ 4306 5, /* * */ 4307 5, /* / */ 4308 10, /* ^ */ 4309 3, /* & */ 4310 12, /* u- */ 4311 14, /* ( */ 4312 1, /* ) */ 4313 1); /* , */ 4314 4315 dcl ( 4316 exp_paren init (1), 4317 sub_paren init (2), 4318 fun_paren init (3), 4319 user_fun_paren init (4) 4320 ) fixed bin int static; 4321 4322 parens_level = 0; 4323 4324 starting_operator_level (0) = operator_level; 4325 4326 want_operand: 4327 token_pt = addr (tokens (current_token)); 4328 4329 if this_token.type & is_operator 4330 then do; 4331 4332 /* check for unary operator */ 4333 4334 if this_token.number = plus_op 4335 then do; 4336 current_token = current_token + 1; 4337 goto want_operand; 4338 end; 4339 4340 if this_token.number = minus_op 4341 then do; 4342 4343 /* if unary minus is followed by constant, reverse sign 4344* of the constant and eliminate the operator */ 4345 4346 if tokens (current_token + 1).type & is_constant 4347 then do; 4348 current_token = current_token + 1; 4349 token_pt = addr (tokens (current_token)); 4350 4351 if this_token.type & is_string 4352 then goto numeric_expression_required; 4353 4354 if single 4355 then this_token.value = -this_token.value; 4356 else d_this_token.value = -d_this_token.value; 4357 call push_constant; 4358 goto want_operator; 4359 end; 4360 4361 current_operator = unary_minus_op; 4362 goto check_stack; 4363 end; 4364 4365 goto incorrect_format; 4366 end; 4367 4368 if this_token.type & is_variable 4369 then do; 4370 current_token = current_token + 1; 4371 4372 if substr (tokens (current_token).name, 1, 4) ^= "( " 4373 then do; 4374 call push_variable; 4375 goto want_op; 4376 end; 4377 4378 call parenthesis ((sub_paren)); 4379 end; 4380 4381 if this_token.type & is_constant 4382 then do; 4383 call push_constant; 4384 goto want_operator; 4385 end; 4386 4387 if this_token.type & is_function 4388 then do; 4389 4390 if this_token.type & is_user 4391 then do; 4392 if substr (tokens (current_token + 1).name, 1, 4) ^= "( " 4393 then do; 4394 if fn_name = this_token.number 4395 then call push_function; 4396 else call user_function (token_pt, 0); 4397 4398 goto want_operator; 4399 end; 4400 4401 current_token = current_token + 1; 4402 call parenthesis ((user_fun_paren)); 4403 end; 4404 4405 /* system function */ 4406 4407 i = basic_data$functions (this_token.number).class; 4408 4409 if number_of_args_required (i) = 0 4410 then do; 4411 if substr (tokens (current_token + 1).name, 1, 4) = "( " 4412 then goto wrong_number_of_args; 4413 4414 i = fixed (substr (this_token.type, 2, 1), 1); 4415 4416 if operand_in_register (i) ^= 0 4417 then call save_register (i); 4418 4419 call function (token_pt, 0); 4420 goto want_operator; 4421 end; 4422 4423 current_token = current_token + 1; 4424 4425 if substr (tokens (current_token).name, 1, 4) ^= "( " 4426 then goto wrong_number_of_args; 4427 4428 if i = n_f_fun | i = n_fs_fun 4429 then do; 4430 current_token = current_token + 1; 4431 if substr (tokens (current_token).name, 1, 4) ^= "# " 4432 then goto file_expression_required; 4433 4434 unspec (tokens (current_token - 1)) = unspec (tokens (current_token - 2)); 4435 end; 4436 4437 call parenthesis ((fun_paren)); 4438 end; 4439 4440 if this_token.type & is_punctuation 4441 then do; 4442 4443 if substr (this_token.name, 1, 4) = "( " 4444 then call parenthesis ((exp_paren)); 4445 4446 /* have an error */ 4447 4448 goto incorrect_format; 4449 end; 4450 4451 if parens_level ^= 0 4452 then goto parenthesis_mismatch; 4453 else goto incorrect_format; 4454 4455 want_operator: 4456 current_token = current_token + 1; 4457 4458 want_op: 4459 token_pt = addr (tokens (current_token)); 4460 4461 if this_token.type & is_operator 4462 then current_operator = this_token.number; 4463 else if substr (this_token.name, 1, 4) = ") " 4464 then current_operator = close_paren; 4465 else if substr (this_token.name, 1, 4) = ", " 4466 then current_operator = comma; 4467 else current_operator = 0; 4468 4469 check_stack: 4470 current_precedence = right_precedence (current_operator); 4471 4472 do while (operator_level > starting_operator_level (parens_level)); 4473 opcode = operator (operator_level); 4474 4475 if precedence (opcode) <= current_precedence 4476 then goto stack_operator; 4477 4478 if opcode <= unary_minus_op 4479 then do; 4480 optype = fixed (opcode = string_op, 1); 4481 4482 /* Check for special case, '+' as || */ 4483 if operand_type (operand_level) = 1 & 4484 operand_type (operand_level - 1) = 1 & 4485 opcode = plus_op then do; 4486 /* change to string operator */ 4487 optype = 1; 4488 goto op (string_op); 4489 end; 4490 4491 if operand_type (operand_level) ^= optype 4492 then goto mixed_expression; 4493 4494 if opcode ^= unary_minus_op 4495 then if operand_type (operand_level - 1) ^= optype 4496 then goto mixed_expression; 4497 end; 4498 4499 goto op (opcode); 4500 4501 /* ADD */ 4502 4503 op (1): 4504 call operate (instructions.add, instructions.add); 4505 goto op_done; 4506 4507 /* SUBTRACT */ 4508 4509 op (2): 4510 if operand_in_register (0) = operand_level 4511 then do; 4512 output_word (output_pos) = operand (operand_level - 1) | instructions.subtract; 4513 output_word (output_pos + 1) = instructions.fneg; 4514 output_pos = output_pos + 2; 4515 end; 4516 else do; 4517 call load_register (0, operand_level - 1); 4518 output_word (output_pos) = instructions.subtract | operand (operand_level); 4519 output_pos = output_pos + 1; 4520 end; 4521 4522 goto op_done; 4523 4524 /* MULTIPLY */ 4525 4526 op (3): 4527 call operate (instructions.multiply, instructions.multiply); 4528 goto op_done; 4529 4530 /* DIVIDE */ 4531 4532 op (4): 4533 call operate (instructions.divide, instructions.divide_inv); 4534 goto op_done; 4535 4536 /* POWER */ 4537 4538 op (5): 4539 if operand_in_register (2) ^= 0 4540 then call save_register (2); 4541 4542 if operand_in_register (0) = operand_level 4543 then do; 4544 output_word (output_pos) = instructions.power_inverse; 4545 output_word (output_pos + 1) = instructions.load (0) | operand (operand_level - 1); 4546 end; 4547 else do; 4548 call load_register (0, operand_level - 1); 4549 output_word (output_pos) = instructions.power; 4550 output_word (output_pos + 1) = instructions.load (0) | operand (operand_level); 4551 end; 4552 4553 output_pos = output_pos + 2; 4554 goto op_done; 4555 4556 /* CONCATENATION */ 4557 4558 op (6): 4559 call load_register (1, operand_level - 1); 4560 4561 output_word (output_pos) = instructions.string_concatenate (0) | operand (operand_level); 4562 output_word (output_pos + 1) = instructions.string_concatenate (1); 4563 4564 output_pos = output_pos + 2; 4565 goto op_done; 4566 4567 /* UNARY MINUS */ 4568 4569 op (7): 4570 call load_register (0, operand_level); 4571 output_word (output_pos) = instructions.fneg; 4572 output_pos = output_pos + 1; 4573 if operand_in_register (2) = operand_level 4574 then operand_in_register (2) = 0; /* use result in reg 0 (071680-MBW) */ 4575 goto op_thru; 4576 4577 /* LEFT PARENTHESIS */ 4578 4579 op (8): 4580 if current_operator = comma 4581 then do; 4582 if parens_type (parens_level) = exp_paren 4583 then goto punctuation_not_allowed; 4584 4585 parens_count (parens_level) = parens_count (parens_level) + 1; 4586 current_token = current_token + 1; 4587 goto want_operand; 4588 end; 4589 4590 if current_operator ^= close_paren 4591 then goto parenthesis_mismatch; 4592 4593 goto paren_xeq (parens_type (parens_level)); 4594 4595 /* finished expression parenthesis */ 4596 4597 paren_xeq (1): 4598 operator_level = operator_level - 1; 4599 4600 parens_level = parens_level - 1; 4601 if parens_level < 0 4602 then goto parenthesis_mismatch; 4603 4604 goto want_operator; 4605 4606 /* finished subscript parenthesis */ 4607 4608 paren_xeq (2): 4609 call push_array (addr (tokens (parens_token (parens_level))), parens_count (parens_level)); 4610 4611 goto paren_xeq (1); 4612 4613 /* finished functions parenthesis */ 4614 4615 paren_xeq (3): 4616 call function (addr (tokens (parens_token (parens_level))), parens_count (parens_level)); 4617 4618 goto paren_xeq (1); 4619 4620 /* finished user function parenthesis */ 4621 4622 paren_xeq (4): 4623 call user_function (addr (tokens (parens_token (parens_level))), parens_count (parens_level)); 4624 4625 goto paren_xeq (1); 4626 4627 op_done: 4628 operand_level = operand_level - 1; 4629 4630 /* If we just finished an operator whose right operand 4631* was subscripted, we have to clear the subscript register */ 4632 4633 if operand_in_register (2) > operand_level 4634 then operand_in_register (2) = 0; 4635 4636 op_thru: 4637 operator_level = operator_level - 1; 4638 4639 operand (operand_level) = (36)"0"b; 4640 operand_type (operand_level) = optype; 4641 operand_in_register (optype) = operand_level; 4642 4643 end; 4644 4645 /* stack the operator */ 4646 4647 stack_operator: 4648 if current_operator = 0 | current_operator >= close_paren 4649 then do; 4650 if parens_level ^= 0 4651 then goto parenthesis_mismatch; 4652 return; 4653 end; 4654 4655 stack_it: 4656 operator_level = operator_level + 1; 4657 if operator_level > hbound (operator, 1) 4658 then goto too_deep; 4659 4660 operator (operator_level) = current_operator; 4661 current_token = current_token + 1; 4662 goto want_operand; 4663 4664 parenthesis: 4665 proc (type); 4666 4667 dcl type fixed bin; /* type of parenthesis found */ 4668 4669 parens_level = parens_level + 1; 4670 if parens_level > hbound (parens_type, 1) 4671 then goto too_deep; 4672 4673 current_operator = open_paren; 4674 4675 parens_type (parens_level) = type; 4676 parens_count (parens_level) = 1; 4677 parens_token (parens_level) = current_token - 1; 4678 starting_operator_level (parens_level) = operator_level; 4679 4680 goto stack_it; 4681 end; 4682 4683 end; 4684 4685 /* This procedure pushes onto the operand stack a reference to the 4686* return value of the function currently being defined. */ 4687 4688 push_function: 4689 proc; 4690 4691 operand_level = operand_level + 1; 4692 if operand_level > hbound (operand, 1) 4693 then goto too_deep; 4694 4695 operand (operand_level) = arg_prototype; 4696 operand_type (operand_level) = fixed (substr (this_token.type, 2, 1), 1); 4697 4698 end; 4699 4700 /* This procedure pushes onto the operand stack a reference to a 4701* scalar variable. */ 4702 4703 push_variable: 4704 proc; 4705 4706 dcl k fixed bin, 4707 amount (2, 0:1) fixed bin static init (1, 1, 2, 1); 4708 4709 operand_level = operand_level + 1; 4710 if operand_level > hbound (operand, 1) 4711 then goto too_deep; 4712 4713 k = fixed (substr (this_token.type, 2, 1), 1); 4714 4715 if scalars (this_token.number) = "0"b 4716 then scalars (this_token.number) = allocate (k, (amount (precision_lng, k))); 4717 4718 operand (operand_level) = scalars (this_token.number) | modifier; 4719 operand_type (operand_level) = k; 4720 end; 4721 4722 /* This procedure pushes onto the operand stack a reference to a 4723* subscripted array; the array subscript(s) are on top of the 4724* operand stack. The number of subscripts is used to dimension 4725* the array if it has not already been dimensioned. Code is 4726* generated that does subscriptrange checking and loads the 4727* address register with a pointer to the desired array element. */ 4728 4729 push_array: 4730 proc (tp, ndims); 4731 4732 dcl tp ptr, /* points at token for array node */ 4733 ndims fixed bin; 4734 4735 dcl m fixed bin; 4736 4737 /* We don't have to check operand_level because there is at least one 4738* subscript expression on the operand stack */ 4739 4740 if ndims > 2 4741 then goto wrong_number_of_subs; 4742 4743 token_pt = tp; 4744 4745 call dimension_array (ndims, 11, 11); 4746 4747 if operand_in_register (2) ^= 0 4748 then do; 4749 4750 /* check to see if address register has been used since address was 4751* loaded, if not used we have to save it */ 4752 4753 do m = address_register_loaded to output_pos; 4754 if (output_word (m) & "111111111111111111000000000001111111"b) = basic_data$array_prototype 4755 then goto clear_address_register; 4756 end; 4757 4758 /* address register not used, we'll have to save it unless it 4759* will be used in the addressing calculation we are about to do */ 4760 4761 if ndims = 1 4762 then if operand_in_register (2) = operand_level 4763 then goto clear_address_register; 4764 else ; 4765 else if operand_in_register (0) ^= operand_level 4766 then if operand_in_register (2) = operand_level - 1 4767 then goto clear_address_register; 4768 4769 call save_register (2); 4770 4771 clear_address_register: 4772 operand_in_register (2) = 0; 4773 end; 4774 4775 call array_op (instructions.subscript, ndims); 4776 4777 operand (operand_level) = basic_data$array_prototype; 4778 operand_type (operand_level) = array_type; 4779 4780 address_register_loaded = output_pos; 4781 end; 4782 4783 /* This procedure generates code for array subscriptrange checking 4784* or re-dimensioning; the argument "op" indicates operators to use. 4785* op(1) is operator for lists 4786* op(2) is operator for tables 4787* op(3) is operator for tables when 2nd subscript is in EAQ 4788* The operator that is selected depends on number of dimensions 4789* and which of the subscript expressions is available in EAQ. */ 4790 4791 array_op: 4792 proc (op, ndims); 4793 4794 dcl op (3) bit (36) aligned, 4795 ndims fixed bin; 4796 4797 if ndims = 1 4798 then do; 4799 call load_register (0, operand_level); 4800 call plop (op (1), "0"b); 4801 end; 4802 else do; 4803 if operand_in_register (0) = operand_level 4804 then call plop (op (3), operand (operand_level - 1)); 4805 else do; 4806 call load_register (0, operand_level - 1); 4807 call plop (op (2), operand (operand_level)); 4808 end; 4809 4810 operand_level = operand_level - 1; 4811 end; 4812 4813 operand_in_register (0) = 0; 4814 operand_in_register (2) = operand_level; 4815 4816 plop: 4817 proc (x1, x2); 4818 4819 dcl (x1, x2) bit (36) aligned; 4820 4821 output_word (output_pos) = instructions.load (2) | array_pt -> array.address | modifier; 4822 output_word (output_pos + 1) = x1; 4823 output_pos = output_pos + 2; 4824 4825 if x2 4826 then do; 4827 output_word (output_pos) = instructions.load (0) | x2; 4828 output_pos = output_pos + 1; 4829 end; 4830 4831 end; 4832 4833 end; 4834 4835 /* This procedure is called to dimension the array specified by 4836* global variable "token_pt" with the indicated bounds. 4837* This procedure is called from the DIM statement processor and 4838* also from MAT and other contexts where an array is expected. 4839* If this is the first reference to the array, the bounds 4840* are set; if this is not the first reference, an error is 4841* generated if number of dimensions is wrong. The global 4842* variable "array_type" is set to the type of the array, and 4843* the global variable "array_pt" is set to point at array block. */ 4844 4845 dimension_array: 4846 proc (ndims, bound1, bound2); 4847 4848 dcl (ndims, bound1, bound2) 4849 fixed bin; 4850 4851 dcl nd fixed bin; 4852 4853 if abs (this_token.number) > 26 4854 then goto invalid_array; 4855 4856 nd = abs (ndims); 4857 4858 array_type = fixed (substr (this_token.type, 2, 1), 1); 4859 array_pt = addr (arrays (this_token.number)); 4860 4861 if array_pt -> array.address = "0"b 4862 then do; 4863 4864 /* first reference to the array */ 4865 4866 array_pt -> array.dimensions = nd; 4867 4868 if statement_type = dim_statement 4869 then dim_not_allowed (this_token.number) = "1"b; 4870 4871 call set_bounds; 4872 4873 array_pt -> array.address = allocate (0, size (array_dope)); 4874 end; 4875 else do; 4876 if ndims > 0 4877 then if nd ^= array_pt -> array.dimensions 4878 then goto wrong_number_of_subs; 4879 4880 if statement_type = dim_statement 4881 then do; 4882 if dim_not_allowed (this_token.number) 4883 then goto array_defined_twice; 4884 4885 dim_not_allowed (this_token.number) = "1"b; 4886 4887 call set_bounds; 4888 end; 4889 end; 4890 4891 set_bounds: 4892 proc; 4893 4894 array_pt -> array.bounds (1) = bound1; 4895 if nd = 2 4896 then array_pt -> array.bounds (2) = bound2; 4897 4898 end; 4899 end; 4900 4901 /* This procedure pushes a reference to a constant onto operand stack. 4902* If DU or DL modification cannot be used, the constant is added to 4903* constant pool . */ 4904 4905 push_constant: 4906 proc; 4907 4908 dcl i fixed bin (18), 4909 d_value float bin (63), 4910 based_single fixed bin (35) based, 4911 based_double fixed bin (71) based, 4912 word bit (36) aligned; 4913 4914 operand_level = operand_level + 1; 4915 if operand_level > hbound (operand, 1) 4916 then goto too_deep; 4917 4918 operand_type (operand_level) = fixed (substr (this_token.type, 2, 1), 1); 4919 4920 if this_token.type & is_string 4921 then do; 4922 i = this_token.number; 4923 word = basic_data$constant_prototype | bit (fixed (i - 1, 18), 18); 4924 end; 4925 4926 else if single 4927 then do; 4928 val = unspec (this_token.value); 4929 4930 if substr (val, 1, 18) = "0"b 4931 then word = substr (val, 19, 18) || "000000000000000111"b; 4932 else if substr (val, 19, 18) = "0"b 4933 then word = substr (val, 1, 18) || "000000000000000011"b; 4934 else do; 4935 4936 do i = 1 to number_of_constants; 4937 if addr (constants (i)) -> based_single = addr (this_token.value) -> based_single 4938 then goto ok; /* can't compare possible ascii as float bin */ 4939 end; 4940 4941 /* check for max_number_of_constants only at end */ 4942 4943 number_of_constants = number_of_constants + 1; 4944 4945 constants (number_of_constants) = this_token.value; 4946 4947 ok: 4948 word = basic_data$constant_prototype 4949 | bit (fixed (i - 1 + size (basic_program_header), 18), 18); 4950 end; 4951 end; 4952 else do; 4953 d_value = d_this_token.value; 4954 4955 dp_case: 4956 do i = 1 to divide (number_of_constants, 2, 17, 0); 4957 if addr (d_constants (i)) -> based_double = addr (d_value) -> based_double 4958 then go to d_ok; /* can't compare possible ascii as float bin */ 4959 end; /* check for max_number_of_constants only at end */ 4960 4961 i = divide (number_of_constants + 3, 2, 17, 0); 4962 number_of_constants = i * 2; 4963 d_constants (i) = d_value; 4964 4965 d_ok: 4966 word = basic_data$constant_prototype 4967 | bit (fixed ((i - 1) * 2 + size (basic_program_header), 18), 18); 4968 end; 4969 4970 operand (operand_level) = word; 4971 return; 4972 4973 push_constant_dp_notok: 4974 entry (a_value); 4975 4976 dcl a_value float bin (63); 4977 4978 d_value = a_value; 4979 operand_type (operand_level) = 0; /* know we have numeric */ 4980 go to dp_case; 4981 4982 end; 4983 4984 /* This function returns "1"b if the specified operand is a reference 4985* to a constant. */ 4986 4987 operand_is_constant: 4988 proc (level) returns (bit (1) aligned); 4989 4990 dcl level fixed bin; 4991 4992 return (((operand (level) & prototype_mask) = basic_data$constant_prototype) | (rand (level).tag = "000111"b) 4993 | (rand (level).tag = "000011"b)); 4994 end; 4995 4996 /* This procedure is called to allocate a block of automatic 4997* storage in either the numeric or string pool. */ 4998 4999 allocate: 5000 proc (which, amount) returns (bit (36) aligned); 5001 5002 dcl which fixed bin, /* 0 for numeric, 1 for string */ 5003 amount fixed bin; /* amount of space to allocate */ 5004 5005 dcl loc fixed bin (18); 5006 5007 if amount = 1 5008 then if odd_available (which) ^= 0 5009 then do; 5010 loc = odd_available (which); 5011 odd_available (which) = 0; 5012 end; 5013 else do; 5014 loc = auto_ctr (which); 5015 auto_ctr (which) = auto_ctr (which) + 1; 5016 end; 5017 else do; 5018 5019 /* two or more words allocated on even boundary */ 5020 5021 if mod (auto_ctr (which), 2) ^= 0 5022 then do; 5023 odd_available (which) = auto_ctr (which); 5024 auto_ctr (which) = auto_ctr (which) + 1; 5025 end; 5026 5027 loc = auto_ctr (which); 5028 auto_ctr (which) = auto_ctr (which) + amount; 5029 end; 5030 5031 return (basic_data$scalar_prototype (which) | bit (loc, 18)); 5032 end; 5033 5034 /* This procedure is called to allocate a temporary of the 5035* specified type. If a new temporary cell must be allocated, 5036* the global variable "modifier" is used to determine if 5037* normal allocation or function local allocation should be 5038* used. */ 5039 5040 allocate_temp: 5041 proc (reg) returns (bit (36) aligned); 5042 5043 dcl reg fixed bin; /* 0 EAQ, 1 string, 2 pointer */ 5044 5045 dcl space (0:2) fixed bin static init (0, 1, 0), 5046 amount (2, 0:2) fixed bin static init (1, 1, 2, 2, 2, 2); 5047 5048 dcl k fixed bin, 5049 ta bit (36) aligned; 5050 5051 temps (reg).next = temps (reg).next + 1; 5052 5053 k = temps (reg).next; 5054 if k > max_temp 5055 then goto too_deep; 5056 5057 ta = temps (reg).address (k); 5058 5059 if ta = "0"b 5060 then do; 5061 if modifier = normal_modifier 5062 then ta = allocate ((space (reg)), (amount (precision_lng, reg))); 5063 else ta = allocate_local (space (reg), amount (precision_lng, reg), reg); 5064 5065 temps (reg).address (k) = ta; 5066 end; 5067 5068 return (ta); 5069 end; 5070 5071 /* This procedure is called to allocate a block of storage in 5072* the local area of a function. */ 5073 5074 allocate_local: 5075 proc (which, amount, reg) returns (bit (36) aligned); 5076 5077 dcl which fixed bin, /* 0 for numeric, 1 for string */ 5078 amount fixed bin, /* number of words to allocate */ 5079 reg fixed bin; /* 0 EAQ, 1 string, 2 pointer */ 5080 5081 dcl loc fixed bin (18), 5082 number (2, 0:2) fixed bin static init (1, 1, 2, 1, 1, 1) options (constant), 5083 n_locs fixed bin (5); 5084 5085 n_locs = fixed (fn_local_word.number, 5) + number (precision_lng, reg); 5086 5087 if amount ^= 1 5088 then if mod (local_ctr, 2) ^= 0 5089 then do; 5090 n_locs = n_locs + 1; 5091 local_ctr = local_ctr + 1; 5092 end; 5093 5094 if n_locs > hbound (fn_local_word.local, 1) 5095 then goto too_many_locals; 5096 5097 fn_local_word.number = bit (n_locs, 5); 5098 5099 loc = local_ctr; 5100 local_ctr = local_ctr + amount; 5101 5102 fn_local_word.local (n_locs) = bit (fixed (which, 1), 1); 5103 if number (precision_lng, reg) = 2 5104 then fn_local_word.local (n_locs - 1) = "0"b; /* count pointers as 2 numeric locals */ 5105 5106 return (arg_prototype | bit (loc, 18)); 5107 end; 5108 5109 /* This procedure is called to load the operand at the specified 5110* level into the specified register, if not already there. If a 5111* load must be generated, the previous contents of the register, 5112* if any, are saved. The register_load entry is the same 5113* except an error is generated if the type of the operand is 5114* incorrect. */ 5115 5116 load_register: 5117 proc (reg, level); 5118 5119 dcl reg fixed bin, /* 0 EAQ, 1 string, 2 pointer */ 5120 level fixed bin; /* stack level of operand */ 5121 5122 lr: 5123 if operand_in_register (reg) = level 5124 then return; 5125 5126 if operand_in_register (reg) ^= 0 5127 then call save_register (reg); 5128 5129 output_word (output_pos) = operand (level) | instructions.load (reg); 5130 output_pos = output_pos + 1; 5131 5132 operand_in_register (reg) = level; 5133 return; 5134 5135 register_load: 5136 entry (reg, level); 5137 5138 if reg ^= operand_type (level) 5139 then goto expression_required (reg); 5140 5141 goto lr; 5142 end; 5143 5144 /* This procedure generates code to save the value in the 5145* specified register in a temporary. */ 5146 5147 save_register: 5148 proc (reg); 5149 5150 dcl reg fixed bin; /* 0 EAQ, 1 string, 2 pointer */ 5151 5152 dcl k fixed bin; 5153 5154 k = operand_in_register (reg); 5155 5156 operand (k) = allocate_temp (reg) | modifier; 5157 5158 if reg ^= 1 5159 then do; 5160 output_word (output_pos) = operand (k) | instructions.store (reg); 5161 output_pos = output_pos + 1; 5162 end; 5163 else do; 5164 output_word (output_pos) = instructions.string_assign (0) | operand (k); 5165 output_word (output_pos + 1) = instructions.string_assign (1); 5166 output_pos = output_pos + 2; 5167 end; 5168 5169 /* if we are saving address pointer register, we have to make operand 5170* address indirect or register indirect */ 5171 5172 if reg = 2 5173 then rand (k).tag = rand (k).tag | "010000"b; 5174 5175 operand_in_register (reg) = 0; 5176 end; 5177 5178 /* This procedure is called to generate code for binary operators. 5179* The left operand is operand(operand_level-1) and the right 5180* operand is operand(operand_level). Which of the instructions 5181* op1 & op2 is used dependes on which of the operands is in 5182* the EAQ. */ 5183 5184 operate: 5185 proc (op1, op2); 5186 5187 dcl (op1, op2) bit (36) aligned; 5188 5189 if operand_in_register (0) = operand_level 5190 then output_word (output_pos) = op2 | operand (operand_level - 1); 5191 else do; 5192 call load_register (0, operand_level - 1); 5193 output_word (output_pos) = op1 | operand (operand_level); 5194 end; 5195 5196 output_pos = output_pos + 1; 5197 if operand_in_register (2) = operand_level - 1 5198 then operand_in_register (2) = 0; /* use result of op (071680-MBW) */ 5199 end; 5200 5201 /* This procedure is called to output a transfer-type instruction 5202* using the address of the line specified by the current_token. */ 5203 5204 gen_xfer: 5205 proc (op); 5206 5207 dcl op bit (36) aligned; 5208 5209 dcl (i, ln, lower, upper) fixed bin, 5210 offset bit (18); 5211 5212 token_pt = addr (tokens (current_token)); 5213 5214 if this_token.type ^= integer_token 5215 then if this_token.type = end_token 5216 then goto line_number_required; 5217 else goto invalid_line_number; 5218 5219 ln = fixed (this_token.value, 17); 5220 5221 if ln <= current_line_number 5222 then do; 5223 5224 /* check to see if line previously defined */ 5225 5226 lower = 1; 5227 upper = number_of_lines; 5228 5229 do while (lower <= upper); 5230 i = divide (upper + lower, 2, 17, 0); 5231 5232 if ln = line (i).number 5233 then do; 5234 5235 if fn_name = 0 5236 then if in_function (i) 5237 then goto l0; 5238 else ; 5239 else if ln <= fn_start 5240 then goto l0; 5241 5242 offset = bit (fixed (fixed (line (i).location, 17) - output_pos + 262144, 18), 18); 5243 goto l1; 5244 end; 5245 5246 if ln < line (i).number 5247 then upper = i - 1; 5248 else lower = i + 1; 5249 end; 5250 5251 end; 5252 5253 /* check to see if this missing line was found before */ 5254 5255 l0: 5256 do i = 1 to missing.count; 5257 if ln = missing.number (i) 5258 then do; 5259 5260 offset = missing.chain (i); 5261 goto l2; 5262 end; 5263 end; 5264 5265 /* first reference to this missing line */ 5266 5267 if i > hbound (missing.missing_lines, 1) 5268 then goto too_many_missing_lines; 5269 5270 offset = "0"b; 5271 missing.count = i; 5272 missing.number (i) = ln; 5273 5274 /* add to usage chain of missing line number */ 5275 5276 l2: 5277 missing.chain (i) = bit (output_pos, 18); 5278 5279 l1: 5280 output_word (output_pos) = op | offset | ic (0); 5281 output_pos = output_pos + 1; 5282 5283 current_token = current_token + 1; 5284 end; 5285 5286 /* This procedure compiles code for system functions; it is called 5287* after the closing ")" has been found, all of the operands are 5288* on the operand stack. The operand stack is peeled back so that 5289* only the value of the function is left. */ 5290 5291 function: 5292 proc (tp, nargs); 5293 5294 dcl tp ptr, /* points at token for function name */ 5295 nargs fixed bin; /* number of args on operand stack */ 5296 5297 /* Special declarations for pos */ 5298 5299 dcl d_value float bin (63), 5300 based_single fixed bin (35) based, 5301 based_double fixed bin (71) based, 5302 word bit (36) aligned; 5303 5304 dcl jump bit (36) aligned, 5305 (i, k) fixed bin; 5306 5307 token_pt = tp; 5308 i = basic_data$functions (this_token.number).class; 5309 5310 /* Don't check the number of args for pos here */ 5311 if i ^= pos_args then 5312 if number_of_args_required (i) >= 0 5313 then if nargs ^= number_of_args_required (i) 5314 then goto wrong_number_of_args; 5315 5316 jump = basic_data$functions (this_token.number).run_time; 5317 k = fixed (substr (this_token.type, 2, 1), 1); 5318 5319 if operand_in_register (1) ^= 0 5320 then call save_register (1); /* fix for bug 086 */ 5321 if operand_in_register (2) ^= 0 5322 then call save_register (2); 5323 5324 goto fn_xeq (i); 5325 5326 /* no arguments required */ 5327 5328 fn_xeq (5): 5329 if operand_in_register (1) ^= 0 5330 then call save_register (1); 5331 5332 fn_xeq (1): 5333 operand_level = operand_level + 1; 5334 5335 fn_put: 5336 if operand_level > hbound (operand, 1) 5337 then goto too_deep; 5338 5339 output_word (output_pos) = jump; 5340 5341 fn_done: 5342 output_pos = output_pos + 1; 5343 5344 fn_thru: 5345 operand (operand_level) = (36)"0"b; 5346 operand_type (operand_level) = k; 5347 5348 operand_in_register (0), operand_in_register (1), operand_in_register (2) = 0; 5349 5350 operand_in_register (k) = operand_level; 5351 5352 return; 5353 5354 /* single numeric argument */ 5355 5356 fn_xeq (6): 5357 fn_xeq (2): 5358 fn_xeq (4): 5359 call register_load (0, operand_level); 5360 5361 goto fn_put; 5362 5363 /* single string argument */ 5364 5365 fn_xeq (3): 5366 call register_load (1, operand_level); 5367 5368 if operand_in_register (0) ^= 0 5369 then call save_register (0); 5370 5371 goto fn_put; 5372 5373 /* two numeric arguments */ 5374 5375 fn_xeq (7): 5376 if operand_in_register (1) ^= 0 5377 then call save_register (1); 5378 5379 fn_xeq (8): 5380 if operand_type (operand_level - 1) + operand_type (operand_level) ^= 0 5381 then goto numeric_expression_required; 5382 5383 if operand_in_register (0) = operand_level 5384 then call save_register (0); 5385 5386 call load_register (0, operand_level - 1); 5387 5388 output_word (output_pos) = jump; 5389 output_pos = output_pos + 1; 5390 5391 output_word (output_pos) = instructions.load (0) | operand (operand_level); 5392 5393 operand_level = operand_level - 1; 5394 goto fn_done; 5395 5396 /* one file arg, one string arg */ 5397 5398 fn_xeq (9): 5399 call register_load (0, operand_level - 1); 5400 call register_load (1, operand_level); 5401 5402 operand_level = operand_level - 1; 5403 goto fn_put; 5404 5405 /* two string, one numeric arg */ 5406 5407 fn_xeq (10): 5408 call register_load (0, operand_level); 5409 call register_load (1, operand_level - 2); 5410 5411 if operand_type (operand_level - 1) = 0 5412 then goto string_expression_required; 5413 5414 output_word (output_pos) = instructions.load (3) | operand (operand_level - 1); 5415 output_pos = output_pos + 1; 5416 5417 operand_level = operand_level - 2; 5418 goto fn_put; 5419 5420 /* one string arg, two numeric args */ 5421 5422 fn_xeq (11): 5423 call register_load (0, operand_level - 1); 5424 call register_load (1, operand_level - 2); 5425 5426 if operand_type (operand_level) ^= 0 5427 then goto numeric_expression_required; 5428 5429 output_word (output_pos) = jump; 5430 output_pos = output_pos + 1; 5431 5432 output_word (output_pos) = instructions.load (0) | operand (operand_level); 5433 5434 operand_level = operand_level - 2; 5435 goto fn_done; 5436 5437 /* variable number of arguments */ 5438 5439 fn_xeq (12): 5440 do i = 0 to 2; 5441 if operand_in_register (i) ^= 0 5442 then call save_register (i); 5443 end; 5444 5445 output_word (output_pos) = instructions.load (4) | bit (fixed (nargs, 18), 18); 5446 output_word (output_pos + 1) = jump; 5447 output_pos = output_pos + 2; 5448 5449 do i = 1 to nargs; 5450 output_word (output_pos) = 5451 instructions.load (operand_type (operand_level - nargs + i)) | operand (operand_level - nargs + i); 5452 output_pos = output_pos + 1; 5453 end; 5454 5455 operand_level = operand_level - nargs + 1; 5456 goto fn_thru; 5457 5458 /* matrix function */ 5459 5460 fn_xeq (13): 5461 goto fn_not_yet; 5462 5463 /* tab and spc functions */ 5464 5465 fn_xeq (14): 5466 goto function_not_allowed; 5467 5468 fn_xeq (16): 5469 /* Presently only used for left$ and right$*/ 5470 /* Error checks to be added */ 5471 5472 /* string argument */ 5473 5474 if operand_type (operand_level - 1) = 0 then goto string_expression_required; 5475 call register_load (1, operand_level - 1); 5476 5477 /* numeric argument */ 5478 5479 if operand_type (operand_level) ^= 0 then goto numeric_expression_required; 5480 call register_load (0, operand_level); 5481 5482 output_word (output_pos) = jump; 5483 output_pos = output_pos + 1; 5484 5485 output_word (output_pos) = instructions.load (0) | operand (operand_level); 5486 5487 operand_level = operand_level - 1; 5488 goto fn_done; 5489 5490 fn_xeq (17): 5491 5492 /* used for pos(a$,b$,[i]) */ 5493 5494 if nargs = 3 then do; 5495 /* Old case of s.ssn */ 5496 goto fn_xeq (10); 5497 end; 5498 else if nargs = 2 then do; 5499 /* create the necessary extra arg for basic_operators_ */ 5500 if single then do; 5501 /* load immediate constant 1 */ 5502 val = unspec (one); 5503 word = substr (val, 1, 18)||"000000000000000011"b; 5504 end; 5505 else do; 5506 /* double precision constant must go in pool */ 5507 d_value = 1; 5508 5509 5510 do i = 1 to divide (number_of_constants, 2, 17, 0); 5511 if addr (d_constants (i)) -> based_double = addr (d_value) -> based_double 5512 then go to d_ok_1; /* can't compare possible ascii as float bin */ 5513 end; /* check for max_number_of_constants only at end */ 5514 5515 i = divide (number_of_constants + 3, 2, 17, 0); 5516 number_of_constants = i * 2; 5517 d_constants (i) = d_value; 5518 5519 d_ok_1: 5520 word = basic_data$constant_prototype 5521 | bit (fixed ((i - 1) * 2 + size (basic_program_header), 18), 18); 5522 end; 5523 output_word(output_pos) = word|instructions.load(0); 5524 output_pos = output_pos + 1; 5525 call register_load (1, operand_level - 1); 5526 if operand_type (operand_level) = 0 then goto string_expression_required; 5527 5528 output_word (output_pos) = operand (operand_level)|instructions.load (3) ; 5529 output_pos = output_pos + 1; 5530 5531 operand_level = operand_level - 1; 5532 goto fn_put; 5533 end; 5534 else do; 5535 goto wrong_number_of_args; 5536 end; 5537 5538 5539 fn_not_yet: 5540 call error_name (86, this_token.name); 5541 goto abort_statement; 5542 end; 5543 5544 /* This procedure returns the offset, with respect to current value 5545* of the location counter output_pos, of the location of the 5546* user defined function specified by global variable token_pt. 5547* If the function is a parameter, the global variable function_is_parameter 5548* is set and the appropriate parameter address is returned. */ 5549 5550 5551 user_function_loc: 5552 proc returns (bit (36) aligned); 5553 5554 /* NOTE: we assume that reference to function is from next 5555* location in object segment */ 5556 5557 function_is_parameter = (fn_table.address (this_token.number) & prototype_mask) = basic_data$param_prototype; 5558 5559 if function_is_parameter 5560 then return (fn_table.address (this_token.number)); 5561 5562 loc = fn_table.address (this_token.number); 5563 5564 if loc 5565 then loc = bit (fixed (fixed (loc, 18) - output_pos + 262144, 18), 18); 5566 else do; 5567 loc = fn_table.usage (this_token.number); 5568 fn_table.usage (this_token.number) = bit (output_pos, 18); 5569 end; 5570 5571 return (loc | ic (0)); 5572 end; 5573 5574 /* This procedure compiles code to call a user-defined function; 5575* it is called after the closing ")" has been found with all of 5576* the operand on the operand stack. The operand stack stack 5577* is peeled back so that only function value is left. */ 5578 5579 user_function: 5580 proc (tp, nargs); 5581 5582 dcl tp ptr, /* points at token for function name */ 5583 nargs fixed bin; /* number of args on operand stack */ 5584 5585 dcl (i, k) fixed bin; 5586 5587 token_pt = tp; 5588 5589 do i = 0 to 2; 5590 if operand_in_register (i) ^= 0 5591 then call save_register (i); 5592 end; 5593 5594 /* generate calling sequence header and skip spot for function call word */ 5595 5596 output_word (output_pos) = instructions.function_call (0) | user_function_loc (); 5597 5598 if (fn_table.address (this_token.number) & prototype_mask) = basic_data$param_prototype 5599 then output_word (output_pos + 1) = instructions.function_call (2); 5600 else output_word (output_pos + 1) = instructions.function_call (1); 5601 5602 output_pos = output_pos + 3; 5603 5604 string (fn_call_word) = bit (fixed (nargs, 5), 5); 5605 5606 if this_token.number < 0 5607 then fn_call_word.mode = "1"b; 5608 5609 do i = 1 to nargs; 5610 k = operand_type (operand_level - nargs + i); 5611 5612 output_word (output_pos) = instructions.load (k) | operand (operand_level - nargs + i); 5613 output_pos = output_pos + 1; 5614 5615 if k ^= 0 5616 then fn_call_word.arg (i) = "1"b; 5617 end; 5618 5619 output_word (output_pos - nargs - 1) = string (fn_call_word); 5620 5621 k = fixed (substr (this_token.type, 2, 1), 1); 5622 operand_level = operand_level - nargs + 1; 5623 operand_type (operand_level) = k; 5624 5625 operand_in_register (0), operand_in_register (1), operand_in_register (2) = 0; 5626 operand_in_register (k) = operand_level; 5627 end; 5628 5629 /* This procedure is called to process an input list for INPUT 5630* or LINPUT statements. It processes a list of references 5631* separated by commas. Argument "type" is 0 if any type of 5632* reference is allowed and 1 if only strings reference are 5633* valid; argument "seq" gives the operator to use; and 5634* argument "input_stm" indicates if we are doing INPUT. */ 5635 5636 input_list: 5637 proc (type, seq, input_stm); 5638 5639 dcl type fixed bin, /* type of reference allowed */ 5640 seq (0:1) bit (36) aligned, 5641 input_stm bit (1) aligned; 5642 5643 list: 5644 call reference; 5645 5646 /* at this point, operand_level must be 1 */ 5647 5648 if operand_type (1) < type 5649 then goto string_reference_required; 5650 5651 output_word (output_pos) = seq (operand_type (1)); 5652 output_pos = output_pos + 1; 5653 5654 if operand_type (1) = 0 5655 then do; 5656 output_word (output_pos) = instructions.store (operand_type (1)) | operand (1); 5657 output_pos = output_pos + 1; 5658 end; 5659 else do; 5660 output_word (output_pos) = instructions.string_assign (0) | operand (1); 5661 output_word (output_pos + 1) = instructions.string_assign (1); 5662 output_pos = output_pos + 2; 5663 end; 5664 5665 operand_level = 0; 5666 5667 if substr (tokens (current_token).name, 1, 4) = ", " 5668 then do; 5669 current_token = current_token + 1; 5670 5671 if current_token ^= number_of_tokens 5672 then goto list; 5673 5674 if ^input_stm 5675 then goto incorrect_format; 5676 5677 return; 5678 end; 5679 5680 if input_stm 5681 then do; 5682 output_word (output_pos) = instructions.end_input; 5683 output_pos = output_pos + 1; 5684 end; 5685 5686 end; 5687 5688 /* Procedure "optional_file" is called when a file expression 5689* is allowed but not required. Entry "required_file" is 5690* called when a file expression is mandatory. */ 5691 5692 optional_file: 5693 proc; 5694 5695 if substr (tokens (current_token).name, 1, 4) ^= "# " 5696 then output_word (output_pos) = instructions.use_tty; 5697 else do; 5698 get_file: 5699 current_token = current_token + 1; 5700 call expression_in_register (0); 5701 5702 if substr (tokens (current_token).name, 1, 4) = ": " 5703 then current_token = current_token + 1; 5704 else if current_token ^= number_of_tokens 5705 then goto missing_colon; 5706 5707 output_word (output_pos) = instructions.use_file; 5708 5709 operand_level = operand_level - 1; 5710 operand_in_register (0) = 0; 5711 end; 5712 5713 output_pos = output_pos + 1; 5714 5715 return; 5716 5717 required_file: 5718 entry; 5719 5720 if substr (tokens (current_token).name, 1, 4) ^= "# " 5721 then goto file_expression_required; 5722 5723 goto get_file; 5724 end; 5725 5726 /* This procedure is called to process an expression appearing 5727* in a PRINT-type of statement. */ 5728 5729 put_expression: 5730 proc (seq); 5731 5732 dcl seq (0:1) bit (36) aligned; 5733 5734 call expression_in_register (-1); 5735 5736 /* at this point, operand_level must be 1 */ 5737 5738 output_word (output_pos) = seq (operand_type (1)); 5739 output_pos = output_pos + 1; 5740 5741 operand_in_register (operand_type (1)) = 0; 5742 operand_level = 0; 5743 5744 end; 5745 5746 /* This procedure is called to process the argument and local 5747* lists in a function definition. It verifys that the arg|local 5748* is valid, updates arg|local count, and saves addressing info 5749* about global variable with same name as arg|local. It returns 5750* with current_token pointing at token after last arg|local. */ 5751 5752 arg_or_local: 5753 proc; 5754 5755 do while ("1"b); 5756 token_pt = addr (tokens (current_token)); 5757 5758 if (this_token.type & is_variable) = "0"b 5759 then goto invalid_arg_list; 5760 5761 /* check if same name used previously in this arg | local list */ 5762 5763 if (scalars (this_token.number) & prototype_mask) = arg_prototype 5764 then goto invalid_arg_list; 5765 5766 al_count = al_count + 1; 5767 if al_count > hbound (save.number, 1) 5768 then goto invalid_arg_list; 5769 5770 save.number (al_count) = this_token.number; /* save the number and address of the global scalar variable 5771* with same name as argument or local */ 5772 5773 save.address (al_count) = scalars (this_token.number); 5774 5775 /* define the argument or local */ 5776 5777 scalars (this_token.number) = arg_prototype | bit (fixed (al_count * precision_lng, 18), 18); 5778 5779 current_token = current_token + 1; 5780 5781 if substr (tokens (current_token).name, 1, 4) ^= ", " 5782 then return; 5783 5784 current_token = current_token + 1; 5785 end; 5786 end; 5787 5788 /* This procedure is called at the end of a function definition. */ 5789 5790 fn_cleanup: 5791 proc; 5792 5793 i = fixed (substr (fn_table.address (fn_name), 1, 18), 18); 5794 output_word (output_pos) = 5795 instructions.function_return (0) | bit (fixed (i - output_pos + 262144, 18), 18) | ic (0); 5796 output_word (output_pos + 1) = instructions.function_return (1); 5797 output_pos = output_pos + 2; 5798 5799 /* fill in jump around function body */ 5800 5801 substr (output_word (i - 1), 1, 18) = bit (fixed (output_pos - i + 1, 18), 18); 5802 5803 /* restore all arguments and locals */ 5804 5805 do i = 1 to al_count; 5806 scalars (save.number (i)) = save.address (i); 5807 end; 5808 5809 fn_name = 0; 5810 5811 call scan_missing_list; 5812 missing_pt = addr (missing_table (0)); 5813 5814 temps_pt = addr (normal_temps); 5815 5816 modifier = normal_modifier; 5817 end; 5818 5819 /* This procedure generates code to do matrix constants or matrix 5820* functions, it expectes the matrix constant or function to be 5821* the third token in the statement. */ 5822 5823 matrix_function: 5824 proc; 5825 5826 dcl m fixed bin; 5827 5828 if basic_data$functions (tokens (3).number).class = matrix_constant 5829 then do; 5830 current_token = 4; 5831 call optional_redimension; 5832 operand_level = operand_level - 1; 5833 end; 5834 else do; 5835 if substr (tokens (4).name, 1, 4) ^= "( " 5836 then goto incorrect_format; 5837 5838 token_pt = addr (tokens (5)); 5839 5840 if this_token.number > 26 5841 then goto numeric_matrix_required; 5842 if (this_token.type & is_numeric) = "0"b 5843 then goto numeric_matrix_required; 5844 5845 if substr (tokens (6).name, 1, 4) ^= ") " 5846 then goto incorrect_format; 5847 5848 if substr (tokens (3).name, 1, 4) = "inv " 5849 then m = 2; 5850 else m = -2; 5851 5852 call dimension_array (m, 11, 11); 5853 5854 output_word (output_pos) = instructions.load (1) | modifier | array_pt -> array.address; 5855 output_pos = output_pos + 1; 5856 5857 token_pt = addr (tokens (1)); 5858 call dimension_array (array_pt -> array.dimensions, 11, 11); 5859 5860 output_word (output_pos) = instructions.load (2) | modifier | array_pt -> array.address; 5861 output_pos = output_pos + 1; 5862 5863 current_token = 7; 5864 end; 5865 5866 output_word (output_pos) = basic_data$functions (tokens (3).number).run_time; 5867 output_pos = output_pos + 1; 5868 end; 5869 5870 /* This procedure is called to push a reference to a matrix onto 5871* the operand stack. The argument indicates if re-dimensioning 5872* is allowed. */ 5873 5874 matrix_reference: 5875 proc (redim_allowed); 5876 5877 dcl redim_allowed bit (1) aligned; 5878 5879 token_pt = addr (tokens (current_token)); 5880 5881 if (this_token.type & is_variable) = "0"b 5882 then goto some_matrix_required; 5883 5884 current_token = current_token + 1; 5885 5886 call optional_redimension; 5887 5888 if have_redim & ^redim_allowed 5889 then goto redim_not_allowed; 5890 5891 operand (operand_level) = basic_data$array_prototype; 5892 operand_type (operand_level) = fixed (substr (this_token.type, 2, 1), 1); 5893 end; 5894 5895 /* This procedure is called when matrix re-dimensioning is allowed 5896* but is not required. If re-dimensioning is not present, 5897* code is generated to load the addressing register with a pointer 5898* to the matrix, this simplifies the interface with matrix operators. */ 5899 5900 optional_redimension: 5901 proc; 5902 5903 if substr (tokens (current_token).name, 1, 4) = "( " 5904 then call redimension_matrix; 5905 else do; 5906 have_redim = "0"b; 5907 call dimension_array (-1, 11, 11); 5908 5909 output_word (output_pos) = instructions.load (2) | modifier | array_pt -> array.address; 5910 output_pos = output_pos + 1; 5911 5912 operand_level = operand_level + 1; 5913 end; 5914 end; 5915 5916 /* This procedure generates code to do matrix re-dimensionsing */ 5917 5918 redimension_matrix: 5919 proc; 5920 5921 call subscript_list; 5922 call dimension_array (number_of_dims, 11, 11); 5923 call array_op (instructions.redimension, number_of_dims); 5924 5925 have_redim = "1"b; 5926 5927 end; 5928 5929 /* This procedure processes a list of matrix references for the 5930* MAT INPUT and MAT LINPUT statements. If called for a MAT INPUT 5931* statement, each mat_input operator is followed by a word which 5932* is zero only for last array in list; this word is used to control 5933* automatic redimensioning of last vector in list. */ 5934 5935 mat_input_list: 5936 proc (type, seq, input_stm); 5937 5938 dcl type fixed bin, /* type of reference allowed */ 5939 seq (0:1) bit (36) aligned, 5940 input_stm bit (1) aligned; 5941 5942 dcl last_mat_input_word fixed bin; 5943 5944 last_mat_input_word = 0; 5945 5946 list: 5947 call matrix_reference ("1"b); 5948 5949 /* at this point operand_level must be 1 */ 5950 5951 if operand_type (1) < type 5952 then goto string_matrix_required; 5953 5954 /* address of matrix is already in address register */ 5955 5956 output_word (output_pos) = seq (operand_type (1)); 5957 output_pos = output_pos + 1; 5958 5959 if seq (0) = instructions.mat_input (0) 5960 then do; 5961 last_mat_input_word = output_pos; 5962 output_word (output_pos) = have_redim || (35)"1"b; 5963 output_pos = output_pos + 1; 5964 end; 5965 5966 operand_level = 0; 5967 5968 if substr (tokens (current_token).name, 1, 4) = ", " 5969 then do; 5970 current_token = current_token + 1; 5971 5972 if current_token ^= number_of_tokens 5973 then goto list; 5974 5975 if ^input_stm 5976 then goto incorrect_format; 5977 end; 5978 else if input_stm 5979 then do; 5980 output_word (output_pos) = instructions.end_input; 5981 output_pos = output_pos + 1; 5982 end; 5983 5984 if last_mat_input_word ^= 0 5985 then if output_word (last_mat_input_word) ^= (36)"1"b 5986 then output_word (last_mat_input_word) = (36)"0"b; 5987 5988 end; 5989 5990 /* This procedure is called when a reference to a numeric list 5991* is required, by CHANGE statement for example. It pushes 5992* pointer to array onto operand stack. */ 5993 5994 numeric_list_reference: 5995 proc; 5996 5997 token_pt = addr (tokens (current_token)); 5998 5999 if this_token.type ^= numeric_variable_token 6000 then goto numeric_list_required; 6001 6002 current_token = current_token + 1; 6003 6004 if substr (tokens (current_token).name, 1, 4) = "( " 6005 then goto incorrect_format; 6006 6007 call dimension_array (-1, 11, 11); 6008 6009 operand_level = operand_level + 1; 6010 6011 operand (operand_level) = array_pt -> array.address | modifier; 6012 operand_type (operand_level) = 0; 6013 6014 end; 6015 6016 /* This procedure generates code to evaluate a matrix expression. 6017* The token indices of the operands of the matrix operator "op" 6018* are given by the global array "mop". */ 6019 6020 matrix_op: 6021 proc (op); 6022 6023 dcl op bit (36) aligned; 6024 6025 /* be sure number is in range to avoid out_of_bounds because of constants, etc. */ 6026 6027 if tokens (mop (1)).number > 26 6028 then go to matrix_required (matrix_type); 6029 ap (1) = addr (arrays (tokens (mop (1)).number)); 6030 if tokens (mop (2)).number > 26 6031 then go to matrix_required (matrix_type); 6032 ap (2) = addr (arrays (tokens (mop (2)).number)); 6033 6034 number_of_dims = max (ap (1) -> array.dimensions, ap (2) -> array.dimensions); 6035 6036 if mop (3) ^= 0 6037 then do; 6038 ap (3) = addr (arrays (tokens (mop (3)).number)); 6039 number_of_dims = max (number_of_dims, ap (3) -> array.dimensions); 6040 end; 6041 6042 if number_of_dims = 0 6043 then number_of_dims = 2; 6044 6045 do i = 1 to 2; 6046 call matrix_operand (i, number_of_dims); 6047 end; 6048 6049 if mop (3) ^= 0 6050 then call matrix_operand (3, number_of_dims); 6051 6052 output_word (output_pos) = op; 6053 output_pos = output_pos + 1; 6054 6055 end; 6056 6057 /* This procedure is called to process a matrix used as operand 6058* of a matrix operator. The argument "num" gives location of 6059* the token index in "mop" array, "dims" gives number of dimensions 6060* to use. */ 6061 6062 matrix_operand: 6063 proc (num, dims); 6064 6065 dcl (num, dims) fixed bin; 6066 6067 token_pt = addr (tokens (mop (num))); 6068 6069 if this_token.type ^= tokens (1).type 6070 then goto matrix_required (matrix_type); 6071 if this_token.number > 26 6072 then goto matrix_required (matrix_type); 6073 6074 call dimension_array (dims, 11, 11); 6075 6076 output_word (output_pos) = instructions.load (num) | modifier | array_pt -> array.address; 6077 output_pos = output_pos + 1; 6078 end; 6079 6080 end; /* of compile_statement */ 6081 6082 /* This procedure issues an error message for each line in the 6083* missing lines table */ 6084 6085 scan_missing_list: 6086 proc; 6087 6088 dcl (i, j, m) fixed bin, 6089 p ptr; 6090 6091 m = 0; 6092 do i = 1 to missing.count; 6093 j = missing.number (i); 6094 6095 if m = 0 6096 then do; 6097 m = output_pos; 6098 output_word (output_pos) = instructions.error (2); 6099 output_pos = output_pos + 1; 6100 end; 6101 6102 do loc = missing.chain (i) repeat (next_loc) while (loc); 6103 p = addrel (output_pt, loc); 6104 next_loc = p -> half (0).left; 6105 6106 p -> half (0).left = bit (fixed (m - fixed (loc, 18), 18), 18); 6107 6108 call error_number_line (-81, j, get_line_number ()); 6109 end; 6110 end; 6111 end; /* of scan_missing_line */ 6112 6113 /* This function returns the source line number that corresponds 6114* to the object code location specified by the global variable loc. */ 6115 6116 get_line_number: 6117 proc returns (fixed bin); 6118 6119 dcl (k, lower, upper) fixed bin, 6120 divide builtin; 6121 6122 lower = 1; 6123 upper = number_of_lines; 6124 6125 do while (lower <= upper); 6126 k = divide (upper + lower, 2, 17, 0); 6127 6128 if loc >= "0"b || line (k).location 6129 then if loc < "0"b || line (k + 1).location 6130 then return (line (k).number); 6131 else lower = k + 1; 6132 else upper = k - 1; 6133 6134 end; 6135 6136 return (-1); 6137 end; /* of get_line_number */ 6138 6139 /* Program to wrap-up single subprogram in compilation 6140* 6141* Initial Version: 15 February 1973 by BLW */ 6142 6143 finish_subprogram: 6144 proc; 6145 6146 dcl (constant_pos, i, k, m, end_pos) 6147 fixed bin (18), 6148 string_start fixed bin (18) unsigned, 6149 p ptr, 6150 name char (8) aligned; 6151 6152 dcl (size, string) builtin; 6153 6154 /* issue warning about undefined lines */ 6155 6156 call scan_missing_list; 6157 6158 /* make sure all for loops are properly closed */ 6159 6160 m = 0; 6161 do i = 1 to for_level; 6162 loc = bit (for_location (i), 18); 6163 call error_line (-79, get_line_number ()); 6164 6165 if m = 0 6166 then do; 6167 m = output_pos; 6168 output_word (output_pos) = instructions.error (3); 6169 output_pos = output_pos + 1; 6170 end; 6171 6172 p = addrel (output_pt, loc); 6173 6174 if for_type (i) ^= 0 6175 then p -> half (3).left = bit (fixed (m - (for_location (i) + 3), 18), 18); 6176 else do; 6177 p -> half (5).left = bit (fixed (m - (for_location (i) + 5), 18), 18); 6178 p -> half (8).left = bit (fixed (m - (for_location (i) + 8), 18), 18); 6179 end; 6180 6181 end; 6182 6183 /* make sure all functions have been defined */ 6184 6185 m = 0; 6186 do i = lbound (fn_table, 1) to hbound (fn_table, 1); 6187 loc = fn_table.usage (i); 6188 6189 if loc 6190 then do; 6191 name = "fn" || substr ("abcdefghijklmnopqrstuvwxyz", abs (i), 1); 6192 if i < 0 6193 then substr (name, 4, 1) = "$"; 6194 6195 if m = 0 6196 then do; 6197 m = output_pos; 6198 output_word (output_pos) = instructions.error (4); 6199 output_pos = output_pos + 1; 6200 end; 6201 6202 do while (loc); 6203 p = addrel (output_pt, loc); 6204 next_loc = p -> half (0).left; 6205 6206 p -> half (0).left = bit (fixed (m - fixed (loc, 18), 18), 18); 6207 6208 call error_name_line (-80, name, get_line_number ()); 6209 6210 loc = next_loc; 6211 end; 6212 end; 6213 end; 6214 6215 end_pos = output_pos; 6216 6217 /* Check for too many constants. If there are, truncate the 6218* constant storage and keep compiling, but generate an error. */ 6219 6220 if number_of_constants > max_number_of_constants 6221 then do; 6222 call error_no_line (-169); 6223 number_of_constants = max_number_of_constants; 6224 call hcs_$truncate_seg (output_pointer, bin (rel (constant_ptr), 18) + max_number_of_constants, code); 6225 end; 6226 6227 /* make sure code always starts on even word boundary */ 6228 6229 if mod (number_of_constants, 2) ^= 0 6230 then number_of_constants = number_of_constants + 1; 6231 6232 /* Copy instructions into text following constants and relocate the entry sequence. */ 6233 /* The instructions were generated in a temporary segment. 6234* output_pt->output_word refers to the temp seg while the instructions are being generated 6235* ant to the "real" output segment the rest of the time. 6236* The location counter output_pos is always correct except for the count of constants; 6237* it is relocated as soon as the number of constants is known and the 6238* instructions have been copied into the "real" output segment. 6239* program_header_pt always points to the program header in the "real" output segment. 6240* */ 6241 6242 6243 block_size = output_pos - first_code_word; 6244 addr (constants (number_of_constants + 1)) -> block = addr (output_word (first_code_word)) -> block; 6245 6246 output_pt = output_pointer; /* reset to real text */ 6247 6248 output_pos = output_pos + number_of_constants; 6249 last_instruction = output_pos - 1; 6250 6251 entry_pos (program_number) = entry_pos (program_number) + number_of_constants; 6252 entry_pt = addrel (output_pointer, entry_pos (program_number)); 6253 if program_number = 1 6254 then main_pt = addr (entry_pt -> basic_entry.word_1); 6255 basic_program_header.incoming_args.location = 6256 bit (fixed (fixed (basic_program_header.incoming_args.location, 18) + number_of_constants, 18), 18); 6257 6258 end_pos = end_pos + number_of_constants; 6259 6260 /* copy data (if any) into end of text */ 6261 6262 if numeric_data_count ^= 0 6263 then do; 6264 if precision_lng = 2 6265 then if mod (output_pos, 2) ^= 0 6266 then output_pos = output_pos + 1; 6267 basic_program_header.numeric_data.location = 6268 bit (bin (output_pos - header_pos (program_number), 18), 18); 6269 6270 block_size = numeric_data_count * precision_lng; 6271 basic_program_header.numeric_data.number = bit (block_size, 18); 6272 6273 addrel (output_pt, output_pos) -> block = addr (numeric_data (1)) -> block; 6274 6275 output_pos = output_pos + block_size; 6276 end; 6277 6278 if string_data_count ^= 0 6279 then do; 6280 basic_program_header.string_data.location = 6281 bit (bin (output_pos - header_pos (program_number), 18), 18); 6282 6283 basic_program_header.string_data.number = bit (string_data_count, 18); 6284 6285 block_size = string_data_count; 6286 addrel (output_pt, output_pos) -> block = addr (string_data (1)) -> block; 6287 output_pos = output_pos + block_size; 6288 end; 6289 6290 /* assign storage to all numeric arrays */ 6291 6292 if precision_lng = 2 6293 then if mod (auto_ctr (0), 2) ^= 0 6294 then auto_ctr (0) = auto_ctr (0) + 1; 6295 6296 string (basic_program_header.numeric_arrays) = process_arrays (1); 6297 6298 6299 string_start = auto_ctr (0); 6300 6301 basic_program_header.numeric_storage.location = "000000000010000000"b; 6302 basic_program_header.numeric_storage.number = bit (fixed (auto_ctr (0) - 128, 18), 18); 6303 6304 /* include string storage at end of numeric storage and then allocate all 6305* string arrays */ 6306 6307 auto_ctr (0) = auto_ctr (0) + auto_ctr (1); 6308 6309 string (basic_program_header.string_arrays) = process_arrays (-1); 6310 6311 /* Be sure that numeric plus string storage fits in one segment 6312* (minus one page). This is only for correct compilation; 6313* there is no guarantee that the program can run. 6314* If there is too much, keep compiling anyway. Garbage will be 6315* generated but it's probably safer not to return early. */ 6316 6317 if auto_ctr (0) > max_storage_amount 6318 then call error_no_line (-170); 6319 6320 basic_program_header.string_storage.location = bit (string_start, 18); 6321 basic_program_header.string_storage.number = bit (fixed (auto_ctr (0) - string_start, 18), 18); 6322 6323 6324 6325 /* output symbol tables for scalars */ 6326 6327 string (basic_program_header.numeric_scalars) = process_scalars (1); 6328 6329 string (basic_program_header.string_scalars) = process_scalars (-1); 6330 6331 /* output statement map */ 6332 6333 m = header_pos (program_number); 6334 basic_program_header.statement_map.location = bit (fixed (output_pos - m, 18), 18); 6335 6336 basic_program_header.statement_map.number = bit (number_of_lines, 18); 6337 6338 do i = 1 to number_of_lines; 6339 output_word (output_pos) = 6340 bit (fixed (fixed (line (i).location, 17) - m + number_of_constants, 18), 18) 6341 || unspec (line (i).number); 6342 output_pos = output_pos + 1; 6343 end; 6344 6345 /* put dummy at end of map */ 6346 6347 output_word (output_pos) = bit (end_pos, 18) || (18)"1"b; 6348 output_pos = output_pos + 1; 6349 6350 if single 6351 then basic_program_header.version_number = 2; 6352 else basic_program_header.version_number = -2; 6353 6354 basic_program_header.precision_ind = precision_lng - 1; 6355 6356 /* fill in entry sequence which comes immediately after 6357* program header */ 6358 6359 k = mod (auto_ctr (0), 16); 6360 if k ^= 0 6361 then auto_ctr (0) = auto_ctr (0) + 16 - k; 6362 6363 entry_pt -> basic_entry.stack_size = bit (fixed (auto_ctr (0), 18), 18); 6364 entry_pt -> basic_entry.eax_7 = "110010111000000000"b; 6365 entry_pt -> basic_entry.word_2 = "111000000000101000011101010001010000"b; 6366 /* eapbp sb|50 (octal),* */ 6367 entry_pt -> basic_entry.header = header_pos (program_number) - entry_pos (program_number); 6368 6369 /* This function assigns storage to all non-parameter arrays and 6370* generates array_symbol blocks for these arrays. The value of 6371* the function is the location and number of generated blocks. */ 6372 6373 process_arrays: 6374 proc (which) returns (bit (36) aligned); 6375 6376 dcl which fixed bin (3); /* 1 numeric, -1 string */ 6377 6378 dcl (num, amount, i) fixed bin (18), 6379 loc bit (18), 6380 (ap, tp) ptr; 6381 6382 loc = bit (bin (output_pos - bin (rel (program_header_pt), 18), 18), 18); 6383 num = 0; 6384 6385 do i = 1 to hbound (arrays, 1); 6386 ap = addr (arrays (which * i)); 6387 if ap -> array.address 6388 then do; 6389 tp = addrel (output_pt, output_pos); 6390 6391 tp -> array_symbol.name = substr (alphanumeric, i, 1); 6392 tp -> array_symbol.location = "00"b || substr (ap -> array.address, 4, 15); 6393 6394 amount, tp -> array_symbol.bounds (1) = ap -> array.bounds (1); 6395 6396 tp -> array_symbol.bounds (2) = ap -> array.bounds (2); 6397 6398 if tp -> array_symbol.bounds (2) >= 0 6399 then amount = amount * tp -> array_symbol.bounds (2); 6400 6401 tp -> array_symbol.parameter = 6402 (ap -> array.address & prototype_mask) = basic_data$param_prototype; 6403 6404 if ^tp -> array_symbol.parameter 6405 then do; 6406 tp -> array_symbol.offset = auto_ctr (0); 6407 auto_ctr (0) = auto_ctr (0) + amount * precision_lng; 6408 end; 6409 6410 num = num + 1; 6411 output_pos = output_pos + size (array_symbol); 6412 end; 6413 end; 6414 6415 if num = 0 6416 then return ((36)"0"b); 6417 6418 output_word (output_pos) = "0"b; 6419 output_pos = output_pos + 1; 6420 6421 return (loc || bit (num, 18)); 6422 end; 6423 6424 /* This function generates a scalar_symbol word in the object segment 6425* for every scalar symbol used in the subprogram. The value of 6426* the function is the location and number of generated words. */ 6427 6428 process_scalars: 6429 proc (which) returns (bit (36) aligned); 6430 6431 dcl which fixed bin (3); /* 1 numeric, -1 string */ 6432 6433 dcl (num, i, k1, k2) fixed bin (18), 6434 loc bit (18), 6435 (tp, sp) ptr; 6436 6437 loc = bit (bin (output_pos - bin (rel (program_header_pt), 18), 18), 18); 6438 num = 0; 6439 6440 do i = 1 to hbound (scalars, 1); 6441 sp = addr (scalars (which * i)); 6442 if sp -> scalar 6443 then do; 6444 tp = addrel (output_pt, output_pos); 6445 6446 if i < 27 6447 then tp -> scalar_symbol.name = substr (alphanumeric, i, 1); 6448 else do; 6449 6450 k1 = divide (i, 26, 17, 0); 6451 k2 = i - 26 * k1; 6452 6453 substr (tp -> scalar_symbol.name, 1, 1) = substr (alphanumeric, k2, 1); 6454 substr (tp -> scalar_symbol.name, 2, 1) = substr (digits, k1, 1); 6455 end; 6456 6457 tp -> scalar_symbol.location = "00"b || substr (sp -> scalar, 4, 15); 6458 6459 /* relocate address of strings */ 6460 6461 if which < 0 6462 then tp -> scalar_symbol.location = 6463 bit (fixed (fixed (tp -> scalar_symbol.location, 17) + string_start, 17), 17); 6464 6465 tp -> scalar_symbol.parameter = (sp -> scalar & prototype_mask) = basic_data$param_prototype; 6466 6467 num = num + 1; 6468 output_pos = output_pos + size (scalar_symbol); 6469 end; 6470 end; 6471 6472 if num = 0 6473 then return ((36)"0"b); 6474 6475 return (loc || bit (num, 18)); 6476 end; 6477 6478 end; /* of finish_subprogram */ 6479 6480 /* This procedure generates a Multics standard object segment */ 6481 6482 finish_object: 6483 proc; 6484 6485 dcl (def_start, def_pos, link_start, sym_start, sym_pos, constant_pos, i, j, k, m, n, end_pos) 6486 fixed bin (18), 6487 name_lng fixed bin (17), 6488 (def_base, link_base, sym_base, p, lib_list_pt) 6489 ptr, 6490 user_id char (32), 6491 based_name char (name_lng) based (lib_name_pt), 6492 (zero_def, seg_def, last_def, b18) 6493 aligned bit (18); 6494 6495 dcl (size, string) builtin; 6496 6497 dcl 1 saved_lib_list aligned based (lib_list_pt), 6498 2 nlibs fixed bin, 6499 2 names (n refer (nlibs)) aligned, 6500 3 offset bit (18) unaligned, 6501 3 lng fixed bin (17) unaligned; 6502 6503 dcl 1 relinfo aligned based, 6504 2 version fixed binary, 6505 2 rel_bit_count fixed binary, 6506 2 relbits bit (i refer (rel_bit_count)) unaligned; 6507 6508 dcl 1 def_header aligned based, 6509 2 forward unaligned bit (18), 6510 2 backward unaligned bit (18), 6511 2 skip unaligned bit (18), 6512 2 flags unaligned bit (18); 6513 6514 dcl 1 link_header aligned based, 6515 2 word_0 bit (36), 6516 2 word_1 unaligned, 6517 3 def_block bit (18), 6518 3 right bit (18), 6519 2 word_2 bit (36), 6520 2 word_3 bit (36), 6521 2 word_4 bit (36), 6522 2 word_5 bit (36), 6523 2 word_6 unaligned, 6524 3 first_link bit (18), 6525 3 block_length bit (18), 6526 2 word_7 unaligned, 6527 3 skip bit (18), 6528 3 static_length bit (18); 6529 6 1 /* BEGIN INCLUDE FILE definition.incl.pl1 */ 6 2 6 3 6 4 6 5 /****^ HISTORY COMMENTS: 6 6* 1) change(86-05-02,Elhard), approve(86-05-02,MCR7391), 6 7* audit(86-07-18,DGHowe), install(86-11-20,MR12.0-1222): 6 8* Modified to add indirect bit to definition flags. 6 9* END HISTORY COMMENTS */ 6 10 6 11 6 12 dcl 1 definition aligned based, 6 13 2 forward unal bit(18), /* offset of next def */ 6 14 2 backward unal bit(18), /* offset of previous def */ 6 15 2 value unal bit(18), 6 16 2 flags unal, 6 17 3 new bit(1), 6 18 3 ignore bit(1), 6 19 3 entry bit(1), 6 20 3 retain bit(1), 6 21 3 argcount bit(1), 6 22 3 descriptors bit(1), 6 23 3 indirect bit(1), 6 24 3 unused bit(8), 6 25 2 class unal bit(3), 6 26 2 symbol unal bit(18), /* offset of ACC for symbol */ 6 27 2 segname unal bit(18); /* offset of segname def */ 6 28 6 29 /* END INCLUDE FILE definition.incl.pl1 */ 6530 7 1 dcl 1 std_symbol_header based aligned, 7 2 2 dcl_version fixed bin, 7 3 2 identifier char(8), 7 4 2 gen_number fixed bin, 7 5 2 gen_created fixed bin(71), 7 6 2 object_created fixed bin(71), 7 7 2 generator char(8), 7 8 2 gen_version unaligned, 7 9 3 offset bit(18), 7 10 3 size bit(18), 7 11 2 userid unaligned, 7 12 3 offset bit(18), 7 13 3 size bit(18), 7 14 2 comment unaligned, 7 15 3 offset bit(18), 7 16 3 size bit(18), 7 17 2 text_boundary bit(18) unaligned, 7 18 2 stat_boundary bit(18) unaligned, 7 19 2 source_map bit(18) unaligned, 7 20 2 area_pointer bit(18) unaligned, 7 21 2 backpointer bit(18) unaligned, 7 22 2 block_size bit(18) unaligned, 7 23 2 next_block bit(18) unaligned, 7 24 2 rel_text bit(18) unaligned, 7 25 2 rel_def bit(18) unaligned, 7 26 2 rel_link bit(18) unaligned, 7 27 2 rel_symbol bit(18) unaligned, 7 28 2 mini_truncate bit(18) unaligned, 7 29 2 maxi_truncate bit(18) unaligned; 6531 8 1 /* BEGIN INCLUDE FILE ... source_map.incl.pl1 */ 8 2 8 3 dcl 1 source_map aligned based, 8 4 2 version fixed bin, 8 5 2 number fixed bin, 8 6 2 map(n refer(source_map.number)) aligned, 8 7 3 pathname unaligned, 8 8 4 offset bit(18), 8 9 4 size bit(18), 8 10 3 uid bit(36), 8 11 3 dtm fixed bin(71); 8 12 8 13 /* END INCLUDE FILE ... source_map.incl.pl1 */ 6532 9 1 /* BEGIN INCLUDE FILE relbts.incl.pl1 */ 9 2 9 3 /* This include file defines the relocation bits as bit (18) entities. See 9 4* also relocation_bits.incl.pl1 and reloc_lower.incl.pl1. */ 9 5 9 6 dcl ( rc_a initial("0"b), /* absolute */ 9 7 rc_t initial("000000000000010000"b), /* text */ 9 8 rc_nt initial("000000000000010001"b), /* negative text */ 9 9 rc_lp18 initial("000000000000010010"b), /* linkage, 18 bit */ 9 10 rc_nlp18 initial("000000000000010011"b), /* negative link, 18 bit */ 9 11 rc_lp15 initial("000000000000010100"b), /* linkage, 15 bit */ 9 12 rc_dp initial("000000000000010101"b), /* def section */ 9 13 rc_s initial("000000000000010110"b), /* symbol segment */ 9 14 rc_ns initial("000000000000010111"b), /* negative symbol */ 9 15 rc_is18 initial("000000000000011000"b), /* internal static 18 */ 9 16 rc_is15 initial("000000000000011001"b), /* internal static 15 */ 9 17 rc_lb initial("000000000000011000"b), /* link block */ 9 18 rc_nlb initial("000000000000011001"b), /* negative link block */ 9 19 rc_sr initial("000000000000011010"b), /* self relative */ 9 20 rc_e initial("000000000000011111"b)) /* escape */ 9 21 bit(18) internal static options(constant); 9 22 9 23 dcl ( rc_dp_dp initial("000000000000010101000000000000010101"b), /* def section, def section */ 9 24 rc_a_dp initial("000000000000000000000000000000010101"b)) /* absolute, def section */ 9 25 bit(36) internal static options(constant); 9 26 9 27 /* END INCLUDE FILE relbts.incl.pl1 */ 6533 10 1 /* BEGIN INCLUDE FILE ... object_map.incl.pl1 */ 10 2 /* coded February 8, 1972 by Michael J. Spier */ 10 3 /* Last modified on 05/20/72 at 13:29:38 by R F Mabee. */ 10 4 /* Made to agree with Spier's document on 20 May 1972 by R F Mabee. */ 10 5 /* modified on 6 May 1972 by R F Mabee to add map_ptr at end of object map. */ 10 6 /* modified May, 1972 by M. Weaver */ 10 7 /* modified 5/75 by E. Wiatrowski and 6/75 by M. Weaver */ 10 8 /* modified 5/77 by M. Weaver to add perprocess_static bit */ 10 9 10 10 declare 1 object_map aligned based, /* Structure describing standard object map */ 10 11 10 12 2 decl_vers fixed bin, /* Version number of current structure format */ 10 13 2 identifier char (8) aligned, /* Must be the constant "obj_map" */ 10 14 2 text_offset bit (18) unaligned, /* Offset relative to base of object segment of base of text section */ 10 15 2 text_length bit (18) unaligned, /* Length in words of text section */ 10 16 2 definition_offset bit (18) unaligned, /* Offset relative to base of object seg of base of definition section */ 10 17 2 definition_length bit (18) unaligned, /* Length in words of definition section */ 10 18 2 linkage_offset bit (18) unaligned, /* Offset relative to base of object seg of base of linkage section */ 10 19 2 linkage_length bit (18) unaligned, /* Length in words of linkage section */ 10 20 2 static_offset bit (18) unaligned, /* Offset relative to base of obj seg of static section */ 10 21 2 static_length bit (18) unaligned, /* Length in words of static section */ 10 22 2 symbol_offset bit (18) unaligned, /* Offset relative to base of object seg of base of symbol section */ 10 23 2 symbol_length bit (18) unaligned, /* Length in words of symbol section */ 10 24 2 break_map_offset bit (18) unaligned, /* Offset relative to base of object seg of base of break map */ 10 25 2 break_map_length bit (18) unaligned, /* Length in words of break map */ 10 26 2 entry_bound bit (18) unaligned, /* Offset in text of last gate entry */ 10 27 2 text_link_offset bit (18) unaligned, /* Offset of first text-embedded link */ 10 28 2 format aligned, /* Word containing bit flags about object type */ 10 29 3 bound bit (1) unaligned, /* On if segment is bound */ 10 30 3 relocatable bit (1) unaligned, /* On if segment has relocation info in its first symbol block */ 10 31 3 procedure bit (1) unaligned, /* On if segment is an executable object program */ 10 32 3 standard bit (1) unaligned, /* On if segment is in standard format (more than just standard map) */ 10 33 3 separate_static bit(1) unaligned, /* On if static is a separate section from linkage */ 10 34 3 links_in_text bit (1) unaligned, /* On if there are text-embedded links */ 10 35 3 perprocess_static bit (1) unaligned, /* On if static is not to be per run unit */ 10 36 3 unused bit (29) unaligned; /* Reserved */ 10 37 10 38 declare map_ptr bit(18) aligned based; /* Last word of the segment. It points to the base of the object map. */ 10 39 10 40 declare object_map_version_2 fixed bin static init(2); 10 41 10 42 /* END INCLUDE FILE ... object_map.incl.pl1 */ 6534 6535 6536 if lib_count > 0 6537 then do; /* save library list */ 6538 lib_list_pt = addrel (output_pt, output_pos); 6539 saved_lib_list.nlibs, n = lib_count; 6540 lib_name_pt = addrel (lib_list_pt, size (saved_lib_list)); 6541 /* get ptr to end of fixed part of lib list */ 6542 do j = 1 to lib_count; /* fill in names */ 6543 name_lng, saved_lib_list.names (j).lng = length (lib_names (j)); 6544 saved_lib_list.names (j).offset = rel (lib_name_pt); 6545 based_name = substr (lib_names (j), 1, name_lng); 6546 lib_name_pt = addrel (lib_name_pt, divide (name_lng + 3, 4, 17, 0)); 6547 end; 6548 output_pos = fixed (rel (lib_name_pt), 18); 6549 end; 6550 else lib_list_pt = null; 6551 6552 /* generate definition section */ 6553 6554 def_start = output_pos + mod (output_pos, 2); 6555 def_base = addrel (output_pt, def_start); 6556 6557 /* generate definition section header */ 6558 6559 def_base -> def_header.flags = "11"b; /* new, ignore */ 6560 6561 zero_def = "000000000000000010"b; 6562 last_def = (18)"0"b; 6563 6564 def_pos = 3; 6565 6566 call generate_definition (seg_name, 3, zero_def, "0"b); 6567 6568 call generate_definition ("symbol_table", 2, "0"b, "0"b); 6569 6570 addrel (def_base, seg_def) -> definition.segname = last_def; 6571 6572 if lib_list_pt ^= null 6573 then call generate_definition ("library_list_", 0, rel (lib_list_pt), "0"b); 6574 6575 6576 /* generate definitions for all subprograms and fill in descriptor field in entry */ 6577 6578 do j = 1 to program_number; 6579 p = addr (subprogram.name (j)); 6580 6581 if length (p -> based_vs) = 0 6582 then p = addr (seg_name); 6583 6584 call generate_definition (p -> based_vs, 0, bit (fixed (subprogram.entry_pos (j) + 1, 18), 18), "1"b); 6585 6586 p = addrel (output_pt, subprogram.entry_pos (j)); 6587 p -> basic_entry.descriptor = last_def; 6588 p -> basic_entry.flag = "1"b; 6589 6590 program_header_pt = addrel (output_pt, subprogram.header_pos (j)); 6591 6592 if generate_object 6593 then basic_program_header.definitions = 0; 6594 else basic_program_header.definitions = def_start - subprogram.header_pos (j); 6595 end; 6596 6597 /* make forward pointer of last definition point to word of zeros 6598* at end of definition section */ 6599 6600 addrel (def_base, last_def) -> definition.forward = bit (def_pos, 18); 6601 6602 def_pos = def_pos + 1; 6603 6604 if ^generate_object 6605 then return; 6606 6607 /* generate linkage section header */ 6608 6609 link_start = def_start + def_pos + mod (def_pos, 2); 6610 link_base = addrel (output_pt, link_start); 6611 6612 link_base -> link_header.def_block = bit (def_start, 18); 6613 6614 link_base -> link_header.first_link, link_base -> link_header.block_length = "000000000000001000"b; 6615 6616 /* generate symbol section header */ 6617 6618 sym_start = link_start + 8; 6619 6620 sym_base = addrel (output_pt, sym_start); 6621 sym_pos = size (std_symbol_header); 6622 6623 sym_base -> std_symbol_header.dcl_version = 1; 6624 sym_base -> std_symbol_header.identifier = "symbtree"; 6625 sym_base -> std_symbol_header.gen_number = 1; 6626 6627 sym_base -> std_symbol_header.gen_created = addr (basic_$symbol_table) -> std_symbol_header.object_created; 6628 6629 sym_base -> std_symbol_header.object_created = clock_ (); 6630 sym_base -> std_symbol_header.generator = "basic"; 6631 6632 m = index (basic_version_$, NL); 6633 symbol_string = substr (basic_version_$, 1, m - 1); 6634 string (sym_base -> std_symbol_header.gen_version) = store_string (); 6635 6636 call get_group_id_ (user_id); 6637 6638 m = index (user_id, " ") - 1; 6639 if m < 0 6640 then m = length (user_id); 6641 symbol_string = substr (user_id, 1, m); 6642 string (sym_base -> std_symbol_header.userid) = store_string (); 6643 6644 string (sym_base -> std_symbol_header.comment) = (36)"0"b; 6645 sym_base -> std_symbol_header.text_boundary = "000000000000000010"b; 6646 sym_base -> std_symbol_header.stat_boundary = "000000000000000010"b; 6647 6648 /* generate source map (which has to start on even boundary) */ 6649 6650 sym_pos = sym_pos + mod (sym_pos, 2); 6651 6652 sym_base -> std_symbol_header.source_map = bit (sym_pos, 18); 6653 6654 p = addrel (sym_base, sym_pos); 6655 p -> source_map.version = 1; 6656 p -> source_map.number, n = source_number; 6657 6658 sym_pos = sym_pos + size (source_map); 6659 6660 do i = 1 to source_number; 6661 symbol_string = source_map_info (i).pathname; 6662 string (p -> source_map.pathname (i)) = store_string (); 6663 6664 p -> source_map.uid (i) = source_map_info (i).uid; 6665 p -> source_map.dtm (i) = source_map_info (i).dtm; 6666 end; 6667 6668 /* generate relocation bits */ 6669 6670 sym_base -> std_symbol_header.maxi_truncate, sym_base -> std_symbol_header.mini_truncate = bit (sym_pos, 18); 6671 6672 /* text section is entirely absolute except for first word of each 6673* entry sequence which gets definitions relocation */ 6674 6675 sym_base -> std_symbol_header.rel_text = bit (sym_pos, 18); 6676 6677 p = addrel (sym_base, sym_pos); 6678 p -> relinfo.version = 1; 6679 6680 i = 0; 6681 k = 0; 6682 6683 do j = 1 to program_number; 6684 m = 2 * entry_pos (j) - k; /* number of absolute half-words */ 6685 6686 do while (m > 1023); 6687 substr (p -> relbits, i + 1, 15) = "111101111111111"b; 6688 i = i + 15; 6689 m = m - 1023; 6690 end; 6691 6692 substr (p -> relbits, i + 1, 15) = "11110"b || bit (fixed (m, 10), 10); 6693 substr (p -> relbits, i + 16, 5) = "10101"b; /* def reloc */ 6694 6695 i = i + 20; 6696 6697 k = 2 * entry_pos (j) + 1; 6698 end; 6699 6700 if lib_list_pt ^= null 6701 then do; /* generate rel bits for library list */ 6702 m = 2 * (fixed (rel (lib_list_pt), 18) + 1) - k; 6703 /* number of absolute half words */ 6704 do while (m > 1023); 6705 substr (p -> relbits, i + 1, 15) = "111101111111111"b; 6706 i = i + 15; 6707 m = m - 1023; 6708 end; 6709 substr (p -> relbits, i + 1, 15) = "11110"b || bit (fixed (m, 10), 10); 6710 i = i + 15; 6711 do j = 1 to lib_count; /* relocat offset wrt text, lng as absolute */ 6712 substr (p -> relbits, i + 1, 10) = "1"b; 6713 i = i + 10; 6714 end; 6715 end; 6716 6717 6718 p -> rel_bit_count = i; 6719 6720 sym_pos = sym_pos + size (p -> relinfo); 6721 p = addrel (sym_base, sym_pos); 6722 6723 /* relocation bits for definition section can be omitted since 6724* binder never looks at them anyway */ 6725 6726 sym_base -> std_symbol_header.rel_def = bit (sym_pos, 18); 6727 p -> relinfo.version = 1; 6728 p -> rel_bit_count = 0; 6729 6730 sym_pos = sym_pos + 3; 6731 6732 p = addrel (sym_base, sym_pos); 6733 6734 /* relocation bits of linkage header are constant */ 6735 6736 sym_base -> std_symbol_header.rel_link = bit (sym_pos, 18); 6737 p -> relinfo.version = 1; 6738 p -> rel_bit_count = 8; 6739 substr (p -> relbits, 1, 8) = "00100000"b; 6740 6741 sym_pos = sym_pos + 3; 6742 p = addrel (p, 3); 6743 6744 /* symbol section is entirely absolute */ 6745 6746 sym_base -> std_symbol_header.rel_symbol = bit (sym_pos, 18); 6747 p -> relinfo.version = 1; 6748 p -> rel_bit_count = 0; 6749 6750 sym_pos = sym_pos + 3; 6751 6752 sym_base -> std_symbol_header.block_size = bit (sym_pos, 18); 6753 6754 /* generate standard object map */ 6755 6756 n = divide (sym_start + sym_pos + 1, 2, 17, 0) * 2; 6757 p = addrel (output_pt, n); 6758 6759 p -> object_map.decl_vers = 2; 6760 p -> object_map.identifier = "obj_map"; 6761 p -> object_map.text_length = bit (output_pos, 18); 6762 p -> object_map.definition_offset = bit (def_start, 18); 6763 p -> object_map.definition_length = bit (def_pos, 18); 6764 p -> object_map.linkage_offset = bit (link_start, 18); 6765 p -> object_map.linkage_length = "000000000000001000"b; 6766 p -> object_map.static_offset = bit (link_start + 8, 18); 6767 p -> object_map.static_length = "0"b; 6768 p -> object_map.symbol_offset = bit (sym_start, 18); 6769 p -> object_map.symbol_length = bit (sym_pos, 18); 6770 6771 p -> object_map.entry_bound, p -> object_map.text_link_offset = "0"b; 6772 6773 p -> object_map.format.relocatable, p -> object_map.format.procedure, p -> object_map.format.standard = "1"b; 6774 6775 output_pos = n + size (p -> object_map); 6776 if which > 1 6777 then output_length = output_pos + 1; /* include word 0 in length */ 6778 else old_source_info.word_count = output_pos + 1; 6779 6780 ptr (output_pt, output_pos) -> map_ptr = bit (n, 18); 6781 6782 generate_definition: 6783 proc (name, class, value, entry_sw); 6784 6785 dcl name char (32) varying, 6786 class fixed bin (3), 6787 entry_sw bit (1) aligned, 6788 value bit (18) aligned; 6789 6790 dcl n fixed bin (9), 6791 i fixed bin, 6792 (def_ptr, q) ptr; 6793 6794 dcl 1 acc aligned based, 6795 2 count bit (9) unaligned, 6796 2 str char (n) unaligned; 6797 6798 b18 = bit (def_pos, 18); 6799 q = addrel (def_base, def_pos); 6800 6801 n = length (name); 6802 q -> acc.count = bit (n, 9); 6803 q -> acc.str = name; 6804 6805 def_pos = def_pos + size (acc); 6806 6807 def_ptr = addrel (def_base, def_pos); 6808 6809 if last_def 6810 then def_ptr -> definition.backward = last_def; 6811 else def_ptr -> definition.backward = zero_def; 6812 6813 addrel (def_base, last_def) -> definition.forward = bit (def_pos, 18); 6814 6815 def_ptr -> definition.new = "1"b; 6816 def_ptr -> definition.retain = "1"b; 6817 def_ptr -> definition.symbol = b18; 6818 def_ptr -> definition.value = value; 6819 6820 def_ptr -> definition.class = bit (class, 3); 6821 6822 if class = 3 6823 then seg_def = bit (def_pos, 18); 6824 else do; 6825 def_ptr -> definition.segname = seg_def; 6826 def_ptr -> definition.entry = entry_sw; 6827 end; 6828 6829 last_def = bit (def_pos, 18); 6830 def_pos = def_pos + 3; 6831 6832 end; 6833 6834 store_string: 6835 proc returns (bit (36) aligned); 6836 6837 dcl p ptr, 6838 b36 bit (36), 6839 based_string char (length (symbol_string)) based aligned; 6840 6841 if length (symbol_string) = 0 6842 then return ((36)"0"b); 6843 6844 substr (b36, 1, 18) = bit (sym_pos, 18); 6845 p = addrel (sym_base, sym_pos); 6846 p -> based_string = symbol_string; 6847 sym_pos = sym_pos + size (based_string); 6848 substr (b36, 19, 18) = bit (fixed (length (symbol_string), 18), 18); 6849 6850 return (b36); 6851 end; 6852 6853 end; /* of finish_object */ 6854 6855 build_lib_list: 6856 proc (pname, al_code); 6857 6858 /* this procedure saves library names to be stored into the object segment */ 6859 6860 dcl pname char (*); 6861 dcl al_code fixed bin (35); 6862 6863 lib_count = lib_count + 1; 6864 lib_names (lib_count) = pname; 6865 al_code = 0; 6866 return; 6867 end; 6868 6869 /* This procedure is called when a table gets full. If it is a small 6870* table, it is copied into the large table segment; if it is already 6871* a large table, tables that occur after it in the large table segment 6872* are pushed down by a specified amount. */ 6873 6874 table_overflow: 6875 proc (tabno); 6876 6877 dcl tabno fixed bin; 6878 6879 dcl p ptr; 6880 dcl j fixed bin; 6881 6882 if small_table (tabno) 6883 then do; 6884 6885 if basic_temp_ptr = null 6886 then call get_temp_segment_ ("basic", basic_temp_ptr, code); 6887 /* obtain an external segment */ 6888 6889 /* Copy the small table into the appropriate spot in the external segment */ 6890 6891 block_size = table_pos (tabno) * table_element_size (precision_lng, tabno); 6892 p = ptr (basic_temp_ptr, large_table_offset (tabno)); 6893 p -> block = table_pt (tabno) -> block; 6894 6895 /* Change table ptr and max length to reference large table */ 6896 6897 table_pt (tabno) = p; 6898 table_max (tabno) = large_table_size (tabno); 6899 small_table (tabno) = "0"b; 6900 end; 6901 else do; 6902 6903 /* Move up any tables that follow this one */ 6904 6905 if large_table_offset (number_of_tables) + table_increment (tabno) > table_limit 6906 then do; 6907 call error_sev (table_full (tabno),4); 6908 goto abort_compilation; 6909 end; 6910 6911 do i = number_of_tables to tabno + 1 by -1; 6912 if ^small_table (i) 6913 then do; 6914 p = addrel (table_pt (i), table_increment (tabno)); 6915 block_size = table_pos (i) * table_element_size (precision_lng, i); 6916 do j = block_size to 1 by -1; 6917 p -> block (j) = table_pt (i) -> block (j); 6918 end; 6919 table_pt (i) = p; 6920 end; 6921 6922 large_table_offset (i) = large_table_offset (i) + table_increment (tabno); 6923 end; 6924 6925 /* Increase size of table */ 6926 6927 table_max (tabno) = table_max (tabno) + table_increment (tabno); 6928 end; 6929 end; /* of table_overflow */ 6930 6931 /* These entries handle errors and format error messages. */ 6932 6933 error: 6934 proc (p_err_num); 6935 dcl (p_err_num, p_sev_level, p_line_num,p_num_var) fixed bin parameter; 6936 dcl p_name_var char (8) aligned parameter; 6937 6938 dcl severity_level fixed bin init (1); 6939 dcl line_num3 fixed bin; 6940 dcl (i, k) fixed bin; 6941 6942 dcl 1 message_overlay aligned based (addr (basic_error_messages_$)), 6943 2 index_block_skip (0:500), 6944 3 (a, b, c) fixed bin, 6945 2 skip unal char (k), 6946 2 message unal char (index_block (i).len - 1); 6947 6948 if mess_sv_in_tb () 6949 then do; 6950 if current_line_number = -1 6951 then line_num3 = current_line_number; 6952 else line_num3 = line_number; 6953 if p_err_num = 3 | p_err_num = 4 | p_err_num = 14 6954 then call pr_sev_line_header2 (p_err_num, severity_level, line_num3); 6955 else call pr_sev_line_header (p_err_num, severity_level, line_num3); 6956 call ioa_ (message); 6957 end; 6958 6959 severity_check: 6960 6961 basic_severity_ = max (basic_severity_, severity_level); 6962 if severity_level >= 4 | number_of_errors >= max_number_of_errors 6963 then goto abort_compilation; 6964 else if p_err_num < 0 then return; 6965 else goto abort_statement; 6966 6967 error_name: 6968 entry (p_err_num, p_name_var); 6969 6970 if mess_sv_in_tb () 6971 then do; 6972 call pr_sev_line_header (p_err_num, severity_level, current_line_number); 6973 call ioa_ (message, p_name_var, current_line_number); 6974 end; 6975 goto severity_check; 6976 6977 error_line: 6978 entry (p_err_num, p_line_num); 6979 6980 if mess_sv_in_tb () 6981 then do; 6982 call pr_sev_line_header (p_err_num, severity_level, p_line_num); 6983 call ioa_ (message, p_line_num); 6984 end; 6985 goto severity_check; 6986 6987 error_sev: 6988 entry (p_err_num, p_sev_level); 6989 6990 if mess_sv_in_tb () 6991 then do; 6992 if current_line_number = -1 6993 then line_num3 = current_line_number; 6994 else line_num3 = line_number; 6995 call pr_sev_line_header (p_err_num, p_sev_level, line_num3); 6996 call ioa_ (message, line_number); 6997 end; 6998 goto severity_check; 6999 7000 error_name_line: 7001 entry (p_err_num, p_name_var, p_line_num); 7002 7003 if mess_sv_in_tb () 7004 then do; 7005 call pr_sev_line_header (p_err_num, severity_level, p_line_num); 7006 call ioa_ (message, p_name_var, p_line_num); 7007 end; 7008 goto severity_check; 7009 7010 error_number_line: 7011 entry (p_err_num, p_num_var, p_line_num); 7012 7013 if mess_sv_in_tb () 7014 then do; 7015 call pr_sev_line_header (p_err_num, severity_level, p_line_num); 7016 call ioa_ (message, p_num_var, p_line_num); 7017 end; 7018 goto severity_check; 7019 7020 error_no_line: 7021 entry (p_err_num); 7022 7023 if mess_sv_in_tb () 7024 then do; 7025 call pr_severity_header (p_err_num, severity_level); 7026 call ioa_ (message); 7027 end; 7028 goto severity_check; 7029 7030 /* Validate error number, look message up in the table and gets its severity level */ 7031 mess_sv_in_tb: 7032 proc returns (bit (1) aligned); 7033 7034 if program_number ^= 0 7035 then if length (subprogram.name (program_number)) ^= 0 7036 then call ioa_ ("Subroutine: ^a", subprogram.name (program_number)); 7037 number_of_errors = number_of_errors + 1; 7038 call ioa_ (""); 7039 i = abs (p_err_num); 7040 7041 if i > hbound (index_block, 1) 7042 then do; 7043 severity_level = 3; 7044 goto print_header_only; 7045 end; 7046 else if index_block(i).sev >= 1 7047 then severity_level = index_block(i).sev; 7048 if p_err_num < 0 then severity_level = min (severity_level, 2); 7049 7050 k = index_block (i).loc; 7051 if k ^= -1 then return ("1"b); 7052 7053 print_header_only: /* Message is not in the table, print header string only */ 7054 7055 if severity_level = 1 7056 then call ioa_ ("WARNING, on line ^d", current_line_number); 7057 else if severity_level = 5 7058 then call ioa_ ("FATAL ERROR, on line ^d", current_line_number); 7059 else call ioa_ ("Severity ^d ERROR, on line ^d", severity_level, current_line_number); 7060 return ("0"b); 7061 end; 7062 7063 7064 7065 /* Print header string with line number */ 7066 7067 pr_sev_line_header:proc (err_num, severity_level, line_num); 7068 dcl (err_num, severity_level, line_num) fixed bin; 7069 7070 i = abs (err_num); 7071 if severity_level = 1 7072 then call ioa_ ("WARNING - ^d, on line ^d", i, line_num); 7073 else if severity_level = 5 7074 then call ioa_ ("FATAL ERROR - ^d, on line ^d", i, line_num); 7075 else call ioa_ ("ERROR - ^d ,Severity ^d on line ^d", i, severity_level, line_num); 7076 return; 7077 7078 end; /* pr_sev_line_header */ 7079 7080 /* Print header string without line number */ 7081 7082 pr_severity_header:proc (err_num, severity_level); 7083 dcl (err_num, severity_level) fixed bin; 7084 7085 i = abs(err_num); 7086 if severity_level = 1 7087 then call ioa_ ("WARNING - ^d", i); 7088 else if severity_level = 5 7089 then call ioa_ ("FATAL ERROR - ^d", i); 7090 else call ioa_ ("ERROR - ^d ,Severity ^d", i, severity_level); 7091 return; 7092 end; /* pr_severity_header */ 7093 7094 7095 /* Print header string with line number */ 7096 7097 pr_sev_line_header2:proc (err_num, severity_level, line_num); 7098 dcl (err_num, severity_level, line_num) fixed bin; 7099 7100 i = abs (err_num); 7101 if line_num > 0 7102 then do; 7103 if severity_level = 1 7104 then call ioa_ ("WARNING - ^d, after line ^d", i, line_num); 7105 else if severity_level = 5 7106 then call ioa_ ("FATAL ERROR - ^d, after line ^d", i, line_num); 7107 else call ioa_ ("ERROR - ^d ,Severity ^d after line ^d", i, severity_level, line_num); 7108 end; 7109 else do; 7110 if severity_level = 1 7111 then call ioa_ ("WARNING - ^d", i); 7112 else if severity_level = 5 7113 then call ioa_ ("FATAL ERROR - ^d", i); 7114 else call ioa_ ("ERROR - ^d ,Severity ^d", i, severity_level); 7115 end; 7116 return; 7117 end; /* pr_severity_header */ 7118 end; /* error */ 7119 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/17/89 1243.2 basic_.pl1 >spec>install>1001>basic_.pl1 546 1 03/27/82 0439.4 basic_symbols.incl.pl1 >ldd>include>basic_symbols.incl.pl1 548 2 03/27/82 0439.4 basic_program_header.incl.pl1 >ldd>include>basic_program_header.incl.pl1 564 3 03/10/77 1345.4 compiler_source_info.incl.pl1 >ldd>include>compiler_source_info.incl.pl1 569 4 03/27/82 0439.4 basic_source_info.incl.pl1 >ldd>include>basic_source_info.incl.pl1 792 5 03/27/82 0439.4 basic_param_types.incl.pl1 >ldd>include>basic_param_types.incl.pl1 6530 6 11/24/86 1226.9 definition.incl.pl1 >ldd>include>definition.incl.pl1 6531 7 05/06/74 1751.6 std_symbol_header.incl.pl1 >ldd>include>std_symbol_header.incl.pl1 6532 8 11/26/79 1320.6 source_map.incl.pl1 >ldd>include>source_map.incl.pl1 6533 9 10/30/80 1648.7 relbts.incl.pl1 >ldd>include>relbts.incl.pl1 6534 10 08/05/77 1022.5 object_map.incl.pl1 >ldd>include>object_map.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. NL constant char(1) initial packed unaligned dcl 848 ref 6632 a_code parameter fixed bin(35,0) dcl 143 set ref 98 111 1051* 1053* a_value parameter float bin(63) dcl 4976 ref 4973 4978 abbrev 015135 automatic char(4) packed unaligned dcl 1297 set ref 1652* 1666* 1670 1678 1686 1698 abbreviation 1 000100 external static char(4) array level 2 dcl 463 ref 1698 abs builtin function dcl 164 ref 2499 3981 4853 4856 6191 7039 7070 7085 7100 acc based structure level 1 dcl 6794 set ref 6805 add based bit(36) level 2 dcl 383 set ref 3029 4503* 4503* add_lib_name 000100 automatic entry variable dcl 152 set ref 94* 107* 120* 3264 add_to_lib_list_ parameter entry variable dcl 143 ref 111 120 addr builtin function dcl 164 ref 71 129 874 929 935 941 958 961 1019 1319 1324 1324 1382 1382 1495 1498 1498 1602 1607 1608 2140 2154 2199 2245 2380 2390 2390 2414 2414 2437 2499 2499 2499 2513 2520 2552 2586 2588 2591 2592 2593 2607 2615 2631 2645 2675 2678 2701 2702 2708 2713 2716 2743 2748 2760 2763 2826 2826 2832 2835 2838 2840 2846 2849 2852 2854 2863 2900 2908 2939 2939 2948 2955 2964 2982 2982 2989 3100 3106 3108 3112 3130 3130 3187 3187 3222 3258 3258 3263 3274 3303 3312 3337 3351 3362 3378 3399 3422 3438 3438 3445 3448 3450 3468 3471 3477 3484 3493 3497 3513 3527 3533 3533 3534 3534 3535 3535 3568 3574 3599 3599 3645 3645 3668 3679 3702 3711 3734 3734 3768 3775 3792 3792 3813 3874 3911 3914 3914 3946 3957 3957 3964 3984 3995 4002 4025 4025 4055 4105 4105 4109 4114 4116 4129 4147 4147 4154 4169 4196 4204 4326 4326 4346 4349 4349 4372 4392 4411 4425 4431 4434 4434 4458 4458 4608 4608 4608 4608 4615 4615 4615 4615 4622 4622 4622 4622 4859 4937 4937 4957 4957 4992 4992 5172 5172 5212 5212 5511 5511 5667 5695 5702 5720 5756 5756 5781 5812 5814 5828 5835 5838 5838 5845 5848 5857 5857 5866 5879 5879 5903 5968 5997 5997 6004 6027 6029 6029 6030 6032 6032 6038 6038 6067 6067 6069 6244 6244 6253 6273 6286 6386 6441 6579 6581 6627 6956 6973 6983 6996 7006 7016 7026 addrel builtin function dcl 164 ref 954 1373 2340 2346 2690 3623 3925 3955 4069 4112 6103 6172 6203 6252 6273 6286 6389 6444 6538 6540 6546 6555 6570 6586 6590 6600 6610 6620 6654 6677 6721 6732 6742 6757 6799 6807 6813 6845 6914 address based bit(36) level 2 in structure "array" dcl 542 in procedure "basic_" set ref 2532 3986 4006* 4821 4861 4873* 5854 5860 5909 6011 6076 6387 6392 6401 address 1 based bit(36) array level 2 in structure "temps" dcl 544 in procedure "basic_" set ref 5057 5065* address 1 007300 automatic bit(36) array level 2 in structure "local_temps" dcl 307 in procedure "basic_" set ref 2751* 2751* 2751* address 1 007201 automatic bit(36) array level 2 in structure "normal_temps" dcl 303 in procedure "basic_" set ref 966* 966* 966* address 1077 005556 automatic bit(36) array level 3 in structure "symbol_table" dcl 295 in procedure "basic_" set ref 976* address 007377 automatic bit(36) array level 2 in structure "fn_table" dcl 311 in procedure "basic_" set ref 2679 2697* 4013 4016* 5557 5559 5562 5598 5793 address 74 007551 automatic bit(36) array level 2 in structure "save" dcl 315 in procedure "basic_" set ref 5773* 5806 address_register_loaded 000215 automatic fixed bin(17,0) dcl 194 set ref 4753 4780* al_code parameter fixed bin(35,0) dcl 6861 set ref 6855 6865* al_count 001350 automatic fixed bin(18,0) dcl 235 set ref 2704* 2720 2772 2806 2817 5766* 5766 5767 5770 5773 5777 5805 alphanumeric 000234 constant char(65) initial packed unaligned dcl 843 ref 3932 6391 6446 6453 amount 016445 automatic fixed bin(18,0) dcl 6378 in procedure "process_arrays" set ref 6394* 6398* 6398 6407 amount 000166 constant fixed bin(17,0) initial array dcl 4706 in procedure "push_variable" ref 4715 amount 000026 internal static fixed bin(17,0) initial array dcl 5045 in procedure "allocate_temp" set ref 5061 5063* amount parameter fixed bin(17,0) dcl 5002 in procedure "allocate" ref 4999 5007 5028 amount parameter fixed bin(17,0) dcl 5077 in procedure "allocate_local" ref 5074 5087 5100 ap 015370 automatic pointer array dcl 2286 in procedure "compile_statement" set ref 3533* 3534* 3535* 3537 3537 3544 3544 6029* 6032* 6034 6034 6038* 6039 ap 016450 automatic pointer dcl 6378 in procedure "process_arrays" set ref 6386* 6387 6392 6394 6396 6401 arg 0(06) 010253 automatic bit(1) array level 2 packed packed unaligned dcl 325 set ref 2721 2729* 5615* arg_prototype 000317 constant bit(36) initial packed unaligned dcl 636 ref 2783 2787 4695 5106 5763 5777 array based structure level 1 dcl 542 array_dope based structure level 1 dcl 1-1 ref 4873 4873 array_pt 015366 automatic pointer dcl 2286 set ref 2532 3984* 3986 4005 4006 4821 4859* 4861 4866 4873 4876 4894 4895 5854 5858 5860 5909 6011 6076 array_symbol based structure level 1 dcl 1-11 set ref 6411 array_type 015352 automatic fixed bin(17,0) dcl 2286 set ref 4778 4858* arrays 1077 005556 automatic structure array level 2 dcl 295 set ref 975 975 3533 3534 3535 3984 4859 6029 6032 6038 6385 6386 assign constant fixed bin(17,0) initial dcl 729 ref 1936 assign_token constant bit(18) initial packed unaligned dcl 652 ref 1919 3222 auto_ctr 000352 automatic fixed bin(35,0) array dcl 225 set ref 985* 986* 5014 5015* 5015 5021 5023 5024* 5024 5027 5028* 5028 6292 6292* 6292 6299 6302 6307* 6307 6307 6317 6321 6359 6360* 6360 6363 6406 6407* 6407 auto_source_info 013134 automatic structure level 1 dcl 566 set ref 71 129 1019 b1 015350 automatic fixed bin(17,0) dcl 2286 set ref 2838* 2861* b18 016543 automatic bit(18) dcl 6485 set ref 6798* 6817 b2 015351 automatic fixed bin(17,0) dcl 2286 set ref 2852* 2861* b36 016576 automatic bit(36) packed unaligned dcl 6837 set ref 6844* 6848* 6850 backslash constant fixed bin(17,0) initial dcl 729 ref 1392 1933 2021 2257 backward 0(18) based bit(18) level 2 packed packed unaligned dcl 6-12 set ref 6809* 6811* base based bit(3) level 2 in structure "itp" packed packed unaligned dcl 605 in procedure "basic_" set ref 2588* base based bit(3) array level 2 in structure "rand" packed packed unaligned dcl 617 in procedure "basic_" ref 2588 based_double based fixed bin(71,0) dcl 4908 in procedure "push_constant" ref 4957 4957 based_double based fixed bin(71,0) dcl 5299 in procedure "function" ref 5511 5511 based_lib_name based structure level 1 dcl 573 based_name based char packed unaligned dcl 6485 set ref 6545* based_single based fixed bin(35,0) dcl 4908 ref 4937 4937 based_string based char dcl 6837 set ref 6846* 6847 based_vs based varying char(32) dcl 600 set ref 3917 3922 3927 3929 3932 6581 6584* basic_$symbol_table 000130 external static fixed bin(17,0) dcl 510 set ref 6627 basic_data$array_prototype 000062 external static bit(36) dcl 369 ref 4754 4777 5891 basic_data$ascii_table 000100 external static structure array level 1 dcl 463 basic_data$ascii_table_length 000102 external static fixed bin(17,0) dcl 468 ref 1697 basic_data$constant_prototype 000064 external static bit(36) dcl 369 ref 4923 4947 4965 4992 5519 basic_data$function_dummy 000066 external static bit(36) dcl 369 ref 2444 basic_data$function_templates 000116 external static bit(18) array dcl 495 set ref 2431 2437 2437 basic_data$functions 000110 external static structure array level 1 dcl 481 basic_data$instruction_sequences 000074 external static structure array level 1 dcl 378 set ref 874 basic_data$inverse_relational 000126 external static bit(36) array dcl 505 ref 3163 basic_data$normal_relational 000124 external static bit(36) array dcl 505 ref 3181 basic_data$numeric_spelling 000112 external static structure array level 1 dcl 486 basic_data$param_prototype 000070 external static bit(36) dcl 369 ref 3962 5557 5598 6401 6465 basic_data$precision_length 000056 external static fixed bin(35,0) dcl 358 ref 870 basic_data$relational_table 000120 external static structure array level 1 dcl 498 basic_data$relational_table_length 000122 external static fixed bin(17,0) dcl 502 ref 1940 basic_data$scalar_prototype 000072 external static bit(36) array dcl 369 ref 5031 basic_data$statement_list 000104 external static structure array level 1 dcl 471 basic_data$statement_spelling 000106 external static structure array level 1 dcl 477 basic_data$string_spelling 000114 external static structure array level 1 dcl 490 basic_entry based structure level 1 dcl 550 set ref 2347 4071 basic_error_messages_$ 000060 external static structure level 1 dcl 361 set ref 6956 6973 6983 6996 7006 7016 7026 basic_next_line 000036 constant entry external dcl 152 ref 1324 basic_numeric_fun_token constant bit(18) initial packed unaligned dcl 652 ref 1752 3471 3755 basic_program_header based structure level 1 dcl 2-1 set ref 954 2251 2342 3263 3914 3937 3953 4947 4965 5519 basic_severity_ 000076 external static fixed bin(17,0) dcl 381 set ref 6959* 6959 basic_string_constant based structure level 1 dcl 2211 set ref 2232 basic_string_fun_token constant bit(18) initial packed unaligned dcl 652 ref 1872 3448 basic_temp_ptr 000200 automatic pointer dcl 175 set ref 886* 897 897* 1038 1038* 6885 6885* 6892 basic_version_$ 000132 external static char(132) packed unaligned dcl 512 ref 6632 6633 bin builtin function dcl 164 ref 6224 6267 6280 6382 6382 6437 6437 binary builtin function dcl 164 ref 2970 bit builtin function dcl 164 ref 1361 1376 2360 2441 2485 2581 2590 2692 2697 2724 2810 3618 3625 3628 3629 3953 4052 4061 4923 4947 4965 5031 5097 5102 5106 5242 5276 5445 5519 5564 5568 5604 5777 5794 5801 6106 6162 6174 6177 6178 6206 6255 6267 6271 6280 6283 6302 6320 6321 6334 6336 6339 6347 6363 6382 6421 6437 6461 6475 6584 6584 6600 6612 6652 6670 6675 6692 6709 6726 6736 6746 6752 6761 6762 6763 6764 6766 6768 6769 6780 6798 6802 6813 6820 6822 6829 6844 6848 bl 015362 automatic fixed bin(17,0) dcl 2286 set ref 3942* 4039* 4039 4040 4041 4076 block based bit(36) array dcl 523 set ref 6244* 6244 6273* 6273 6286* 6286 6893* 6893 6917* 6917 block_length 6(18) based bit(18) level 3 packed packed unaligned dcl 6514 set ref 6614* block_size 17(18) based bit(18) level 2 in structure "std_symbol_header" packed packed unaligned dcl 7-1 in procedure "finish_object" set ref 6752* block_size 001351 automatic fixed bin(18,0) dcl 235 in procedure "basic_" set ref 6243* 6244 6270* 6271 6273 6275 6285* 6286 6287 6891* 6893 6915* 6916 bound1 parameter fixed bin(17,0) dcl 4848 ref 4845 4894 bound2 parameter fixed bin(17,0) dcl 4848 ref 4845 4895 bounds 2 based fixed bin(17,0) array level 2 in structure "array_symbol" packed packed unaligned dcl 1-11 in procedure "basic_" set ref 6394* 6396* 6398 6398 bounds 1101 005556 automatic fixed bin(17,0) array level 3 in structure "symbol_table" dcl 295 in procedure "basic_" set ref 978* 978* bounds 2 based fixed bin(17,0) array level 2 in structure "array" dcl 542 in procedure "basic_" set ref 4894* 4895* 6394 6396 buffer1 015406 automatic bit(36) array dcl 2312 set ref 4040* 4077 buffer2 015446 automatic bit(36) array dcl 2312 set ref 4041* 4078 ch 430 010254 automatic char(1) array level 2 dcl 330 set ref 1326 1326 1326 1398 1400 1409 1411 1431 1461 1476 1517 1519 1528 1529 1572 1588 1624 1648 1663 1666 1681 1690 1747 1747 1771 1799 1834 1864 1864 1904 1922 1928 1936 1964 2018 2064 2140 2146 2154 2161 2167 2174 2182 2218 2227 2257 2259 ch_class 30 010254 automatic fixed bin(17,0) array level 2 dcl 330 set ref 1392 1392 1395 1402 1428 1442 1458 1473 1502 1523 1537 1550 1560 1583 1628 1660 1678 1686 1726 1766 1794 1829 1859 1862 1862 1902 1933 1933 1936 1936 1984 1996 1996 2021 2021 2024 2134 2138 2151 2180 2257 2257 chain 1 based bit(18) array level 3 packed packed unaligned dcl 525 set ref 1371 5260 5276* 6102 chain_statement constant fixed bin(17,0) initial dcl 691 ref 1466 change 1 based bit(36) array level 2 dcl 383 ref 2658 change_statement constant fixed bin(17,0) initial dcl 691 ref 1481 check_eof 3 based bit(36) level 2 dcl 383 ref 3119 class parameter fixed bin(3,0) dcl 6785 in procedure "generate_definition" ref 6782 6820 6822 class 1 000110 external static fixed bin(17,0) array level 2 in structure "basic_data$functions" dcl 481 in procedure "basic_" ref 2429 3757 4407 5308 5828 class 1(33) based bit(3) level 2 in structure "definition" packed packed unaligned dcl 6-12 in procedure "finish_object" set ref 6820* cleanup 000104 stack reference condition dcl 170 ref 892 clock_ 000040 constant entry external dcl 152 ref 6629 close_paren constant fixed bin(17,0) initial dcl 750 ref 4463 4590 4647 code 000351 automatic fixed bin(35,0) dcl 224 set ref 86* 894* 897* 901* 902 1038* 1042* 3264* 3265 6224* 6885* comma constant fixed bin(17,0) initial dcl 750 ref 4465 4579 comment 14 based structure level 2 packed packed unaligned dcl 7-1 set ref 6644* compare 4 based bit(36) level 2 dcl 383 ref 3039 3059 3062 3072 3153 3171 compiler_source_info based structure level 1 dcl 3-6 compiler_source_info_version_2 constant fixed bin(17,0) initial dcl 3-16 ref 90 constant_length based fixed bin(17,0) level 2 dcl 2211 set ref 2246* 2247 constant_loc 015333 automatic fixed bin(17,0) dcl 2206 set ref 2244* 2245 2251 constant_ptr 000152 automatic pointer dcl 175 set ref 954* 2240 2245 3263 3914 4937 4945 4957 4963 5511 5517 6224 6244 constant_value 1 based char level 2 dcl 2211 set ref 2247* constants based float bin(27) array dcl 583 set ref 2240* 2245 3263 3914 4937 4945* 6244 conversion 000120 stack reference condition dcl 170 ref 853 convert builtin function dcl 164 ref 2083 2086 2087 2101 2104 2105 count based fixed bin(17,0) level 2 in structure "missing" dcl 525 in procedure "basic_" set ref 959* 1367 1381 1385* 1385 2744* 5255 5271* 6092 count based bit(9) level 2 in structure "acc" packed packed unaligned dcl 6794 in procedure "generate_definition" set ref 6802* count based fixed bin(17,0) level 2 in structure "based_lib_name" dcl 573 in procedure "basic_" ref 3264 3264 cs1 015136 automatic char(1) packed unaligned dcl 1297 set ref 1670* 1681* 1690* 1700* 1710 1712 current_line_number 000225 automatic fixed bin(17,0) dcl 194 set ref 924* 1332 1349 1359* 2819 5221 6950 6950 6972* 6973* 6992 6992 7053* 7057* 7059* current_operator 015567 automatic fixed bin(17,0) dcl 4284 set ref 4361* 4461* 4463* 4465* 4467* 4469 4579 4590 4647 4647 4660 4673* current_precedence 015570 automatic fixed bin(17,0) dcl 4284 set ref 4469* 4475 current_token 000211 automatic fixed bin(17,0) dcl 194 set ref 1317* 1491* 1493* 1493 1495 1498 1510 1511* 1602 1606* 1606 1607 1608 2380 2385* 2385 2387 2390 2397* 2397 2414 2414 2494* 2494 2499 2499 2499 2511* 2511 2513 2517* 2517 2520 2535* 2535 2552 2615 2618* 2618 2631 2634* 2634 2645 2647* 2647 2706* 2711* 2711 2716 2733* 2733 2763 2770* 2770 2799 2802 2826 2832 2835 2838 2840 2843* 2843 2846 2849 2852 2854 2858* 2858 2863 2865* 2865 2892 2904* 2904 2908 2911* 2911 2946* 2946 2951* 2951 2955 2958* 2958 2964 2981* 2981 2982 2989 3115* 3130 3137* 3137 3187 3196* 3196 3222 3225* 3225 3258 3271* 3271 3272 3274 3276* 3276 3309* 3337 3342* 3342 3351 3354* 3354 3362 3378 3385* 3385 3386 3422 3424* 3424 3454* 3480* 3490* 3493 3496* 3496 3497 3500* 3500 3502 3506* 3506 3523* 3555* 3561* 3568 3571* 3571 3574 3577* 3577 3635* 3635 3645 3663* 3663 3668 3679 3684* 3684 3693 3702 3705* 3705 3711 3714* 3714 3723 3734 3743* 3743 3746 3766* 3766 3768 3771* 3771 3775 3778* 3778 3792 3840 3877* 3940* 3952* 3957 3964 3993* 3993 3995 3999* 3999 4002 4024* 4024 4025 4054* 4054 4055 4057* 4057 4118* 4129 4131* 4131 4147 4154 4161* 4161 4167* 4167 4169 4192* 4192 4196 4199* 4199 4204 4207* 4207 4326 4336* 4336 4346 4348* 4348 4349 4370* 4370 4372 4392 4401* 4401 4411 4423* 4423 4425 4430* 4430 4431 4434 4434 4455* 4455 4458 4586* 4586 4661* 4661 4677 5212 5283* 5283 5667 5669* 5669 5671 5695 5698* 5698 5702 5702* 5702 5704 5720 5756 5779* 5779 5781 5784* 5784 5830* 5863* 5879 5884* 5884 5903 5968 5970* 5970 5972 5997 6002* 6002 6004 d_constants based float bin(63) array dcl 585 set ref 4957 4963* 5511 5517* d_numeric_data based float bin(63) array dcl 579 set ref 2011* d_this_token based structure level 1 dcl 538 d_tokens 002622 automatic structure array level 1 dcl 289 set ref 1319 1495 1498 1602 1607 1608 2380 2390 2414 2414 2499 2499 2499 2513 2520 2552 2607 2615 2631 2645 2675 2678 2701 2702 2708 2713 2716 2763 2826 2832 2835 2838 2840 2846 2849 2852 2854 2863 2900 2908 2939 2948 2955 2964 2982 2989 3100 3106 3108 3112 3130 3187 3222 3258 3274 3303 3312 3337 3351 3362 3378 3399 3422 3438 3445 3448 3450 3468 3471 3477 3484 3493 3497 3513 3527 3533 3534 3535 3568 3574 3599 3645 3668 3679 3702 3711 3734 3768 3775 3792 3813 3874 3911 3914 3946 3957 3964 3995 4002 4025 4055 4105 4105 4109 4114 4116 4129 4147 4154 4169 4196 4204 4326 4346 4349 4372 4392 4411 4425 4431 4434 4434 4458 4608 4608 4615 4615 4622 4622 5212 5667 5695 5702 5720 5756 5781 5828 5835 5838 5845 5848 5857 5866 5879 5903 5968 5997 6004 6027 6029 6030 6032 6038 6067 6069 d_value 016076 automatic float bin(63) dcl 4908 in procedure "push_constant" set ref 4953* 4957 4963 4978* d_value 016210 automatic float bin(63) dcl 5299 in procedure "function" set ref 5507* 5511 5517 data_read 5 based bit(36) array level 2 dcl 383 set ref 3813* data_statement constant fixed bin(17,0) initial dcl 691 ref 1487 date_time_modified 76 based fixed bin(71,0) level 2 in structure "source_info" dcl 562 in procedure "basic_" set ref 78* 84* 916 date_time_modified 64 based fixed bin(71,0) level 2 in structure "old_source_info" dcl 568 in procedure "basic_" ref 84 dcl_version based fixed bin(17,0) level 2 dcl 7-1 set ref 6623* debug_sw parameter bit(1) dcl 143 ref 111 dec_num 000354 automatic float dec(22) dcl 229 set ref 2083 2086 2101 2104 2132* 2140 2154 2199 decimal constant fixed bin(17,0) initial dcl 729 ref 1996 decl_vers based fixed bin(17,0) level 2 dcl 10-10 set ref 6759* def_base 016516 automatic pointer dcl 6485 set ref 6555* 6559 6570 6600 6799 6807 6813 def_block 1 based bit(18) level 3 packed packed unaligned dcl 6514 set ref 6612* def_header based structure level 1 dcl 6508 def_pos 016503 automatic fixed bin(18,0) dcl 6485 set ref 6564* 6600 6602* 6602 6609 6609 6763 6798 6799 6805* 6805 6807 6813 6822 6829 6830* 6830 def_ptr 016562 automatic pointer dcl 6790 set ref 6807* 6809 6811 6815 6816 6817 6818 6820 6825 6826 def_start 016502 automatic fixed bin(18,0) dcl 6485 set ref 6554* 6555 6594 6609 6612 6762 definition based structure level 1 dcl 6-12 definition_length 4(18) based bit(18) level 2 packed packed unaligned dcl 10-10 set ref 6763* definition_offset 4 based bit(18) level 2 packed packed unaligned dcl 10-10 set ref 6762* definitions 15(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 2-1 set ref 6592* 6594* descriptor based bit(18) level 3 packed packed unaligned dcl 550 set ref 6587* digit constant fixed bin(17,0) initial dcl 729 ref 1523 1996 2134 2138 2151 2180 digit_0 constant fixed bin(17,0) initial dcl 818 ref 1529 2182 digits 000231 constant char(10) initial packed unaligned dcl 846 in procedure "basic_" ref 6454 digits 0(09) based char(1) array level 2 in structure "num_overlay" packed packed unaligned dcl 2118 in procedure "convert_number" set ref 2140* 2154* dim_not_allowed 1075 005556 automatic bit(1) array level 2 packed packed unaligned dcl 295 set ref 973* 3989* 4868* 4882 4885* dim_statement constant fixed bin(17,0) initial dcl 691 ref 4868 4880 dimensions 1 based fixed bin(17,0) level 2 in structure "array" dcl 542 in procedure "basic_" set ref 3537 3537 3544 3544 4005* 4866* 4876 5858* 6034 6034 6039 dimensions 1100 005556 automatic fixed bin(17,0) array level 3 in structure "symbol_table" dcl 295 in procedure "basic_" set ref 977* dims parameter fixed bin(17,0) dcl 6065 set ref 6062 6074* dirname 12 based varying char(168) level 2 dcl 562 set ref 77* 87* 914 divide builtin function dcl 164 in procedure "basic_" ref 4955 4961 5230 5510 5515 6450 6546 6756 divide 7 based bit(36) level 2 in structure "instructions" dcl 383 in procedure "basic_" set ref 4532* divide builtin function dcl 6119 in procedure "get_line_number" ref 6126 divide_inv 10 based bit(36) level 2 dcl 383 set ref 4532* dollar constant fixed bin(17,0) initial dcl 729 ref 1537 1550 1628 1726 1859 dtm 4 based fixed bin(71,0) array level 3 in structure "source_map" dcl 8-3 in procedure "finish_object" set ref 6665* dtm 54 011304 automatic fixed bin(71,0) array level 2 in structure "source_map_info" dcl 350 in procedure "basic_" set ref 916* 6665 eax_7 1(18) based bit(18) level 3 packed packed unaligned dcl 550 set ref 6364* end_input 11 based bit(36) level 2 dcl 383 ref 5682 5980 end_pos 016425 automatic fixed bin(18,0) dcl 6146 set ref 6215* 6258* 6258 6347 end_print 12 based bit(36) level 2 dcl 383 ref 3749 end_statement constant fixed bin(17,0) initial dcl 691 ref 1315 end_token constant bit(18) initial packed unaligned dcl 652 ref 1319 1507 2414 3450 3477 3874 5214 enter_main 13 based bit(36) level 2 dcl 383 ref 2346 enter_proc 14 based bit(36) level 2 dcl 383 ref 4069 entry 1(20) based bit(1) level 3 packed packed unaligned dcl 6-12 set ref 6826* entry_bound 11 based bit(18) level 2 packed packed unaligned dcl 10-10 set ref 6771* entry_pos 12 001554 automatic fixed bin(18,0) array level 2 dcl 284 set ref 2344* 4066* 6251* 6251 6252 6367 6584 6584 6586 6684 6697 entry_pt 000156 automatic pointer dcl 175 set ref 6252* 6253 6363 6364 6365 6367 entry_sw parameter bit(1) dcl 6785 ref 6782 6826 err_count parameter fixed bin(17,0) dcl 134 set ref 27 1048* err_num parameter fixed bin(17,0) dcl 7098 in procedure "pr_sev_line_header2" ref 7097 7100 err_num parameter fixed bin(17,0) dcl 7083 in procedure "pr_severity_header" ref 7082 7085 err_num parameter fixed bin(17,0) dcl 7068 in procedure "pr_sev_line_header" ref 7067 7070 error 15 based bit(36) array level 2 dcl 383 ref 1060 6098 6168 6198 error_number 5 010254 automatic fixed bin(17,0) level 2 dcl 330 set ref 1326 1326* 1330 1332 1332 1337 error_table_$translation_failed 000054 external static fixed bin(35,0) dcl 226 ref 1053 exp 015212 automatic fixed bin(17,0) dcl 2114 set ref 2128* 2182* 2182 2189* 2189 2199 exp_paren constant fixed bin(17,0) initial dcl 4315 ref 4443 4582 exp_sign 015215 automatic fixed bin(17,0) dcl 2114 set ref 2169* 2173* 2189 exponent 5(28) based fixed bin(7,0) level 2 packed packed unaligned dcl 2118 set ref 2199* file 21 based bit(36) level 2 dcl 383 ref 2916 file_param constant fixed bin(17,0) initial dcl 5-1 ref 2409 4045 finish 1 000114 external static fixed bin(17,0) array level 2 in structure "basic_data$string_spelling" dcl 490 in procedure "basic_" ref 1851 finish 1 000106 external static fixed bin(17,0) array level 2 in structure "basic_data$statement_spelling" dcl 477 in procedure "basic_" ref 1433 finish 1 000112 external static fixed bin(17,0) array level 2 in structure "basic_data$numeric_spelling" dcl 486 in procedure "basic_" ref 1720 first 000104 external static char(4) array level 2 dcl 471 ref 1435 first_auto_loc constant fixed bin(17,0) initial dcl 800 ref 985 first_code_word 001352 automatic fixed bin(18,0) dcl 235 set ref 2343* 3938* 6243 6244 first_link 6 based bit(18) level 3 packed packed unaligned dcl 6514 set ref 6614* first_statement 001472 automatic bit(1) dcl 268 set ref 909* 2329 2363* 3893 3897* fixed builtin function dcl 164 ref 1361 1376 1376 1400 1519 1529 1612 1624 1710 1712 1718 2182 2218 2360 2440 2441 2485 2485 2491 2581 2590 2692 2692 2702 2838 2852 3618 3625 3628 3629 3953 4052 4061 4414 4480 4696 4713 4858 4918 4923 4947 4965 5085 5102 5219 5242 5242 5317 5445 5519 5564 5564 5604 5621 5777 5793 5794 5801 5892 6106 6106 6174 6177 6178 6206 6206 6255 6255 6302 6321 6334 6339 6339 6363 6461 6461 6548 6584 6584 6692 6702 6709 6848 fixed_output_word based fixed bin(17,0) array dcl 518 set ref 3671* flag 0(30) based bit(6) level 2 in structure "itp" packed packed unaligned dcl 605 in procedure "basic_" set ref 2589* flag 0(18) based bit(1) level 3 in structure "basic_entry" packed packed unaligned dcl 550 in procedure "basic_" set ref 6588* flags 1(18) based structure level 2 in structure "definition" packed packed unaligned dcl 6-12 in procedure "finish_object" flags 1(18) based bit(18) level 2 in structure "def_header" packed packed unaligned dcl 6508 in procedure "finish_object" set ref 6559* float builtin function dcl 164 ref 1710 1712 floating_nine 000322 constant bit(36) initial packed unaligned dcl 636 ref 2651 floating_zero 000323 constant bit(36) initial packed unaligned dcl 636 ref 3150 3168 fn_call_word 010253 automatic structure level 1 packed packed unaligned dcl 325 set ref 2700* 2738 5604* 5619 fn_local_word based structure level 1 dcl 627 set ref 2768* 2810* fn_name 000221 automatic fixed bin(17,0) dcl 194 set ref 923* 1363 2671 2678* 2679 2689 2697 2698 2883 2924 4151 4394 5235 5793 5809* fn_start 000220 automatic fixed bin(17,0) dcl 194 set ref 2819* 5239 fn_table 007377 automatic structure array level 1 dcl 311 set ref 981 981 982* 6186 6186 fn_type 015353 automatic fixed bin(17,0) dcl 2286 set ref 2702* 2776* 2781 fneg 22 based bit(36) level 2 dcl 383 ref 4513 4571 fnloc 015401 automatic bit(36) dcl 2286 set ref 2421* 2441* 2472 2483 for_level 000224 automatic fixed bin(17,0) dcl 194 set ref 922* 2933* 2933 2936 3011 3012 3027 3595 3606 3616 3625 3633* 3633 6161 for_location 001354 automatic fixed bin(18,0) array dcl 235 set ref 3027* 3616 6162 6174 6177 6178 for_type 000341 automatic fixed bin(17,0) array dcl 194 set ref 2936 3012* 3625 6174 for_variable 001544 automatic bit(36) array dcl 278 set ref 3011* 3606 format 12 based structure level 2 dcl 10-10 forward based bit(18) level 2 packed packed unaligned dcl 6-12 set ref 6600* 6813* fszn 23 based bit(36) level 2 dcl 383 ref 3056 ft 015346 automatic fixed bin(17,0) dcl 2286 set ref 2969* 2989* 2992* 2993* 3012 3033 fun_paren constant fixed bin(17,0) initial dcl 4315 ref 4437 function_arg 24 based bit(36) array level 2 dcl 383 ref 2472 2473 2483 2484 2487 function_call 31 based bit(36) array level 2 dcl 383 ref 5596 5598 5600 function_is_parameter 015403 automatic bit(1) dcl 2286 set ref 2452* 2465 5557* 5559 function_modifier constant bit(36) initial packed unaligned dcl 636 ref 2756 function_return 34 based bit(36) array level 2 dcl 383 ref 5794 5796 gen_created 4 based fixed bin(71,0) level 2 dcl 7-1 set ref 6627* gen_number 3 based fixed bin(17,0) level 2 dcl 7-1 set ref 6625* gen_version 12 based structure level 2 packed packed unaligned dcl 7-1 set ref 6634* generate_object 001474 automatic bit(1) dcl 268 set ref 76* 82* 104* 117* 130* 876 6592 6604 generator 10 based char(8) level 2 dcl 7-1 set ref 6630* get_fcb_pt 36 based bit(36) level 2 dcl 383 ref 4040 get_group_id_ 000052 constant entry external dcl 152 ref 6636 get_next_source_seg_ parameter entry variable dcl 143 ref 111 1020 get_temp_segment_ 000042 constant entry external dcl 152 ref 901 6885 given_ename 1 based varying char(32) level 2 dcl 562 set ref 77* 83* 88 878 gosub 37 based bit(36) level 2 dcl 383 ref 3093 half based structure array level 1 dcl 520 have_redim 015402 automatic bit(1) dcl 2286 set ref 5888 5906* 5925* 5962 hbound builtin function dcl 164 ref 930 936 942 969 975 981 1495 1602 2459 2529 2721 2807 2936 3311 3903 4657 4670 4692 4710 4915 5094 5267 5335 5767 6186 6385 6440 7041 hcs_$fs_get_path_name 000046 constant entry external dcl 152 ref 86 hcs_$truncate_seg 000050 constant entry external dcl 152 ref 6224 header 4 based fixed bin(17,0) level 2 dcl 550 set ref 6367* header_pos 11 001554 automatic fixed bin(18,0) array level 2 dcl 284 set ref 2339* 3924* 4112 6267 6280 6333 6367 6590 6594 i 016174 automatic fixed bin(17,0) dcl 5209 in procedure "gen_xfer" set ref 5230* 5232 5235 5242 5246 5246 5248 5255* 5257 5260* 5267 5271 5272 5276 i 016507 automatic fixed bin(18,0) dcl 6485 in procedure "finish_object" set ref 6660* 6661 6662 6664 6664 6665 6665* 6680* 6687 6688* 6688 6692 6693 6695* 6695 6705 6706* 6706 6709 6710* 6710 6712 6713* 6713 6718 6720 i 016074 automatic fixed bin(18,0) dcl 4908 in procedure "push_constant" set ref 4922* 4923 4936* 4937* 4947 4955* 4957* 4961* 4962 4963 4965 i 016214 automatic fixed bin(17,0) dcl 5304 in procedure "function" set ref 5308* 5311 5311 5311 5324 5439* 5441 5441* 5449* 5450 5450* 5510* 5511* 5515* 5516 5517 5519 i 016463 automatic fixed bin(18,0) dcl 6433 in procedure "process_scalars" set ref 6440* 6441 6446 6446 6450 6451* i 016234 automatic fixed bin(17,0) dcl 5585 in procedure "user_function" set ref 5589* 5590 5590* 5609* 5610 5612 5615* i 016446 automatic fixed bin(18,0) dcl 6378 in procedure "process_arrays" set ref 6385* 6386 6391* i 016622 automatic fixed bin(17,0) dcl 6940 in procedure "error" set ref 6956 6956 6973 6973 6983 6983 6996 6996 7006 7006 7016 7016 7026 7026 7039* 7041 7046 7046 7050 7070* 7071* 7073* 7075* 7085* 7086* 7088* 7090* 7100* 7103* 7105* 7107* 7110* 7112* 7114* i 015566 automatic fixed bin(17,0) dcl 4284 in procedure "expression" set ref 4407* 4409 4414* 4416 4416* 4428 4428 i 015344 automatic fixed bin(17,0) dcl 2286 in procedure "compile_statement" set ref 2359* 2360* 2429* 2431 2437 2443* 2444 2447* 2509* 2516* 2525* 2525 2533 2585* 2588 2590 2591 2592 2593* 2728* 2729 2729* 2750* 2751 2751 2751* 2812* 2813 2813* 3135* 3163 3181 3311* 3312 3312* 3378* 3380 3382 3513* 3515 3521 3616* 3618 3623 3625 3628 3629 3661* 3671 3671 3757* 3759 3916* 3917* 3975* 3992* 3998* 4017* 4045* 4049* 4049 4052 4076* 4077 4078* 5793* 5794 5801 5801 5805* 5806 5806* 6045* 6046* i 015124 automatic fixed bin(17,0) dcl 1297 in procedure "lexical_analyzer" set ref 1367* 1368 1371 1381* 1455* 1461* 1697* 1698 1700* 1720* 1721 1753* 1851* 1852 1873* 1940* 1941 1944* i 000335 automatic fixed bin(17,0) dcl 194 in procedure "basic_" set ref 86* 87 880* 881 881 965* 966 966 966* 969* 970* 975* 976 977 978 978* 981* 982* 6911* 6912 6914 6915 6915 6917 6919 6922 6922* i 015330 automatic fixed bin(17,0) dcl 2206 in procedure "quoted_string" set ref 2225* 2227* i 016422 automatic fixed bin(18,0) dcl 6146 in procedure "finish_subprogram" set ref 6161* 6162 6174 6174 6177 6178* 6186* 6187 6191 6192* 6338* 6339 6339* i 016372 automatic fixed bin(17,0) dcl 6088 in procedure "scan_missing_list" set ref 6092* 6093 6102* ic 000312 constant bit(36) initial array dcl 646 ref 2441 2574 2684 3019 3041 3058 3060 3061 3063 3074 3618 5279 5571 5794 identifier 1 based char(8) level 2 in structure "object_map" dcl 10-10 in procedure "finish_object" set ref 6760* identifier 1 based char(8) level 2 in structure "std_symbol_header" dcl 7-1 in procedure "finish_object" set ref 6624* if_statement constant fixed bin(17,0) initial dcl 691 ref 1421 1915 in_function based bit(1) array level 2 packed packed unaligned dcl 587 set ref 1363* 5235 incoming_args 5 based structure level 2 dcl 2-1 set ref 2351* 3946* index builtin function dcl 164 ref 880 3378 3513 6632 6638 index_block 000060 external static structure array level 2 dcl 361 set ref 7041 info_p parameter pointer dcl 134 ref 27 74 83 84 85 6778 inner_product 40 based bit(36) level 2 dcl 383 ref 3584 input 41 based bit(36) array level 2 dcl 383 set ref 3205* input_length 2 010254 automatic fixed bin(17,0) level 2 dcl 330 set ref 860* 918 1024* 1064 1311 1334 input_lng 101 based fixed bin(21,0) level 2 dcl 562 set ref 92* 132* 860 1024 input_pointer 102 based pointer level 2 dcl 562 set ref 91* 131* 859 1021 1023 input_pos 3 010254 automatic fixed bin(17,0) level 2 dcl 330 set ref 861* 918 1025* 1064 1311 1334* input_pt 010254 automatic pointer level 2 dcl 330 set ref 859* 1023* input_stm parameter bit(1) dcl 5938 in procedure "mat_input_list" ref 5935 5975 5978 input_stm parameter bit(1) dcl 5639 in procedure "input_list" ref 5636 5674 5680 inst 015376 automatic bit(36) dcl 2286 set ref 3106* 3108* 3163* 3181* 3198* 3650* 3652* 3654* 3658 3764* 3780 inst_pt 000166 automatic pointer dcl 175 set ref 874* 1060 2346 2404 2405 2472 2473 2483 2484 2487 2574 2580 2651 2657 2658 2684 2783 2787 2788 2877 2916 3018 3019 3029 3030 3039 3041 3056 3058 3059 3060 3061 3062 3063 3072 3074 3084 3090 3093 3106 3108 3119 3153 3158 3159 3171 3176 3177 3205 3234 3239 3240 3284 3295 3322 3329 3346 3358 3365 3366 3373 3399 3404 3417 3453 3479 3504 3521 3552 3582 3583 3584 3585 3613 3618 3650 3652 3654 3666 3688 3696 3697 3707 3716 3727 3739 3749 3789 3806 3813 3818 3833 3842 3849 3857 3868 3879 3886 4040 4041 4069 4079 4091 4126 4243 4503 4503 4512 4513 4518 4526 4526 4532 4532 4544 4545 4549 4550 4561 4562 4571 4775 4821 4827 5129 5160 5164 5165 5391 5414 5432 5445 5450 5485 5523 5528 5596 5598 5600 5612 5656 5660 5661 5682 5695 5707 5794 5796 5854 5860 5909 5923 5959 5980 6076 6098 6168 6198 instruction_temp_ptr 000150 automatic pointer dcl 175 set ref 887* 894 894* 901* 1042 1042* 2346 2348 3955 4069 4072 instructions based structure level 1 dcl 383 int 015200 automatic fixed bin(71,0) dcl 2096 in procedure "d_convert_number" set ref 2104* 2104 2105 int 015170 automatic fixed bin(17,0) dcl 2078 in procedure "s_convert_number" set ref 2086* 2086 2087 integer 015134 automatic bit(1) packed unaligned dcl 1297 set ref 1887 2083 2101 2134* 2148* 2163* integer_constant_token constant bit(18) initial packed unaligned dcl 652 ref 2835 2849 4027 4105 integer_token constant bit(18) initial packed unaligned dcl 652 ref 1887 5214 ioa_ 000034 constant entry external dcl 152 ref 904 6956 6973 6983 6996 7006 7016 7026 7034 7038 7053 7057 7059 7071 7073 7075 7086 7088 7090 7103 7105 7107 7110 7112 7114 ip 015127 automatic fixed bin(17,0) dcl 1297 set ref 1405* 1414* 1419* 1426* 1426 1442 1456* 1456 1458 1461 1471* 1471 1473 1476 1501* 1501 1502 1517 1519 1521* 1521 1523 1528 1529 1531* 1531 1537 1544* 1544 1550 1560 1566* 1566 1572 1581* 1581 1583 1588 1624 1626* 1626 1628 1635* 1635 1646* 1646 1648 1654* 1654 1660 1663 1666 1678 1681 1686 1690 1726 1747 1747 1763* 1763 1766 1771 1792* 1792 1794 1799 1827* 1827 1829 1834 1857* 1857 1859 1862 1862 1864 1864 1865* 1865 1902 1904 1922 1928 1931* 1931 1933 1933 1936 1936 1936 1938* 1938 1964 1983* 1983 1984 1993* 1993 1996 1996 2015* 2015 2018 2021 2021 2024 2064 2134 2138 2140 2141* 2141 2146 2150* 2150 2151 2154 2155* 2155 2161 2165* 2165 2167 2170* 2170 2174 2174* 2174 2180 2182 2183* 2183 2192* 2192 2218 2226* 2226 2227 2257 2257 2257 2259 2261* 2261 2264* 2264 is_constant constant bit(18) initial packed unaligned dcl 673 ref 3260 4346 4381 is_function constant bit(18) initial packed unaligned dcl 673 ref 2414 4387 is_numeric constant bit(18) initial packed unaligned dcl 673 ref 5842 is_operator constant bit(18) initial packed unaligned dcl 673 ref 4329 4461 is_punctuation constant bit(18) initial packed unaligned dcl 673 ref 4440 is_string constant bit(18) initial packed unaligned dcl 673 ref 2525 2607 3260 3440 4049 4351 4920 is_user constant bit(18) initial packed unaligned dcl 673 ref 2421 2675 4149 4390 is_variable constant bit(18) initial packed unaligned dcl 673 ref 2499 2829 3964 4164 4368 5758 5881 itp based structure level 1 dcl 605 set ref 2587* j 016373 automatic fixed bin(17,0) dcl 6088 in procedure "scan_missing_list" set ref 6093* 6108* j 015125 automatic fixed bin(17,0) dcl 1297 in procedure "lexical_analyzer" set ref 1381* 1382 1382* 1400* 1433 1433 1718* 1720 1720 1851 1851 j 015345 automatic fixed bin(17,0) dcl 2286 in procedure "compile_statement" set ref 2440* 2441 2443 2508* 2515* 2515 2523* 3991* 3997* 3997 4005 j 016510 automatic fixed bin(18,0) dcl 6485 in procedure "finish_object" set ref 6542* 6543 6543 6544 6545* 6578* 6579 6584 6584 6586 6590 6594* 6683* 6684 6697* 6711* j 016610 automatic fixed bin(17,0) dcl 6880 in procedure "table_overflow" set ref 6916* 6917 6917* jump 016213 automatic bit(36) dcl 5304 set ref 5316* 5339 5388 5429 5446 5482 k 016623 automatic fixed bin(17,0) dcl 6940 in procedure "error" set ref 6956 6973 6983 6996 7006 7016 7026 7050* 7051 k 016511 automatic fixed bin(18,0) dcl 6485 in procedure "finish_object" set ref 6681* 6684 6697* 6702 k 016235 automatic fixed bin(17,0) dcl 5585 in procedure "user_function" set ref 5610* 5612 5615 5621* 5623 5626 k 016130 automatic fixed bin(17,0) dcl 5048 in procedure "allocate_temp" set ref 5053* 5054 5057 5065 k 016423 automatic fixed bin(18,0) dcl 6146 in procedure "finish_subprogram" set ref 6359* 6360 6360 k 016410 automatic fixed bin(17,0) dcl 6119 in procedure "get_line_number" set ref 6126* 6128 6128 6128 6131 6132 k 015126 automatic fixed bin(17,0) dcl 1297 in procedure "lexical_analyzer" set ref 1447* 1449 1455 k 016022 automatic fixed bin(17,0) dcl 4706 in procedure "push_variable" set ref 4713* 4715* 4715 4719 k 015331 automatic fixed bin(17,0) dcl 2206 in procedure "quoted_string" set ref 2218* 2220 2225 2232 2246 2247 2247 2256* 2258* 2258 2259 k 016156 automatic fixed bin(17,0) dcl 5152 in procedure "save_register" set ref 5154* 5156 5160 5164 5172 5172 k 016215 automatic fixed bin(17,0) dcl 5304 in procedure "function" set ref 5317* 5346 5350 k1 016464 automatic fixed bin(18,0) dcl 6433 set ref 6450* 6451 6454 k2 016465 automatic fixed bin(18,0) dcl 6433 set ref 6451* 6453 large_table_offset 001364 automatic fixed bin(18,0) array dcl 235 set ref 932* 938* 944* 6892 6905 6922* 6922 large_table_size 000266 constant fixed bin(17,0) initial array dcl 806 ref 6898 last_def 016542 automatic bit(18) dcl 6485 set ref 6562* 6570 6587 6600 6809 6809 6813 6829* last_instruction 001353 automatic fixed bin(18,0) dcl 235 set ref 6249* last_mat_input_word 016340 automatic fixed bin(17,0) dcl 5942 set ref 5944* 5961* 5984 5984 5984 last_statement 001473 automatic bit(1) dcl 268 set ref 963* 1004 2879* lbound builtin function dcl 164 ref 969 975 981 6186 left based bit(18) array level 2 packed packed unaligned dcl 520 set ref 1374 1376* 2440 2691 2692* 3625* 3628* 3629* 6104 6106* 6174* 6177* 6178* 6204 6206* len 2 000060 external static fixed bin(17,0) array level 3 dcl 361 set ref 6956 6956 6973 6973 6983 6983 6996 6996 7006 7006 7016 7016 7026 7026 length builtin function dcl 164 ref 3927 3929 6543 6581 6639 6801 6841 6846 6847 6847 6848 7034 let_statement constant fixed bin(17,0) initial dcl 691 ref 1404 1413 letter constant fixed bin(17,0) initial dcl 729 ref 1395 1402 1428 1458 1473 1560 1583 1678 1686 1766 1794 1829 1862 1862 letter_a constant fixed bin(17,0) initial dcl 816 ref 1400 1519 1612 1624 1718 level parameter fixed bin(17,0) dcl 5119 in procedure "load_register" ref 5116 5122 5129 5132 5135 5138 level parameter fixed bin(17,0) dcl 4990 in procedure "operand_is_constant" ref 4987 4992 4992 4992 lib_count 000337 automatic fixed bin(17,0) dcl 194 set ref 890* 6536 6539 6542 6711 6863* 6863 6864 lib_list_pt 016526 automatic pointer dcl 6485 set ref 6538* 6539 6540 6540 6543 6544 6550* 6572 6572 6572 6700 6702 lib_name_pt 000202 automatic pointer dcl 175 set ref 3263* 3264 6540* 6544 6545 6546* 6546 6548 lib_names 013240 automatic varying char(168) array dcl 571 set ref 6543 6545 6864* line based structure array level 1 dcl 587 line_num parameter fixed bin(17,0) dcl 7098 in procedure "pr_sev_line_header2" set ref 7097 7101 7103* 7105* 7107* line_num parameter fixed bin(17,0) dcl 7068 in procedure "pr_sev_line_header" set ref 7067 7071* 7073* 7075* line_num3 016621 automatic fixed bin(17,0) dcl 6939 set ref 6950* 6952* 6953* 6955* 6992* 6994* 6995* line_number 4 010254 automatic fixed bin(17,0) initial level 2 dcl 330 set ref 330* 1346 1349 1359 1368 6952 6994 6996* line_table 000012 internal static fixed bin(17,0) initial dcl 794 set ref 1356* link_base 016520 automatic pointer dcl 6485 set ref 6610* 6612 6614 6614 link_header based structure level 1 dcl 6514 link_start 016504 automatic fixed bin(18,0) dcl 6485 set ref 6609* 6610 6618 6764 6766 linkage_length 5(18) based bit(18) level 2 packed packed unaligned dcl 10-10 set ref 6765* linkage_offset 5 based bit(18) level 2 packed packed unaligned dcl 10-10 set ref 6764* linput 43 based bit(36) array level 2 dcl 383 set ref 3284* ln 016175 automatic fixed bin(17,0) dcl 5209 set ref 5219* 5221 5232 5239 5246 5257 5272 lng 1(18) based fixed bin(17,0) array level 3 packed packed unaligned dcl 6497 set ref 6543* load 45 based bit(36) array level 2 dcl 383 set ref 2651 2657 3018 3090* 3582 3583 3613 4041 4545 4550 4821 4827 5129 5391 5414 5432 5445 5450 5485 5523 5528 5612 5854 5860 5909 6076 loc 016140 automatic fixed bin(18,0) dcl 5081 in procedure "allocate_local" set ref 5099* 5106 loc 000060 external static fixed bin(17,0) array level 3 in structure "basic_error_messages_$" dcl 361 in procedure "basic_" set ref 7050 loc 016466 automatic bit(18) packed unaligned dcl 6433 in procedure "process_scalars" set ref 6437* 6475 loc 001501 automatic bit(18) dcl 276 in procedure "basic_" set ref 1371* 1371* 1373 1376* 2689* 2689* 2690 2692* 5562* 5564 5564* 5564 5567* 5571 6102* 6102* 6103 6106* 6128 6128 6162* 6172 6187* 6189 6202 6203 6206 6210* loc 016447 automatic bit(18) packed unaligned dcl 6378 in procedure "process_arrays" set ref 6382* 6421 loc 016120 automatic fixed bin(18,0) dcl 5005 in procedure "allocate" set ref 5010* 5014* 5027* 5031 loc_number based structure level 1 packed packed unaligned dcl 2-18 local 0(06) based bit(1) array level 2 packed packed unaligned dcl 627 set ref 2807 2813* 5094 5102* 5103* local_ctr 001347 automatic fixed bin(18,0) dcl 235 set ref 2772* 2817* 5087 5091* 5091 5099 5100* 5100 local_pt 000164 automatic pointer dcl 175 set ref 2760* 2768 2807 2810 2813 5085 5094 5097 5102 5103 local_temps 007300 automatic structure array level 1 unaligned dcl 307 set ref 2748 location 5 based bit(18) level 3 in structure "basic_program_header" packed packed unaligned dcl 2-1 in procedure "basic_" set ref 3953* 6255* 6255 location 3 based bit(18) level 3 in structure "basic_program_header" packed packed unaligned dcl 2-1 in procedure "basic_" set ref 6267* location 2 based bit(18) level 3 in structure "basic_program_header" packed packed unaligned dcl 2-1 in procedure "basic_" set ref 6320* location 14 based bit(18) level 3 in structure "basic_program_header" packed packed unaligned dcl 2-1 in procedure "basic_" set ref 6334* location 0(19) based bit(17) level 2 in structure "array_symbol" packed packed unaligned dcl 1-11 in procedure "basic_" set ref 6392* location 0(01) based bit(17) array level 2 in structure "line" packed packed unaligned dcl 587 in procedure "basic_" set ref 1361* 2360* 5242 6128 6128 6339 location 0(19) based bit(17) level 2 in structure "scalar_symbol" packed packed unaligned dcl 1-6 in procedure "basic_" set ref 6457* 6461* 6461 location 1 based bit(18) level 3 in structure "basic_program_header" packed packed unaligned dcl 2-1 in procedure "basic_" set ref 6301* location 4 based bit(18) level 3 in structure "basic_program_header" packed packed unaligned dcl 2-1 in procedure "basic_" set ref 6280* lower 016411 automatic fixed bin(17,0) dcl 6119 in procedure "get_line_number" set ref 6122* 6125 6126 6131* lower 016176 automatic fixed bin(17,0) dcl 5209 in procedure "gen_xfer" set ref 5226* 5229 5230 5248* m 016306 automatic fixed bin(17,0) dcl 5826 in procedure "matrix_function" set ref 5848* 5850* 5852* m 016512 automatic fixed bin(18,0) dcl 6485 in procedure "finish_object" set ref 6632* 6633 6638* 6639 6639* 6641 6684* 6686 6689* 6689 6692 6702* 6704 6707* 6707 6709 m 015556 automatic fixed bin(17,0) dcl 4260 in procedure "expression_in_register" set ref 4264* 4266* 4268* m 016374 automatic fixed bin(17,0) dcl 6088 in procedure "scan_missing_list" set ref 6091* 6095 6097* 6106 m 016032 automatic fixed bin(17,0) dcl 4735 in procedure "push_array" set ref 4753* 4754* m 016424 automatic fixed bin(18,0) dcl 6146 in procedure "finish_subprogram" set ref 6160* 6165 6167* 6174 6177 6178 6185* 6195 6197* 6206 6333* 6334 6339 main_pt 000142 automatic pointer dcl 175 set ref 70* 1047 6253* map 2 based structure array level 2 dcl 8-3 map_ptr based bit(18) dcl 10-38 set ref 6780* margin 52 based bit(36) level 2 dcl 383 ref 3295 mat_data_read 53 based bit(36) array level 2 dcl 383 set ref 3399* mat_input 55 based bit(36) array level 2 dcl 383 set ref 3322* 5959 mat_linput 57 based bit(36) array level 2 dcl 383 set ref 3329* mat_print 61 based bit(36) array level 2 dcl 383 ref 3373 mat_print_using 63 based bit(36) array level 2 dcl 383 ref 3358 mat_read 65 based bit(36) array level 2 dcl 383 set ref 3404* mat_statement constant fixed bin(17,0) initial dcl 691 ref 1810 1836 mat_write 67 based bit(36) array level 2 dcl 383 ref 3417 matrix_add_sub 71 based bit(36) array level 2 dcl 383 set ref 3521* matrix_assign_numeric 73 based bit(36) level 2 dcl 383 set ref 3479* matrix_assign_string 74 based bit(36) level 2 dcl 383 set ref 3453* matrix_constant constant fixed bin(17,0) initial dcl 763 ref 5828 matrix_mult 75 based bit(36) array level 2 dcl 383 ref 3552 matrix_scalar_mult 100 based bit(36) level 2 dcl 383 set ref 3504* matrix_secondary 000217 constant char(8) initial array packed unaligned dcl 851 ref 3311 3312 matrix_type 000216 automatic fixed bin(17,0) dcl 194 set ref 3452* 3463* 6027 6030 6069 6071 max builtin function dcl 164 ref 6034 6039 6959 max_line_number constant fixed bin(17,0) initial dcl 820 ref 1346 max_number_of_constants constant fixed bin(17,0) initial dcl 826 ref 6220 6223 6224 max_number_of_digits constant fixed bin(17,0) initial dcl 836 ref 2196 2199 max_number_of_errors constant fixed bin(17,0) initial dcl 824 ref 6962 max_number_of_lines defined fixed bin(18,0) dcl 260 ref 1356 max_numeric_data_count defined fixed bin(18,0) dcl 260 ref 2002 max_storage_amount constant fixed bin(20,0) initial dcl 838 ref 6317 max_string_constant_length constant fixed bin(17,0) initial dcl 833 ref 2220 max_string_data_count defined fixed bin(18,0) dcl 260 ref 2030 2045 max_subprogram_name_length constant fixed bin(17,0) initial dcl 830 ref 3929 max_temp constant fixed bin(17,0) initial dcl 802 ref 965 2750 5054 maxi_truncate 23 based bit(18) level 2 packed packed unaligned dcl 7-1 set ref 6670* message based char level 2 packed packed unaligned dcl 6942 set ref 6956* 6973* 6983* 6996* 7006* 7016* 7026* message_overlay based structure level 1 dcl 6942 min builtin function dcl 164 ref 4116 7048 mini_truncate 22(18) based bit(18) level 2 packed packed unaligned dcl 7-1 set ref 6670* minus_op constant fixed bin(17,0) initial dcl 750 ref 4340 missing based structure level 1 dcl 525 missing_lines 1 based structure array level 2 packed packed unaligned dcl 525 set ref 1382 1382 5267 missing_lines_word based fixed bin(17,0) array dcl 527 set ref 1382* 1382 missing_pt 000204 automatic pointer dcl 175 set ref 958* 959 1367 1368 1371 1381 1382 1382 1385 1385 2743* 2744 5255 5257 5260 5267 5271 5272 5276 5812* 6092 6093 6102 missing_table 007741 automatic structure array level 1 dcl 319 set ref 958 2743 5812 mod builtin function dcl 164 ref 947 2572 5021 5087 6229 6264 6292 6359 6554 6609 6650 mode 0(05) 010253 automatic bit(1) level 2 packed packed unaligned dcl 325 set ref 2701* 5606* modifier 001503 automatic bit(36) dcl 278 set ref 925* 2402 2462 2756* 4718 4821 5061 5156 5816* 5854 5860 5909 6011 6076 mop 015356 automatic fixed bin(17,0) array dcl 2286 set ref 3434* 3435* 3436* 3502* 3511* 6027 6029 6030 6032 6036 6038 6049 6067 mp parameter pointer dcl 134 set ref 27 1047* mult_type 015361 automatic fixed bin(17,0) dcl 2286 set ref 3544* 3546 3552 multiply 101 based bit(36) level 2 dcl 383 set ref 4526* 4526* n 016513 automatic fixed bin(18,0) dcl 6485 in procedure "finish_object" set ref 6539* 6540 6656* 6658 6756* 6757 6775 6780 n 016560 automatic fixed bin(9,0) dcl 6790 in procedure "generate_definition" set ref 6801* 6802 6803 6805 n_args 015404 automatic fixed bin(5,0) dcl 2286 set ref 2708* 2720* 2721 2724 2728 2806 2813 n_f_fun constant fixed bin(17,0) initial dcl 763 ref 4428 n_fs_fun constant fixed bin(17,0) initial dcl 763 ref 4428 n_locals 015405 automatic fixed bin(5,0) dcl 2286 set ref 2806* 2807 2810 2812 n_locs 016141 automatic fixed bin(5,0) dcl 5081 set ref 5085* 5090* 5090 5094 5097 5102 5103 name parameter varying char(32) dcl 6785 in procedure "generate_definition" ref 6782 6801 6803 name based char(1) level 2 in structure "array_symbol" packed packed unaligned dcl 1-11 in procedure "basic_" set ref 6391* name 000120 external static char(4) array level 2 in structure "basic_data$relational_table" dcl 498 in procedure "basic_" ref 1941 name 016432 automatic char(8) dcl 6146 in procedure "finish_subprogram" set ref 6191* 6192* 6208* name 001554 automatic varying char(32) array level 2 in structure "subprogram" dcl 284 in procedure "basic_" set ref 2335* 2337* 3917 3922* 6579 7034 7034* name 000110 external static char(4) array level 2 in structure "basic_data$functions" dcl 481 in procedure "basic_" ref 1721 1852 name based char(2) level 2 in structure "scalar_symbol" packed packed unaligned dcl 1-6 in procedure "basic_" set ref 6446* 6453* 6454* name 1 based char(8) level 2 in structure "this_token" dcl 536 in procedure "basic_" set ref 1083* 1089* 1101* 1139* 1151* 1166* 1175* 1270* 1279* 1499* 1517* 1528* 1572* 1574 1588* 1590 1592 1597 1608 1610* 1612 1619 1641 1718 1721 1747 1771* 1775 1778 1780 1782 1784 1786 1789 1799* 1805 1807 1812 1814 1816 1820 1822 1824 1834* 1836 1840 1852 1859 1864* 1866 1904* 1922* 1928* 1936* 1941 1964* 1970* 2392 3192 3192 3650 3652 3654 3736 3795 3798 4019 4443 4463 4465 5539* name 1 based char(8) array level 2 in structure "tokens" dcl 529 in procedure "basic_" set ref 1608* 2380 2414 2499 2499 2499 2513 2520 2552 2615 2631 2645 2708 2713 2716 2763 2832 2840 2846 2854 2863 2900 2908 2948 2955 2964 3106 3108 3112 3274 3312 3337 3351 3362 3378 3399 3422 3445 3468 3484 3493 3497 3513 3527 3568 3574 3668 3679 3702 3711 3768 3775 3813 3946 3964 3995 4002 4055 4129 4154 4169 4196 4204 4372 4392 4411 4425 4431 5667 5695 5702 5720 5781 5835 5845 5848 5903 5968 6004 name_lng 016514 automatic fixed bin(17,0) dcl 6485 set ref 6543* 6545 6545 6546 names 1 based structure array level 2 dcl 6497 nargs parameter fixed bin(17,0) dcl 5582 in procedure "user_function" ref 5579 5604 5609 5610 5612 5619 5622 nargs parameter fixed bin(17,0) dcl 5294 in procedure "function" ref 5291 5311 5445 5449 5450 5450 5455 5490 5498 nd 016056 automatic fixed bin(17,0) dcl 4851 set ref 4856* 4866 4876 4895 ndims 015347 automatic fixed bin(17,0) dcl 2286 in procedure "compile_statement" set ref 2842* 2857* 2861* ndims parameter fixed bin(17,0) dcl 4732 in procedure "push_array" set ref 4729 4740 4745* 4761 4775* ndims parameter fixed bin(17,0) dcl 4794 in procedure "array_op" ref 4791 4797 ndims parameter fixed bin(17,0) dcl 4848 in procedure "dimension_array" ref 4845 4856 4876 new 1(18) based bit(1) level 3 packed packed unaligned dcl 6-12 set ref 6815* new_line constant fixed bin(17,0) initial dcl 729 ref 1392 1660 1933 2021 2257 next 007300 automatic fixed bin(17,0) array level 2 in structure "local_temps" dcl 307 in procedure "basic_" set ref 2754* 2754* 2754* next based fixed bin(17,0) array level 2 in structure "temps" dcl 544 in procedure "basic_" set ref 2318* 2318* 2318* 5051* 5051 5053 next_lib_name 1 based char level 2 packed packed unaligned dcl 573 set ref 3264* next_line_err 000016 internal static fixed bin(17,0) initial array dcl 822 set ref 1337* next_line_storage 010254 automatic structure level 1 unaligned dcl 330 set ref 1324 1324 next_loc 001502 automatic bit(18) dcl 276 set ref 1374* 1377 2691* 2693 6104* 6109 6204* 6210 nlibs based fixed bin(17,0) level 2 dcl 6497 set ref 6539* no_digits 015216 automatic bit(1) packed unaligned dcl 2114 set ref 2178* 2181* 2186 normal_modifier constant bit(36) initial packed unaligned dcl 636 ref 5061 5816 normal_temps 007201 automatic structure array level 1 unaligned dcl 303 set ref 961 5814 npars 000217 automatic fixed bin(17,0) dcl 194 set ref 3941* 3960* 3960 4052 4061 4063 null builtin function dcl 164 ref 70 74 886 887 894 897 1021 1038 1042 6550 6572 6700 6885 num 016462 automatic fixed bin(18,0) dcl 6433 in procedure "process_scalars" set ref 6438* 6467* 6467 6472 6475 num 016444 automatic fixed bin(18,0) dcl 6378 in procedure "process_arrays" set ref 6383* 6410* 6410 6415 6421 num parameter fixed bin(17,0) dcl 6065 in procedure "matrix_operand" ref 6062 6067 6076 num_overlay based structure level 1 dcl 2118 number 1 based fixed bin(17,0) level 2 in structure "source_map" dcl 8-3 in procedure "finish_object" set ref 6656* number 4(18) based bit(18) level 3 in structure "basic_program_header" packed packed unaligned dcl 2-1 in procedure "basic_" set ref 6283* number 3 based fixed bin(17,0) level 2 in structure "this_token" dcl 536 in procedure "basic_" set ref 1519* 1529* 1529 1540* 1540 1556* 1556 1612* 1624* 1631* 1631 1753* 1873* 1902* 1944* 1957* 2429 2444 2499 3135 3263 3465 3757 3764 3970 3973 3981 3984 3989 4013 4016 4151 4334 4340 4394 4407 4461 4715 4715 4718 4853 4859 4868 4882 4885 4922 5308 5316 5557 5559 5562 5567 5568 5598 5606 5763 5770 5773 5777 5840 6071 number 5(18) based bit(18) level 3 in structure "basic_program_header" packed packed unaligned dcl 2-1 in procedure "basic_" set ref 4061* number based bit(5) level 2 in structure "fn_local_word" packed packed unaligned dcl 627 in procedure "basic_" set ref 5085 5097* number 000160 constant fixed bin(17,0) initial array dcl 5081 in procedure "allocate_local" ref 5085 5103 number 007551 automatic fixed bin(17,0) array level 2 in structure "save" dcl 315 in procedure "basic_" set ref 2729 2813 5767 5770* 5806 number 010253 automatic bit(5) level 2 in structure "fn_call_word" packed packed unaligned dcl 325 in procedure "basic_" set ref 2724* number 2(18) based bit(18) level 3 in structure "basic_program_header" packed packed unaligned dcl 2-1 in procedure "basic_" set ref 6321* number 3 000104 external static fixed bin(17,0) array level 2 in structure "basic_data$statement_list" dcl 471 in procedure "basic_" ref 1447 number 1(18) based bit(18) level 3 in structure "basic_program_header" packed packed unaligned dcl 2-1 in procedure "basic_" set ref 6302* number 3 based fixed bin(17,0) array level 2 in structure "tokens" dcl 529 in procedure "basic_" set ref 2678 3533 3534 3535 3914 5828 5866 6027 6029 6030 6032 6038 number 0(18) based fixed bin(17,0) array level 2 in structure "line" packed packed unaligned dcl 587 in procedure "basic_" set ref 1359* 5232 5246 6128 6339 number 1(18) based fixed bin(17,0) array level 3 in structure "missing" packed packed unaligned dcl 525 in procedure "basic_" set ref 1368 5257 5272* 6093 number 14(18) based bit(18) level 3 in structure "basic_program_header" packed packed unaligned dcl 2-1 in procedure "basic_" set ref 6336* number 3(18) based bit(18) level 3 in structure "basic_program_header" packed packed unaligned dcl 2-1 in procedure "basic_" set ref 6271* number_of_args_required 000271 constant fixed bin(17,0) initial array dcl 789 ref 4409 5311 5311 number_of_assigns 000213 automatic fixed bin(17,0) dcl 194 set ref 1490* 1920* 1920 3211 3215 number_of_constants 001375 automatic fixed bin(19,0) dcl 248 set ref 950* 2240 2244 2250* 2250 4936 4943* 4943 4945 4955 4961 4962* 5510 5515 5516* 6220 6223* 6229 6229* 6229 6244 6248 6251 6255 6258 6339 number_of_dims 000214 automatic fixed bin(17,0) dcl 194 set ref 3546* 3548* 3550* 4173* 4196* 4201* 5922* 5923* 6034* 6039* 6039 6042 6042* 6046* 6049* number_of_errors 000206 automatic fixed bin(17,0) dcl 194 set ref 888* 905* 1048 1051 3253* 3253 6962 7037* 7037 number_of_lines defined fixed bin(18,0) dcl 254 set ref 1354* 1354 1356 1359 1361 1363 2359 3907* 3907 5227 6123 6336 6338 number_of_tables constant fixed bin(17,0) initial dcl 810 ref 6905 6911 number_of_tokens 000212 automatic fixed bin(17,0) dcl 194 set ref 1318* 1510* 2387 2799 2802 2892 3272 3386 3693 3723 3746 3830 3840 3949 4101 5671 5704 5972 numeric_arrays 11 based structure level 2 dcl 2-1 set ref 6296* numeric_constant_token constant bit(18) initial packed unaligned dcl 652 ref 1708 1889 4105 numeric_data based float bin(27) array dcl 577 in procedure "basic_" set ref 2009* 6273 numeric_data 3 based structure level 2 in structure "basic_program_header" dcl 2-1 in procedure "basic_" numeric_data_count defined fixed bin(18,0) dcl 254 set ref 2002 2007* 2007 2009 2011 6262 6270 numeric_data_table 000010 internal static fixed bin(17,0) initial dcl 794 set ref 2002* numeric_function_param constant fixed bin(17,0) initial dcl 5-1 ref 2491 4017 numeric_list_param constant fixed bin(17,0) initial dcl 5-1 ref 2509 3992 numeric_operator_token constant bit(18) initial packed unaligned dcl 652 ref 1895 numeric_scalar_param constant fixed bin(17,0) initial dcl 5-1 ref 2550 3975 numeric_scalars 7 based structure level 2 dcl 2-1 set ref 6327* numeric_storage 1 based structure level 2 dcl 2-1 numeric_table_param constant fixed bin(17,0) initial dcl 5-1 ref 2516 3998 numeric_variable_token constant bit(18) initial packed unaligned dcl 652 ref 1543 1565 1611 2941 3601 5999 numsign 015131 automatic float bin(27) dcl 1297 set ref 1980* 1988* 2009 2011 nv 015355 automatic fixed bin(17,0) dcl 2286 set ref 2623* 2642* 2657 nwords 015332 automatic fixed bin(17,0) dcl 2206 set ref 2232* 2240 2250 object_created 6 based fixed bin(71,0) level 2 dcl 7-1 set ref 6627 6629* object_map based structure level 1 dcl 10-10 set ref 6775 odd_available 000230 automatic fixed bin(17,0) array dcl 194 set ref 988* 989* 5007 5010 5011* 5023* offset 1 based fixed bin(17,0) level 2 in structure "array_symbol" dcl 1-11 in procedure "basic_" set ref 6406* offset 0(03) based bit(15) array level 2 in structure "rand" packed packed unaligned dcl 617 in procedure "basic_" ref 2592 offset 1 based bit(18) level 2 in structure "itp" packed packed unaligned dcl 605 in procedure "basic_" set ref 2592* offset 1 based bit(18) array level 3 in structure "saved_lib_list" packed packed unaligned dcl 6497 in procedure "finish_object" set ref 6544* offset 016200 automatic bit(18) packed unaligned dcl 5209 in procedure "gen_xfer" set ref 5242* 5260* 5270* 5279 old_source_info based structure level 1 dcl 568 on 102 based bit(36) level 2 dcl 383 ref 3650 3652 on_gosub 103 based bit(36) level 2 dcl 383 ref 3654 on_statement constant fixed bin(17,0) initial dcl 691 ref 1423 one constant float bin(27) initial dcl 783 ref 5502 op parameter bit(36) dcl 5207 in procedure "gen_xfer" ref 5204 5279 op parameter bit(36) dcl 6023 in procedure "matrix_op" ref 6020 6052 op parameter bit(36) array dcl 4794 in procedure "array_op" set ref 4791 4800* 4803* 4807* op1 parameter bit(36) dcl 5187 ref 5184 5193 op2 parameter bit(36) dcl 5187 ref 5184 5189 opcode 015571 automatic fixed bin(17,0) dcl 4284 set ref 4473* 4475 4478 4480 4483 4494 4499 open_paren constant fixed bin(17,0) initial dcl 750 ref 4673 operand 001504 automatic bit(36) array dcl 278 set ref 2402* 2405 2459 2463* 2529 2532* 2588 2591 2592 2593 2657 2970* 3011 3018 3029 3030 3039 3056 3059 3062 3072 3150 3153 3158 3168 3171 3176 3234 3239 3582 3583 3585 3606 3613 4041 4241* 4243 4512 4518 4545 4550 4561 4639* 4692 4695* 4710 4718* 4777* 4803* 4807* 4915 4970* 4992 4992 4992 5129 5156* 5160 5164 5172 5172 5189 5193 5335 5344* 5391 5414 5432 5450 5485 5528 5612 5656 5660 5891* 6011* operand_in_register 000272 automatic fixed bin(17,0) array dcl 194 set ref 2322* 2322* 2322* 2377 2408* 2547 2556 3008 3148 3349* 3691* 3709* 3709* 3709* 3784* 3790* 3790* 3790* 4246* 4416 4509 4538 4542 4573 4573* 4633 4633* 4641* 4747 4761 4765 4765 4771* 4803 4813* 4814* 5122 5126 5132* 5154 5175* 5189 5197 5197* 5319 5321 5328 5348* 5348* 5348* 5350* 5368 5375 5383 5441 5590 5625* 5625* 5625* 5626* 5710* 5741* operand_level 000222 automatic fixed bin(17,0) dcl 194 set ref 991* 1008 2402 2405 2409 2458* 2458 2459 2463 2491 2528* 2528 2529 2532 2533 2544* 2544 2544* 2547 2547 2550 2550 2581 2585 2597* 2661* 2777* 2777 2919* 2919 2973* 2989* 3078* 3122* 3122 3184* 3184 3215 3218 3218 3230* 3230 3232 3234 3236* 3236 3238 3239 3242* 3242 3298* 3298 3348* 3360* 3376* 3420* 3507* 3507 3588* 3588 3632* 3643* 3643 3690* 3783* 3783 3852* 3852 3881* 3881 4043* 4219 4234* 4239* 4241 4243 4264 4268* 4483 4483 4491 4494 4509 4512 4517 4518 4542 4545 4548 4550 4558 4561 4569* 4573 4627* 4627 4633 4639 4640 4641 4691* 4691 4692 4695 4696 4709* 4709 4710 4718 4719 4761 4765 4765 4777 4778 4799* 4803 4803 4806 4807 4810* 4810 4814 4914* 4914 4915 4918 4970 4979 5189 5189 5192 5193 5197 5332* 5332 5335 5344 5346 5350 5356* 5365* 5379 5379 5383 5386 5391 5393* 5393 5398 5400* 5402* 5402 5407* 5409 5411 5414 5417* 5417 5422 5424 5426 5432 5434* 5434 5450 5450 5455* 5455 5468 5475 5479 5480* 5485 5487* 5487 5525 5526 5528 5531* 5531 5610 5612 5622* 5622 5623 5626 5665* 5709* 5709 5742* 5832* 5832 5891 5892 5912* 5912 5966* 6009* 6009 6011 6012 operand_type 000232 automatic fixed bin(17,0) array dcl 194 set ref 2374 2409* 2491* 2533* 2544* 2547 2547* 2550* 2550 2590 2638 3145 3145 3148 3150 3166* 3168 3218 3218 3228 3232 3358 3373 3417 3565 4219 4264 4483 4483 4491 4494 4640* 4696* 4719* 4778* 4918* 4979* 5138 5346* 5379 5379 5411 5426 5450 5468 5479 5526 5610 5623* 5648 5651 5654 5656 5738 5741 5892* 5951 5956 6012* operator 000275 automatic fixed bin(17,0) array dcl 194 set ref 4473 4657 4660* operator_level 000223 automatic fixed bin(17,0) dcl 194 set ref 993* 1008 4324 4472 4473 4597* 4597 4636* 4636 4655* 4655 4657 4660 4678 optype 015572 automatic fixed bin(17,0) dcl 4284 set ref 4480* 4487* 4491 4494 4640 4641 output_length parameter fixed bin(17,0) dcl 134 set ref 98 106* 111 119* 6776* output_pointer parameter pointer dcl 134 set ref 27 98 111 867 954 6224* 6246 6252 output_pos 001346 automatic fixed bin(18,0) dcl 235 set ref 868* 947 947* 947 954 1060 1062* 1062 1361 1376 2339 2340 2342* 2342 2343 2344 2346 2347* 2347 2360 2404 2405 2406* 2406 2444 2447 2449* 2449 2472 2473 2474* 2474 2483 2484 2487 2488* 2488 2572 2574 2575* 2575 2580 2581 2582 2583* 2583 2586 2594* 2594 2651 2652* 2652 2657 2658 2659* 2659 2684 2685* 2685 2692 2697 2738 2739* 2739 2760 2761* 2761 2783 2784* 2784 2787 2788 2789* 2789 2889 2890* 2890 2916 2917* 2917 3018 3019 3020* 3020 3027 3029 3030 3031* 3031 3039 3041 3043* 3043 3056 3058 3059 3060 3061 3062 3063 3065* 3065 3072 3074 3076* 3076 3093 3094* 3094 3119 3120* 3120 3153 3154* 3154 3158 3159 3160* 3160 3171 3172* 3172 3176 3177 3178* 3178 3234 3235* 3235 3239 3240 3241* 3241 3295 3296* 3296 3346 3347* 3347 3358 3359* 3359 3365 3366 3367* 3367 3373 3374* 3374 3382 3383* 3383 3390 3391* 3391 3417 3418* 3418 3552 3553* 3553 3582 3583 3584 3585 3587* 3587 3613 3614* 3614 3618 3618 3619* 3619 3625 3628 3629 3658 3659* 3659 3661 3671 3688 3689* 3689 3696 3697 3698* 3698 3716 3717* 3717 3727 3729* 3729 3739 3741* 3741 3749 3750* 3750 3780 3781* 3781 3806 3808* 3808 3833 3834* 3834 3842 3843* 3843 3849 3850* 3850 3857 3859* 3859 3868 3869* 3869 3879 3880* 3880 3886 3888* 3888 3924 3925 3937* 3937 3938 3955 4063* 4063 4066 4069 4071* 4071 4077 4078 4079 4080* 4080 4243 4244* 4244 4512 4513 4514* 4514 4518 4519* 4519 4544 4545 4549 4550 4553* 4553 4561 4562 4564* 4564 4571 4572* 4572 4753 4780 4821 4822 4823* 4823 4827 4828* 4828 5129 5130* 5130 5160 5161* 5161 5164 5165 5166* 5166 5189 5193 5196* 5196 5242 5276 5279 5281* 5281 5339 5341* 5341 5388 5389* 5389 5391 5414 5415* 5415 5429 5430* 5430 5432 5445 5446 5447* 5447 5450 5452* 5452 5482 5483* 5483 5485 5523 5524* 5524 5528 5529* 5529 5564 5568 5596 5598 5600 5602* 5602 5612 5613* 5613 5619 5651 5652* 5652 5656 5657* 5657 5660 5661 5662* 5662 5682 5683* 5683 5695 5707 5713* 5713 5738 5739* 5739 5794 5794 5796 5797* 5797 5801 5854 5855* 5855 5860 5861* 5861 5866 5867* 5867 5909 5910* 5910 5956 5957* 5957 5961 5962 5963* 5963 5980 5981* 5981 6052 6053* 6053 6076 6077* 6077 6097 6098 6099* 6099 6167 6168 6169* 6169 6197 6198 6199* 6199 6215 6243 6248* 6248 6249 6264 6264* 6264 6267 6273 6275* 6275 6280 6286 6287* 6287 6334 6339 6342* 6342 6347 6348* 6348 6382 6389 6411* 6411 6418 6419* 6419 6437 6444 6468* 6468 6538 6548* 6554 6554 6761 6775* 6776 6778 6780 output_pt 000146 automatic pointer dcl 175 set ref 867* 1060 1373 2340 2348* 2404 2405 2444 2447 2472 2473 2483 2484 2487 2574 2580 2581 2582 2586 2651 2657 2658 2684 2690 2738 2760 2783 2787 2788 2889 2916 3018 3019 3029 3030 3039 3041 3056 3058 3059 3060 3061 3062 3063 3072 3074 3093 3119 3153 3158 3159 3171 3176 3177 3234 3239 3240 3295 3346 3358 3365 3366 3373 3382 3390 3417 3552 3582 3583 3584 3585 3613 3618 3623 3658 3671 3688 3696 3697 3716 3727 3739 3749 3780 3806 3833 3842 3849 3857 3868 3879 3886 3925 4072* 4077 4078 4079 4112 4243 4512 4513 4518 4544 4545 4549 4550 4561 4562 4571 4754 4821 4822 4827 5129 5160 5164 5165 5189 5193 5279 5339 5388 5391 5414 5429 5432 5445 5446 5450 5482 5485 5523 5528 5596 5598 5600 5612 5619 5651 5656 5660 5661 5682 5695 5707 5738 5794 5796 5801 5854 5860 5866 5909 5956 5962 5980 5984 5984 6052 6076 6098 6103 6168 6172 6198 6203 6244 6246* 6273 6286 6339 6347 6389 6418 6444 6538 6555 6586 6590 6610 6620 6757 6780 output_word based bit(36) array dcl 516 set ref 1060* 2404* 2405* 2444* 2447* 2472* 2473* 2483* 2484* 2487* 2574* 2580* 2581* 2582* 2586 2651* 2657* 2658* 2684* 2738* 2760 2783* 2787* 2788* 2889* 2916* 3018* 3019* 3029* 3030* 3039* 3041* 3056* 3058* 3059* 3060* 3061* 3062* 3063* 3072* 3074* 3093* 3119* 3153* 3158* 3159* 3171* 3176* 3177* 3234* 3239* 3240* 3295* 3346* 3358* 3365* 3366* 3373* 3382* 3390* 3417* 3552* 3582* 3583* 3584* 3585* 3613* 3618* 3658* 3688* 3696* 3697* 3716* 3727* 3739* 3749* 3780* 3806* 3833* 3842* 3849* 3857* 3868* 3879* 3886* 4077* 4078* 4079* 4243* 4512* 4513* 4518* 4544* 4545* 4549* 4550* 4561* 4562* 4571* 4754 4821* 4822* 4827* 5129* 5160* 5164* 5165* 5189* 5193* 5279* 5339* 5388* 5391* 5414* 5429* 5432* 5445* 5446* 5450* 5482* 5485* 5523* 5528* 5596* 5598* 5600* 5612* 5619* 5651* 5656* 5660* 5661* 5682* 5695* 5707* 5738* 5794* 5796* 5801* 5854* 5860* 5866* 5909* 5956* 5962* 5980* 5984 5984* 6052* 6076* 6098* 6168* 6198* 6244 6339* 6347* 6418* overflow 000126 stack reference condition dcl 170 ref 856 p 016524 automatic pointer dcl 6485 in procedure "finish_object" set ref 6579* 6581 6581* 6584 6586* 6587 6588 6654* 6655 6656 6662 6664 6665 6677* 6678 6687 6692 6693 6705 6709 6712 6718 6720 6721* 6727 6728 6732* 6737 6738 6739 6742* 6742 6747 6748 6757* 6759 6760 6761 6762 6763 6764 6765 6766 6767 6768 6769 6771 6771 6773 6773 6773 6775 p 015326 automatic pointer dcl 2206 in procedure "quoted_string" set ref 2245* 2246 2247 p 016430 automatic pointer dcl 6146 in procedure "finish_subprogram" set ref 6172* 6174 6177 6178 6203* 6204 6206 p 015364 automatic pointer dcl 2286 in procedure "compile_statement" set ref 2437* 2440 2444 2447 2586* 2587 2588 2589 2590 2591 2592 2593 2690* 2691 2692 3623* 3625 3628 3629 3914* 3917 3922 3927 3929 3932 3955* 4052 4063 p 016606 automatic pointer dcl 6879 in procedure "table_overflow" set ref 6892* 6893 6897 6914* 6917 6919 p 015132 automatic pointer dcl 1297 in procedure "lexical_analyzer" set ref 1373* 1374 1376 p 016574 automatic pointer dcl 6837 in procedure "store_string" set ref 6845* 6846 p 016376 automatic pointer dcl 6088 in procedure "scan_missing_list" set ref 6103* 6104 6106 p_err_num parameter fixed bin(17,0) dcl 6935 set ref 6933 6953 6953 6953 6953* 6955* 6964 6967 6972* 6977 6982* 6987 6995* 7000 7005* 7010 7015* 7020 7025* 7039 7048 p_line_num parameter fixed bin(17,0) dcl 6935 set ref 6977 6982* 6983* 7000 7005* 7006* 7010 7015* 7016* p_name_var parameter char(8) dcl 6936 set ref 6967 6973* 7000 7006* p_num_var parameter fixed bin(17,0) dcl 6935 set ref 7010 7016* p_sev_level parameter fixed bin(17,0) dcl 6935 set ref 6987 6995* param_info based bit(9) array level 2 packed packed unaligned dcl 602 set ref 4052* param_info_aligned based structure level 1 dcl 602 set ref 4063 parameter 0(18) based bit(1) level 2 in structure "array_symbol" packed packed unaligned dcl 1-11 in procedure "basic_" set ref 6401* 6404 parameter 0(18) based bit(1) level 2 in structure "scalar_symbol" packed packed unaligned dcl 1-6 in procedure "basic_" set ref 6465* parens_count 015635 automatic fixed bin(17,0) array dcl 4287 set ref 4585* 4585 4608* 4615* 4622* 4676* parens_level 015573 automatic fixed bin(17,0) dcl 4284 set ref 4322* 4451 4472 4582 4585 4585 4593 4600* 4600 4601 4608 4608 4608 4615 4615 4615 4622 4622 4622 4650 4669* 4669 4670 4675 4676 4677 4678 parens_token 015676 automatic fixed bin(17,0) array dcl 4287 set ref 4608 4608 4615 4615 4622 4622 4677* parens_type 015574 automatic fixed bin(17,0) array dcl 4287 set ref 4582 4593 4670 4675* pathname 011304 automatic varying char(168) array level 2 in structure "source_map_info" dcl 350 in procedure "basic_" set ref 914* 6661 pathname 2 based structure array level 3 in structure "source_map" packed packed unaligned dcl 8-3 in procedure "finish_object" set ref 6662* plus_op constant fixed bin(17,0) initial dcl 750 ref 4334 4483 pname parameter char packed unaligned dcl 6860 ref 6855 6864 pos_args constant fixed bin(17,0) initial dcl 763 ref 5311 power 104 based bit(36) level 2 dcl 383 ref 4549 power_inverse 105 based bit(36) level 2 dcl 383 ref 4544 prec 015213 automatic fixed bin(17,0) dcl 2114 set ref 2129* 2139* 2139 2140 2152* 2152 2154 2194 2196 2199 precedence 000205 constant fixed bin(17,0) initial array dcl 4290 ref 4475 precision_ind 15 based fixed bin(17,0) level 2 packed packed unaligned dcl 2-1 set ref 6354* precision_lng 000226 automatic fixed bin(17,0) dcl 194 set ref 870* 871 874 2437 2772 2817 4241* 4715 5061 5063 5085 5103 5777 6264 6270 6292 6354 6407 6891 6915 print 106 based bit(36) array level 2 dcl 383 set ref 3789* print_fun constant fixed bin(17,0) initial dcl 763 ref 3759 print_new_line 110 based bit(36) level 2 dcl 383 ref 3366 3697 3727 print_using 111 based bit(36) array level 2 dcl 383 set ref 3707* print_using_end 114 based bit(36) level 2 dcl 383 ref 3365 3696 3716 print_using_start 113 based bit(36) level 2 dcl 383 ref 3346 3688 procedure 12(02) based bit(1) level 3 packed packed unaligned dcl 10-10 set ref 6773* program_header_pt 000154 automatic pointer dcl 175 set ref 954 2251 2340* 2342 2351 2352 3263 3914 3925* 3935 3937 3946 3953 3953 4061 4112* 4114 4114 4116 4116 4947 4965 5519 6255 6255 6267 6271 6280 6283 6296 6301 6302 6309 6320 6321 6327 6329 6334 6336 6350 6352 6354 6382 6437 6590* 6592 6594 program_number 000207 automatic fixed bin(17,0) dcl 194 set ref 889* 2334* 2873 3896* 3903 3916 3921* 3921 3922 3924 4066 4112 6251 6251 6252 6253 6267 6280 6333 6367 6367 6578 6683 7034 7034 7034 prototype_mask 000321 constant bit(36) initial packed unaligned dcl 636 ref 4992 5557 5598 5763 6401 6465 ptr builtin function dcl 164 ref 2437 6780 6892 ptr_register_mask 000320 constant bit(36) initial packed unaligned dcl 636 ref 3962 punctuation_token constant bit(18) initial packed unaligned dcl 652 ref 1962 q 016564 automatic pointer dcl 6790 set ref 6799* 6802 6803 quote constant fixed bin(17,0) initial dcl 729 ref 1442 rand based structure array level 1 dcl 617 randomize 115 based bit(36) level 2 dcl 383 ref 3806 read 116 based bit(36) array level 2 dcl 383 set ref 3818* redim_allowed parameter bit(1) dcl 5877 ref 5874 5888 redimension 120 based bit(36) array level 2 dcl 383 set ref 5923* reg parameter fixed bin(17,0) dcl 5119 in procedure "load_register" set ref 5116 5122 5126 5126* 5129 5132 5135 5138 5138 reg parameter fixed bin(17,0) dcl 5043 in procedure "allocate_temp" set ref 5040 5051 5051 5053 5057 5061 5061 5063 5063 5063* 5065 reg parameter fixed bin(17,0) dcl 5077 in procedure "allocate_local" ref 5074 5085 5103 reg parameter fixed bin(17,0) dcl 5150 in procedure "save_register" set ref 5147 5154 5156* 5158 5160 5172 5175 reg parameter fixed bin(17,0) dcl 4258 in procedure "expression_in_register" ref 4255 4264 4266 rel builtin function dcl 164 ref 6224 6382 6437 6544 6548 6572 6572 6702 rel_bit_count 1 based fixed bin(17,0) level 2 dcl 6503 set ref 6687 6692 6693 6705 6709 6712 6718* 6728* 6738* 6739 6748* rel_def 21 based bit(18) level 2 packed packed unaligned dcl 7-1 set ref 6726* rel_link 21(18) based bit(18) level 2 packed packed unaligned dcl 7-1 set ref 6736* rel_symbol 22 based bit(18) level 2 packed packed unaligned dcl 7-1 set ref 6746* rel_text 20(18) based bit(18) level 2 packed packed unaligned dcl 7-1 set ref 6675* relational constant fixed bin(17,0) initial dcl 729 ref 1936 relational_token constant bit(18) initial packed unaligned dcl 652 ref 1943 3132 relbits 2 based bit level 2 packed packed unaligned dcl 6503 set ref 6687* 6692* 6693* 6705* 6709* 6712* 6739* release_temp_segment_ 000044 constant entry external dcl 152 ref 894 897 1038 1042 relinfo based structure level 1 dcl 6503 set ref 6720 relocatable 12(01) based bit(1) level 3 packed packed unaligned dcl 10-10 set ref 6773* remark_statement constant fixed bin(17,0) initial dcl 691 ref 1485 reset_ascii 123 based bit(36) level 2 dcl 383 ref 3842 reset_data 124 based bit(36) level 2 dcl 383 ref 3833 reset_random 125 based bit(36) level 2 dcl 383 ref 3849 rest 015140 automatic char(8) packed unaligned dcl 1297 in procedure "lexical_analyzer" set ref 1454* 1461* 1464 1476* 1478 rest 1 000104 external static char(8) array level 2 in structure "basic_data$statement_list" dcl 471 in procedure "basic_" ref 1464 retain 1(21) based bit(1) level 3 packed packed unaligned dcl 6-12 set ref 6816* return 126 based bit(36) level 2 dcl 383 ref 3857 right_precedence 000172 constant fixed bin(17,0) initial array dcl 4302 ref 4469 rtrim builtin function dcl 164 ref 88 run_time 2 000110 external static bit(36) array level 2 dcl 481 ref 2444 3764 5316 5866 save 007551 automatic structure level 1 dcl 315 save_fcb_pt 127 based bit(36) level 2 dcl 383 ref 2405 saved_lib_list based structure level 1 dcl 6497 set ref 6540 scalar based bit(36) dcl 540 ref 6442 6457 6465 scalar_symbol based structure level 1 dcl 1-6 set ref 6468 scalars 005556 automatic bit(36) array level 2 dcl 295 set ref 969 969 970* 3970 3973* 4715 4715* 4718 5763 5773 5777* 5806* 6440 6441 scale 015214 automatic fixed bin(17,0) dcl 2114 set ref 2130* 2153* 2153 2199 scratch 130 based bit(36) level 2 dcl 383 ref 3868 secondary_token constant bit(18) initial packed unaligned dcl 652 ref 1576 1607 3100 3189 3303 3647 seg_def 016541 automatic bit(18) dcl 6485 set ref 6570 6822* 6825 seg_name 001376 automatic varying char(32) dcl 250 set ref 878* 880 881* 881 884* 6566* 6581 segname 65 based varying char(32) level 2 in structure "source_info" dcl 562 in procedure "basic_" set ref 77* 88* 914 segname 53 based varying char(32) level 2 in structure "old_source_info" dcl 568 in procedure "basic_" ref 83 segname 2(18) based bit(18) level 2 in structure "definition" packed packed unaligned dcl 6-12 in procedure "finish_object" set ref 6570* 6825* seq parameter bit(36) array dcl 5732 in procedure "put_expression" ref 5729 5738 seq parameter bit(36) array dcl 5639 in procedure "input_list" ref 5636 5651 seq parameter bit(36) array dcl 5938 in procedure "mat_input_list" ref 5935 5956 5959 setdigits 131 based bit(36) level 2 dcl 383 ref 3879 sev 1 000060 external static fixed bin(17,0) array level 3 dcl 361 set ref 7046 7046 severity_level parameter fixed bin(17,0) dcl 7083 in procedure "pr_severity_header" set ref 7082 7086 7088 7090* severity_level 016620 automatic fixed bin(17,0) initial dcl 6938 in procedure "error" set ref 6938* 6953* 6955* 6959 6962 6972* 6982* 7005* 7015* 7025* 7043* 7046* 7048* 7048 7053 7057 7059* severity_level parameter fixed bin(17,0) dcl 7068 in procedure "pr_sev_line_header" set ref 7067 7071 7073 7075* severity_level parameter fixed bin(17,0) dcl 7098 in procedure "pr_sev_line_header2" set ref 7097 7103 7105 7107* 7110 7112 7114* sign builtin function dcl 164 ref 2989 single 001471 automatic bit(1) dcl 266 set ref 871* 873* 1710 1881 2009 2970 4354 4926 5500 6350 size builtin function dcl 6152 in procedure "finish_subprogram" ref 6411 6468 size 000112 stack reference condition dcl 170 in procedure "basic_" ref 855 size builtin function dcl 952 in begin block on line 951 ref 954 size builtin function dcl 1307 in procedure "lexical_analyzer" ref 2232 2251 size builtin function dcl 6495 in procedure "finish_object" ref 6540 6621 6658 6720 6775 6805 6847 size builtin function dcl 2314 in procedure "compile_statement" ref 2342 2347 3263 3914 3937 3953 4063 4071 4873 4873 4947 4965 5519 small_line 001036 automatic fixed bin(17,0) array dcl 233 set ref 941 942 small_numeric_data 000362 automatic float bin(63) array dcl 231 set ref 929 930 small_string_data 000672 automatic fixed bin(17,0) array dcl 232 set ref 935 936 small_table 001476 automatic bit(1) array dcl 268 set ref 933* 939* 945* 6882 6899* 6912 source_info based structure level 1 dcl 562 source_info_pointer parameter pointer dcl 134 ref 98 105 111 118 source_info_pt 000144 automatic pointer dcl 175 set ref 71* 77 77 77 78 79 83 84 85 87 88 88 90 91 92 105* 118* 129* 131 132 859 860 878 914 914 915 916 1019* 1020* 1021 1023 1024 source_l parameter fixed bin(17,0) dcl 134 ref 27 92 125 132 source_map based structure level 1 dcl 8-3 in procedure "finish_object" set ref 6658 source_map 16 based bit(18) level 2 in structure "std_symbol_header" packed packed unaligned dcl 7-1 in procedure "finish_object" set ref 6652* source_map_info 011304 automatic structure array level 1 dcl 350 source_number 000340 automatic fixed bin(17,0) dcl 194 set ref 865* 912* 912 914 915 916 6656 6660 source_p parameter pointer dcl 134 set ref 27 86* 91 125 131 sp 016472 automatic pointer dcl 6433 set ref 6441* 6442 6457 6465 space 000023 internal static fixed bin(17,0) initial array dcl 5045 set ref 5061 5063* stack_size 1 based bit(18) level 3 packed packed unaligned dcl 550 set ref 6363* standard 12(03) based bit(1) level 3 packed packed unaligned dcl 10-10 set ref 6773* start 000114 external static fixed bin(17,0) array level 2 in structure "basic_data$string_spelling" dcl 490 in procedure "basic_" ref 1851 start 000112 external static fixed bin(17,0) array level 2 in structure "basic_data$numeric_spelling" dcl 486 in procedure "basic_" ref 1720 start 000106 external static fixed bin(17,0) array level 2 in structure "basic_data$statement_spelling" dcl 477 in procedure "basic_" ref 1433 starting_operator_level 015737 automatic fixed bin(17,0) array dcl 4287 set ref 4324* 4472 4678* stat_boundary 15(18) based bit(18) level 2 packed packed unaligned dcl 7-1 set ref 6646* statement_ending 15 010254 automatic fixed bin(17,0) level 2 dcl 330 set ref 863* statement_map 14 based structure level 2 dcl 2-1 statement_number 14 010254 automatic fixed bin(17,0) level 2 dcl 330 set ref 862* 1340 statement_type 000210 automatic fixed bin(17,0) dcl 194 set ref 1315* 1404* 1413* 1421* 1423* 1433* 1435* 1442 1442* 1447 1464 1466 1481* 1485 1487 1810 1836 1915 2324 2367 4868 4880 static_length 6(18) based bit(18) level 2 packed packed unaligned dcl 10-10 set ref 6767* static_offset 6 based bit(18) level 2 packed packed unaligned dcl 10-10 set ref 6766* std_symbol_header based structure level 1 dcl 7-1 set ref 6621 stm 015137 automatic char(4) packed unaligned dcl 1297 set ref 1398* 1409* 1411 1421 1423 1431* 1435 stop 132 based bit(36) level 2 dcl 383 ref 2877 3886 store 133 based bit(36) array level 2 dcl 383 ref 2783 3030 3234 3585 4243 5160 5656 str 0(09) based char level 2 packed packed unaligned dcl 6794 set ref 6803* string builtin function dcl 2314 in procedure "compile_statement" set ref 2351* 2587* 2700* 2738 2768* 2810* 3946* 5604* 5619 string builtin function dcl 6152 in procedure "finish_subprogram" set ref 6296* 6309* 6327* 6329* string 0(28) based bit(1) level 2 in structure "itp" packed packed unaligned dcl 605 in procedure "basic_" set ref 2591* string builtin function dcl 164 in procedure "basic_" set ref 973* 982* string builtin function dcl 6495 in procedure "finish_object" set ref 6634* 6642* 6644* 6662* string 0(28) based bit(1) array level 2 in structure "rand" packed packed unaligned dcl 617 in procedure "basic_" ref 2591 string_arrays 12 based structure level 2 dcl 2-1 set ref 6309* string_assign 136 based bit(36) array level 2 dcl 383 ref 2787 2788 3239 3240 5164 5165 5660 5661 string_compare 140 based bit(36) array level 2 dcl 383 ref 3158 3159 3176 3177 string_concatenate 142 based bit(36) array level 2 dcl 383 ref 4561 4562 string_constant 015226 automatic char(250) packed unaligned dcl 2206 set ref 2227* 2247 2259* string_constant_token constant bit(18) initial packed unaligned dcl 652 ref 1955 3911 string_data based fixed bin(17,0) array dcl 581 in procedure "basic_" set ref 2039* 2058* 6286 string_data 4 based structure level 2 in structure "basic_program_header" dcl 2-1 in procedure "basic_" string_data_count defined fixed bin(18,0) dcl 254 set ref 2030 2034* 2034 2039 2045 2056* 2056 2058 6278 6283 6285 string_data_table 000011 internal static fixed bin(17,0) initial dcl 794 set ref 2030* 2045* string_op constant fixed bin(17,0) initial dcl 750 ref 4480 4488 string_operator_token constant bit(18) initial packed unaligned dcl 652 ref 1909 string_scalars 10 based structure level 2 dcl 2-1 set ref 6329* string_start 016426 automatic fixed bin(18,0) unsigned dcl 6146 set ref 6299* 6320 6321 6461 string_storage 2 based structure level 2 dcl 2-1 string_variable_token constant bit(18) initial packed unaligned dcl 652 ref 1539 1555 sub_ok 001475 automatic bit(1) dcl 268 set ref 910* 2326 2881* 3900 3909* 4087 sub_paren constant fixed bin(17,0) initial dcl 4315 ref 4378 sub_statement constant fixed bin(17,0) initial dcl 691 ref 1442 2324 subend 144 based bit(36) level 2 dcl 383 ref 4091 subend_statement constant fixed bin(17,0) initial dcl 691 ref 1442 subprogram 001554 automatic structure array level 1 dcl 284 set ref 3903 subprogram_call 145 based bit(36) level 2 dcl 383 ref 2580 subscript 146 based bit(36) array level 2 dcl 383 set ref 4775* substr builtin function dcl 164 set ref 87 881 1409* 1431* 1461* 1476* 1478 1517* 1528* 1572* 1574 1588* 1590 1592 1597 1608 1610* 1612 1619 1641 1666* 1670 1678 1686 1718 1721 1747 1771* 1775 1778 1780 1782 1784 1786 1789 1799* 1820 1822 1824 1834* 1840 1852 1859 1864* 1866 1904* 1922* 1928* 1936* 1941 1964* 2227* 2247 2259* 2380 2392 2414 2485* 2485 2491 2499 2499 2499 2513 2520 2552 2615 2631 2645 2701 2702 2708 2713 2716 2763 2832 2840 2846 2854 2863 2900 2908 2948 2955 2964 3106 3108 3112 3192 3192 3274 3351 3362 3378 3399 3422 3445 3468 3484 3493 3497 3513 3527 3568 3574 3650 3652 3654 3668 3702 3711 3736 3768 3775 3795 3798 3813 3946 3964 3995 4002 4019 4055 4129 4154 4169 4196 4204 4372 4392 4411 4414 4425 4431 4443 4463 4465 4696 4713 4858 4918 4930 4930 4932 4932 5317 5503 5621 5667 5695 5702 5720 5781 5793 5801* 5835 5845 5848 5892 5903 5968 6004 6191 6192* 6391 6392 6446 6453* 6453 6454* 6454 6457 6545 6633 6641 6687* 6692* 6693* 6705* 6709* 6712* 6739* 6844* 6848* subtract 151 based bit(36) level 2 dcl 383 ref 4512 4518 sv 015354 automatic fixed bin(17,0) dcl 2286 set ref 2622* 2641* 2655* 2658 sym_base 016522 automatic pointer dcl 6485 set ref 6620* 6623 6624 6625 6627 6629 6630 6634 6642 6644 6645 6646 6652 6654 6670 6670 6675 6677 6721 6726 6732 6736 6746 6752 6845 sym_pos 016506 automatic fixed bin(18,0) dcl 6485 set ref 6621* 6650* 6650 6650 6652 6654 6658* 6658 6670 6675 6677 6720* 6720 6721 6726 6730* 6730 6732 6736 6741* 6741 6746 6750* 6750 6752 6756 6769 6844 6845 6847* 6847 sym_start 016505 automatic fixed bin(18,0) dcl 6485 set ref 6618* 6620 6756 6768 symbol 2 based bit(18) level 2 packed packed unaligned dcl 6-12 set ref 6817* symbol_length 7(18) based bit(18) level 2 packed packed unaligned dcl 10-10 set ref 6769* symbol_offset 7 based bit(18) level 2 packed packed unaligned dcl 10-10 set ref 6768* symbol_string 014774 automatic varying char(300) dcl 632 set ref 6633* 6641* 6661* 6841 6846 6846 6847 6847 6848 symbol_table 005556 automatic structure level 1 dcl 295 ta 016131 automatic bit(36) dcl 5048 set ref 5057* 5059 5061* 5063* 5065 5068 tab_for_comma 152 based bit(36) level 2 dcl 383 ref 3739 table_element_size 000255 constant fixed bin(17,0) initial array dcl 814 ref 6891 6915 table_full 000013 internal static fixed bin(17,0) initial array dcl 812 set ref 6907* table_increment 000263 constant fixed bin(17,0) initial array dcl 808 ref 6905 6914 6922 6927 table_limit constant fixed bin(18,0) initial dcl 804 ref 6905 table_max 001372 automatic fixed bin(18,0) array dcl 235 set ref 930* 936* 942* 1356 1356 2002 2002 2030 2030 2045 2045 6898* 6927* 6927 table_pos 001367 automatic fixed bin(18,0) array dcl 235 set ref 931* 937* 943* 1354* 1354 1354 1354 1356 1356 1359 1359 1361 1361 1363 1363 2002 2002 2007* 2007 2007 2007 2009 2009 2011 2011 2030 2030 2034* 2034 2034 2034 2039 2039 2045 2045 2056* 2056 2056 2056 2058 2058 2359 2359 3907* 3907 3907 3907 5227 5227 6123 6123 6262 6262 6270 6270 6278 6278 6283 6283 6285 6285 6336 6336 6338 6338 6891 6915 table_pt 000170 automatic pointer array dcl 175 set ref 929* 935* 941* 1359 1361 1363 2009 2011 2039 2058 2360 5232 5235 5242 5246 6128 6128 6128 6273 6286 6339 6339 6893 6897* 6914 6917 6919* tabno parameter fixed bin(17,0) dcl 6877 ref 6874 6882 6891 6891 6892 6893 6897 6898 6898 6899 6905 6907 6911 6914 6922 6927 6927 6927 tag 0(30) based bit(6) array level 2 in structure "rand" packed packed unaligned dcl 617 in procedure "basic_" set ref 2593 4992 4992 5172* 5172 tag 1(30) based bit(6) level 2 in structure "itp" packed packed unaligned dcl 605 in procedure "basic_" set ref 2593* temp_ch 16 010254 automatic fixed bin(17,0) level 2 dcl 330 set ref 864* temp_dir 001407 automatic char(168) packed unaligned dcl 251 set ref 86* 87 temp_ent 001461 automatic char(32) packed unaligned dcl 252 set ref 86* temps based structure array level 1 dcl 544 temps_pt 000162 automatic pointer dcl 175 set ref 961* 2318 2318 2318 2748* 5051 5051 5053 5057 5065 5814* text_boundary 15 based bit(18) level 2 packed packed unaligned dcl 7-1 set ref 6645* text_length 3(18) based bit(18) level 2 packed packed unaligned dcl 10-10 set ref 6761* text_link_offset 11(18) based bit(18) level 2 packed packed unaligned dcl 10-10 set ref 6771* this_token based structure level 1 dcl 536 time_limit 6 based float bin(27) level 2 dcl 2-1 set ref 2352* 3935* 4114 4114* 4116* 4116 tmi 153 based bit(36) level 2 dcl 383 ref 3041 3060 tnz 154 based bit(36) level 2 dcl 383 ref 3108 token_length 015130 automatic fixed bin(17,0) dcl 1297 set ref 1651* 1657 1663 1665* 1665 1666 1670 1676 token_pt 000160 automatic pointer dcl 175 set ref 1083 1089 1101 1139 1151 1166 1175 1270 1279 1498* 1499 1507 1517 1519 1528 1529 1529 1539 1540 1540 1543 1555 1556 1556 1565 1572 1574 1576 1588 1590 1592 1597 1608 1610 1611 1612 1612 1619 1624 1630 1631 1631 1634 1641 1708 1710 1712 1718 1721 1747 1752 1753 1771 1775 1778 1780 1782 1784 1786 1789 1799 1805 1807 1812 1814 1816 1820 1822 1824 1834 1836 1840 1852 1859 1864 1866 1872 1873 1881 1885 1887 1889 1895 1902 1904 1909 1919 1922 1928 1936 1941 1943 1944 1955 1957 1962 1964 1970 2390* 2392 2414 2421 2429 2444 2491 2499 2499 2525 2826* 2829 2939* 2941 2982* 3130* 3132 3135 3187* 3189 3192 3192 3258* 3260 3260 3263 3438* 3440 3465 3599* 3601 3645* 3647 3650 3652 3654 3734* 3736 3755 3757 3764 3792* 3795 3798 3957* 3964 3970 3973 3981 3984 3989 4008 4008 4013 4016 4019 4025* 4027 4049 4147* 4149 4151 4164 4173* 4190 4208* 4326* 4329 4334 4340 4349* 4351 4354 4354 4356 4356 4368 4381 4387 4390 4394 4396* 4407 4414 4419* 4440 4443 4458* 4461 4461 4463 4465 4696 4713 4715 4715 4718 4743* 4853 4858 4859 4868 4882 4885 4918 4920 4922 4928 4937 4945 4953 5212* 5214 5214 5219 5307* 5308 5316 5317 5539 5557 5559 5562 5567 5568 5587* 5598 5606 5621 5756* 5758 5763 5770 5773 5777 5838* 5840 5842 5857* 5879* 5881 5892 5997* 5999 6067* 6069 6071 tokens based structure array level 1 dcl 529 set ref 1495 1498 1602 2390 2826 2939 2982 3130 3187 3258 3438 3599 3645 3734 3792 3957 4025 4147 4326 4349 4434* 4434 4458 4608 4608 4615 4615 4622 4622 5212 5756 5838 5857 5879 5997 6067 tp parameter pointer dcl 4732 in procedure "push_array" ref 4729 4743 tp parameter pointer dcl 5294 in procedure "function" ref 5291 5307 tp 016470 automatic pointer dcl 6433 in procedure "process_scalars" set ref 6444* 6446 6453 6454 6457 6461 6461 6465 tp parameter pointer dcl 5582 in procedure "user_function" ref 5579 5587 tp 016452 automatic pointer dcl 6378 in procedure "process_arrays" set ref 6389* 6391 6392 6394 6396 6398 6398 6401 6404 6406 tp 015532 automatic pointer dcl 4188 in procedure "subscript_list" set ref 4190* 4208 tpl 155 based bit(36) level 2 dcl 383 ref 3058 tpnz 156 based bit(36) level 2 dcl 383 ref 3063 3074 tra 157 based bit(36) level 2 dcl 383 set ref 2574 2684 3019 3061 3084* 3618 3666* type 0(09) based bit(9) level 2 in structure "itp" packed packed unaligned dcl 605 in procedure "basic_" set ref 2590* type parameter fixed bin(17,0) dcl 5639 in procedure "input_list" ref 5636 5648 type based bit(18) array level 2 in structure "tokens" dcl 529 in procedure "basic_" set ref 1319* 1607* 2414 2607 2675 2701 2702 2835 2849 3100 3222 3303 3448 3450 3471 3477 3874 3911 4105 4105 4346 6069 type based bit(18) level 2 in structure "this_token" dcl 536 in procedure "basic_" set ref 1507* 1539* 1543* 1555* 1565* 1576* 1611* 1630* 1634* 1708* 1752* 1872* 1887* 1889* 1895* 1909* 1919* 1943* 1955* 1962* 2414 2421 2491 2499 2525 2829 2941 3132 3189 3260 3260 3440 3601 3647 3755 3964 4008 4008 4027 4049 4149 4164 4329 4351 4368 4381 4387 4390 4414 4440 4461 4696 4713 4858 4918 4920 5214 5214 5317 5621 5758 5842 5881 5892 5999 6069 type parameter fixed bin(17,0) dcl 4667 in procedure "parenthesis" ref 4664 4675 type parameter fixed bin(17,0) dcl 5938 in procedure "mat_input_list" ref 5935 5951 tze 160 based bit(36) level 2 dcl 383 ref 3106 uid 3 based bit(36) array level 3 in structure "source_map" dcl 8-3 in procedure "finish_object" set ref 6664* uid 53 011304 automatic bit(36) array level 2 in structure "source_map_info" dcl 350 in procedure "basic_" set ref 915* 6664 unary_minus_op constant fixed bin(17,0) initial dcl 750 ref 4361 4478 4494 underflow 000134 stack reference condition dcl 170 ref 857 unique_id 66 based bit(36) level 2 in structure "old_source_info" dcl 568 in procedure "basic_" ref 85 unique_id 100 based bit(36) level 2 in structure "source_info" dcl 562 in procedure "basic_" set ref 79* 85* 915 unspec builtin function dcl 164 set ref 1400 1519 1529 1612 1624 1690* 1690 1710 1712 1718 2182 2218 2240* 2970 3382 4434* 4434 4928 5502 6339 upper 016412 automatic fixed bin(17,0) dcl 6119 in procedure "get_line_number" set ref 6123* 6125 6126 6132* upper 016177 automatic fixed bin(17,0) dcl 5209 in procedure "gen_xfer" set ref 5227* 5229 5230 5246* usage 1 007377 automatic bit(18) array level 2 dcl 311 set ref 2689 2698* 5567 5568* 6187 use_fcb 161 based bit(36) level 2 dcl 383 ref 4079 use_file 162 based bit(36) level 2 dcl 383 ref 2404 5707 use_tty 163 based bit(36) level 2 dcl 383 ref 5695 user_fun_paren constant fixed bin(17,0) initial dcl 4315 ref 4402 user_id 016530 automatic char(32) packed unaligned dcl 6485 set ref 6636* 6638 6639 6641 user_numeric_fun_token constant bit(18) initial packed unaligned dcl 652 ref 1634 4008 user_string_fun_token constant bit(18) initial packed unaligned dcl 652 ref 1630 4008 userid 13 based structure level 2 packed packed unaligned dcl 7-1 set ref 6642* val 015377 automatic bit(36) dcl 2286 in procedure "compile_statement" set ref 4928* 4930 4930 4932 4932 5502* 5503 val 000100 external static char(1) array level 2 in structure "basic_data$ascii_table" dcl 463 in procedure "basic_" ref 1700 value 1 based bit(18) level 2 in structure "definition" packed packed unaligned dcl 6-12 in procedure "finish_object" set ref 6818* value 015171 automatic float bin(27) dcl 2078 in procedure "s_convert_number" set ref 2083* 2083 2087* 2087 2090 value 4 based float bin(63) level 2 in structure "d_this_token" dcl 538 in procedure "basic_" set ref 1712* 1885* 4356* 4356 4953 value 4 based float bin(27) array level 2 in structure "tokens" dcl 529 in procedure "basic_" set ref 2838 2852 2989 4109 4114 4116 value 015202 automatic float bin(63) dcl 2096 in procedure "d_convert_number" set ref 2101* 2101 2105* 2105 2108 value 4 based float bin(27) level 2 in structure "this_token" dcl 536 in procedure "basic_" set ref 1710* 1881* 4354* 4354 4928 4937 4945 5219 value parameter bit(18) dcl 6785 in procedure "generate_definition" ref 6782 6818 verify builtin function dcl 164 ref 3932 version based fixed bin(17,0) level 2 in structure "source_info" dcl 562 in procedure "basic_" set ref 90* version based fixed bin(17,0) level 2 in structure "source_map" dcl 8-3 in procedure "finish_object" set ref 6655* version based fixed bin(17,0) level 2 in structure "relinfo" dcl 6503 in procedure "finish_object" set ref 6678* 6727* 6737* 6747* version_number based fixed bin(17,0) level 2 dcl 2-1 set ref 6350* 6352* which parameter fixed bin(17,0) dcl 5002 in procedure "allocate" ref 4999 5007 5010 5011 5014 5015 5015 5021 5023 5023 5024 5024 5027 5028 5028 5031 which parameter fixed bin(3,0) dcl 6376 in procedure "process_arrays" ref 6373 6386 which parameter fixed bin(3,0) dcl 6431 in procedure "process_scalars" ref 6428 6441 6461 which 000336 automatic fixed bin(17,0) dcl 194 in procedure "basic_" set ref 69* 103* 116* 128* 997 1017 1045 2335 3249 6776 which parameter fixed bin(17,0) dcl 5077 in procedure "allocate_local" ref 5074 5102 whole based bit(36) array dcl 625 ref 2444 2447 word 016100 automatic bit(36) dcl 4908 in procedure "push_constant" set ref 4923* 4930* 4932* 4947* 4965* 4970 word 016212 automatic bit(36) dcl 5299 in procedure "function" set ref 5503* 5519* 5523 word 015400 automatic bit(36) dcl 2286 in procedure "compile_statement" set ref 2462* 2463 2473 2484 2485* 2485 2487 2877* 2889 3962* 3973 4006 4016 4040 4091* word_0 based structure level 2 packed packed unaligned dcl 550 word_1 1 based structure level 2 in structure "link_header" packed packed unaligned dcl 6514 in procedure "finish_object" word_1 1 based structure level 2 in structure "basic_entry" packed packed unaligned dcl 550 in procedure "basic_" set ref 6253 word_2 2 based bit(36) level 2 dcl 550 set ref 6365* word_3 3 based bit(36) level 2 dcl 550 set ref 2346* 4069* word_6 6 based structure level 2 packed packed unaligned dcl 6514 word_count 67 based fixed bin(17,0) level 2 dcl 568 set ref 6778* write 164 based bit(36) array level 2 dcl 383 set ref 4126* x1 parameter bit(36) dcl 4819 ref 4816 4822 x2 parameter bit(36) dcl 4819 ref 4816 4825 4827 zero_def 016540 automatic bit(18) dcl 6485 set ref 6561* 6566* 6811 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. array_p automatic pointer dcl 175 based_single based fixed bin(35,0) dcl 5299 call_statement internal static fixed bin(17,0) initial dcl 691 concat internal static fixed bin(17,0) initial dcl 729 constant_pos automatic fixed bin(18,0) dcl 6146 in procedure "finish_subprogram" constant_pos automatic fixed bin(18,0) dcl 6485 in procedure "finish_object" def_statement internal static fixed bin(17,0) initial dcl 691 dim builtin function dcl 164 divide_op internal static fixed bin(17,0) initial dcl 750 end_pos automatic fixed bin(18,0) dcl 6485 err automatic fixed bin(17,0) dcl 194 file_statement internal static fixed bin(17,0) initial dcl 691 fnend_statement internal static fixed bin(17,0) initial dcl 691 for_statement internal static fixed bin(17,0) initial dcl 691 gosub_statement internal static fixed bin(17,0) initial dcl 691 goto_statement internal static fixed bin(17,0) initial dcl 691 i automatic fixed bin(17,0) dcl 6790 illegal internal static fixed bin(17,0) initial dcl 729 input_statement internal static fixed bin(17,0) initial dcl 691 instruction based structure level 1 dcl 592 is_assign internal static bit(18) initial packed unaligned dcl 673 is_basic internal static bit(18) initial packed unaligned dcl 673 is_integer internal static bit(18) initial packed unaligned dcl 673 is_relational internal static bit(18) initial packed unaligned dcl 673 is_secondary internal static bit(18) initial packed unaligned dcl 673 library_statement internal static fixed bin(17,0) initial dcl 691 linput_statement internal static fixed bin(17,0) initial dcl 691 margin_statement internal static fixed bin(17,0) initial dcl 691 matrix_fun internal static fixed bin(17,0) initial dcl 763 minus internal static fixed bin(17,0) initial dcl 729 n_0_fun internal static fixed bin(17,0) initial dcl 763 n_n_fun internal static fixed bin(17,0) initial dcl 763 n_nn_fun internal static fixed bin(17,0) initial dcl 763 n_s_fun internal static fixed bin(17,0) initial dcl 763 n_ssn_fun internal static fixed bin(17,0) initial dcl 763 n_var_fun internal static fixed bin(17,0) initial dcl 763 next_statement internal static fixed bin(17,0) initial dcl 691 object_map_version_2 internal static fixed bin(17,0) initial dcl 10-40 plus internal static fixed bin(17,0) initial dcl 729 power internal static fixed bin(17,0) initial dcl 729 power_op internal static fixed bin(17,0) initial dcl 750 print_statement internal static fixed bin(17,0) initial dcl 691 punctuation internal static fixed bin(17,0) initial dcl 729 quotient internal static fixed bin(17,0) initial dcl 729 randomize_statement internal static fixed bin(17,0) initial dcl 691 rc_a internal static bit(18) initial packed unaligned dcl 9-6 rc_a_dp internal static bit(36) initial packed unaligned dcl 9-23 rc_dp internal static bit(18) initial packed unaligned dcl 9-6 rc_dp_dp internal static bit(36) initial packed unaligned dcl 9-23 rc_e internal static bit(18) initial packed unaligned dcl 9-6 rc_is15 internal static bit(18) initial packed unaligned dcl 9-6 rc_is18 internal static bit(18) initial packed unaligned dcl 9-6 rc_lb internal static bit(18) initial packed unaligned dcl 9-6 rc_lp15 internal static bit(18) initial packed unaligned dcl 9-6 rc_lp18 internal static bit(18) initial packed unaligned dcl 9-6 rc_nlb internal static bit(18) initial packed unaligned dcl 9-6 rc_nlp18 internal static bit(18) initial packed unaligned dcl 9-6 rc_ns internal static bit(18) initial packed unaligned dcl 9-6 rc_nt internal static bit(18) initial packed unaligned dcl 9-6 rc_s internal static bit(18) initial packed unaligned dcl 9-6 rc_sr internal static bit(18) initial packed unaligned dcl 9-6 rc_t internal static bit(18) initial packed unaligned dcl 9-6 read_statement internal static fixed bin(17,0) initial dcl 691 remark internal static fixed bin(17,0) initial dcl 729 reset_statement internal static fixed bin(17,0) initial dcl 691 return_statement internal static fixed bin(17,0) initial dcl 691 reverse builtin function dcl 164 s_0_fun internal static fixed bin(17,0) initial dcl 763 s_n_fun internal static fixed bin(17,0) initial dcl 763 s_nn_fun internal static fixed bin(17,0) initial dcl 763 s_snn_fun internal static fixed bin(17,0) initial dcl 763 s_ssn_fun internal static fixed bin(17,0) initial dcl 763 scratch_statement internal static fixed bin(17,0) initial dcl 691 search builtin function dcl 164 setdigits_statement internal static fixed bin(17,0) initial dcl 691 stop_statement internal static fixed bin(17,0) initial dcl 691 string builtin function dcl 1307 string_function_param internal static fixed bin(17,0) initial dcl 5-1 string_list_param internal static fixed bin(17,0) initial dcl 5-1 string_scalar_param internal static fixed bin(17,0) initial dcl 5-1 string_table_param internal static fixed bin(17,0) initial dcl 5-1 teach_statement internal static fixed bin(17,0) initial dcl 691 time_statement internal static fixed bin(17,0) initial dcl 691 times internal static fixed bin(17,0) initial dcl 729 times_op internal static fixed bin(17,0) initial dcl 750 write_statement internal static fixed bin(17,0) initial dcl 691 NAMES DECLARED BY EXPLICIT CONTEXT. abort_compilation 002024 constant label dcl 1038 ref 1066 6908 6962 abort_statement 002123 constant label dcl 1060 ref 5541 6964 allocate 013615 constant entry internal dcl 4999 ref 3962 4241 4715 4873 5061 allocate_local 013764 constant entry internal dcl 5074 ref 5063 allocate_temp 013673 constant entry internal dcl 5040 ref 2402 2462 5156 arg_or_local 015552 constant entry internal dcl 5752 ref 2715 2801 array_defined_twice 002621 constant label dcl 1270 ref 4882 array_occurs_twice 002541 constant label dcl 1234 ref 3986 array_op 013127 constant entry internal dcl 4791 ref 4775 5923 asc_loop 003575 constant label dcl 1654 ref 1667 asc_ok 003704 constant label dcl 1708 ref 1682 1691 1701 assign_missing 002265 constant label dcl 1122 ref 3211 assign_out_of_order 002657 constant label dcl 1282 ref 3222 basic_ 000666 constant entry external dcl 27 build_lib_list 021353 constant entry internal dcl 6855 ref 94 107 call_list 005227 constant label dcl 2385 ref 2552 check_dot 010243 constant label dcl 3561 ref 3465 3468 3537 check_line 001151 constant entry external dcl 125 check_stack 012276 constant label dcl 4469 ref 4362 clear_address_register 013103 constant label dcl 4771 ref 4754 4761 4765 comma_check 004353 constant label dcl 2015 in procedure "lexical_analyzer" ref 2041 2060 comma_check 010722 constant label dcl 3792 in procedure "compile_statement" ref 3785 compile 001055 constant entry external dcl 98 compile_statement 005102 constant entry internal dcl 2283 ref 1006 convert_number 004623 constant entry internal dcl 2111 ref 2081 2099 d_convert_number 004567 constant entry internal dcl 2093 ref 1885 2011 d_ok 013541 constant label dcl 4965 ref 4957 d_ok_1 015077 constant label dcl 5519 ref 5511 data 000026 constant label array(18) dcl 1974 ref 1984 2067 dimension_array 013244 constant entry internal dcl 4845 ref 2523 2861 4745 5852 5858 5907 5922 6007 6074 done 006513 constant label dcl 2892 ref 2598 2662 2822 2869 2920 2929 3080 3086 3096 3199 3207 3245 3272 3286 3299 3323 3330 3395 3407 3428 3458 3474 3481 3508 3524 3556 3591 3636 3672 3699 3718 3731 3752 3809 3821 3835 3844 3853 3861 3870 3882 3889 4083 4119 4135 dp_case 013505 constant label dcl 4955 ref 4980 end 006475 constant label dcl 2879 ref 4092 end_not_allowed 002551 constant label dcl 1240 ref 2873 end_or_subend_must_be_last 002545 constant label dcl 1237 error 021617 constant entry internal dcl 6933 ref 1008 1070 1074 1077 1080 1086 1092 1095 1098 1104 1107 1110 1113 1116 1119 1122 1125 1128 1132 1136 1142 1145 1148 1154 1157 1160 1163 1169 1172 1178 1181 1184 1187 1190 1193 1196 1199 1202 1205 1208 1211 1214 1217 1220 1224 1228 1231 1234 1237 1240 1243 1246 1249 1252 1255 1258 1261 1264 1267 1273 1276 1282 1285 1314 1337 2220 2885 3252 3265 error_line 022016 constant entry internal dcl 6977 ref 6163 error_name 021736 constant entry internal dcl 6967 ref 1083 1089 1101 1139 1151 1166 1175 1270 1279 5539 error_name_line 022155 constant entry internal dcl 7000 ref 6208 error_no_line 022320 constant entry internal dcl 7020 ref 6222 6317 error_number_line 022237 constant entry internal dcl 7010 ref 6108 error_sev 022073 constant entry internal dcl 6987 ref 6907 expression 012010 constant entry internal dcl 4281 ref 2371 2542 2613 3128 3139 4217 4262 expression_in_register 011772 constant entry internal dcl 4255 ref 2398 2648 2776 2913 3117 3228 3293 3344 3491 3640 3686 3773 3847 3878 5700 5734 expression_required 000000 constant label array(0:1) dcl 1128 set ref 5138 file_expression_required 002305 constant label dcl 1136 ref 2900 4431 5720 file_occurs_twice 002555 constant label dcl 1243 finish 002023 constant label dcl 1032 ref 1335 finish_object 020003 constant entry internal dcl 6482 ref 1032 finish_subprogram 016612 constant entry internal dcl 6143 ref 1014 fn_cleanup 015623 constant entry internal dcl 5790 ref 2792 2886 2928 fn_done 014500 constant label dcl 5341 ref 5394 5435 5488 fn_not_yet 015143 constant label dcl 5539 ref 5460 fn_put 014472 constant label dcl 5335 ref 5361 5371 5403 5418 5532 fn_thru 014501 constant label dcl 5344 ref 5456 fn_xeq 000137 constant label array(17) dcl 5328 ref 5324 5496 fnend_without_def 002465 constant label dcl 1199 ref 2924 for_done 006777 constant label dcl 3078 ref 3045 3066 for_expression 011733 constant entry internal dcl 4229 ref 2960 2984 for_next_mismatch 002441 constant label dcl 1184 ref 3606 for_too_deep 002445 constant label dcl 1187 ref 2936 fun_cannot_be_passed 002644 constant label dcl 1279 ref 2431 function 014414 constant entry internal dcl 5291 ref 4419 4615 function_not_allowed 002416 constant label dcl 1175 ref 5465 function_occurs_twice 002640 constant label dcl 1276 ref 4013 gen_xfer 014240 constant entry internal dcl 5204 ref 3084 3090 3198 3666 generate_definition 021163 constant entry internal dcl 6782 ref 6566 6568 6572 6584 get_file 015475 constant label dcl 5698 ref 5723 get_line_number 016532 constant entry internal dcl 6116 ref 6108 6108 6163 6163 6208 6208 have_statement_type 003232 constant label dcl 1442 ref 1406 1415 1435 id_string_function 004444 constant entry internal dcl 1848 ref 1758 1775 1803 incorrect_format 002140 constant label dcl 1074 ref 2026 2387 2520 2615 2631 2832 2846 2854 2892 2948 2955 3108 3112 3274 3316 3351 3445 3450 3493 3497 3527 3568 3574 3702 3775 3949 4002 4027 4101 4105 4109 4204 4365 4448 4453 5674 5835 5845 5975 6004 init 001747 constant label dcl 991 ref 1064 3254 input_list 015376 constant entry internal dcl 5636 ref 3205 3284 3813 3818 integer_constant_required 002461 constant label dcl 1196 ref 2835 2849 invalid_arg_list 002501 constant label dcl 1208 ref 2716 2721 2802 5758 5763 5767 invalid_array 002340 constant label dcl 1151 ref 3981 4853 invalid_asc 002216 constant label dcl 1098 ref 1648 1657 1660 1678 1686 1705 invalid_character 002235 constant label dcl 1104 set ref 1974 invalid_constant 002241 constant label dcl 1107 ref 853 1996 2186 2194 2196 invalid_def 002505 constant label dcl 1211 ref 2675 invalid_function 002154 constant label dcl 1083 ref 1726 1869 invalid_line_number 002353 constant label dcl 1154 ref 5217 invalid_operator 002222 constant label dcl 1101 ref 1951 invalid_statement 002167 constant label dcl 1086 ref 1395 1428 1439 1458 1466 1473 1478 invalid_subprogram_name 002605 constant label dcl 1261 ref 3927 3929 3932 invalid_subprogram_parameter 002611 constant label dcl 1264 ref 4019 invalid_variable 002173 constant label dcl 1089 ref 1583 1766 1794 1846 1972 2829 4151 4154 4164 is_op 004155 constant label dcl 1902 ref 1911 is_secondary 003453 constant label dcl 1576 ref 1590 1592 1778 1780 1782 1784 1786 1805 1807 1812 1814 1816 1836 join 001172 constant label dcl 853 ref 95 108 121 l0 014342 constant label dcl 5255 ref 5235 5239 l1 014403 constant label dcl 5279 ref 5243 l2 014375 constant label dcl 5276 ref 5261 lexical_analyzer 002670 constant entry internal dcl 1294 ref 999 1005 line_number_required 002357 constant label dcl 1157 ref 5214 line_number_too_large 002144 constant label dcl 1077 ref 1346 line_too_long 002206 constant label dcl 1092 ref 1495 1602 list 016145 constant label dcl 5946 in procedure "mat_input_list" ref 5972 list 015400 constant label dcl 5643 in procedure "input_list" ref 5671 load_register 014056 constant entry internal dcl 5116 ref 2544 2578 2655 2914 3166 4239 4517 4548 4558 4569 4799 4806 5192 5386 loop 002671 constant label dcl 1311 ref 1392 1485 2021 2071 lr 014060 constant label dcl 5122 ref 5141 mat 000116 constant label array(5) dcl 3320 ref 3312 mat_input_list 016142 constant entry internal dcl 5935 ref 3322 3329 3399 3404 mat_print_list 007635 constant label dcl 3370 ref 3386 mat_print_using_list 007603 constant label dcl 3354 ref 3362 mat_write_list 007745 constant label dcl 3414 ref 3425 matrix_function 015710 constant entry internal dcl 5823 ref 3448 3473 matrix_op 016264 constant entry internal dcl 6020 ref 3453 3479 3504 3521 matrix_operand 016371 constant entry internal dcl 6062 ref 3541 3542 3550 6046 6049 matrix_reference 016034 constant entry internal dcl 5874 ref 3356 3370 3414 5946 matrix_required 000002 constant label array(0:1) dcl 1220 set ref 6027 6030 6069 6071 mess_sv_in_tb 022365 constant entry internal dcl 7031 ref 6948 6970 6980 6990 7003 7013 7023 missing_colon 002406 constant label dcl 1169 ref 2908 5704 mixed_expression 002251 constant label dcl 1113 ref 3145 4491 4494 mixed_let 002261 constant label dcl 1119 ref 3218 multiple_commas 002451 constant label dcl 1190 ref 2064 multiple_def 002475 constant label dcl 1205 ref 2679 nested_def 002471 constant label dcl 1202 ref 2671 next_arg 005622 constant label dcl 2552 ref 2411 2496 2536 next_data_value 004276 constant label dcl 1980 set ref 1487 2018 next_libe 007346 constant label dcl 3258 ref 3277 next_print 010627 constant label dcl 3743 ref 3798 next_token 003340 constant label dcl 1493 ref 1547 1557 1567 1578 1614 1638 1713 1754 1874 1891 1905 1923 1933 1945 1958 1966 next_without_for 002435 constant label dcl 1181 ref 3595 no_line_number 002150 constant label dcl 1080 non_quoted_string 005053 constant entry internal dcl 2253 ref 2058 not_a_function 003776 constant label dcl 1763 ref 1747 not_yet 002271 constant label dcl 1125 set ref 2602 4096 numeric_expression 011725 constant entry internal dcl 4214 ref 2906 2953 4194 4200 4232 numeric_expression_required 002275 constant label dcl 1128 ref 3874 4219 4351 5379 5426 5479 numeric_list_reference 016230 constant entry internal dcl 5994 ref 2620 2629 3572 3578 numeric_list_required 002531 constant label dcl 1228 ref 5999 numeric_matrix_required 002521 constant label dcl 1220 ref 5840 5842 numeric_variable_required 002431 constant label dcl 1178 ref 2941 3565 3601 ok 013470 constant label dcl 4947 ref 4937 on_list 010466 constant label dcl 3663 ref 3668 op 000123 constant label array(8) dcl 4503 ref 4488 4499 op_done 012645 constant label dcl 4627 ref 4505 4522 4528 4534 4554 4565 op_thru 012653 constant label dcl 4636 ref 4575 operand_is_constant 013567 constant entry internal dcl 4987 ref 2544 2989 4234 operate 014202 constant entry internal dcl 5184 ref 4503 4526 4532 operation_not_allowed 002455 constant label dcl 1193 ref 2024 optional_file 015462 constant entry internal dcl 5692 ref 3203 3282 3290 3320 3327 3334 3403 3676 3817 optional_redimension 016066 constant entry internal dcl 5900 ref 5831 5886 overflow_error 002134 constant label dcl 1070 set ref 856 param_list 011250 constant label dcl 3957 ref 4058 paren_xeq 000133 constant label array(4) dcl 4597 ref 4593 4611 4618 4625 parenthesis 012705 constant entry internal dcl 4664 ref 4378 4402 4437 4443 parenthesis_mismatch 002324 constant label dcl 1142 ref 4451 4590 4601 4650 place 005021 constant label dcl 2232 ref 2265 plop 013220 constant entry internal dcl 4816 ref 4800 4803 4807 pr_sev_line_header 022577 constant entry internal dcl 7067 ref 6955 6972 6982 6995 7005 7015 pr_sev_line_header2 023027 constant entry internal dcl 7097 ref 6953 pr_severity_header 022720 constant entry internal dcl 7082 ref 7025 print_comma 010622 constant label dcl 3739 ref 3795 print_done 010606 constant label dcl 3727 ref 3802 print_header_only 022477 constant label dcl 7053 ref 7044 print_list 010603 constant label dcl 3723 ref 3746 print_using_list 010533 constant label dcl 3693 ref 3711 process_arrays 017510 constant entry internal dcl 6373 ref 6296 6309 process_scalars 017643 constant entry internal dcl 6428 ref 6327 6329 process_source 001525 constant label dcl 912 ref 1026 program_out_of_order 002212 constant label dcl 1095 ref 1349 punctuation_not_allowed 002330 constant label dcl 1145 ref 4582 push_array 013012 constant entry internal dcl 4729 ref 4173 4608 push_constant 013363 constant entry internal dcl 4905 ref 4030 4357 4383 push_constant_dp_notok 013557 constant entry internal dcl 4973 ref 2974 push_function 012730 constant entry internal dcl 4688 ref 4159 4394 push_variable 012745 constant entry internal dcl 4703 ref 2944 3604 4169 4374 put_expression 015533 constant entry internal dcl 5729 ref 3707 3789 4126 quoted_string 004766 constant entry internal dcl 2203 ref 1957 2039 redim_not_allowed 002511 constant label dcl 1214 ref 5888 redimension_matrix 016117 constant entry internal dcl 5918 ref 5903 reference 011630 constant entry internal dcl 4144 ref 2636 3216 3563 5643 register_load 014112 constant entry internal dcl 5135 ref 4268 5356 5365 5398 5400 5407 5409 5422 5424 5475 5480 5525 relational_required 002245 constant label dcl 1110 ref 3132 required_file 015524 constant entry internal dcl 5717 ref 3411 3838 3865 4123 run_unit_compiler 001113 constant entry external dcl 111 s_convert_number 004534 constant entry internal dcl 2075 ref 1881 2009 save_register 014123 constant entry internal dcl 5147 ref 2377 2547 2556 3008 4416 4538 4769 5126 5319 5321 5328 5368 5375 5383 5441 5590 scan_missing_list 016441 constant entry internal dcl 6085 ref 5811 6156 set_bounds 013350 constant entry internal dcl 4891 ref 4871 4887 severity_check 021716 constant label dcl 6959 ref 6975 6985 6998 7008 7018 7028 size_error 002134 constant label dcl 1070 ref 855 some_matrix_required 002515 constant label dcl 1217 set ref 5881 split 003500 constant label dcl 1602 ref 1789 1820 1822 1824 1840 1866 stack_it 012674 constant label dcl 4655 ref 4680 stack_operator 012665 constant label dcl 4647 ref 4475 statement_outside_program 002561 constant label dcl 1246 ref 2326 step_type 000113 constant label array(-1:1) dcl 3039 ref 3033 stm 000050 constant label array(35) dcl 2371 ref 2367 2866 store_string 021312 constant entry internal dcl 6834 ref 6634 6642 6662 string_constant_required 002601 constant label dcl 1258 ref 3911 string_expression_required 002301 constant label dcl 1132 ref 2374 5411 5468 5526 string_matrix_required 002525 constant label dcl 1224 ref 5951 string_reference_required 002412 constant label dcl 1172 ref 2638 3260 3260 5648 sub_not_allowed 002565 constant label dcl 1249 ref 3900 subend_not_allowed 002615 constant label dcl 1267 ref 4087 subprogram_defined_twice 002571 constant label dcl 1252 ref 3917 subscript_list 011673 constant entry internal dcl 4185 ref 4172 5921 sw 000004 constant label array(18) dcl 1507 ref 1502 table_overflow 021410 constant entry internal dcl 6874 ref 1356 2002 2030 2045 then_goto_gosub_missing 002367 constant label dcl 1163 ref 3647 3654 then_goto_missing 002255 constant label dcl 1116 ref 3189 3192 too_deep 002334 constant label dcl 1148 ref 2459 2529 4657 4670 4692 4710 4915 5054 5335 too_many_locals 002535 constant label dcl 1231 ref 2807 5094 too_many_missing_lines 002363 constant label dcl 1160 ref 5267 too_many_subprograms 002634 constant label dcl 1273 ref 3903 underflow_error 002663 constant label dcl 1285 ref 857 user_function 015230 constant entry internal dcl 5579 ref 4396 4622 user_function_loc 015157 constant entry internal dcl 5551 ref 2421 5596 variable_occurs_twice 002575 constant label dcl 1255 ref 3970 want_op 012250 constant label dcl 4458 ref 4375 want_operand 012014 constant label dcl 4326 ref 4337 4587 4662 want_operator 012247 constant label dcl 4455 ref 4358 4384 4398 4420 4604 write_list 011611 constant label dcl 4126 ref 4132 wrong_number_of_args 002311 constant label dcl 1139 ref 3768 4411 4425 5311 5535 wrong_number_of_subs 002373 constant label dcl 1166 ref 4740 4876 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 24772 25126 24271 25002 Length 25664 24271 134 522 501 24 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME basic_ 8186 external procedure is an external procedure. on unit on line 853 64 on unit on unit on line 855 64 on unit on unit on line 856 64 on unit on unit on line 857 64 on unit on unit on line 892 80 on unit begin block on line 951 begin block shares stack frame of external procedure basic_. lexical_analyzer internal procedure shares stack frame of external procedure basic_. id_string_function internal procedure shares stack frame of external procedure basic_. s_convert_number internal procedure shares stack frame of external procedure basic_. d_convert_number internal procedure shares stack frame of external procedure basic_. convert_number internal procedure shares stack frame of external procedure basic_. quoted_string internal procedure shares stack frame of external procedure basic_. compile_statement internal procedure shares stack frame of external procedure basic_. reference internal procedure shares stack frame of external procedure basic_. subscript_list internal procedure shares stack frame of external procedure basic_. numeric_expression internal procedure shares stack frame of external procedure basic_. for_expression internal procedure shares stack frame of external procedure basic_. expression_in_register internal procedure shares stack frame of external procedure basic_. expression internal procedure shares stack frame of external procedure basic_. parenthesis internal procedure shares stack frame of external procedure basic_. push_function internal procedure shares stack frame of external procedure basic_. push_variable internal procedure shares stack frame of external procedure basic_. push_array internal procedure shares stack frame of external procedure basic_. array_op internal procedure shares stack frame of external procedure basic_. plop internal procedure shares stack frame of external procedure basic_. dimension_array internal procedure shares stack frame of external procedure basic_. set_bounds internal procedure shares stack frame of external procedure basic_. push_constant internal procedure shares stack frame of external procedure basic_. operand_is_constant internal procedure shares stack frame of external procedure basic_. allocate internal procedure shares stack frame of external procedure basic_. allocate_temp internal procedure shares stack frame of external procedure basic_. allocate_local internal procedure shares stack frame of external procedure basic_. load_register internal procedure shares stack frame of external procedure basic_. save_register internal procedure shares stack frame of external procedure basic_. operate internal procedure shares stack frame of external procedure basic_. gen_xfer internal procedure shares stack frame of external procedure basic_. function internal procedure shares stack frame of external procedure basic_. user_function_loc internal procedure shares stack frame of external procedure basic_. user_function internal procedure shares stack frame of external procedure basic_. input_list internal procedure shares stack frame of external procedure basic_. optional_file internal procedure shares stack frame of external procedure basic_. put_expression internal procedure shares stack frame of external procedure basic_. arg_or_local internal procedure shares stack frame of external procedure basic_. fn_cleanup internal procedure shares stack frame of external procedure basic_. matrix_function internal procedure shares stack frame of external procedure basic_. matrix_reference internal procedure shares stack frame of external procedure basic_. optional_redimension internal procedure shares stack frame of external procedure basic_. redimension_matrix internal procedure shares stack frame of external procedure basic_. mat_input_list internal procedure shares stack frame of external procedure basic_. numeric_list_reference internal procedure shares stack frame of external procedure basic_. matrix_op internal procedure shares stack frame of external procedure basic_. matrix_operand internal procedure shares stack frame of external procedure basic_. scan_missing_list internal procedure shares stack frame of external procedure basic_. get_line_number internal procedure shares stack frame of external procedure basic_. finish_subprogram internal procedure shares stack frame of external procedure basic_. process_arrays internal procedure shares stack frame of external procedure basic_. process_scalars internal procedure shares stack frame of external procedure basic_. finish_object internal procedure shares stack frame of external procedure basic_. generate_definition internal procedure shares stack frame of external procedure basic_. store_string internal procedure shares stack frame of external procedure basic_. build_lib_list 66 internal procedure is assigned to an entry variable. table_overflow internal procedure shares stack frame of external procedure basic_. error internal procedure shares stack frame of external procedure basic_. mess_sv_in_tb internal procedure shares stack frame of external procedure basic_. pr_sev_line_header internal procedure shares stack frame of external procedure basic_. pr_severity_header internal procedure shares stack frame of external procedure basic_. pr_sev_line_header2 internal procedure shares stack frame of external procedure basic_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 numeric_data_table basic_ 000011 string_data_table basic_ 000012 line_table basic_ 000013 table_full basic_ 000016 next_line_err basic_ 000023 space allocate_temp 000026 amount allocate_temp STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME basic_ 000100 add_lib_name basic_ 000142 main_pt basic_ 000144 source_info_pt basic_ 000146 output_pt basic_ 000150 instruction_temp_ptr basic_ 000152 constant_ptr basic_ 000154 program_header_pt basic_ 000156 entry_pt basic_ 000160 token_pt basic_ 000162 temps_pt basic_ 000164 local_pt basic_ 000166 inst_pt basic_ 000170 table_pt basic_ 000200 basic_temp_ptr basic_ 000202 lib_name_pt basic_ 000204 missing_pt basic_ 000206 number_of_errors basic_ 000207 program_number basic_ 000210 statement_type basic_ 000211 current_token basic_ 000212 number_of_tokens basic_ 000213 number_of_assigns basic_ 000214 number_of_dims basic_ 000215 address_register_loaded basic_ 000216 matrix_type basic_ 000217 npars basic_ 000220 fn_start basic_ 000221 fn_name basic_ 000222 operand_level basic_ 000223 operator_level basic_ 000224 for_level basic_ 000225 current_line_number basic_ 000226 precision_lng basic_ 000230 odd_available basic_ 000232 operand_type basic_ 000272 operand_in_register basic_ 000275 operator basic_ 000335 i basic_ 000336 which basic_ 000337 lib_count basic_ 000340 source_number basic_ 000341 for_type basic_ 000351 code basic_ 000352 auto_ctr basic_ 000354 dec_num basic_ 000362 small_numeric_data basic_ 000672 small_string_data basic_ 001036 small_line basic_ 001346 output_pos basic_ 001347 local_ctr basic_ 001350 al_count basic_ 001351 block_size basic_ 001352 first_code_word basic_ 001353 last_instruction basic_ 001354 for_location basic_ 001364 large_table_offset basic_ 001367 table_pos basic_ 001372 table_max basic_ 001375 number_of_constants basic_ 001376 seg_name basic_ 001407 temp_dir basic_ 001461 temp_ent basic_ 001471 single basic_ 001472 first_statement basic_ 001473 last_statement basic_ 001474 generate_object basic_ 001475 sub_ok basic_ 001476 small_table basic_ 001501 loc basic_ 001502 next_loc basic_ 001503 modifier basic_ 001504 operand basic_ 001544 for_variable basic_ 001554 subprogram basic_ 002622 d_tokens basic_ 005556 symbol_table basic_ 007201 normal_temps basic_ 007300 local_temps basic_ 007377 fn_table basic_ 007551 save basic_ 007741 missing_table basic_ 010253 fn_call_word basic_ 010254 next_line_storage basic_ 011304 source_map_info basic_ 013134 auto_source_info basic_ 013240 lib_names basic_ 014774 symbol_string basic_ 015124 i lexical_analyzer 015125 j lexical_analyzer 015126 k lexical_analyzer 015127 ip lexical_analyzer 015130 token_length lexical_analyzer 015131 numsign lexical_analyzer 015132 p lexical_analyzer 015134 integer lexical_analyzer 015135 abbrev lexical_analyzer 015136 cs1 lexical_analyzer 015137 stm lexical_analyzer 015140 rest lexical_analyzer 015170 int s_convert_number 015171 value s_convert_number 015200 int d_convert_number 015202 value d_convert_number 015212 exp convert_number 015213 prec convert_number 015214 scale convert_number 015215 exp_sign convert_number 015216 no_digits convert_number 015226 string_constant quoted_string 015326 p quoted_string 015330 i quoted_string 015331 k quoted_string 015332 nwords quoted_string 015333 constant_loc quoted_string 015344 i compile_statement 015345 j compile_statement 015346 ft compile_statement 015347 ndims compile_statement 015350 b1 compile_statement 015351 b2 compile_statement 015352 array_type compile_statement 015353 fn_type compile_statement 015354 sv compile_statement 015355 nv compile_statement 015356 mop compile_statement 015361 mult_type compile_statement 015362 bl compile_statement 015364 p compile_statement 015366 array_pt compile_statement 015370 ap compile_statement 015376 inst compile_statement 015377 val compile_statement 015400 word compile_statement 015401 fnloc compile_statement 015402 have_redim compile_statement 015403 function_is_parameter compile_statement 015404 n_args compile_statement 015405 n_locals compile_statement 015406 buffer1 compile_statement 015446 buffer2 compile_statement 015532 tp subscript_list 015556 m expression_in_register 015566 i expression 015567 current_operator expression 015570 current_precedence expression 015571 opcode expression 015572 optype expression 015573 parens_level expression 015574 parens_type expression 015635 parens_count expression 015676 parens_token expression 015737 starting_operator_level expression 016022 k push_variable 016032 m push_array 016056 nd dimension_array 016074 i push_constant 016076 d_value push_constant 016100 word push_constant 016120 loc allocate 016130 k allocate_temp 016131 ta allocate_temp 016140 loc allocate_local 016141 n_locs allocate_local 016156 k save_register 016174 i gen_xfer 016175 ln gen_xfer 016176 lower gen_xfer 016177 upper gen_xfer 016200 offset gen_xfer 016210 d_value function 016212 word function 016213 jump function 016214 i function 016215 k function 016234 i user_function 016235 k user_function 016306 m matrix_function 016340 last_mat_input_word mat_input_list 016372 i scan_missing_list 016373 j scan_missing_list 016374 m scan_missing_list 016376 p scan_missing_list 016410 k get_line_number 016411 lower get_line_number 016412 upper get_line_number 016422 i finish_subprogram 016423 k finish_subprogram 016424 m finish_subprogram 016425 end_pos finish_subprogram 016426 string_start finish_subprogram 016430 p finish_subprogram 016432 name finish_subprogram 016444 num process_arrays 016445 amount process_arrays 016446 i process_arrays 016447 loc process_arrays 016450 ap process_arrays 016452 tp process_arrays 016462 num process_scalars 016463 i process_scalars 016464 k1 process_scalars 016465 k2 process_scalars 016466 loc process_scalars 016470 tp process_scalars 016472 sp process_scalars 016502 def_start finish_object 016503 def_pos finish_object 016504 link_start finish_object 016505 sym_start finish_object 016506 sym_pos finish_object 016507 i finish_object 016510 j finish_object 016511 k finish_object 016512 m finish_object 016513 n finish_object 016514 name_lng finish_object 016516 def_base finish_object 016520 link_base finish_object 016522 sym_base finish_object 016524 p finish_object 016526 lib_list_pt finish_object 016530 user_id finish_object 016540 zero_def finish_object 016541 seg_def finish_object 016542 last_def finish_object 016543 b18 finish_object 016560 n generate_definition 016562 def_ptr generate_definition 016564 q generate_definition 016574 p store_string 016576 b36 store_string 016606 p table_overflow 016610 j table_overflow 016620 severity_level error 016621 line_num3 error 016622 i error 016623 k error THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 r_e_as r_ne_as alloc_char_temp cat_realloc_chars call_ent_var_desc call_ent_var call_ext_out_desc call_ext_out return_mac fl2_to_fx1 tra_ext_1 sign_mac mdfx1 enable_op shorten_stack ext_entry int_entry int_entry_desc set_chars_eis index_chars_eis real_to_real_round_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. basic_next_line clock_ get_group_id_ get_temp_segment_ hcs_$fs_get_path_name hcs_$truncate_seg ioa_ release_temp_segment_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. basic_$symbol_table basic_data$array_prototype basic_data$ascii_table basic_data$ascii_table_length basic_data$constant_prototype basic_data$function_dummy basic_data$function_templates basic_data$functions basic_data$instruction_sequences basic_data$inverse_relational basic_data$normal_relational basic_data$numeric_spelling basic_data$param_prototype basic_data$precision_length basic_data$relational_table basic_data$relational_table_length basic_data$scalar_prototype basic_data$statement_list basic_data$statement_spelling basic_data$string_spelling basic_error_messages_$ basic_severity_ basic_version_$ error_table_$translation_failed LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 330 000655 27 000660 69 000677 70 000701 71 000703 74 000705 76 000711 77 000712 78 000715 79 000717 80 000720 82 000721 83 000723 84 000732 85 000734 86 000736 87 000767 88 001000 89 001033 90 001034 91 001036 92 001042 94 001044 95 001047 98 001050 103 001070 104 001072 105 001074 106 001100 107 001101 108 001104 111 001105 116 001126 117 001130 118 001132 119 001136 120 001137 121 001144 125 001145 128 001157 129 001161 130 001163 131 001164 132 001170 853 001172 855 001211 856 001230 857 001247 859 001266 860 001271 861 001274 862 001275 863 001276 864 001277 865 001300 867 001301 868 001304 870 001305 871 001310 873 001315 874 001316 876 001322 878 001324 880 001331 881 001340 883 001346 884 001347 886 001354 887 001356 888 001357 889 001360 890 001361 892 001362 894 001376 897 001425 899 001455 901 001456 902 001501 904 001503 905 001517 906 001521 909 001522 910 001524 912 001525 914 001526 915 001570 916 001573 918 001575 922 001601 923 001602 924 001603 925 001605 929 001606 930 001610 931 001612 932 001613 933 001614 935 001616 936 001620 937 001621 938 001622 939 001624 941 001625 942 001627 943 001631 944 001632 945 001634 947 001635 950 001642 954 001643 958 001651 959 001653 961 001654 963 001656 965 001657 966 001667 967 001672 969 001674 970 001701 971 001702 973 001704 975 001707 976 001715 977 001717 978 001720 979 001724 981 001726 982 001733 983 001740 985 001742 986 001744 988 001745 989 001746 991 001747 993 001750 997 001751 999 001754 1000 001755 1004 001756 1005 001760 1006 001761 1008 001762 1010 001771 1014 001772 1015 001773 1017 001774 1019 001777 1020 002001 1021 002010 1023 002015 1024 002017 1025 002021 1026 002022 1032 002023 1038 002024 1042 002053 1045 002102 1047 002105 1048 002110 1049 002112 1051 002113 1053 002117 1055 002122 1060 002123 1062 002127 1064 002130 1066 002133 1070 002134 1074 002140 1077 002144 1080 002150 1083 002154 1086 002167 1089 002173 1092 002206 1095 002212 1098 002216 1101 002222 1104 002235 1107 002241 1110 002245 1113 002251 1116 002255 1119 002261 1122 002265 1125 002271 1128 002275 1132 002301 1136 002305 1139 002311 1142 002324 1145 002330 1148 002334 1151 002340 1154 002353 1157 002357 1160 002363 1163 002367 1166 002373 1169 002406 1172 002412 1175 002416 1178 002431 1181 002435 1184 002441 1187 002445 1190 002451 1193 002455 1196 002461 1199 002465 1202 002471 1205 002475 1208 002501 1211 002505 1214 002511 1217 002515 1220 002521 1224 002525 1228 002531 1231 002535 1234 002541 1237 002545 1240 002551 1243 002555 1246 002561 1249 002565 1252 002571 1255 002575 1258 002601 1261 002605 1264 002611 1267 002615 1270 002621 1273 002634 1276 002640 1279 002644 1282 002657 1285 002663 7119 002667 1294 002670 1311 002671 1314 002674 1315 002700 1317 002702 1318 002704 1319 002705 1321 002706 1324 002707 1326 002720 1330 002736 1332 002740 1334 002750 1335 002752 1337 002753 1340 002763 1346 002765 1349 002770 1354 002772 1356 002773 1359 003005 1361 003013 1363 003023 1367 003030 1368 003037 1371 003044 1373 003052 1374 003055 1376 003060 1377 003072 1381 003075 1382 003105 1383 003111 1385 003113 1387 003115 1392 003117 1395 003124 1398 003126 1400 003131 1402 003135 1404 003140 1405 003142 1406 003143 1409 003144 1411 003147 1413 003155 1414 003157 1415 003160 1419 003161 1421 003163 1423 003171 1426 003176 1428 003177 1431 003202 1433 003205 1435 003221 1437 003227 1439 003231 1442 003232 1447 003243 1449 003251 1454 003252 1455 003254 1456 003263 1458 003264 1461 003270 1462 003275 1464 003277 1466 003311 1471 003314 1473 003315 1476 003321 1478 003324 1481 003327 1485 003331 1487 003334 1490 003336 1491 003337 1493 003340 1495 003341 1498 003344 1499 003347 1501 003352 1502 003353 1507 003356 1510 003357 1511 003361 1513 003363 1517 003364 1519 003367 1521 003373 1523 003374 1528 003400 1529 003403 1531 003410 1537 003411 1539 003415 1540 003417 1541 003421 1543 003422 1544 003424 1547 003426 1550 003427 1555 003431 1556 003433 1557 003435 1560 003436 1565 003440 1566 003442 1567 003444 1572 003445 1574 003450 1576 003453 1578 003455 1581 003456 1583 003457 1588 003463 1590 003466 1592 003471 1597 003473 1602 003500 1606 003503 1607 003504 1608 003510 1610 003520 1611 003523 1612 003525 1614 003531 1619 003532 1624 003536 1626 003542 1628 003543 1630 003547 1631 003551 1632 003553 1634 003554 1635 003556 1638 003560 1641 003561 1646 003565 1648 003566 1651 003572 1652 003573 1654 003575 1657 003576 1660 003601 1663 003605 1665 003612 1666 003613 1667 003620 1670 003621 1676 003627 1678 003631 1681 003641 1682 003643 1686 003644 1690 003651 1691 003655 1697 003656 1698 003667 1700 003676 1701 003700 1703 003701 1705 003703 1708 003704 1710 003706 1712 003716 1713 003723 1718 003724 1720 003730 1721 003743 1726 003752 1747 003756 1752 003766 1753 003770 1754 003772 1756 003773 1758 003775 1763 003776 1766 003777 1771 004003 1775 004007 1778 004013 1780 004017 1782 004021 1784 004023 1786 004025 1789 004027 1792 004033 1794 004034 1799 004040 1803 004042 1805 004043 1807 004050 1810 004052 1812 004055 1814 004061 1816 004063 1820 004065 1822 004072 1824 004074 1827 004076 1829 004077 1834 004103 1836 004106 1840 004115 1846 004123 1881 004124 1885 004135 1887 004143 1889 004150 1891 004152 1895 004153 1902 004155 1904 004161 1905 004163 1909 004164 1911 004166 1915 004167 1919 004172 1920 004174 1922 004175 1923 004200 1928 004201 1931 004204 1933 004205 1936 004213 1938 004223 1940 004225 1941 004235 1943 004243 1944 004245 1945 004246 1947 004247 1951 004251 1955 004252 1957 004254 1958 004262 1962 004263 1964 004265 1966 004270 1970 004271 1972 004274 1974 004275 1980 004276 1983 004300 1984 004301 1988 004304 1993 004306 1996 004307 2002 004315 2007 004327 2009 004330 2011 004342 2015 004353 2018 004354 2021 004360 2024 004365 2026 004367 2030 004370 2034 004402 2039 004403 2041 004412 2045 004413 2056 004425 2058 004426 2060 004435 2064 004436 2067 004442 2071 004443 1848 004444 1851 004445 1852 004461 1857 004470 1859 004471 1862 004501 1864 004507 1865 004515 1866 004516 1869 004523 1872 004524 1873 004526 1874 004530 1876 004531 1877 004533 2075 004534 2081 004536 2083 004537 2086 004552 2087 004560 2090 004563 2093 004567 2099 004571 2101 004572 2104 004605 2105 004613 2108 004617 2111 004623 2128 004624 2129 004625 2130 004626 2132 004627 2134 004632 2138 004637 2139 004644 2140 004645 2141 004652 2142 004653 2146 004654 2148 004657 2150 004660 2151 004661 2152 004666 2153 004667 2154 004670 2155 004675 2156 004676 2161 004677 2163 004702 2165 004703 2167 004704 2169 004710 2170 004712 2171 004713 2173 004714 2174 004716 2178 004721 2180 004723 2181 004730 2182 004731 2183 004741 2184 004742 2186 004743 2189 004745 2192 004750 2194 004752 2196 004754 2199 004756 2201 004765 2203 004766 2218 004770 2220 004774 2225 005002 2226 005011 2227 005012 2228 005017 2232 005021 2240 005026 2244 005031 2245 005034 2246 005036 2247 005040 2250 005044 2251 005046 2253 005053 2256 005055 2257 005056 2258 005067 2259 005070 2261 005075 2262 005076 2264 005077 2265 005101 2283 005102 2318 005103 2322 005107 2324 005112 2326 005115 2329 005117 2334 005121 2335 005123 2337 005130 2339 005135 2340 005137 2342 005142 2343 005144 2344 005146 2346 005147 2347 005154 2348 005156 2351 005160 2352 005161 2359 005163 2360 005173 2361 005204 2363 005206 2367 005207 2371 005211 2374 005212 2377 005214 2380 005222 2385 005227 2387 005230 2390 005233 2392 005236 2397 005244 2398 005245 2402 005250 2404 005257 2405 005263 2406 005267 2408 005271 2409 005272 2411 005274 2414 005275 2421 005305 2429 005313 2431 005321 2437 005324 2440 005335 2441 005340 2443 005350 2444 005360 2447 005375 2449 005377 2450 005400 2452 005402 2458 005403 2459 005404 2462 005407 2463 005416 2465 005420 2472 005422 2473 005427 2474 005433 2475 005435 2483 005436 2484 005443 2485 005447 2487 005457 2488 005462 2491 005464 2494 005471 2496 005472 2499 005473 2508 005515 2509 005517 2511 005521 2513 005523 2515 005530 2516 005531 2517 005533 2520 005534 2523 005541 2525 005546 2528 005552 2529 005553 2532 005556 2533 005560 2535 005563 2536 005564 2542 005565 2544 005566 2547 005604 2550 005617 2552 005622 2556 005627 2572 005635 2574 005641 2575 005646 2578 005647 2580 005654 2581 005660 2582 005670 2583 005671 2585 005673 2586 005703 2587 005706 2588 005711 2589 005716 2590 005720 2591 005726 2592 005732 2593 005737 2594 005741 2595 005743 2597 005745 2598 005746 2602 005747 2607 005750 2613 005753 2615 005754 2618 005761 2620 005762 2622 005763 2623 005765 2624 005767 2629 005770 2631 005771 2634 005776 2636 005777 2638 006000 2641 006003 2642 006005 2645 006007 2647 006014 2648 006015 2649 006020 2651 006021 2652 006026 2655 006027 2657 006033 2658 006041 2659 006045 2661 006047 2662 006050 2666 006051 2671 006052 2675 006054 2678 006057 2679 006061 2684 006064 2685 006071 2689 006072 2690 006076 2691 006101 2692 006104 2693 006116 2697 006121 2698 006130 2700 006131 2701 006132 2702 006142 2704 006146 2706 006147 2708 006151 2711 006160 2713 006161 2715 006164 2716 006165 2720 006172 2721 006174 2724 006176 2728 006205 2729 006213 2731 006221 2733 006223 2738 006224 2739 006227 2743 006230 2744 006232 2748 006233 2750 006235 2751 006245 2752 006250 2754 006252 2756 006255 2760 006257 2761 006262 2763 006263 2768 006270 2770 006271 2772 006272 2776 006276 2777 006300 2781 006302 2783 006304 2784 006311 2785 006312 2787 006313 2788 006320 2789 006323 2792 006325 2793 006326 2799 006327 2801 006332 2802 006333 2806 006336 2807 006341 2810 006343 2812 006350 2813 006357 2815 006367 2817 006371 2819 006375 2822 006377 2826 006400 2829 006404 2832 006407 2835 006412 2838 006415 2840 006422 2842 006430 2843 006432 2844 006434 2846 006435 2849 006437 2852 006442 2854 006446 2857 006451 2858 006453 2861 006455 2863 006457 2865 006464 2866 006465 2869 006466 2873 006467 2877 006472 2879 006475 2881 006477 2883 006500 2885 006502 2886 006506 2889 006507 2890 006512 2892 006513 2896 006516 2900 006517 2904 006522 2906 006523 2908 006524 2911 006531 2913 006532 2914 006536 2916 006543 2917 006547 2919 006550 2920 006552 2924 006553 2928 006555 2929 006556 2933 006557 2936 006560 2939 006563 2941 006565 2944 006570 2946 006571 2948 006572 2951 006575 2953 006576 2955 006577 2958 006604 2960 006605 2964 006606 2969 006615 2970 006617 2973 006625 2974 006627 2976 006633 2981 006634 2982 006635 2984 006641 2989 006642 2992 006660 2993 006663 3008 006664 3011 006671 3012 006674 3018 006676 3019 006703 3020 006707 3027 006711 3029 006713 3030 006716 3031 006721 3033 006723 3039 006725 3041 006731 3043 006734 3045 006735 3056 006736 3058 006742 3059 006745 3060 006750 3061 006753 3062 006756 3063 006761 3065 006764 3066 006766 3072 006767 3074 006773 3076 006776 3078 006777 3080 007000 3084 007001 3086 007010 3090 007011 3093 007020 3094 007024 3096 007025 3100 007026 3106 007033 3108 007042 3112 007047 3115 007052 3117 007054 3119 007057 3120 007063 3122 007064 3123 007066 3128 007067 3130 007070 3132 007074 3135 007077 3137 007101 3139 007102 3145 007103 3148 007106 3150 007111 3153 007116 3154 007122 3156 007123 3158 007124 3159 007131 3160 007134 3163 007136 3164 007143 3166 007144 3168 007150 3171 007155 3172 007161 3174 007162 3176 007163 3177 007170 3178 007173 3181 007175 3184 007202 3187 007204 3189 007210 3192 007213 3196 007220 3198 007221 3199 007223 3203 007224 3205 007225 3207 007243 3211 007244 3215 007246 3216 007251 3218 007252 3222 007261 3225 007266 3226 007267 3228 007270 3230 007274 3232 007276 3234 007302 3235 007307 3236 007310 3237 007312 3238 007314 3239 007316 3240 007323 3241 007326 3242 007330 3243 007332 3245 007333 3249 007334 3252 007337 3253 007343 3254 007345 3258 007346 3260 007352 3263 007357 3264 007363 3265 007402 3271 007410 3272 007411 3274 007414 3276 007420 3277 007421 3282 007422 3284 007423 3286 007442 3290 007443 3293 007444 3295 007447 3296 007453 3298 007454 3299 007456 3303 007457 3309 007464 3311 007466 3312 007473 3314 007507 3316 007511 3320 007512 3322 007513 3323 007531 3327 007532 3329 007533 3330 007552 3334 007553 3337 007554 3342 007562 3344 007563 3346 007567 3347 007573 3348 007574 3349 007575 3351 007576 3354 007603 3356 007604 3358 007610 3359 007615 3360 007616 3362 007617 3365 007624 3366 007627 3367 007632 3368 007634 3370 007635 3373 007641 3374 007646 3376 007647 3378 007650 3380 007664 3382 007665 3383 007670 3385 007671 3386 007672 3388 007675 3390 007676 3391 007700 3395 007701 3399 007702 3403 007724 3404 007725 3407 007743 3411 007744 3414 007745 3417 007751 3418 007756 3420 007757 3422 007760 3424 007765 3425 007766 3428 007767 3434 007770 3435 007772 3436 007774 3438 007775 3440 007777 3445 010002 3448 010005 3450 010012 3452 010014 3453 010015 3454 010024 3458 010026 3463 010027 3465 010030 3468 010033 3471 010036 3473 010041 3474 010042 3477 010043 3479 010045 3480 010054 3481 010056 3484 010057 3490 010062 3491 010064 3493 010067 3496 010074 3497 010075 3500 010102 3502 010103 3504 010105 3506 010114 3507 010115 3508 010117 3511 010120 3513 010122 3515 010133 3521 010134 3523 010143 3524 010145 3527 010146 3533 010151 3534 010155 3535 010161 3537 010165 3541 010173 3542 010201 3544 010207 3546 010217 3548 010224 3550 010226 3552 010232 3553 010237 3555 010240 3556 010242 3561 010243 3563 010245 3565 010246 3568 010250 3571 010255 3572 010256 3574 010257 3577 010264 3578 010265 3582 010266 3583 010273 3584 010277 3585 010301 3587 010304 3588 010306 3591 010310 3595 010311 3599 010313 3601 010315 3604 010320 3606 010321 3613 010325 3614 010331 3616 010332 3618 010334 3619 010346 3623 010347 3625 010353 3628 010370 3629 010402 3632 010414 3633 010415 3635 010417 3636 010420 3640 010421 3643 010424 3645 010426 3647 010432 3650 010435 3652 010444 3654 010452 3658 010457 3659 010461 3661 010463 3663 010466 3666 010467 3668 010476 3671 010503 3672 010507 3676 010510 3679 010511 3684 010517 3686 010520 3688 010524 3689 010530 3690 010531 3691 010532 3693 010533 3696 010536 3697 010542 3698 010545 3699 010547 3702 010550 3705 010554 3707 010555 3709 010564 3711 010567 3714 010574 3716 010575 3717 010601 3718 010602 3723 010603 3727 010606 3729 010612 3731 010613 3734 010614 3736 010617 3739 010622 3741 010626 3743 010627 3746 010630 3749 010633 3750 010637 3752 010640 3755 010641 3757 010644 3759 010653 3764 010655 3766 010660 3768 010661 3771 010666 3773 010667 3775 010672 3778 010677 3780 010700 3781 010703 3783 010704 3784 010706 3785 010707 3789 010710 3790 010717 3792 010722 3795 010726 3798 010731 3802 010733 3806 010734 3808 010740 3809 010741 3813 010742 3817 010764 3818 010765 3821 011003 3825 011004 3830 011005 3833 011010 3834 011014 3835 011015 3838 011016 3840 011017 3842 011022 3843 011026 3844 011027 3847 011030 3849 011033 3850 011037 3852 011040 3853 011042 3857 011043 3859 011047 3861 011050 3865 011051 3868 011052 3869 011056 3870 011057 3874 011060 3877 011062 3878 011064 3879 011067 3880 011073 3881 011074 3882 011076 3886 011077 3888 011103 3889 011104 3893 011105 3896 011107 3897 011110 3898 011111 3900 011112 3903 011114 3907 011117 3909 011121 3911 011122 3914 011125 3916 011131 3917 011141 3919 011152 3921 011154 3922 011155 3924 011167 3925 011171 3927 011174 3929 011176 3932 011200 3935 011213 3937 011215 3938 011217 3940 011221 3941 011223 3942 011224 3946 011225 3949 011232 3952 011235 3953 011237 3955 011244 3957 011250 3960 011254 3962 011255 3964 011267 3970 011301 3973 011305 3975 011307 3976 011311 3981 011312 3984 011321 3986 011325 3989 011327 3991 011334 3992 011336 3993 011340 3995 011342 3997 011347 3998 011350 3999 011352 4002 011353 4005 011360 4006 011362 4007 011364 4008 011365 4013 011371 4016 011376 4017 011400 4018 011402 4019 011403 4024 011407 4025 011410 4027 011414 4030 011417 4039 011420 4040 011421 4041 011426 4043 011431 4045 011432 4049 011434 4052 011440 4054 011453 4055 011454 4057 011462 4058 011463 4061 011464 4063 011473 4066 011477 4069 011504 4071 011511 4072 011513 4076 011515 4077 011525 4078 011530 4079 011533 4080 011536 4081 011540 4083 011542 4087 011543 4091 011545 4092 011550 4096 011551 4101 011552 4105 011555 4109 011564 4112 011566 4114 011574 4116 011601 4118 011605 4119 011607 4123 011610 4126 011611 4129 011620 4131 011625 4132 011626 4135 011627 4144 011630 4147 011631 4149 011635 4151 011643 4154 011646 4159 011652 4161 011653 4162 011654 4164 011655 4167 011657 4169 011660 4172 011667 4173 011670 4177 011672 4185 011673 4190 011674 4192 011676 4194 011677 4196 011700 4199 011710 4200 011711 4201 011712 4204 011714 4207 011721 4208 011722 4210 011724 4214 011725 4217 011726 4219 011727 4222 011732 4229 011733 4232 011734 4234 011735 4239 011742 4241 011745 4243 011761 4244 011767 4246 011770 4249 011771 4255 011772 4262 011774 4264 011775 4266 012004 4268 012005 4269 012007 4281 012010 4322 012011 4324 012012 4326 012014 4329 012020 4334 012026 4336 012031 4337 012032 4340 012033 4346 012035 4348 012041 4349 012042 4351 012046 4354 012051 4356 012057 4357 012062 4358 012063 4361 012064 4362 012066 4365 012067 4368 012070 4370 012072 4372 012073 4374 012100 4375 012101 4378 012102 4381 012106 4383 012111 4384 012112 4387 012113 4390 012115 4392 012117 4394 012124 4396 012132 4398 012135 4401 012136 4402 012137 4407 012143 4409 012152 4411 012154 4414 012161 4416 012165 4419 012171 4420 012174 4423 012175 4425 012176 4428 012203 4430 012210 4431 012211 4434 012216 4437 012224 4440 012230 4443 012233 4448 012243 4451 012244 4453 012246 4455 012247 4458 012250 4461 012254 4463 012262 4465 012270 4467 012275 4469 012276 4472 012301 4473 012306 4475 012310 4478 012313 4480 012316 4483 012322 4487 012334 4488 012336 4491 012340 4494 012343 4499 012351 4503 012353 4505 012363 4509 012364 4512 012367 4513 012375 4514 012400 4515 012402 4517 012403 4518 012411 4519 012417 4522 012420 4526 012421 4528 012432 4532 012433 4534 012444 4538 012445 4542 012453 4544 012456 4545 012462 4546 012467 4548 012470 4549 012476 4550 012502 4553 012507 4554 012511 4558 012512 4561 012521 4562 012527 4564 012532 4565 012534 4569 012535 4571 012540 4572 012544 4573 012545 4575 012551 4579 012552 4582 012555 4585 012560 4586 012561 4587 012562 4590 012563 4593 012565 4597 012567 4600 012571 4601 012573 4604 012575 4608 012576 4611 012612 4615 012613 4618 012627 4622 012630 4625 012644 4627 012645 4633 012647 4636 012653 4639 012655 4640 012657 4641 012661 4643 012664 4647 012665 4650 012671 4652 012673 4655 012674 4657 012675 4660 012700 4661 012703 4662 012704 4664 012705 4669 012707 4670 012710 4673 012713 4675 012715 4676 012720 4677 012722 4678 012725 4680 012727 4688 012730 4691 012731 4692 012732 4695 012735 4696 012737 4698 012744 4703 012745 4709 012746 4710 012747 4713 012752 4715 012756 4718 013001 4719 013007 4720 013011 4729 013012 4740 013014 4743 013017 4745 013022 4747 013037 4753 013041 4754 013051 4756 013056 4761 013060 4764 013067 4765 013070 4769 013077 4771 013103 4775 013104 4777 013116 4778 013122 4780 013124 4781 013126 4791 013127 4797 013131 4799 013134 4800 013137 4801 013152 4803 013153 4806 013171 4807 013177 4810 013212 4813 013214 4814 013215 4833 013217 4816 013220 4821 013222 4822 013230 4823 013233 4825 013235 4827 013237 4828 013242 4831 013243 4845 013244 4853 013246 4856 013255 4858 013262 4859 013266 4861 013272 4866 013274 4868 013276 4871 013306 4873 013307 4874 013324 4876 013325 4880 013332 4882 013335 4885 013343 4887 013346 4899 013347 4891 013350 4894 013351 4895 013355 4898 013362 4905 013363 4914 013364 4915 013365 4918 013370 4920 013375 4922 013400 4923 013403 4924 013413 4926 013414 4928 013416 4930 013421 4932 013434 4936 013443 4937 013453 4939 013460 4943 013462 4945 013463 4947 013470 4951 013501 4953 013502 4955 013505 4957 013515 4959 013523 4961 013525 4962 013531 4963 013533 4965 013541 4970 013554 4971 013556 4973 013557 4978 013561 4979 013564 4980 013566 4987 013567 4992 013571 4999 013615 5007 013617 5010 013625 5011 013626 5012 013627 5014 013630 5015 013632 5016 013636 5021 013637 5023 013644 5024 013646 5027 013652 5028 013654 5031 013661 5040 013673 5051 013675 5053 013700 5054 013705 5057 013707 5059 013712 5061 013713 5063 013731 5065 013753 5068 013761 5074 013764 5085 013766 5087 013776 5090 014006 5091 014007 5094 014010 5097 014013 5099 014022 5100 014024 5102 014027 5103 014041 5106 014047 5116 014056 5122 014060 5126 014066 5129 014076 5130 014106 5132 014107 5133 014111 5135 014112 5138 014114 5141 014122 5147 014123 5154 014125 5156 014130 5158 014144 5160 014150 5161 014154 5162 014155 5164 014156 5165 014162 5166 014165 5172 014167 5175 014200 5176 014201 5184 014202 5189 014204 5192 014215 5193 014223 5196 014231 5197 014232 5199 014237 5204 014240 5212 014242 5214 014246 5217 014253 5219 014254 5221 014257 5226 014261 5227 014263 5229 014265 5230 014271 5232 014274 5235 014303 5238 014311 5239 014312 5242 014315 5243 014330 5246 014331 5248 014336 5249 014341 5255 014342 5257 014351 5260 014356 5261 014362 5263 014363 5267 014365 5270 014367 5271 014370 5272 014371 5276 014375 5279 014403 5281 014411 5283 014412 5284 014413 5291 014414 5307 014416 5308 014421 5311 014430 5316 014436 5317 014441 5319 014445 5321 014453 5324 014461 5328 014463 5332 014471 5335 014472 5339 014475 5341 014500 5344 014501 5346 014503 5348 014505 5350 014510 5352 014513 5356 014514 5361 014517 5365 014520 5368 014524 5371 014531 5375 014532 5379 014540 5383 014544 5386 014552 5388 014560 5389 014563 5391 014564 5393 014572 5394 014574 5398 014575 5400 014603 5402 014607 5403 014611 5407 014612 5409 014615 5411 014624 5414 014627 5415 014634 5417 014635 5418 014637 5422 014640 5424 014646 5426 014655 5429 014660 5430 014663 5432 014664 5434 014671 5435 014673 5439 014674 5441 014701 5443 014705 5445 014707 5446 014720 5447 014723 5449 014725 5450 014735 5452 014747 5453 014750 5455 014752 5456 014757 5460 014760 5465 014761 5468 014762 5475 014765 5479 014774 5480 014777 5482 015002 5483 015005 5485 015006 5487 015014 5488 015016 5490 015017 5496 015023 5498 015024 5500 015026 5502 015030 5503 015032 5504 015040 5507 015041 5510 015043 5511 015053 5513 015061 5515 015063 5516 015067 5517 015071 5519 015077 5523 015112 5524 015116 5525 015117 5526 015126 5528 015131 5529 015136 5531 015137 5532 015141 5535 015142 5539 015143 5541 015156 5551 015157 5557 015161 5559 015172 5562 015177 5564 015202 5567 015214 5568 015217 5571 015224 5579 015230 5587 015232 5589 015235 5590 015241 5592 015245 5596 015247 5598 015256 5600 015272 5602 015275 5604 015277 5606 015305 5609 015311 5610 015321 5612 015330 5613 015335 5615 015336 5617 015344 5619 015346 5621 015354 5622 015360 5623 015364 5625 015367 5626 015372 5627 015375 5636 015376 5643 015400 5648 015401 5651 015405 5652 015410 5654 015411 5656 015413 5657 015420 5658 015421 5660 015422 5661 015427 5662 015432 5665 015434 5667 015435 5669 015442 5671 015443 5674 015446 5677 015451 5680 015452 5682 015455 5683 015460 5686 015461 5692 015462 5695 015463 5698 015475 5700 015476 5702 015501 5704 015510 5707 015513 5709 015517 5710 015521 5713 015522 5715 015523 5717 015524 5720 015525 5723 015532 5729 015533 5734 015535 5738 015541 5739 015546 5741 015547 5742 015550 5744 015551 5752 015552 5755 015553 5756 015554 5758 015560 5763 015563 5766 015570 5767 015571 5770 015574 5773 015577 5777 015601 5779 015611 5781 015612 5784 015620 5785 015621 5786 015622 5790 015623 5793 015624 5794 015631 5796 015644 5797 015647 5801 015651 5805 015663 5806 015673 5807 015676 5809 015700 5811 015701 5812 015702 5814 015704 5816 015706 5817 015707 5823 015710 5828 015711 5830 015722 5831 015724 5832 015725 5833 015727 5835 015730 5838 015733 5840 015735 5842 015740 5845 015743 5848 015746 5850 015754 5852 015756 5854 015763 5855 015771 5857 015772 5858 015774 5860 016012 5861 016020 5863 016021 5866 016023 5867 016032 5868 016033 5874 016034 5879 016036 5881 016042 5884 016045 5886 016046 5888 016047 5891 016055 5892 016061 5893 016065 5900 016066 5903 016067 5906 016076 5907 016077 5909 016106 5910 016114 5912 016115 5914 016116 5918 016117 5921 016120 5922 016121 5923 016126 5925 016137 5927 016141 5935 016142 5944 016144 5946 016145 5951 016151 5956 016155 5957 016160 5959 016161 5961 016165 5962 016167 5963 016173 5966 016174 5968 016175 5970 016202 5972 016203 5975 016206 5977 016211 5978 016212 5980 016215 5981 016220 5984 016221 5988 016227 5994 016230 5997 016231 5999 016235 6002 016240 6004 016241 6007 016246 6009 016255 6011 016256 6012 016262 6014 016263 6020 016264 6027 016266 6029 016300 6030 016303 6032 016313 6034 016316 6036 016323 6038 016325 6039 016332 6042 016337 6045 016343 6046 016351 6047 016353 6049 016355 6052 016363 6053 016367 6055 016370 6062 016371 6067 016373 6069 016400 6071 016405 6074 016412 6076 016427 6077 016437 6078 016440 6085 016441 6091 016442 6092 016443 6093 016453 6095 016457 6097 016461 6098 016463 6099 016466 6102 016467 6103 016476 6104 016501 6106 016504 6108 016516 6109 016524 6110 016527 6111 016531 6116 016532 6122 016534 6123 016536 6125 016540 6126 016543 6128 016546 6131 016576 6132 016602 6134 016605 6136 016606 6143 016612 6156 016613 6160 016614 6161 016615 6162 016625 6163 016632 6165 016640 6167 016642 6168 016644 6169 016647 6172 016650 6174 016654 6177 016672 6178 016704 6181 016716 6185 016720 6186 016721 6187 016727 6189 016732 6191 016733 6192 016750 6195 016754 6197 016756 6198 016760 6199 016763 6202 016764 6203 016766 6204 016771 6206 016774 6208 017006 6210 017014 6211 017016 6213 017017 6215 017021 6220 017023 6222 017026 6223 017032 6224 017034 6229 017053 6243 017060 6244 017063 6246 017073 6248 017076 6249 017100 6251 017103 6252 017110 6253 017113 6255 017121 6258 017132 6262 017134 6264 017136 6267 017145 6270 017154 6271 017157 6273 017164 6275 017175 6278 017177 6280 017201 6283 017210 6285 017215 6286 017217 6287 017230 6292 017232 6296 017244 6299 017253 6301 017255 6302 017257 6307 017272 6309 017276 6317 017305 6320 017314 6321 017320 6327 017333 6329 017342 6333 017351 6334 017355 6336 017364 6338 017371 6339 017401 6342 017422 6343 017423 6347 017425 6348 017436 6350 017437 6352 017444 6354 017446 6359 017453 6360 017457 6363 017467 6364 017475 6365 017477 6367 017501 6478 017507 6373 017510 6382 017512 6383 017524 6385 017525 6386 017533 6387 017540 6389 017542 6391 017546 6392 017552 6394 017562 6396 017566 6398 017570 6401 017574 6404 017605 6406 017610 6407 017612 6410 017616 6411 017617 6413 017621 6415 017623 6418 017630 6419 017632 6421 017633 6428 017643 6437 017645 6438 017657 6440 017660 6441 017665 6442 017671 6444 017673 6446 017677 6450 017706 6451 017710 6453 017715 6454 017720 6457 017724 6461 017734 6465 017751 6467 017762 6468 017763 6470 017764 6472 017766 6475 017773 6482 020003 6536 020004 6538 020006 6539 020012 6540 020015 6542 020021 6543 020031 6544 020040 6545 020043 6546 020052 6547 020057 6548 020061 6549 020064 6550 020065 6554 020067 6555 020074 6559 020077 6561 020101 6562 020103 6564 020104 6566 020106 6568 020114 6570 020131 6572 020137 6578 020157 6579 020167 6581 020172 6584 020177 6586 020227 6587 020236 6588 020240 6590 020242 6592 020246 6594 020254 6595 020257 6600 020261 6602 020271 6604 020272 6609 020275 6610 020305 6612 020310 6614 020315 6618 020321 6620 020323 6621 020326 6623 020330 6624 020332 6625 020335 6627 020337 6629 020343 6630 020351 6632 020355 6633 020370 6634 020401 6636 020406 6638 020415 6639 020425 6641 020430 6642 020437 6644 020444 6645 020445 6646 020447 6650 020451 6652 020455 6654 020462 6655 020466 6656 020470 6658 020473 6660 020476 6661 020505 6662 020515 6664 020526 6665 020532 6666 020534 6670 020536 6675 020546 6677 020553 6678 020557 6680 020561 6681 020562 6683 020563 6684 020573 6686 020600 6687 020603 6688 020610 6689 020612 6690 020614 6692 020615 6693 020631 6695 020636 6697 020640 6698 020646 6700 020650 6702 020654 6704 020662 6705 020665 6706 020672 6707 020674 6708 020676 6709 020677 6710 020713 6711 020715 6712 020725 6713 020732 6714 020734 6718 020736 6720 020741 6721 020745 6726 020751 6727 020757 6728 020761 6730 020762 6732 020764 6736 020770 6737 020775 6738 020777 6739 021001 6741 021005 6742 021007 6746 021011 6747 021016 6748 021020 6750 021021 6752 021023 6756 021030 6757 021036 6759 021041 6760 021043 6761 021046 6762 021053 6763 021060 6764 021065 6765 021072 6766 021074 6767 021103 6768 021105 6769 021112 6771 021117 6773 021123 6775 021131 6776 021134 6778 021144 6780 021152 6853 021162 6782 021163 6798 021165 6799 021172 6801 021176 6802 021201 6803 021206 6805 021212 6807 021216 6809 021222 6811 021227 6813 021232 6815 021242 6816 021244 6817 021246 6818 021250 6820 021252 6822 021261 6825 021272 6826 021275 6829 021302 6830 021307 6832 021311 6834 021312 6841 021314 6844 021320 6845 021325 6846 021331 6847 021336 6848 021342 6850 021347 6855 021352 6863 021366 6864 021370 6865 021406 6866 021407 6874 021410 6882 021412 6885 021415 6891 021444 6892 021455 6893 021461 6897 021472 6898 021473 6899 021475 6900 021476 6905 021477 6907 021504 6908 021517 6911 021520 6912 021531 6914 021533 6915 021543 6916 021553 6917 021557 6918 021566 6919 021571 6922 021575 6923 021602 6927 021605 6929 021611 6938 021613 6933 021617 6948 021622 6950 021627 6952 021634 6953 021636 6955 021661 6956 021673 6959 021716 6962 021724 6964 021732 6967 021736 6970 021741 6972 021746 6973 021761 6975 022015 6977 022016 6980 022023 6982 022030 6983 022043 6985 022072 6987 022073 6990 022076 6992 022103 6994 022110 6995 022112 6996 022125 6998 022154 7000 022155 7003 022162 7005 022167 7006 022202 7008 022236 7010 022237 7013 022244 7015 022251 7016 022264 7018 022317 7020 022320 7023 022323 7025 022330 7026 022341 7028 022364 7031 022365 7034 022367 7037 022421 7038 022422 7039 022433 7041 022441 7043 022443 7044 022445 7046 022446 7048 022456 7050 022465 7051 022471 7053 022477 7057 022523 7059 022551 7060 022574 7067 022577 7070 022601 7071 022606 7073 022641 7075 022670 7076 022717 7082 022720 7085 022722 7086 022727 7088 022754 7090 023002 7091 023026 7097 023027 7100 023031 7101 023036 7103 023040 7105 023070 7107 023117 7108 023146 7110 023147 7112 023174 7114 023222 7116 023246 ----------------------------------------------------------- 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