COMPILATION LISTING OF SEGMENT probe_get_value_ Compiled by: Multics PL/I Compiler, Release 33a, of May 30, 1990 Compiled at: ACTC Technologies Inc. Compiled on: 10/17/90 0816.3 mdt Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1990 * 4* * * 5* * Copyright, (C) Honeywell Bull Inc., 1988 * 6* * * 7* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 8* * * 9* * Copyright (c) 1972 by Massachusetts Institute of * 10* * Technology and Honeywell Information Systems, Inc. * 11* * * 12* *********************************************************** */ 13 14 /* format: style1,insnl,ifthendo,indthenelse,^indnoniterdo,^inditerdo,indcom,^indthenbegin,^indprocbody,ind2,ll78,initcol0,dclind4,idind24,struclvlind1,comcol41 */ 15 16 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 17 18 /****^ HISTORY COMMENTS: 19* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 20* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1212): 21* Added parsing of values like -> when 22* language is PASCAL. Fixed bugs in parsing of array values or cross 23* sections. 24* 2) change(88-05-30,WAAnderson), approve(88-09-30,MCR7952), 25* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 26* Changed 'get_level' so it calls 'get_c_brackets' when the language is 27* C instead of 'get_parens'. 'get_c_brackets' is functionally the same 28* as 'get_parens' in the sense that they both evaluate subscripts. 29* 3) change(88-06-01,WAAnderson), approve(88-09-30,MCR7952), 30* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 31* Changed the code in 'get_c_brackets' to accept s single pair of empty 32* brackets. This allows character arrays and pointers to characters to be 33* handled as strings. No type checking is done in this procedure. 34* 4) change(88-06-07,WAAnderson), approve(88-09-30,MCR7952), 35* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 36* Changed the code in 'parse_normal' to modify a reference node from being 37* a pointer to a character to a string value of maxlength 256 when empty 38* brackets are used. 39* 5) change(88-07-19,WAAnderson), approve(88-09-30,MCR7952), 40* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 41* Added the procedure 'get_unqualified_c_value' to provide the same 42* functionality as 'get_unqualified_value' but is specifically 43* designed for the C symbol table format. 44* 6) change(88-07-25,WAAnderson), approve(88-09-30,MCR7952), 45* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 46* Modified 'parse_normal' and 'get_unqualified_c_value' to handle 47* subscripts within a structure. 48* 7) change(88-09-07,WAAnderson), approve(88-09-30,MCR7952), 49* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 50* Added format control comment to make the source more readable. 51* 8) change(88-10-28,WAAnderson), approve(88-10-28,MCR7952), 52* audit(88-10-31,RWaters), install(88-11-11,MR12.2-1210): 53* Modified code to compute the complete address of a character pointer 54* referenced with subscripts. Prior to this fix, only literal values could 55* be used as pointer subscripts. 56* 9) change(90-09-20,Bubric), approve(90-10-01,MCR8211), audit(90-10-01,Itani), 57* install(90-10-17,MR12.4-1044): 58* Have the calls to the routine 'nothing' changed to calls to the routine 59* 'null_entry_'. 60* END HISTORY COMMENTS */ 61 62 probe_get_value_: 63 proc (); 64 call probe_error_$malfunction (); /* dummy entry */ 65 return; 66 67 /* This routine is called to parse and interpret a reference to some data item. 68* One argument is used to specify the type of reference allowed at the current point. 69* It returns information about the reference in a structure called reference. 70* If necessary (i.e. a cross-section reference is found), the array real_subscripts 71* is filled in with the bounds (low and high). 72* 73* entries: 74* 75* $value - gets a VARIABLE may include function call 76* $reference - a misnomer, gets a "reference" to a symbol node - used by "symbol" request only 77* Modified JRD 15 Aug 79 78* Modified JRD 5 Sep 79 - for true COBOL parsing - a great pain! 79* Modified 19 Feb 80 for %probe variables */ 80 /* Changed to accept first 3 bits of P_switches 08/26/81 S. Herbst */ 81 /* Changed to understand pathnames & virtual entries 09/11/81 S. Herbst */ 82 /* Modified June 83 JMAthane to add "a la PASCAL" parsing */ 83 /* Fixed "segno|offset->var" references (constant qualifier) broken earlier 07/27/83 S. Herbst */ 84 /* Changed to handle Pascal cross-section by changing the reference's array bounds 08/16/83 S. Herbst */ 85 /* Added version strings to runtime_symbol_info_ structures 10/06/83 S. Herbst */ 86 /* Fixed "Qualifier ^p is null." msg to not show qualifier's qualifier 02/09/84 S. Herbst */ 87 /* Fixed "sb $100" to reference FORTRAN statement label 02/16/84 S. Herbst */ 88 /* Fixed not to automatically translate "-" to "_" in (COBOL) identifiers 09/20/84 Steve Herbst */ 89 /* Fixed bug in cross arrays in Pascal, 90* Added parsing of "->" in parse_a_la_pascal. 91* JMAthane June 85 */ 92 93 /* 94* THIS CODE IS A BOGUS HOAX - here's why 95* 96* The concepts it implements are subtlely different from those of PL/I 97* (See Chapter Six of AG94) The kinds of reference one might be interested in are: 98* 99* a value - really a pointer to it (useful in expressions) 100* a reference - a pointer to some storage (what PL/I means) 101* a declaration - for the "symbol" request 102* 103* Now there is this crock want_external_sw (position 1 of P_switches) 104* If it is ON, this code does not invoke a function. This means that a reference to an external function 105* that returns an entry will return the first function, not its value. 106* PL/I is very explicit on this point. The value of a reference should depend 107* only on its syntax, not on what the caller wants. 108* 109**/ 110 111 /* The syntax of a reference: 112* {} enclose optional material, | separates choices 113* {}* indefinite repetition of option 114* 115* REF ::= constant { -> VAR} | VAR 116* VAR ::= VAR1 { -> VAR } 117* VAR1 ::= LEVEL{.LEVEL}* {[generation]} {(ARGLIST)} 118* LEVEL ::= NAME {SUBS} 119* SUBS ::= (DIM {,DIM}*) 120* DIM ::= expression | expression : expression | * 121* 122**/ 123 124 dcl ( 125 P_probe_info_ptr pointer, 126 1 P_reference structure aligned like reference_node, 127 P_switches bit (36) aligned, 128 P_code fixed bin (35) 129 ) parameter; 130 131 dcl switches bit (36); 132 dcl need_to_indirect_and_make_string 133 bit (1) init ("0"b); 134 135 136 dcl 1 ref_arg_list aligned based (P_reference.argument_list) 137 like reference_arg_list; 138 dcl 1 ref_subscripts aligned based (P_reference.subscript_ptr) 139 like reference_subscripts; 140 dcl 1 ref_source_info aligned based (P_reference.source_info_ptr) 141 like source_info; 142 dcl 1 sub_refs aligned 143 based (P_reference.subscript_refs_ptr) 144 like subscript_reference_ptrs; 145 146 dcl ( 147 UPPER init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"), 148 LOWER init ("abcdefghijklmnopqrstuvwxyz") 149 ) 150 char (27) aligned internal static 151 options (constant); 152 153 dcl want_value bit (1) aligned; 154 /* tells whether or not to get full address */ 155 dcl code fixed bin (35); 156 dcl make_lower bit (1) aligned; 157 158 dcl dummy_entry entry variable; 159 160 dcl 1 subscript aligned based like reference_node; 161 /* dummy subscript */ 162 163 dcl identifier_tokens_name char (ct -> identifier.length) 164 based (ct -> identifier.name); 165 166 dcl id_token char (id_ptr -> identifier.length) 167 based (id_ptr -> identifier.name); 168 169 dcl cv_entry_ entry (char (*), ptr, fixed bin (35)) 170 returns (entry); 171 172 dcl probe_check_ptr_$indirectable 173 entry (ptr, fixed bin (35)); 174 dcl probe_error_$record entry options (variable); 175 dcl probe_error_$malfunction 176 entry options (variable); 177 dcl probe_eval_$evaluate entry (ptr, 1 aligned like reference_node, 178 bit (36) aligned, bit (1) aligned, 179 fixed bin (35)); 180 dcl probe_eval_$add_c_dims entry (ptr, 1 aligned like reference_node, 181 bit (36) aligned, bit (1) aligned, 182 fixed bin (35), fixed bin (6) unsigned); 183 dcl probe_create_reference_ entry (ptr, ptr); 184 dcl probe_get_$expression entry (pointer, 1 aligned like reference_node, 185 fixed bin (35)); 186 dcl probe_get_$generation entry (pointer, pointer, fixed bin, 187 fixed bin (35)); 188 189 dcl ( 190 probe_et_$bad_locator, 191 probe_et_$bad_operator, 192 probe_et_$bad_pointer, 193 probe_et_$dim_limit, 194 probe_et_$null_ptr, 195 probe_et_$recorded_message, 196 probe_et_$too_long 197 ) fixed bin (35) external static; 198 199 dcl error_table_$badpath fixed bin (35) external static; 200 201 dcl (addr, addrel, bin, binary, convert, divide, fixed, hbound, index) 202 builtin; 203 dcl (length, maxlength, null, substr, translate, unspec, verify) 204 builtin; 205 dcl id_ptr ptr; 206 207 probe_get_value_$value: 208 entry (P_probe_info_ptr, P_reference, P_switches, P_code); 209 210 want_value = "1"b; 211 switches = P_switches; 212 need_to_indirect_and_make_string = "0"b; 213 214 goto start; 215 216 217 probe_get_value_$reference: 218 entry (P_probe_info_ptr, P_reference, P_code); 219 220 want_value = "0"b; 221 unspec (switches) = "0"b; 222 goto start; 223 224 start: 225 226 probe_info_ptr = P_probe_info_ptr; 227 code = 0; 228 229 P_reference.name = ""; /* initialize the variables */ 230 P_reference.flags = "0"b; 231 P_reference.precision = 0; 232 P_reference.symbol_ptr = null; 233 P_reference.address_ptr = null; 234 P_reference.type_ptr = null; 235 P_reference.base_addr = null (); 236 P_reference.have_generation = "0"b; 237 P_reference.invocation_level = 0; 238 P_reference.type = 0; 239 P_reference.optional_info.n_subscripts = 0; 240 P_reference.optional_info.n_arguments = 0; 241 242 ref_arg_list.number = 0; 243 ref_subscripts.number = 0; 244 ref_source_info.block_ptr, ref_source_info.stack_ptr, 245 ref_source_info.entry_ptr = null; 246 247 248 if probe_info.language_type = COBOL_lang_type 249 | probe_info.language_type = PASCAL_lang_type 250 then make_lower = "1"b; 251 else if probe_info.language_type = FORTRAN_lang_type 252 then make_lower = 253 current_source.seg_info_ptr -> seg_info.bits.ignore_case; 254 else make_lower = "0"b; 255 256 if probe_info.ct -> token.type = GREATER_THAN 257 | probe_info.ct -> token.type = LESS_THAN 258 then 259 call get_pathname (); 260 else if looks_like_cobol () 261 then call parse_ala_cobol; 262 else if probe_info.language_type = PASCAL_lang_type 263 then 264 call parse_ala_pascal; 265 else call parse_normal; 266 267 SOME_ERROR: 268 P_code = code; 269 return; 270 271 272 RECORDED_MESSAGE: 273 code = probe_et_$recorded_message; 274 goto SOME_ERROR; 275 276 277 disgruntled: 278 proc (ecode); 279 dcl ecode fixed bin (35) parameter; 280 281 code = ecode; 282 goto SOME_ERROR; 283 end disgruntled; 284 285 parse_normal: 286 proc; /* parse a REF */ 287 288 dcl based_ptr pointer based; 289 dcl based_packed_ptr pointer unal based; 290 291 dcl stu_$offset_to_pointer entry (pointer, pointer, pointer, pointer, 292 pointer, pointer) returns (pointer); 293 dcl probe_check_ptr_$check entry (ptr, fixed bin (35)); 294 dcl 01 acc_str based, 295 02 str_len fixed bin (9) unsigned unaligned, 296 02 str_name char (0 refer (acc_str.str_len)) unaligned; 297 dcl name_ptr ptr; 298 dcl (tsp, old_addr, final_ptr) 299 ptr; 300 dcl offset_bits fixed bin (6) unsigned; 301 dcl offset_words fixed bin (18) unsigned; 302 dcl mod builtin; 303 dcl original_class fixed bin (6) unsigned; 304 305 original_class = 0; 306 307 if probe_info.ct -> token.type = CONSTANT_TYPE then do; 308 P_reference.constant = "1"b; 309 P_reference.constant_token_ptr = probe_info.ct; 310 P_reference.name = "<>";/* should be smart and get name ! */ 311 call bump_ct (); 312 end; 313 else if current_token.type = NAME_TYPE & 314 probe_info.language_type = C_lang_type 315 then 316 call get_unqualified_c_reference (); 317 else if current_token.type = NAME_TYPE 318 then 319 call get_unqualified_reference (); 320 else do; /* some operator */ 321 call probe_error_$record (probe_info_ptr, probe_et_$bad_operator, 322 OPERATOR_VALUES (binary (substr (current_token.type, 13, 6), 17))); 323 goto RECORDED_MESSAGE; 324 end; 325 326 old_addr = null (); 327 do while (probe_info.ct -> token.type = ARROW & 328 probe_info.language_type = C_lang_type); 329 330 if (P_reference.address_ptr = null ()) 331 then 332 call probe_eval_$evaluate (probe_info_ptr, P_reference, (switches), 333 want_value, 334 code); 335 336 if P_reference.type ^= pointer_dtype then do; 337 call probe_error_$record (probe_info_ptr, 0, 338 "The -> symbol may be used only in conjuction with pointers to structures." 339 ); 340 goto RECORDED_MESSAGE; 341 end; 342 if (P_reference.symbol_ptr ^= null ()) then do; 343 tsp = P_reference.symbol_ptr; 344 do while ((fixed (tsp -> runtime_symbol.type) = pointer_dtype | 345 fixed (tsp -> runtime_symbol.type) = c_typeref_dtype) 346 & /* typeref */ 347 tsp -> runtime_symbol.son ^= "000000"b3); 348 tsp = addrel (tsp, fixed (tsp -> runtime_symbol.son)); 349 end; 350 P_reference.symbol_ptr = null (); 351 P_reference.type = 0; 352 old_addr = P_reference.address_ptr; 353 P_reference.address_ptr = null (); 354 P_reference.type_ptr = null (); 355 P_reference.base_addr = null (); 356 name_ptr = addrel (tsp, fixed (tsp -> runtime_symbol.name)); 357 P_reference.name = 358 substr (name_ptr -> acc_str.str_name, 1, 359 name_ptr -> acc_str.str_len) || "."; 360 end; 361 362 call bump_ct (); 363 364 if probe_info.ct -> token.type = NAME_TYPE 365 then do; 366 call get_unqualified_c_reference (); 367 call probe_eval_$evaluate (probe_info_ptr, P_reference, (switches), 368 want_value, 369 code); 370 371 final_ptr = old_addr -> based_ptr; 372 if (P_reference.symbol_ptr ^= null ()) then do; 373 if (^P_reference.symbol_ptr -> runtime_symbol.bits.simple & 374 P_reference.symbol_ptr -> runtime_symbol.offset ^= 0) 375 then do; 376 offset_bits = 377 convert (offset_bits, 378 P_reference.symbol_ptr -> runtime_symbol.offset); 379 offset_words = 380 convert (offset_words, divide (offset_bits, 36, 17, 0)); 381 offset_bits = convert (offset_bits, mod (offset_bits, 36)); 382 addr (final_ptr) -> its_unsigned.offset = 383 addr (final_ptr) -> its_unsigned.offset + offset_words; 384 addr (final_ptr) -> its_unsigned.bit_offset = 385 addr (final_ptr) -> its_unsigned.bit_offset 386 + offset_bits; 387 end; 388 end; 389 dcl null_entry_ entry options (variable); 390 call null_entry_ (); 391 392 P_reference.address_ptr = final_ptr; 393 394 if (P_reference.n_subscripts > 0) 395 then 396 call probe_eval_$add_c_dims (probe_info_ptr, P_reference, 397 (switches), "1"b, code, original_class); 398 399 end; 400 end; 401 402 if (old_addr ^= null ()) then do; 403 code = 0; 404 goto SOME_ERROR; 405 end; 406 407 do while (probe_info.ct -> token.type = ARROW & 408 probe_info.language_type ^= C_lang_type); 409 410 call probe_eval_$evaluate (probe_info_ptr, P_reference, (switches), 411 want_value, 412 code); 413 414 if P_reference.constant then do; 415 if P_reference.type ^= pointer_dtype 416 then call disgruntled (probe_et_$bad_pointer); 417 P_reference.base_addr = P_reference.address_ptr -> based_ptr; 418 end; /* constant */ 419 else do; 420 if probe_info.execute then do; /* we have valid data */ 421 if P_reference.type = pointer_dtype 422 then if P_reference.packed 423 then P_reference.base_addr = 424 P_reference.address_ptr -> based_packed_ptr; 425 else P_reference.base_addr = 426 P_reference.address_ptr -> based_ptr; 427 else if P_reference.type = offset_dtype 428 then P_reference.base_addr = stu_$offset_to_pointer ( 429 ref_source_info.block_ptr, P_reference.symbol_ptr, 430 P_reference.address_ptr, ref_source_info.stack_ptr, 431 (ref_source_info.seg_info_ptr -> seg_info.linkage_ptr) 432 , null); 433 else do; /* other data type no good */ 434 call probe_error_$record (probe_info_ptr, probe_et_$bad_locator, 435 P_reference.name); 436 goto RECORDED_MESSAGE; 437 end; 438 end; /* execute case */ 439 else P_reference.base_addr = null (); 440 /* just syntax-checking */ 441 end; /* variable case */ 442 443 if probe_info.flags.execute then do; 444 call probe_check_ptr_$check (P_reference.base_addr, code); 445 if code ^= 0 446 then goto SOME_ERROR; 447 448 call probe_check_ptr_$indirectable (P_reference.base_addr, code); 449 if code ^= 0 then do; 450 if P_reference.constant 451 then call probe_error_$record 452 (probe_info_ptr, code, "Qualifier ^p", 453 P_reference.base_addr); 454 else if code = probe_et_$null_ptr 455 then call probe_error_$record (probe_info_ptr, 0, 456 "Qualifier ^a is null.", 457 qualifier_name (P_reference.symbol_ptr)); 458 else call probe_error_$record (probe_info_ptr, code, 459 "Qualifier ^a = ^w ^w", 460 qualifier_name (P_reference.symbol_ptr), 461 substr (unspec (P_reference.base_addr), 1, 36), 462 substr (unspec (P_reference.base_addr), 37, 36)); 463 go to RECORDED_MESSAGE; 464 end; 465 end; 466 467 /* these could be dangerous */ 468 469 P_reference.flags = "0"b; 470 P_reference.n_subscripts, P_reference.n_arguments = 0; 471 P_reference.address_ptr = null (); 472 P_reference.name = ""; 473 474 call bump_ct (); 475 476 /* Now, what are we pointing to */ 477 478 if current_token.type = NAME_TYPE 479 then call get_unqualified_reference (); 480 else if current_token.type = CONSTANT_TYPE then do; 481 call probe_error_$record (probe_info_ptr, 0, 482 "A constant cannot be based."); 483 goto RECORDED_MESSAGE; 484 end; 485 else do; 486 call probe_error_$record (probe_info_ptr, 0, "Bad syntax ""-> ^a"".", 487 OPERATOR_VALUES (binary (substr (current_token.type, 13, 6), 17))); 488 goto RECORDED_MESSAGE; 489 end; 490 491 end; /* do while loop */ 492 493 if index (P_reference.name, "$") = 1 494 & probe_info.language_type = FORTRAN_lang_type & 495 verify (substr (P_reference.name, 2), "0123456789 ") = 0 496 then 497 P_reference.name = substr (P_reference.name, 2); 498 if (probe_info.language_type ^= C_lang_type 499 | P_reference.address_ptr = null ()) 500 then 501 call probe_eval_$evaluate (probe_info_ptr, P_reference, (switches), 502 want_value, code); 503 504 /* The empty brackets mean indirection. The symbol must be a char pointer 505* though. */ 506 if (need_to_indirect_and_make_string) then do; 507 if (P_reference.symbol_ptr = null ()) then do; 508 call probe_error_$record (probe_info_ptr, 0, 509 "Could not locate the symbol ^a", P_reference.name); 510 goto RECORDED_MESSAGE; 511 end; 512 if (P_reference.symbol_ptr -> runtime_symbol.son ^= "000000"b3 & 513 P_reference.type = pointer_dtype) 514 then do; 515 do while (fixed (P_reference.symbol_ptr -> runtime_symbol.type) 516 = pointer_dtype | 517 fixed (P_reference.symbol_ptr -> runtime_symbol.type) 518 = c_typeref_dtype); 519 P_reference.symbol_ptr = 520 addrel (P_reference.symbol_ptr, 521 fixed (P_reference.symbol_ptr -> runtime_symbol.son)); 522 end; 523 if (fixed (P_reference.symbol_ptr -> runtime_symbol.type) 524 = char_dtype) then do; 525 P_reference.symbol_ptr = null (); 526 P_reference.address_ptr = P_reference.address_ptr -> based_ptr; 527 P_reference.type = char_dtype; 528 P_reference.precision = 256; 529 P_reference.flags.packed = "1"b; 530 P_reference.flags.constant = "1"b; 531 P_reference.flags.c_ptr_to_char = "1"b; 532 end; 533 else do; 534 call probe_error_$record (probe_info_ptr, 0, 535 "The empty subscript is only valid for character array references^/using pointer values through one level of indirection." 536 ); 537 goto RECORDED_MESSAGE; 538 end; 539 end; 540 else if (P_reference.type = char_dtype 541 & fixed (P_reference.symbol_ptr -> runtime_symbol.ndims) > 0) 542 then do; 543 P_reference.symbol_ptr = null (); 544 P_reference.precision = 256; 545 P_reference.flags.packed = "1"b; 546 P_reference.flags.constant = "1"b; 547 end; 548 else do; 549 call probe_error_$record (probe_info_ptr, 0, 550 "The empty subscript is only valid for character array references^/using pointer values through one level of indirection." 551 ); 552 goto RECORDED_MESSAGE; 553 end; 554 need_to_indirect_and_make_string = "0"b; 555 end; 556 557 return; 558 559 get_unqualified_c_reference: 560 proc (); 561 562 dcl temp_created bit (1); 563 dcl (t_ref, s_ptr) ptr; 564 dcl name_ptr_2 ptr; 565 dcl old_addr ptr; 566 dcl offset_bits fixed bin (6) unsigned; 567 dcl offset_words fixed bin (18) unsigned; 568 569 call get_level (); 570 571 temp_created = "0"b; 572 old_addr = null (); 573 574 do while (probe_info.ct -> token.type = PERIOD); 575 576 if ^temp_created then do; 577 call probe_create_reference_ (probe_info_ptr, t_ref); 578 t_ref -> reference_node.optional_info.subscript_ptr = 579 P_reference.optional_info.subscript_ptr; 580 t_ref -> reference_node.optional_info.argument_list = 581 P_reference.optional_info.argument_list; 582 t_ref -> reference_node.optional_info.n_subscripts = 583 P_reference.optional_info.n_subscripts; 584 t_ref -> reference_node.optional_info.n_arguments = 585 P_reference.optional_info.n_arguments; 586 t_ref -> reference_node.subscript_refs_ptr = 587 P_reference.subscript_refs_ptr; 588 temp_created = "1"b; 589 end; 590 591 t_ref -> reference_node.name = id_token; 592 593 call probe_eval_$evaluate (probe_info_ptr, t_ref -> reference_node, 594 (switches), want_value, code); 595 596 if original_class = 0 & t_ref -> reference_node.symbol_ptr ^= null () 597 then 598 original_class = 599 convert (original_class, 600 t_ref -> reference_node.symbol_ptr 601 -> runtime_symbol.address.class); 602 603 code = 0; 604 605 if (old_addr = null ()) 606 then do; 607 old_addr = t_ref -> reference_node.address_ptr; 608 P_reference.address_ptr = old_addr; 609 end; 610 611 s_ptr = t_ref -> reference_node.symbol_ptr; 612 613 if (s_ptr ^= null ()) then do; 614 if fixed (s_ptr -> runtime_symbol.type) = c_typeref_dtype then do; 615 /* typeref */ 616 do while (fixed (s_ptr -> runtime_symbol.type) = c_typeref_dtype); 617 s_ptr = addrel (s_ptr, fixed (s_ptr -> runtime_symbol.son)); 618 end; 619 P_reference.name = 620 substr (P_reference.name, 1, 621 length (P_reference.name) - length (id_token)); 622 name_ptr_2 = addrel (s_ptr, fixed (s_ptr -> runtime_symbol.name)); 623 P_reference.name = 624 substr (name_ptr_2 -> acc_str.str_name, 1, 625 name_ptr_2 -> acc_str.str_len); 626 end; 627 end; 628 629 P_reference.name = P_reference.name || "."; 630 call bump_ct (); 631 if probe_info.ct -> token.type ^= NAME_TYPE then do; 632 call probe_error_$record (probe_info_ptr, 0, 633 "A name must follow a ""."" in a structure qualified reference"); 634 goto RECORDED_MESSAGE; 635 end; 636 637 P_reference.optional_info.n_subscripts = 0; 638 P_reference.optional_info.n_arguments = 0; 639 640 call get_level (); 641 642 call probe_eval_$evaluate (probe_info_ptr, P_reference, (switches), 643 want_value, code); 644 645 code = 0; 646 647 s_ptr = P_reference.symbol_ptr; 648 649 if s_ptr = null () then do; 650 call probe_error_$record (probe_info_ptr, 0, 651 "Could not locate the symbol."); 652 goto RECORDED_MESSAGE; 653 end; 654 if (^s_ptr -> runtime_symbol.bits.simple & 655 s_ptr -> runtime_symbol.offset ^= 0) then do; 656 offset_bits = convert (offset_bits, s_ptr -> runtime_symbol.offset); 657 658 offset_words = 659 convert (offset_words, divide (offset_bits, 36, 17, 0)); 660 offset_bits = convert (offset_bits, mod (offset_bits, 36)); 661 addr (old_addr) -> its_unsigned.offset = 662 addr (old_addr) -> its_unsigned.offset + offset_words; 663 addr (old_addr) -> its_unsigned.bit_offset = 664 addr (old_addr) -> its_unsigned.bit_offset + offset_bits; 665 end; 666 667 P_reference.address_ptr = old_addr; 668 669 if (P_reference.n_subscripts > 0) 670 then 671 call probe_eval_$add_c_dims (probe_info_ptr, P_reference, 672 (switches), "1"b, code, original_class); 673 end; 674 675 /* we are end of structure ref or simple ref */ 676 677 if probe_info.ct -> token.type = LEFT_BRACKET then do; 678 call bump_ct (); 679 680 call probe_get_$generation (probe_info_ptr, P_reference.source_info_ptr, 681 P_reference.invocation_level, code); 682 if code ^= 0 683 then goto SOME_ERROR; 684 685 if probe_info.ct -> operator.type ^= RIGHT_BRACKET 686 then do; 687 call probe_error_$record (probe_info_ptr, 0, 688 "Syntax error in generation of ^a", P_reference.name); 689 goto RECORDED_MESSAGE; 690 end; 691 692 P_reference.have_generation = "1"b; 693 call bump_ct (); /* past the ] */ 694 695 end; 696 697 /* an arglist would go here */ 698 699 end get_unqualified_c_reference; 700 701 get_unqualified_reference: 702 proc (); 703 704 call get_level (); 705 706 do while (probe_info.ct -> token.type = PERIOD); 707 P_reference.name = P_reference.name || "."; 708 call bump_ct (); 709 if probe_info.ct -> token.type ^= NAME_TYPE then do; 710 call probe_error_$record (probe_info_ptr, 0, 711 "A name must follow a ""."" in a structure qualified reference"); 712 goto RECORDED_MESSAGE; 713 end; 714 call get_level (); 715 end; 716 717 /* we are end of structure ref or simple ref */ 718 719 if probe_info.ct -> token.type = LEFT_BRACKET then do; 720 call bump_ct (); 721 722 call probe_get_$generation (probe_info_ptr, P_reference.source_info_ptr, 723 P_reference.invocation_level, code); 724 if code ^= 0 725 then goto SOME_ERROR; 726 727 if probe_info.ct -> operator.type ^= RIGHT_BRACKET 728 then do; 729 call probe_error_$record (probe_info_ptr, 0, 730 "Syntax error in generation of ^a", P_reference.name); 731 goto RECORDED_MESSAGE; 732 end; 733 734 P_reference.have_generation = "1"b; 735 call bump_ct (); /* past the ] */ 736 737 end; 738 739 /* an arglist would go here */ 740 741 if make_lower 742 then P_reference.name = translate (P_reference.name, LOWER, UPPER); 743 end get_unqualified_reference; 744 745 746 get_level: 747 proc (); 748 749 id_ptr = probe_info.ct; 750 751 if length (P_reference.name) + length (identifier_tokens_name) 752 > maxlength (P_reference.name) 753 then call disgruntled (probe_et_$too_long); 754 755 P_reference.name = P_reference.name || identifier_tokens_name; 756 call bump_ct (); 757 758 if probe_info.ct -> token.type = LEFT_PAREN 759 then call get_parens; 760 else if (probe_info.ct -> token.type = LEFT_BRACKET & 761 probe_info.language_type = C_lang_type) 762 then 763 call get_c_brackets (); 764 765 end get_level; 766 767 end parse_normal; 768 769 qualifier_name: 770 proc (P_ptr) returns (char (256) varying); 771 772 dcl (P_ptr, p) ptr; 773 dcl name char (256) varying; 774 775 776 p = P_ptr; 777 name = addrel (p, p -> runtime_symbol.name) -> acc.string; 778 do while (fixed (p -> runtime_symbol.level, 6) > 1); 779 /* print fathers */ 780 p = addrel (p, p -> runtime_symbol.father); 781 name = addrel (p, p -> runtime_symbol.name) -> acc.string || "." || name; 782 end; 783 return (name); 784 785 end qualifier_name; 786 787 parse_ala_cobol: 788 proc; 789 790 791 P_reference.name = identifier_tokens_name; 792 call bump_ct (); /* past the name */ 793 do while (cobol_connector ((probe_info.ct))); 794 call bump_ct (); 795 if probe_info.ct -> token.type ^= NAME_TYPE then do; 796 call probe_error_$record (probe_info_ptr, 0, 797 "Syntax error - a name is needed after ""of"" or ""in"""); 798 goto RECORDED_MESSAGE; 799 end; 800 801 if length (P_reference.name) + length (".") 802 + length (identifier_tokens_name) > 803 maxlength (P_reference.name) 804 then call disgruntled (probe_et_$too_long); 805 806 P_reference.name = "." || P_reference.name; 807 P_reference.name = identifier_tokens_name || P_reference.name; 808 809 call bump_ct (); /* past the name */ 810 811 end; /* do-while comma loop */ 812 813 P_reference.name = translate (P_reference.name, LOWER, UPPER); 814 815 if probe_info.ct -> token.type = LEFT_PAREN then do; 816 call bump_ct (); /* past the ( */ 817 call get_dim (); /* first subscript */ 818 do while (probe_info.ct -> token.type = COMMA); 819 call bump_ct (); 820 call get_dim (); 821 end; 822 823 if probe_info.ct -> token.type ^= RIGHT_PAREN then do; 824 call probe_error_$record (probe_info_ptr, 0, 825 "Syntax error in subscript list"); 826 goto RECORDED_MESSAGE; 827 end; 828 call bump_ct (); 829 end; /* subscript hacking */ 830 call probe_eval_$evaluate (probe_info_ptr, P_reference, (switches), 831 want_value, code); 832 end parse_ala_cobol; 833 834 parse_ala_pascal: 835 proc; /* parse a PASCAL REF */ 836 837 /* This procedure parses reference to a PASCAL variable and to a PASCAL constant set. 838* It works as the compiler works: If the reference is composed of more than 839* one symbol, it looks for the first name in the symbol table (done in probe_eval_) 840* and after, uses the attributes of this symbol to analyse the following symbols. 841* No abbreviation (as in PL/1, where reference to a field of a record may 842* be sufficient) is allowed: "v a" trying to get the value of "b.a" 843* will return "symbol a not declared" ("not found" would be better..). 844* excepted if we are in a "with b" block.. 845* 846**/ 847 dcl based_ptr pointer based; 848 dcl based_packed_ptr pointer unal based; 849 850 dcl size builtin; 851 dcl (first_ref, next_ref, 852 first_type_ptr, next_type_ptr) 853 ptr; 854 dcl (first_type, next_type, 855 first_value, next_value) 856 fixed bin (35); 857 dcl field_ptr ptr; 858 dcl got_args bit (1) init ("0"b); 859 dcl (Block_ptr, 860 Base_addr, 861 Linkage_ptr, 862 Stack_ptr) ptr; 863 dcl 1 type_info like runtime_type_info; 864 dcl (low, mult, new_high, new_low) 865 fixed bin (35); 866 dcl probe_pascal_$real_type entry (fixed bin (35), ptr, fixed bin (35), ptr) 867 ; 868 dcl stu_$find_runtime_symbol 869 entry (ptr, char (*) aligned, ptr, fixed bin) 870 returns (ptr); 871 dcl probe_pascal_$indice_id entry (fixed bin (35), ptr, fixed bin (35)) 872 returns (char (32) varying); 873 dcl probe_pascal_$indice_value 874 entry (ptr, ptr, fixed bin (35), fixed bin (35), 875 ptr, fixed bin (35)); 876 dcl probe_invoke_$function entry (ptr, 1 aligned like reference_node, 877 1 aligned like reference_node); 878 dcl subp ptr; 879 dcl found_ptr ptr; 880 dcl steps fixed bin; 881 dcl new_name char (32) varying; 882 dcl element_name char (256) varying; 883 dcl i fixed bin; 884 dcl bit_offset fixed bin (35); 885 dcl current_indice fixed bin; 886 dcl array_type_ptr ptr; 887 dcl 1 p based, 888 2 p1 bit (30) unal, 889 2 ftag bit (6) unal, 890 2 p2 bit (36) unal; 891 892 893 type_info.version = RUNTIME_TYPE_INFO_VERSION_1; 894 if probe_info.ct -> token.type = CONSTANT_TYPE then do; 895 P_reference.constant = "1"b; 896 P_reference.constant_token_ptr = probe_info.ct; 897 P_reference.name = "<>";/* should be smart and get name ! */ 898 call bump_ct (); 899 call probe_eval_$evaluate (probe_info_ptr, P_reference, (switches), 900 want_value, code); 901 if current_token.type = ARROW 902 then 903 if P_reference.type = pointer_dtype 904 then 905 if probe_info.execute 906 then go to arrow_found_execute; 907 else go to arrow_found_check; 908 goto SOME_ERROR; 909 end; 910 911 if ^probe_info.execute then do; /* just probe syntax checking */ 912 if current_token.type = NAME_TYPE then do; 913 /* PASCAL identifier */ 914 P_reference.name = identifier_tokens_name; 915 call bump_ct (); 916 if current_token.type = LEFT_PAREN then do; 917 call get_parens; 918 got_args = "1"b; 919 end; 920 call probe_eval_$evaluate (probe_info_ptr, P_reference, (switches), 921 want_value, code); 922 if code ^= 0 923 then go to SOME_ERROR; 924 continue_to_check: 925 if ^got_args then do; 926 if current_token.type = LEFT_PAREN then do; 927 call get_parens; 928 got_args = "1"b; 929 end; 930 end; 931 if got_args 932 then go to end_of_parsing; 933 ; /* no more after parens */ 934 if current_token.type = LEFT_BRACKET then do; 935 next_indice: 936 call probe_pascal_$indice_value (probe_info_ptr, next_ref, 937 next_value, next_type, 938 next_type_ptr, code); 939 if code ^= 0 940 then go to SOME_ERROR; 941 if current_token.type = COMMA then do; 942 call bump_ct (); 943 go to next_indice; 944 end; 945 if current_token.type ^= LEFT_BRACKET then do; 946 call probe_error_$record (probe_info_ptr, 0, 947 "Syntax error in array indices : Comma or left bracket expected." 948 ); 949 go to RECORDED_MESSAGE; 950 end; 951 call bump_ct (); 952 go to continue_to_check; 953 end; 954 if (current_token.type = PASCAL_ARROW) | 955 (current_token.type = ARROW) then do; 956 arrow_found_check: 957 call bump_ct (); 958 go to continue_to_check; 959 end; 960 if current_token.type = PERIOD then do; 961 call bump_ct (); 962 if current_token.type ^= NAME_TYPE then do; 963 call probe_error_$record (probe_info_ptr, 0, 964 "Syntax error : Field name expected after period."); 965 go to RECORDED_MESSAGE; 966 end; 967 call bump_ct (); 968 go to continue_to_check; 969 end; 970 end; 971 else if current_token.type = LEFT_BRACKET then do; 972 /* set */ 973 next_elem: 974 call probe_pascal_$indice_value (probe_info_ptr, next_ref, 975 next_value, next_type, 976 next_type_ptr, code); 977 if code ^= 0 978 then go to SOME_ERROR; 979 if current_token.type = COMMA then do; 980 call bump_ct (); 981 go to next_elem; 982 end; 983 if current_token.type ^= LEFT_BRACKET then do; 984 call probe_error_$record (probe_info_ptr, 0, 985 "Syntax error in set value : Comma or left bracket expected." 986 ); 987 go to RECORDED_MESSAGE; 988 end; 989 call bump_ct (); 990 end; 991 end; 992 993 else if current_token.type = NAME_TYPE then do; 994 P_reference.name = identifier_tokens_name; 995 call bump_ct (); 996 997 if current_token.type = LEFT_PAREN then do; 998 call get_parens; 999 got_args = "1"b; 1000 end; 1001 1002 call probe_eval_$evaluate (probe_info_ptr, P_reference, (switches), 1003 want_value, code); 1004 if code ^= 0 1005 then go to SOME_ERROR; 1006 if P_reference.builtin | P_reference.function then do; 1007 got_args = "0"b; 1008 P_reference.n_subscripts = 0; 1009 end; 1010 1011 Block_ptr = P_reference.source_info_ptr -> source_info.block_ptr; 1012 Stack_ptr = P_reference.source_info_ptr -> source_info.stack_ptr; 1013 Linkage_ptr = 1014 P_reference.source_info_ptr -> source_info.seg_info_ptr 1015 -> seg_info.linkage_ptr; 1016 Base_addr = P_reference.base_addr; 1017 1018 continue_to_parse: 1019 if ^got_args then do; 1020 if current_token.type = LEFT_PAREN then do; 1021 call get_parens; 1022 got_args = "1"b; 1023 end; 1024 end; 1025 if got_args 1026 then 1027 if P_reference.type_ptr ^= null then do; 1028 1029 type_info.version = RUNTIME_TYPE_INFO_VERSION_1; 1030 1031 call runtime_symbol_info_$type (P_reference.type_ptr, 1032 addr (type_info), code); 1033 if code ^= 0 1034 then go to SOME_ERROR; 1035 1036 if type_info.type ^= pascal_procedure_type_dtype 1037 then go to not_a_proc; 1038 if type_info.base_type ^= 0 then do; 1039 /* function */ 1040 if want_value then do; 1041 /* evaluate it */ 1042 call probe_invoke_$function (probe_info_ptr, 1043 P_reference, P_reference); 1044 end; 1045 P_reference.symbol_ptr = null; 1046 P_reference.type = type_info.base_type; 1047 P_reference.type_ptr = type_info.base_type_addr; 1048 P_reference.precision = type_info.size; 1049 end; 1050 got_args = "0"b; 1051 end; 1052 else do; 1053 not_a_proc: 1054 call probe_error_$record (probe_info_ptr, 0, 1055 "^a is not a procedure.", P_reference.name); 1056 go to RECORDED_MESSAGE; 1057 end; 1058 if current_token.type = LEFT_BRACKET then do; 1059 /* array indices */ 1060 call bump_ct (); 1061 if P_reference.type_ptr ^= null then do; 1062 if P_reference.type_ptr -> pascal_symbol_node_header.array_info 1063 then do; 1064 n_dims = 1065 runtime_symbol_info_$array_dims (P_reference.type_ptr); 1066 P_reference.packed = 1067 P_reference.type_ptr 1068 -> pascal_symbol_node_header.packed; 1069 bit_offset = 0; 1070 element_name = P_reference.name; 1071 P_reference.cross_section = 1072 is_cross_section ((probe_info.ct)); 1073 if P_reference.cross_section 1074 then P_reference.n_subscripts, 1075 P_reference.n_arguments, ref_subscripts.number = 1076 0; 1077 do; 1078 dcl 1 array_info like runtime_array_info; 1079 array_info.version = RUNTIME_ARRAY_INFO_VERSION_1; 1080 array_type_ptr = P_reference.type_ptr; 1081 current_indice = 0; 1082 continue_subarray: 1083 if P_reference.cross_section 1084 then P_reference.n_subscripts, 1085 P_reference.n_arguments, 1086 ref_subscripts.number = 1087 ref_subscripts.number + n_dims; 1088 call runtime_symbol_info_$array (array_type_ptr, 1089 addr (array_info), code); 1090 if code ^= 0 1091 then go to SOME_ERROR; 1092 do i = 1 to n_dims; 1093 if P_reference.cross_section then do; 1094 call probe_create_reference_ (probe_info_ptr, subp); 1095 sub_refs.ptr (1, i + current_indice) = subp; 1096 if current_token.type = TIMES then do; 1097 /* star extent */ 1098 subp -> subscript.flags.star_extent = "1"b; 1099 subp -> subscript.name = 1100 "<>"; 1101 call probe_create_reference_ (probe_info_ptr, 1102 subp); 1103 sub_refs.ptr (2, i + current_indice) = subp; 1104 subp -> subscript.flags.star_extent = "1"b; 1105 subp -> subscript.name = 1106 "<>"; 1107 ref_subscripts.value (1, i + current_indice) = 1108 decode (array_info.bounds (i).lower, 1109 array_info.bounds (i).lower_is_encoded, 1110 P_reference.type_ptr); 1111 ref_subscripts.value (2, i + current_indice) = 1112 decode (array_info.bounds (i).upper, 1113 array_info.bounds (i).upper_is_encoded, 1114 P_reference.type_ptr); 1115 call bump_ct (); 1116 go to next_dim; 1117 end; 1118 end; 1119 call get_indice_value (); 1120 if P_reference.cross_section then do; 1121 subp -> reference_node = next_ref -> reference_node; 1122 new_low = next_value; 1123 if current_token.type = COLON then do; 1124 call bump_ct (); 1125 call get_indice_value (); 1126 call probe_create_reference_ (probe_info_ptr, 1127 subp); 1128 sub_refs.ptr (2, i + current_indice) = subp; 1129 subp -> reference_node = 1130 next_ref -> reference_node; 1131 new_high = next_value; 1132 if new_high < new_low then do; 1133 call probe_error_$record (probe_info_ptr, 0, 1134 "Invalid range specification ^a..^a", 1135 probe_pascal_$indice_id (array_info (i) 1136 .subscript_type, 1137 array_info (i).subscript_type_addr, 1138 new_low), 1139 probe_pascal_$indice_id (array_info (i) 1140 .subscript_type, 1141 array_info (i).subscript_type_addr, 1142 new_high)); 1143 go to RECORDED_MESSAGE; 1144 end; 1145 end; 1146 else do; 1147 new_high = new_low; 1148 sub_refs.ptr (2, i + current_indice) = null; 1149 end; 1150 ref_subscripts.value (1, i + current_indice) = 1151 new_low; 1152 ref_subscripts.value (2, i + current_indice) = 1153 new_high; 1154 end; 1155 else do; 1156 mult = 1157 convert_units (mult, (array_info.array_units)); 1158 bit_offset = bit_offset + mult * (next_value - low); 1159 end; 1160 new_name = 1161 probe_pascal_$indice_id (array_info.bounds (i) 1162 .subscript_type, 1163 array_info.bounds (i).subscript_type_addr, 1164 next_value); 1165 if length (element_name) + 1 + length (new_name) > 1166 maxlength (element_name) 1167 then call disgruntled (probe_et_$too_long); 1168 if i = 1 1169 then element_name = element_name || "[" || new_name; 1170 else element_name = element_name || "," || new_name; 1171 next_dim: 1172 if i = n_dims then do; 1173 if current_token.type = RIGHT_BRACKET then do; 1174 call bump_ct (); 1175 if length (element_name) 1176 = maxlength (element_name) 1177 then 1178 call disgruntled (probe_et_$too_long); 1179 if ^P_reference.cross_section 1180 then P_reference.name = element_name || "]"; 1181 end; 1182 else do; 1183 call probe_error_$record (probe_info_ptr, 0, 1184 "Right bracket expected after ""^a""", 1185 element_name); 1186 go to RECORDED_MESSAGE; 1187 end; 1188 end; 1189 else do; 1190 if current_token.type = COMMA then do; 1191 call bump_ct (); 1192 end; 1193 else do; 1194 call probe_error_$record (probe_info_ptr, 0, 1195 "Comma expected after ""^a""", 1196 element_name); 1197 go to RECORDED_MESSAGE; 1198 end; 1199 end; 1200 end; 1201 1202 1203 get_indice_value: 1204 proc; 1205 1206 1207 call probe_pascal_$indice_value (probe_info_ptr, next_ref, next_value, 1208 next_type, 1209 next_type_ptr, code); 1210 if code ^= 0 1211 then go to SOME_ERROR; 1212 call probe_pascal_$real_type (array_info.bounds (i).subscript_type, 1213 array_info.bounds (i).subscript_type_addr, 1214 array_info.bounds (i).subscript_type, 1215 array_info.bounds (i).subscript_type_addr); 1216 if next_type ^= array_info.bounds (i).subscript_type 1217 | next_type_ptr ^= array_info.bounds (i).subscript_type_addr then do; 1218 call probe_error_$record (probe_info_ptr, 0, 1219 "Incorrect type of value in array indices."); 1220 go to RECORDED_MESSAGE; 1221 end; 1222 low = decode (array_info.bounds (i).lower, 1223 array_info.bounds (i).lower_is_encoded, P_reference.type_ptr); 1224 mult = decode (array_info.bounds (i).multiplier, 1225 array_info.bounds (i).multiplier_is_encoded, P_reference.type_ptr); 1226 if next_value < low | next_value > decode (array_info.bounds (i).upper, 1227 array_info.bounds (i).upper_is_encoded, P_reference.type_ptr) then do; 1228 call probe_error_$record (probe_info_ptr, 0, 1229 "Array indice out of bounds."); 1230 go to RECORDED_MESSAGE; 1231 end; 1232 end get_indice_value; 1233 1234 end; 1235 if ^P_reference.cross_section then do; 1236 P_reference.address_ptr = 1237 bitrel (P_reference.address_ptr, bit_offset); 1238 1239 type_info.version = RUNTIME_TYPE_INFO_VERSION_1; 1240 1241 call runtime_symbol_info_$type (P_reference.type_ptr, 1242 addr (type_info), code); 1243 if code ^= 0 1244 then go to SOME_ERROR; 1245 1246 P_reference.type = type_info.base_type; 1247 P_reference.type_ptr = type_info.base_type_addr; 1248 P_reference.precision = type_info.size; 1249 end; 1250 else do; 1251 if (current_token.type = PASCAL_ARROW) 1252 | (current_token.type = LEFT_PAREN) 1253 | (current_token.type = PERIOD) then do; 1254 no_more_specs: 1255 call probe_error_$record (probe_info_ptr, 0, 1256 "No more specification allowed after subarray description." 1257 ); 1258 go to RECORDED_MESSAGE; 1259 end; 1260 if current_token.type = LEFT_BRACKET then do; 1261 call bump_ct (); 1262 call runtime_symbol_info_$type (array_type_ptr, 1263 addr (type_info), code); 1264 if code ^= 0 1265 then go to SOME_ERROR; 1266 array_type_ptr = type_info.base_type_addr; 1267 current_indice = current_indice + n_dims; 1268 if array_type_ptr ^= null 1269 then 1270 n_dims = 1271 runtime_symbol_info_$array_dims ( 1272 array_type_ptr); 1273 else n_dims = 0; 1274 if n_dims = 0 1275 then go to no_more_specs; 1276 else go to continue_subarray; 1277 end; 1278 end; 1279 go to continue_to_parse; 1280 end; 1281 else go to not_an_array; 1282 end; 1283 else do; 1284 not_an_array: 1285 call probe_error_$record (probe_info_ptr, 0, 1286 "^a is not an array", P_reference.name); 1287 go to RECORDED_MESSAGE; 1288 end; 1289 end; 1290 if probe_info.ct -> token.type = ARROW then do; 1291 arrow_found_execute: 1292 if P_reference.type ^= pointer_dtype /* probe pointer variable */ 1293 then do; 1294 if P_reference.type ^= pascal_user_defined_type_instance_dtype 1295 then do; 1296 bad_locator: 1297 call probe_error_$record (probe_info_ptr, 0, 1298 "Given locator is not a pointer."); 1299 go to RECORDED_MESSAGE; 1300 end; 1301 type_info.version = RUNTIME_TYPE_INFO_VERSION_1; 1302 call runtime_symbol_info_$type (P_reference.type_ptr, 1303 addr (type_info), code); 1304 if code ^= 0 1305 then go to SOME_ERROR; 1306 if type_info.type ^= pascal_typed_pointer_type_dtype 1307 then go to bad_locator; 1308 end; 1309 if P_reference.address_ptr ^= null 1310 then 1311 if want_value then do; 1312 if ((P_reference.type = pointer_dtype) 1313 & (P_reference.packed)) | 1314 (P_reference.precision = 36) 1315 then 1316 P_reference.address_ptr = 1317 P_reference.address_ptr -> based_packed_ptr; 1318 else 1319 P_reference.address_ptr = 1320 P_reference.address_ptr -> based_ptr; 1321 if P_reference.address_ptr = null then do; 1322 call probe_error_$record (probe_info_ptr, 0, 1323 "Given locator is null."); 1324 go to RECORDED_MESSAGE; 1325 end; 1326 end; 1327 call bump_ct (); 1328 if current_token.type ^= NAME_TYPE then do; 1329 call probe_error_$record (probe_info_ptr, 0, 1330 "Type identifier expected after arrow."); 1331 go to RECORDED_MESSAGE; 1332 end; 1333 P_reference.type_ptr = 1334 stu_$find_runtime_symbol (Block_ptr, (current_identifier_name), 1335 found_ptr, steps); 1336 if P_reference.type_ptr = null then do; 1337 if current_identifier_name = "integer" then do; 1338 P_reference.type = pascal_integer_dtype; 1339 P_reference.precision = 35; 1340 end; 1341 else if current_identifier_name = "real" then do; 1342 P_reference.type = pascal_real_dtype; 1343 P_reference.precision = 63; 1344 end; 1345 else if current_identifier_name = "boolean" then do; 1346 P_reference.type = pascal_boolean_dtype; 1347 P_reference.precision = 36; 1348 end; 1349 else if current_identifier_name = "char" then do; 1350 P_reference.type = pascal_char_dtype; 1351 P_reference.precision = 36; 1352 end; 1353 else do; 1354 call probe_error_$record (probe_info_ptr, 0, 1355 "Symbol ^a not found.", current_identifier_name); 1356 go to RECORDED_MESSAGE; 1357 end; 1358 end; 1359 else do; 1360 call runtime_symbol_info_$type (P_reference.type_ptr, 1361 addr (type_info), code); 1362 if code ^= 0 1363 then go to SOME_ERROR; 1364 if (type_info.type = pascal_typed_pointer_type_dtype) 1365 | (type_info.type = pascal_user_defined_type_dtype) 1366 | (type_info.type = pascal_set_dtype) 1367 | (type_info.type = pascal_record_type_dtype) 1368 | (type_info.type = pascal_record_file_type_dtype) then do; 1369 P_reference.type = pascal_user_defined_type_instance_dtype; 1370 if type_info.type = pascal_typed_pointer_type_dtype 1371 then 1372 P_reference.precision = 72; 1373 /* supposed non packed */ 1374 else P_reference.precision = 0; 1375 end; 1376 else if type_info.type = pascal_enumerated_type_dtype then do; 1377 P_reference.type = pascal_enumerated_type_instance_dtype; 1378 P_reference.precision = 36; 1379 end; 1380 else do; 1381 call probe_error_$record (probe_info_ptr, 0, 1382 "^a is not a type.", current_identifier_name); 1383 go to RECORDED_MESSAGE; 1384 end; 1385 end; 1386 P_reference.name = "(" || current_identifier_name || ")"; 1387 P_reference.symbol_ptr = null; 1388 call bump_ct (); 1389 go to continue_to_parse; 1390 end; 1391 else 1392 if current_token.type = PASCAL_ARROW then do; 1393 if P_reference.type_ptr ^= null then do; 1394 if P_reference.type_ptr -> pascal_symbol_node_header.type = 1395 pascal_typed_pointer_type_dtype then do; 1396 /* variable pointer */ 1397 if P_reference.address_ptr ^= null 1398 then 1399 if want_value then do; 1400 if P_reference.precision = 36 1401 then 1402 P_reference.address_ptr = 1403 P_reference.address_ptr 1404 -> based_packed_ptr; 1405 else 1406 P_reference.address_ptr = 1407 P_reference.address_ptr -> based_ptr; 1408 if P_reference.address_ptr = null then do; 1409 call probe_error_$record (probe_info_ptr, 0, 1410 "Pointer ^a is null.", P_reference.name) 1411 ; 1412 go to RECORDED_MESSAGE; 1413 end; 1414 end; 1415 1416 call runtime_symbol_info_$type (P_reference.type_ptr, 1417 addr (type_info), code); 1418 if code ^= 0 1419 then go to SOME_ERROR; 1420 1421 P_reference.symbol_ptr = null; 1422 P_reference.type = type_info.base_type; 1423 P_reference.type_ptr = type_info.base_type_addr; 1424 P_reference.precision = type_info.size; 1425 P_reference.name = P_reference.name || "^"; 1426 call bump_ct (); 1427 go to continue_to_parse; 1428 end; 1429 else if P_reference.type_ptr -> pascal_symbol_node_header.type = 1430 pascal_record_file_type_dtype then do; 1431 /* file window */ 1432 1433 type_info.version = RUNTIME_TYPE_INFO_VERSION_1; 1434 1435 call runtime_symbol_info_$type (P_reference.type_ptr, 1436 addr (type_info), code); 1437 if code ^= 0 1438 then go to SOME_ERROR; 1439 1440 P_reference.type = type_info.base_type; 1441 P_reference.type_ptr = type_info.base_type_addr; 1442 go to file_window_join; 1443 end; 1444 else go to not_a_ptr; 1445 end; 1446 else if P_reference.type = pascal_text_file_dtype then do; 1447 /* text file window */ 1448 P_reference.type = pascal_char_dtype; 1449 P_reference.precision = 36; 1450 P_reference.type_ptr = null; 1451 file_window_join: 1452 P_reference.symbol_ptr = null; 1453 P_reference.name = P_reference.name || "^"; 1454 if P_reference.address_ptr ^= null then do; 1455 if P_reference.address_ptr -> p.ftag ^= "43"b3 1456 | P_reference.address_ptr -> based_ptr = null 1457 then 1458 P_reference.address_ptr = null; 1459 else 1460 P_reference.address_ptr = 1461 addrel (P_reference.address_ptr -> based_ptr, 1462 window_place_in_pascal_fsb); 1463 end; 1464 call bump_ct (); 1465 go to continue_to_parse; 1466 end; 1467 else do; 1468 not_a_ptr: 1469 call probe_error_$record (probe_info_ptr, 0, 1470 "^a is neither a file nor a typed pointer.", 1471 P_reference.name); 1472 go to RECORDED_MESSAGE; 1473 end; 1474 end; 1475 if current_token.type = PERIOD then do; 1476 /* PASCAL field expected */ 1477 call bump_ct (); 1478 if current_token.type ^= NAME_TYPE then do; 1479 no_field_name: 1480 call probe_error_$record (probe_info_ptr, 0, 1481 "A field name must follow the ""."""); 1482 go to RECORDED_MESSAGE; 1483 end; 1484 if P_reference.type_ptr ^= null then do; 1485 if P_reference.type_ptr -> pascal_symbol_node_header.type 1486 = pascal_record_type_dtype then do; 1487 field_ptr = runtime_symbol_info_$son (P_reference.type_ptr); 1488 call scan_record (field_ptr, (want_value)); 1489 end; 1490 else go to not_a_record; 1491 end; 1492 else if P_reference.type = pascal_record_type_dtype then do; 1493 field_ptr = runtime_symbol_info_$son (P_reference.symbol_ptr); 1494 call scan_record (field_ptr, "0"b); 1495 end; 1496 else do; 1497 not_a_record: 1498 call probe_error_$record (probe_info_ptr, 0, 1499 "^a is not a record", P_reference.name); 1500 go to RECORDED_MESSAGE; 1501 end; 1502 call probe_error_$record (probe_info_ptr, 0, 1503 "^a is not a field of ^a", identifier_tokens_name, 1504 P_reference.name); 1505 go to RECORDED_MESSAGE; 1506 end; /* field of record */ 1507 end; /* identifier */ 1508 1509 else if current_token.type = LEFT_BRACKET then do; 1510 /* PASCAL set */ 1511 P_reference.type = pascal_user_defined_type_instance_dtype; 1512 allocate pascal_symbol_node_header in (expression_area) 1513 set (P_reference.type_ptr); 1514 unspec (P_reference.type_ptr -> pascal_symbol_node_header) = "0"b; 1515 P_reference.type_ptr -> pascal_symbol_node_header.type = 1516 pascal_set_dtype; 1517 allocate pascal_set in (expression_area) set (P_reference.address_ptr); 1518 P_reference.precision = size (pascal_set); 1519 P_reference.packed = "0"b; 1520 P_reference.name = "<>"; 1521 P_reference.descriptor = 0; 1522 1523 P_reference.address_ptr -> pascal_set = "0"b; 1524 1525 call bump_ct (); 1526 1527 if current_token.type = RIGHT_BRACKET then do; 1528 /* empty set */ 1529 call bump_ct (); 1530 go to end_of_parsing; 1531 end; 1532 1533 call probe_pascal_$indice_value (probe_info_ptr, first_ref, first_value, 1534 first_type, first_type_ptr, code); 1535 if code ^= 0 1536 then go to SOME_ERROR; 1537 call fill_set (first_value, first_ref); 1538 1539 do while (current_token.type = COMMA); 1540 call bump_ct (); 1541 call probe_pascal_$indice_value (probe_info_ptr, next_ref, next_value, 1542 next_type, 1543 next_type_ptr, code); 1544 if code ^= 0 1545 then go to SOME_ERROR; 1546 if (first_type ^= next_type) 1547 | (first_type_ptr ^= next_type_ptr) then do; 1548 call probe_error_$record (probe_info_ptr, 0, 1549 "Types of elements of set do not match."); 1550 go to RECORDED_MESSAGE; 1551 end; 1552 call fill_set (next_value, next_ref); 1553 end; 1554 1555 if current_token.type ^= RIGHT_BRACKET then do; 1556 call probe_error_$record (probe_info_ptr, 0, 1557 "Error in set description."); 1558 go to RECORDED_MESSAGE; 1559 end; 1560 1561 call bump_ct (); 1562 go to end_of_parsing; 1563 end; /* PASCAL <> */ 1564 1565 end_of_parsing: 1566 return; 1567 1568 /* Procedures internal to parse_ala_pascal */ 1569 1570 bitrel: 1571 proc (P_ptr, P_bit_offset) returns (ptr); 1572 dcl P_ptr ptr parameter; 1573 dcl P_bit_offset fixed bin (35) parameter; 1574 1575 dcl 1 str unaligned based (P_ptr), 1576 2 filler unal bit (P_bit_offset), 1577 2 target unal bit (1); 1578 1579 if P_bit_offset < 0 1580 then return (null); 1581 return (addr (str.target)); 1582 1583 end bitrel; 1584 1585 1586 convert_units: 1587 proc (value, unit_code) returns (fixed bin (35)); 1588 1589 dcl value fixed bin (35) parameter; 1590 /* offset in raw */ 1591 dcl unit_code fixed bin (2) parameter unsigned; 1592 1593 1594 goto units_case (unit_code); 1595 1596 units_case (0): 1597 return (value * bits_per_word); /* word */ 1598 units_case (1): 1599 return (value); /* bit */ 1600 units_case (2): 1601 return (value * bits_per_character); /* char */ 1602 units_case (3): 1603 return (value * bits_per_half); /* halfword */ 1604 1605 end convert_units; 1606 1607 1608 decode: 1609 proc (value, encoded, symbp) returns (fixed bin (35)); 1610 1611 dcl value fixed bin (35); 1612 dcl encoded bit (1); 1613 dcl symbp ptr; 1614 1615 dcl ptr builtin; 1616 dcl stu_$decode_runtime_value_extended 1617 entry (fixed bin (35), ptr, ptr, ptr, ptr, ptr, 1618 ptr, fixed bin (35)) returns (fixed bin (35)); 1619 dcl result fixed bin (35); 1620 1621 if ^encoded 1622 then return (value); 1623 else do; 1624 result = 1625 stu_$decode_runtime_value_extended (value, Block_ptr, Stack_ptr, 1626 Linkage_ptr, 1627 ptr (Block_ptr, 0), Base_addr, symbp, code); 1628 if code ^= 0 1629 then go to SOME_ERROR; 1630 return (result); 1631 end; 1632 1633 end decode; 1634 1635 1636 fill_set: 1637 proc (val, ref_ptr); 1638 1639 dcl val fixed bin (35); 1640 dcl ref_ptr ptr; 1641 1642 if val >= pascal_max_set_size then do; 1643 call probe_error_$record (probe_info_ptr, 0, 1644 "Value of ^a is out of PASCAL set range.", 1645 ref_ptr -> reference_node.name); 1646 go to RECORDED_MESSAGE; 1647 end; 1648 substr (P_reference.address_ptr -> pascal_set, val + 1, 1) = "1"b; 1649 1650 end fill_set; 1651 1652 1653 is_cross_section: 1654 proc (P_ct) returns (bit (1)); 1655 1656 dcl (P_ct, ct) ptr; 1657 1658 do ct = P_ct repeat (ct -> current_token.next) while (ct ^= null); 1659 if ct -> current_token.type = RIGHT_BRACKET 1660 then return ("0"b); 1661 if ct -> current_token.type = C_INDIRECTION 1662 | ct -> current_token.type = TIMES | ct -> current_token.type = COLON 1663 then return ("1"b); 1664 end; 1665 return ("0"b); 1666 1667 end is_cross_section; 1668 1669 1670 scan_record: 1671 proc (FIELD_PTR, EXECUTE); 1672 1673 dcl FIELD_PTR ptr; 1674 dcl EXECUTE bit (1); 1675 1676 dcl prev_ptr ptr; 1677 dcl i fixed bin; 1678 1679 prev_ptr = null; 1680 call scan_fields (FIELD_PTR); 1681 if prev_ptr ^= null then do; 1682 n_variants = runtime_symbol_info_$n_variants (prev_ptr); 1683 if n_variants ^= 0 1684 then 1685 begin; 1686 dcl 1 variant_info like runtime_variant_info; 1687 1688 variant_info.version = RUNTIME_VARIANT_INFO_VERSION_1; 1689 1690 call runtime_symbol_info_$variant (prev_ptr, addr (variant_info), 1691 code); 1692 if code ^= 0 1693 then go to SOME_ERROR; 1694 1695 do i = 1 to n_variants; 1696 call scan_record (variant_info.case (i).brother_addr, EXECUTE); 1697 end; 1698 end; 1699 end; 1700 return; 1701 1702 scan_fields: 1703 proc (FIELD_P); 1704 1705 dcl FIELD_P ptr; 1706 1707 dcl name_ptr ptr; 1708 dcl 1 type_info like runtime_type_info; 1709 dcl 1 address_info like runtime_address_info; 1710 1711 do while (FIELD_P ^= null); 1712 name_ptr = runtime_symbol_info_$name (FIELD_P); 1713 if name_ptr ^= null then do; 1714 if name_ptr -> acc.string = identifier_tokens_name then do; 1715 if (length (P_reference.name) + 1 + name_ptr -> acc.num_chars) > 1716 maxlength (P_reference.name) 1717 then call disgruntled (probe_et_$too_long); 1718 P_reference.name = 1719 P_reference.name || "." || identifier_tokens_name; 1720 1721 type_info.version = RUNTIME_TYPE_INFO_VERSION_1; 1722 1723 call runtime_symbol_info_$type (FIELD_P, addr (type_info), code); 1724 if code ^= 0 1725 then go to SOME_ERROR; 1726 1727 if EXECUTE then do; 1728 1729 address_info.version = RUNTIME_ADDRESS_INFO_VERSION_1; 1730 1731 call runtime_symbol_info_$address (FIELD_P, 1732 addr (address_info), code); 1733 if code ^= 0 1734 then go to SOME_ERROR; 1735 1736 P_reference.address_ptr = bitrel (P_reference.address_ptr, 1737 convert_units ( 1738 decode (address_info.offset, 1739 address_info.offset_is_encoded, FIELD_P), 1740 bin (address_info.units, 2))); 1741 end; 1742 P_reference.type = type_info.type; 1743 P_reference.type_ptr = type_info.type_addr; 1744 P_reference.packed = type_info.packed; 1745 P_reference.precision = type_info.size; 1746 P_reference.symbol_ptr = FIELD_P; 1747 call bump_ct (); 1748 go to continue_to_parse; 1749 end; 1750 end; 1751 prev_ptr = FIELD_P; 1752 FIELD_P = runtime_symbol_info_$brother (FIELD_P); 1753 end; 1754 end scan_fields; 1755 1756 end scan_record; 1757 1758 end parse_ala_pascal; 1759 1760 /* COMMON SUBROUTINES FOR DIFFERENT STYLES OF PARSING */ 1761 1762 add: 1763 proc (P_str); 1764 1765 dcl P_str char (*); 1766 1767 if length (P_reference.name) + length (P_str) > maxlength (P_reference.name) 1768 then 1769 call disgruntled (probe_et_$too_long); 1770 1771 P_reference.name = P_reference.name || P_str; 1772 1773 end add; 1774 1775 1776 get_dim: 1777 proc; 1778 1779 /* we parse a dim - that may be 1780* 1781* DIM ::= expression | expression:expression | * 1782* 1783* global import P_reference, sub_refs, ct 1784* 1785**/ 1786 1787 dcl subp ptr; 1788 dcl sub_no fixed bin; 1789 1790 if P_reference.n_subscripts >= hbound (sub_refs.ptr, 2) 1791 then call disgruntled (probe_et_$dim_limit); 1792 1793 sub_no, P_reference.n_subscripts = P_reference.n_subscripts + 1; 1794 P_reference.n_arguments = P_reference.n_arguments + 1; 1795 1796 call probe_create_reference_ (probe_info_ptr, subp); 1797 sub_refs.ptr (1, sub_no) = subp; 1798 1799 if (ct -> token.type = TIMES | ct -> token.type = C_INDIRECTION) 1800 & ^P_reference.path then do; 1801 /* star extent */ 1802 subp -> subscript.flags.star_extent = "1"b; 1803 subp -> subscript.name = "<>"; 1804 call probe_create_reference_ (probe_info_ptr, subp); 1805 sub_refs.ptr (2, sub_no) = subp; 1806 subp -> subscript.flags.star_extent = "1"b; 1807 subp -> subscript.name = "<>"; 1808 call bump_ct (); 1809 P_reference.cross_section = "1"b; 1810 end; 1811 1812 else do; 1813 call probe_get_$expression (probe_info_ptr, subp -> reference_node, 1814 code); 1815 if code ^= 0 1816 then goto SOME_ERROR; 1817 1818 if probe_info.ct -> operator.type = COLON then do; 1819 call probe_create_reference_ (probe_info_ptr, subp); 1820 sub_refs.ptr (2, sub_no) = subp; 1821 call bump_ct (); 1822 call probe_get_$expression (probe_info_ptr, subp -> reference_node, 1823 code); 1824 if code ^= 0 1825 then goto SOME_ERROR; 1826 P_reference.cross_section = "1"b; 1827 end; 1828 else sub_refs.ptr (2, sub_no) = null (); 1829 end; /* non-* case */ 1830 1831 end get_dim; 1832 1833 1834 get_parens: 1835 proc (); 1836 1837 call bump_ct (); /* past the ( */ 1838 if probe_info.ct -> operator.type = RIGHT_PAREN then do; 1839 /* () */ 1840 call bump_ct (); 1841 P_reference.function = "1"b; /* it is () */ 1842 end; 1843 else do; 1844 call get_dim (); /* first subscript */ 1845 do while (probe_info.ct -> token.type = COMMA); 1846 /* DO=UNTIL */ 1847 call bump_ct (); /* past comma, or first paren */ 1848 call get_dim (); 1849 end; /* do until no comma loop */ 1850 1851 if probe_info.ct -> operator.type ^= RIGHT_PAREN then do; 1852 call probe_error_$record (probe_info_ptr, 0, 1853 "Syntax error in subscript/argument list"); 1854 goto RECORDED_MESSAGE; 1855 end; 1856 call bump_ct (); /* past the ) */ 1857 end; /* non - null subscript/arg list loop */ 1858 1859 end get_parens; 1860 1861 1862 get_c_brackets: 1863 proc (); 1864 1865 dcl not_end_of_dims bit (1); 1866 1867 1868 call bump_ct (); /* past the [ */ 1869 /* One empty subscript is allowed if the symbol is a char ptr in C */ 1870 if (probe_info.ct -> token.type = RIGHT_BRACKET) 1871 then 1872 need_to_indirect_and_make_string = "1"b; 1873 else call get_dim (); 1874 not_end_of_dims = "1"b; 1875 do while (not_end_of_dims); 1876 if (probe_info.ct -> token.type = RIGHT_BRACKET) then do; 1877 call bump_ct (); 1878 if (probe_info.ct -> token.type = LEFT_BRACKET) then do; 1879 call bump_ct (); 1880 if (probe_info.ct -> token.type = RIGHT_BRACKET) then do; 1881 /* call probe_error_$record (probe_info_ptr, 0, 1882* "Only the first subscript of a character array referenced using^/ a pointer value may be empty." 1883* ); 1884* goto RECORDED_MESSAGE;*/ 1885 end; 1886 else call get_dim (); 1887 end; 1888 else not_end_of_dims = "0"b; 1889 end; 1890 else do; 1891 call probe_error_$record (probe_info_ptr, 0, 1892 "Syntax error in subscript/argument list"); 1893 goto RECORDED_MESSAGE; 1894 end; 1895 end; 1896 1897 end get_c_brackets; 1898 1899 1900 get_pathname: 1901 proc (); 1902 1903 1904 do while (probe_info.ct -> token.type = GREATER_THAN 1905 | probe_info.ct -> token.type = LESS_THAN | 1906 probe_info.ct -> token.type = PERIOD 1907 | probe_info.ct -> token.type = DOLLAR_SIGN | 1908 probe_info.ct -> token.type = OR_BAR); 1909 1910 if probe_info.ct -> token.type = GREATER_THAN 1911 then call add (">"); 1912 else if probe_info.ct -> token.type = LESS_THAN 1913 then call add ("<"); 1914 else if probe_info.ct -> token.type = PERIOD 1915 then call add ("."); 1916 else if probe_info.ct -> token.type = DOLLAR_SIGN 1917 then call add ("$"); 1918 else call add ("|"); 1919 1920 call bump_ct (); 1921 1922 if probe_info.ct -> token.type >= probe_info.end_token 1923 then go to GOT_PATH; 1924 else if probe_info.ct -> token.type ^= NAME_TYPE then do; 1925 call probe_error_$record (probe_info_ptr, error_table_$badpath); 1926 go to RECORDED_MESSAGE; 1927 end; 1928 1929 call add (identifier_tokens_name); 1930 1931 call bump_ct (); 1932 end; 1933 GOT_PATH: 1934 dummy_entry = cv_entry_ ((P_reference.name), null, code); 1935 if code ^= 0 then do; 1936 call probe_error_$record (probe_info_ptr, code, P_reference.name); 1937 go to RECORDED_MESSAGE; 1938 end; 1939 1940 P_reference.path = "1"b; 1941 1942 call get_parens (); 1943 1944 end get_pathname; 1945 1946 1947 1948 bump_ct: 1949 proc; 1950 probe_info.ct = probe_info.ct -> token.next; 1951 end bump_ct; 1952 1953 1954 cobol_connector: 1955 proc (p) returns (bit (1) aligned); 1956 dcl p ptr parameter; 1957 dcl based_two char (2) unal based (p -> identifier.name); 1958 dcl c2 char (2) aligned; 1959 if p -> token.type = NAME_TYPE 1960 then if p -> identifier.length = 2 then do; 1961 c2 = based_two; 1962 if c2 = "of" | c2 = "in" | c2 = "OF" | c2 = "IN" 1963 then return ("1"b); 1964 end; 1965 return ("0"b); 1966 end cobol_connector; 1967 1968 looks_like_cobol: 1969 proc () returns (bit (1) aligned); 1970 if probe_info.language_type = COBOL_lang_type 1971 & probe_info.ct -> token.type = NAME_TYPE 1972 then if cobol_connector ((probe_info.ct -> token.next)) 1973 then return ("1"b); 1974 return ("0"b); /* cobol, but in "normal" form */ 1975 end looks_like_cobol; 1976 1977 /* INCLUDE FILES */ 1978 1 1 /* BEGIN INCLUDE FILE probe_info.incl.pl1 */ 1 2 1 3 1 4 1 5 /****^ HISTORY COMMENTS: 1 6* 1) change(88-10-24,WAAnderson), approve(88-10-24,MCR7952), 1 7* audit(88-10-24,RWaters), install(88-10-27,MR12.2-1194): 1 8* Added field 'retry_using_main' to add new C feature. 1 9* END HISTORY COMMENTS */ 1 10 1 11 1 12 /* Created: 04/22/79 W. Olin Sibert, from subsystem_info 1 13* Modified: 22 Sept 79 JRd to remove: default (ptr & (auto|based)) init (null ()); 1 14* Added flags.setting_break 08/22/83 Steve Herbst 1 15* Added flags.executing_quit_request 01/15/85 Steve Herbst 1 16**/ 1 17 1 18 dcl 1 probe_info aligned based (probe_info_ptr), /* standard data for a probe invocation */ 1 19 2 probe_info_version fixed bin, /* version of this structure */ 1 20 1 21 2 static_info_ptr pointer unaligned, /* pointer to static information structure */ 1 22 2 modes_ptr pointer unaligned, /* pointer to probe_modes structure */ 1 23 1 24 2 ptr_to_current_source ptr, /* current_source is based on this */ 1 25 2 ptr_to_initial_source ptr, /* initial_source is based on this */ 1 26 2 machine_cond_ptr pointer, /* pointer to machine conditions, if we faulted to get here */ 1 27 1 28 2 token_info aligned, /* information about token chain currently being processed */ 1 29 3 first_token pointer unaligned, /* first token in chain */ 1 30 3 ct pointer unaligned, /* pointer to current token; updated in MANY places */ 1 31 3 end_token bit (18) aligned, /* token type at which to stop scanning token chain */ 1 32 3 buffer_ptr pointer unaligned, /* pointer to input buffer */ 1 33 3 buffer_lth fixed bin (21), /* and length */ 1 34 1 35 2 random_info aligned, 1 36 3 current_stack_frame pointer unaligned, /* stack frame pointer for frame in which probe was invoked */ 1 37 3 input_type fixed bin, /* current input type */ 1 38 3 language_type fixed bin, /* current language being processed */ 1 39 3 return_method fixed bin, /* how we should return after exiting probe */ 1 40 3 entry_method fixed bin, /* how we got here in the first place */ 1 41 3 pad1 (19) bit (36) aligned, 1 42 1 43 2 break_info, /* break info -- only interesting if we got here via a break */ 1 44 3 break_slot_ptr pointer, /* pointer to break slot -- non-null IFF at a break */ 1 45 3 last_break_slot_ptr pointer unaligned, /* pointer to previous break slot, not presently used */ 1 46 3 break_reset bit (1) aligned, /* this break has been reset by somebody further on */ 1 47 3 real_break_return_loc pointer, /* where to REALLY return to, modulo previous bit */ 1 48 1 49 2 probe_area_info, /* information about various probe areas */ 1 50 3 break_segment_ptr pointer unaligned, /* pointer to Personid.probe */ 1 51 3 break_area_ptr pointer unaligned, /* pointer to area in break segment */ 1 52 3 scratch_area_ptr pointer unaligned, /* pointer to probe scratch seg in process dir */ 1 53 3 probe_area_ptr pointer unaligned, /* This area lasts as long as an invocation of probe. */ 1 54 3 work_area_ptr pointer unaligned, /* This area lasts as long as the current request line */ 1 55 3 expression_area_ptr pointer unaligned, /* This area lasts as long as the current command */ 1 56 1 57 2 flags aligned, /* this, in particular, should be saved and restored correctly */ 1 58 (3 execute, /* "1"b => execute requests, "0"b => just check syntax */ 1 59 3 in_listener, /* ON => in probe listener loop */ 1 60 3 executing_request, /* ON => executing a request */ 1 61 3 in_interpret_line, /* executing in probe_listen_$interpret_line */ 1 62 3 setting_break, /* executing "after" or "before": check syntax of "if" */ 1 63 3 executing_quit_request, /* to prevent error looping during "quit" request */ 1 64 3 pad (30)) bit (1) unaligned, 1 65 1 66 2 io_switches, /* switches probe will do normal I/O on */ 1 67 3 input_switch pointer, 1 68 3 output_switch pointer, 1 69 1 70 2 error_info, /* information about the last error saved for later printing */ 1 71 3 error_code fixed bin (35), 1 72 3 error_message char (300) varying, 1 73 1 74 2 listener_info, /* internal use by probe listener */ 1 75 3 request_name character (32) varying, /* primary name of the request being processed */ 1 76 3 abort_probe_label label variable, 1 77 3 abort_line_label label variable, 1 78 3 depth fixed binary, /* count of active invocations of probe */ 1 79 3 previous pointer unaligned, /* -> previous invocation's info */ 1 80 3 next pointer unaligned, 1 81 1 82 2 end_of_probe_info pointer aligned, 1 83 2 retry_using_main fixed bin aligned; 1 84 1 85 1 86 dcl probe_info_ptr pointer; 1 87 1 88 dcl probe_info_version fixed bin static options (constant) initial (1); 1 89 1 90 dcl probe_info_version_1 fixed bin static options (constant) initial (1); 1 91 1 92 dcl scratch_area area based (probe_info.scratch_area_ptr); 1 93 dcl probe_area area based (probe_info.probe_area_ptr); 1 94 dcl work_area area based (probe_info.work_area_ptr); 1 95 dcl expression_area area based (probe_info.expression_area_ptr); 1 96 1 97 /* END INCLUDE FILE probe_info.incl.pl1 */ 1979 1980 2 1 /* BEGIN INCLUDE FILE probe_tokens.incl.pl1 */ 2 2 /* Split up into probe_tokens and probe_references, 04/22/79 WOS */ 2 3 2 4 dcl 1 token_header aligned based, /* header information common to all tokens */ 2 5 2 next pointer unaligned, /* pointer to next token in chain */ 2 6 2 prev pointer unaligned, /* same for previous token */ 2 7 2 type bit (18) aligned, 2 8 2 buffer_ptr pointer unaligned, /* pointer to beginning of input buffer */ 2 9 2 location fixed bin (17) unal, /* offset in input buffer */ 2 10 2 length fixed bin (17) unal, 2 11 2 flags aligned, 2 12 (3 leading_whitespace, /* there is whitespace before thios token */ 2 13 3 trailing_whitespace) bit (1) unaligned, /* and same for after */ 2 14 3 pad1 bit (34) unaligned; 2 15 2 16 dcl 1 token aligned based, /* produced by scan_probe_input_ */ 2 17 2 header aligned like token_header; /* that's all there is */ 2 18 2 19 dcl 1 identifier aligned based, /* keyword or identifier token */ 2 20 2 header aligned like token_header, 2 21 2 length fixed bin, /* length of name */ 2 22 2 name pointer unaligned; /* to string in buffer containing name */ 2 23 2 24 dcl 1 operator aligned based, /* for punctuation */ 2 25 2 header aligned like token_header; /* nothing but a header here */ 2 26 2 27 dcl 1 constant aligned based, /* for strings pointers numbers etc */ 2 28 2 header aligned like token_header, 2 29 2 encoded_precision aligned, /* encoded precision kludge for assign_ */ 2 30 3 scale fixed bin (17) unaligned, /* arithmetic scale */ 2 31 3 precision fixed bin (17) unaligned, /* arithmetic precision or other size */ 2 32 2 scale_and_precision fixed bin (35), /* An identical copy of the two values above */ 2 33 2 data_type fixed bin, /* standard data type code + packed bit */ 2 34 2 data_ptr pointer unaligned; 2 35 2 36 2 37 dcl (OPERATOR_TYPE init ("100"b), /* types for above */ 2 38 NAME_TYPE init ("010"b), 2 39 CONSTANT_TYPE init ("001"b)) bit (18) internal static options (constant); 2 40 2 41 2 42 dcl current_identifier_name /* Overlays for looking at the current tokens */ 2 43 char (probe_info.ct -> identifier.length) based (probe_info.ct -> identifier.name); 2 44 dcl 1 current_constant aligned like constant based (probe_info.ct); 2 45 dcl 1 current_token aligned like token based (probe_info.ct); 2 46 2 47 /* END INCLUDE FILE probe_tokens.incl.pl1 */ 1981 1982 3 1 /* BEGIN INCLUDE FILE probe_references.incl.pl1 */ 3 2 3 3 /****^ HISTORY COMMENTS: 3 4* 1) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 3 5* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 3 6* Added new field (c_symbol) for C-Probe support. 3 7* 2) change(88-10-28,WAAnderson), approve(88-10-28,MCR7952), 3 8* audit(88-10-31,RWaters), install(88-11-11,MR12.2-1210): 3 9* Added new field (c_sub_c_ptr) for C-Probe_support. 3 10* END HISTORY COMMENTS */ 3 11 3 12 /* Split out of probe_tokens, 04/22/79 WOS */ 3 13 /* modified for probe variables Feb 19 80 JRD */ 3 14 /* Modified June 83 JMAthane to add "type_ptr" and "builtin" fields */ 3 15 3 16 dcl 1 reference_node aligned based, /* information about a reference */ 3 17 2 symbol_ptr pointer aligned, /* to symbol table entry for reference */ 3 18 2 type_ptr pointer aligned, /* to symbol table entry for type (null if none) */ 3 19 2 address_ptr pointer aligned, /* to location of variable */ 3 20 2 base_addr pointer aligned, /* pointer on which whole symbol is based */ 3 21 2 source_info_ptr pointer aligned, /* to symbol structure for reference */ 3 22 3 23 2 name char (256) unaligned varying, /* symbol name */ 3 24 3 25 2 type fixed bin (35), /* data type */ 3 26 2 descriptor fixed bin (35), /* type || packed */ 3 27 2 precision fixed bin (35), /* scale and precision */ 3 28 2 flags, 3 29 3 packed bit (1) unal, /* data is in packed format */ 3 30 3 constant bit (1) unal, /* data is really a constant */ 3 31 3 cross_section bit (1) unal, /* reference is an array cross-section */ 3 32 3 function bit (1) unal, /* reference is function value */ 3 33 3 octal bit (1) unal, /* indicates that this is the octal bif */ 3 34 3 star_extent bit (1) unal, /* reference is a star subscript for father */ 3 35 3 have_generation bit (1) unal, /* this reference has an explicitly specified generation */ 3 36 3 pseudo_var bit (1) unal, /* it is ok to assign to it */ 3 37 3 probe_variable bit (1) unal, 3 38 3 path bit (1) unal, /* it's a pathname/virtual entry */ 3 39 3 builtin bit (1) unal, /* probe builtinvalue */ 3 40 3 c_ptr_to_char bit (1) unal, 3 41 3 c_sub_c_ptr bit (1) unal, 3 42 3 pad2 bit (23) unal, 3 43 3 44 2 optional_info, /* information which may or may not be present */ 3 45 3 argument_list pointer unaligned, /* pointer to reference_arg_list */ 3 46 3 subscript_ptr pointer unaligned, /* pointer to reference_subscripts */ 3 47 3 n_arguments fixed bin, /* number of arguments in argument list */ 3 48 3 n_subscripts fixed bin, /* number of subscripts present */ 3 49 3 50 2 constant_token_ptr pointer unaligned, /* pointer to constant token if this is a constant */ 3 51 2 subscript_refs_ptr pointer unaligned, /* pointer to array of subscript reference node pointers */ 3 52 2 invocation_level fixed bin, /* invocation level number ("[-17]") for this reference */ 3 53 2 probe_var_info_ptr ptr unal, /* only if flags.probe_variable */ 3 54 2 c_symbol_ptr ptr unal, 3 55 2 pad1 (9) pointer unaligned, 3 56 2 end_of_reference_node pointer aligned; 3 57 3 58 3 59 dcl 1 reference_arg_list aligned based, /* argument list; based on reference.argument_list */ 3 60 2 number fixed bin, /* number of arguments actually present */ 3 61 2 node (16) pointer aligned; /* reference node pointers for each argument */ 3 62 3 63 3 64 dcl 1 reference_subscripts aligned based, /* subscript array; based on reference.subscript_ptr */ 3 65 2 number fixed bin, /* number actually present */ 3 66 2 value (2, 16) fixed bin (24); /* values for lower and upper bound for each */ 3 67 3 68 3 69 dcl 1 subscript_reference_ptrs aligned based, /* array of pointers to subscript reference nodes */ 3 70 2 ptr (2, 16) pointer aligned; 3 71 3 72 /* END INCLUDE FILE probe_references.incl.pl1 */ 1983 1984 4 1 /* BEGIN INCLUDE FILE ... probe_source_info.incl.pl1 4 2* 4 3* James R. Davis 2 July 79 */ 4 4 4 5 dcl 1 source_info based aligned, 4 6 2 stmnt_map_entry_index fixed bin, /* index in stmnt map for this stmnt */ 4 7 2 instruction_ptr ptr, /* to last instruction executed */ 4 8 2 block_ptr ptr, /* to runtime_block node */ 4 9 2 stack_ptr ptr, /* to a stack frame */ 4 10 2 entry_ptr ptr, /* to entry seq. for this proc */ 4 11 2 seg_info_ptr ptr; /* to seg_info */ 4 12 4 13 dcl 1 current_source aligned like source_info based (probe_info.ptr_to_current_source); 4 14 dcl 1 initial_source aligned like source_info based (probe_info.ptr_to_initial_source); 4 15 4 16 /* END INCLUDE FILE ... probe_source_info.incl.pl1 */ 1985 1986 5 1 /* BEGIN INCLUDE FILE ... probe_seg_info.incl.pl1 5 2* 5 3* 25 June 79 JRDavis 5 4* 5 5* Modified 7 April 1983, TO - Add fields for character offset/line 5 6* correction per file. 5 7**/ 5 8 5 9 dcl 1 seg_info based aligned, /* place to remember information about object seg */ 5 10 2 language_type fixed bin, /* language of source program */ 5 11 2 bits aligned, 5 12 3 ignore_case bit (1) unal, 5 13 3 bound_segment bit (1) unaligned, 5 14 3 component bit (1) unaligned, 5 15 3 pad bit (33) unal, 5 16 2 names, /* where to find it */ 5 17 3 directory_name character (168) unal, /* what directory */ 5 18 3 entry_name character (32) unal, /* what segment */ 5 19 3 segname character (32) unal, /* procedure segname definition */ 5 20 2 identifier fixed bin (71), /* time of object creation */ 5 21 2 pointers, /* location of various parts of segment */ 5 22 3 symbol_header_ptr ptr unal, /* to symbol section */ 5 23 3 original_source_ptr ptr unal, /* to segment source map */ 5 24 3 statement_map_ptr ptr unal, /* to segment statement map */ 5 25 3 break_info ptr unal, /* for unbound segments, and start of chain for 5 26* bound ones, -> break_map !obsolete, I think! */ 5 27 3 chain ptr unal, /* to entry for next component if bound */ 5 28 3 linkage_ptr ptr unal, /* to linkage section */ 5 29 2 bounds aligned, /* structure of bounds information */ 5 30 3 text_bounds, 5 31 4 start fixed bin (35), 5 32 4 end fixed bin (35), 5 33 3 symbol_bounds, 5 34 4 start fixed bin (35), 5 35 4 end fixed bin (35), 5 36 2 map_size fixed bin, /* size of statement map */ 5 37 2 error_code fixed bin (35), /* errors encoutered while getting info, are recorded here */ 5 38 2 bound_create_time fixed bin (71), /* time seg containing was bound or compiled. */ 5 39 2 bound_sym_header ptr unal, /* to sym. section header for bound seg */ 5 40 2 pad (1) fixed bin (35), 5 41 5 42 2 nfiles fixed bin, 5 43 2 per_file (seg_info_nfiles refer (seg_info.nfiles)), 5 44 3 file_pointers ptr unal, 5 45 3 break_line (0:3) fixed bin (18) unsigned unaligned; 5 46 5 47 dcl seg_info_nfiles fixed bin; /* for allocation purposes */ 5 48 5 49 5 50 /* END INCLUDE FILE ... probe_seg_info.incl.pl1 */ 1987 1988 6 1 /* BEGIN INCLUDE FILE ... runtime_symbol.incl.pl1 ... Modified 07/79 */ 6 2 6 3 dcl 1 runtime_symbol aligned based, 6 4 2 flag unal bit(1), /* always "1"b for Version II */ 6 5 2 use_digit unal bit(1), /* if "1"b and units are half words units are really digits */ 6 6 2 array_units unal bit(2), 6 7 2 units unal bit(2), /* addressing units */ 6 8 2 type unal bit(6), /* data type */ 6 9 2 level unal bit(6), /* structure level */ 6 10 2 ndims unal bit(6), /* number of dimensions */ 6 11 2 bits unal, 6 12 3 aligned bit(1), 6 13 3 packed bit(1), 6 14 3 simple bit(1), 6 15 2 skip unal bit(1), 6 16 2 scale unal bit(8), /* arithmetic scale factor */ 6 17 2 name unal bit(18), /* rel ptr to acc name */ 6 18 2 brother unal bit(18), /* rel ptr to brother entry */ 6 19 2 father unal bit(18), /* rel ptr to father entry */ 6 20 2 son unal bit(18), /* rel ptr to son entry */ 6 21 2 address unal, 6 22 3 location bit(18), /* location in storage class */ 6 23 3 class bit(4), /* storage class */ 6 24 3 next bit(14), /* rel ptr to next of same class */ 6 25 2 size fixed bin(35), /* encoded string|arith size */ 6 26 2 offset fixed bin(35), /* encoded offset from address */ 6 27 2 virtual_org fixed bin(35), 6 28 2 bounds(1), 6 29 3 lower fixed bin(35), /* encoded lower bound */ 6 30 3 upper fixed bin(35), /* encoded upper bound */ 6 31 3 multiplier fixed bin(35); /* encoded multiplier */ 6 32 6 33 dcl 1 runtime_bound based, 6 34 2 lower fixed bin(35), 6 35 2 upper fixed bin(35), 6 36 2 multiplier fixed bin(35); 6 37 6 38 dcl 1 runtime_block aligned based, 6 39 2 flag unal bit(1), /* always "1"b for Version II */ 6 40 2 quick unal bit(1), /* "1"b if quick block */ 6 41 2 fortran unal bit(1), /* "1"b if fortran program */ 6 42 2 standard unal bit(1), /* "1"b if program has std obj segment */ 6 43 2 owner_flag unal bit(1), /* "1"b if block has valid owner field */ 6 44 2 skip unal bit(1), 6 45 2 type unal bit(6), /* = 0 for a block node */ 6 46 2 number unal bit(6), /* begin block number */ 6 47 2 start unal bit(18), /* rel ptr to start of symbols */ 6 48 2 name unal bit(18), /* rel ptr to name of proc */ 6 49 2 brother unal bit(18), /* rel ptr to brother block */ 6 50 2 father unal bit(18), /* rel ptr to father block */ 6 51 2 son unal bit(18), /* rel ptr to son block */ 6 52 2 map unal, 6 53 3 first bit(18), /* rel ptr to first word of map */ 6 54 3 last bit(18), /* rel ptr to last word of map */ 6 55 2 entry_info unal bit(18), /* info about entry of quick block */ 6 56 2 header unal bit(18), /* rel ptr to symbol header */ 6 57 2 chain(4) unal bit(18), /* chain(i) is rel ptr to first symbol 6 58* on start list with length >= 2**i */ 6 59 2 token(0:5) unal bit(18), /* token(i) is rel ptr to first token 6 60* on list with length >= 2 ** i */ 6 61 2 owner unal bit(18); /* rel ptr to owner block */ 6 62 6 63 dcl 1 runtime_token aligned based, 6 64 2 next unal bit(18), /* rel ptr to next token */ 6 65 2 dcl unal bit(18), /* rel ptr to first dcl of this token */ 6 66 2 name, /* ACC */ 6 67 3 size unal unsigned fixed bin (9), /* number of chars in token */ 6 68 3 string unal char(n refer(runtime_token.size)); 6 69 6 70 dcl 1 encoded_value aligned based, 6 71 2 flag bit (2) unal, 6 72 2 code bit (4) unal, 6 73 2 n1 bit (6) unal, 6 74 2 n2 bit (6) unal, 6 75 2 n3 bit (18) unal; 6 76 6 77 /* END INCLUDE FILE ... runtime_symbol.incl.pl1 */ 1989 1990 7 1 /* BEGIN INCLUDE FILE --- acc.incl.pl1 7 2* 7 3*James R. Davis 21 Nov 78 7 4**/ 7 5 7 6 dcl 1 acc based aligned, 7 7 2 num_chars fixed bin (9) unsigned unaligned, 7 8 2 string char (0 refer (acc.num_chars)) unaligned; 7 9 7 10 /* END INCLUDE FILE --- acc.incl.pl1 */ 1991 1992 8 1 /* BEGIN INCLUDE FILE ... probe_operators.incl.pl1 */ 8 2 8 3 8 4 8 5 /****^ HISTORY COMMENTS: 8 6* 1) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 8 7* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 8 8* Added new C operators. 8 9* END HISTORY COMMENTS */ 8 10 8 11 8 12 /* These are the operator.types for each defined operator */ 8 13 /* Modified June 83 JMAthane for PASCAL_ARROW new operator */ 8 14 /* Added PASCAL_RANGE and PASCAL_ASSIGN 07/26/83 S. Herbst */ 8 15 /* Modified April 88 Hinatsu Addition of C types */ 8 16 8 17 dcl (PLUS init ("400001"b3), MINUS init ("400002"b3), 8 18 TIMES init ("400003"b3), SLASH init ("400004"b3), 8 19 OR_BAR init ("400005"b3), NOT_SIGN init ("400006"b3), 8 20 LESS_THAN init ("400007"b3), GREATER_THAN init ("400010"b3), 8 21 EQUALS init ("400011"b3), NOT_EQUALS init ("400012"b3), 8 22 NOT_GREATER_THAN init ("400013"b3), NOT_LESS_THAN init ("400014"b3), 8 23 PERIOD init ("400015"b3), COLON init ("400016"b3), 8 24 AMPERSAND init ("400017"b3), PERCENT init ("400020"b3), 8 25 DOLLAR_SIGN init ("400021"b3), LEFT_BRACKET init ("400022"b3), 8 26 RIGHT_BRACKET init ("400023"b3), ARROW init ("400024"b3), 8 27 COMMA init ("400025"b3), QUESTION_MARK init ("400026"b3), 8 28 PASCAL_ARROW init ("400027"b3), PASCAL_RANGE init ("400030"b3), 8 29 PASCAL_ASSIGN init ("400031"b3), 8 30 8 31 /* Additons to support C types */ 8 32 C_LEFT_SHIFT init ("400032"b3), C_RIGHT_SHIFT init ("400033"b3), 8 33 8 34 /* operator 28 are left for future expansion */ 8 35 8 36 LEFT_PAREN init ("400035"b3), RIGHT_PAREN init ("400036"b3), 8 37 C_EQUAL init ("400037"b3), C_NOT_EQUAL init ("400040"b3), 8 38 SEMI_COLON init ("400041"b3), NEW_LINE init ("400042"b3), 8 39 C_INDIRECTION init ("400034"b3) 8 40 8 41 ) bit (18) aligned internal static options (constant); 8 42 8 43 dcl OPERATOR_VALUES (0:34) char (4) varying internal static options (constant) init 8 44 ("????", "+", "-", "*", "/", "|", "^", "<", 8 45 ">", "=", "^=", "<=", ">=", ".", ":", "&", 8 46 "%", "$", "[", "]", "->", ",", "?", "^", 8 47 "..", ":=", "<<", ">>", "*", "(", ")", 8 48 "==", "!=", ";"," 8 49 "); 8 50 8 51 /* END INCLUDE FILE ... probe_operators.incl.pl1 */ 1993 1994 9 1 /* BEGIN INCLUDE FILE ... probe_lang_types.incl.pl1 9 2* 9 3* JRD 26 June 79 9 4* MBW 31 July 1981 to add algol68 */ 9 5 9 6 9 7 /****^ HISTORY COMMENTS: 9 8* 1) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 9 9* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 9 10* Added C Language type. 9 11* END HISTORY COMMENTS */ 9 12 9 13 9 14 /* Modified June 83 JMAthane to add PASCAL language type */ 9 15 /* Modified April 88 Hinatsu to add C language type */ 9 16 9 17 dcl (UNKNOWN_lang_type init (1), 9 18 OTHER_lang_type init (2), 9 19 PL1_lang_type init (3), 9 20 FORTRAN_lang_type init (4), 9 21 COBOL_lang_type init (5), 9 22 ALM_lang_type init (6), 9 23 ALGOL68_lang_type init (7), 9 24 PASCAL_lang_type init (8), 9 25 C_lang_type init (9)) fixed bin internal static options (constant); 9 26 9 27 dcl official_language_names (9) char (32) internal static options (constant) init 9 28 ("Unknown", "other", "PL/I", "FORTRAN", "COBOL", "ALM", "Algol 68", "Pascal", "C"); 9 29 9 30 dcl palatable_language_names (9) char (32) internal static options (constant) init 9 31 ("Unknown", "Other", "pl1", "fortran", "cobol", "alm", "algol68", "pascal", "c"); 9 32 9 33 /* END INCLUDE FILE ... probe_lang_types.incl.pl1 */ 1995 1996 10 1 /* BEGIN INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 10 2 10 3 10 4 /****^ HISTORY COMMENTS: 10 5* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 10 6* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1208): 10 7* Added pascal_string_type_dtype descriptor type. Its number is 87. 10 8* Objects of this type are PASCAL string types. 10 9* 2) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 10 10* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 10 11* Added the new C types. 10 12* END HISTORY COMMENTS */ 10 13 10 14 /* This include file defines mnemonic names for the Multics 10 15* standard descriptor types, using both pl1 and cobol terminology. 10 16* PG 780613 10 17* JRD 790530 10 18* JRD 791016 10 19* MBW 810731 10 20* TGO 830614 Add hex types. 10 21* Modified June 83 JMAthane to add PASCAL data types 10 22* TGO 840120 Add float dec extended and generic, float binary generic 10 23**/ 10 24 10 25 dcl (real_fix_bin_1_dtype init (1), 10 26 real_fix_bin_2_dtype init (2), 10 27 real_flt_bin_1_dtype init (3), 10 28 real_flt_bin_2_dtype init (4), 10 29 cplx_fix_bin_1_dtype init (5), 10 30 cplx_fix_bin_2_dtype init (6), 10 31 cplx_flt_bin_1_dtype init (7), 10 32 cplx_flt_bin_2_dtype init (8), 10 33 real_fix_dec_9bit_ls_dtype init (9), 10 34 real_flt_dec_9bit_dtype init (10), 10 35 cplx_fix_dec_9bit_ls_dtype init (11), 10 36 cplx_flt_dec_9bit_dtype init (12), 10 37 pointer_dtype init (13), 10 38 offset_dtype init (14), 10 39 label_dtype init (15), 10 40 entry_dtype init (16), 10 41 structure_dtype init (17), 10 42 area_dtype init (18), 10 43 bit_dtype init (19), 10 44 varying_bit_dtype init (20), 10 45 char_dtype init (21), 10 46 varying_char_dtype init (22), 10 47 file_dtype init (23), 10 48 real_fix_dec_9bit_ls_overp_dtype init (29), 10 49 real_fix_dec_9bit_ts_overp_dtype init (30), 10 50 real_fix_bin_1_uns_dtype init (33), 10 51 real_fix_bin_2_uns_dtype init (34), 10 52 real_fix_dec_9bit_uns_dtype init (35), 10 53 real_fix_dec_9bit_ts_dtype init (36), 10 54 real_fix_dec_4bit_uns_dtype init (38), /* digit-aligned */ 10 55 real_fix_dec_4bit_ts_dtype init (39), /* byte-aligned */ 10 56 real_fix_dec_4bit_bytealigned_uns_dtype init (40), /* COBOL */ 10 57 real_fix_dec_4bit_ls_dtype init (41), /* digit-aligned */ 10 58 real_flt_dec_4bit_dtype init (42), /* digit-aligned */ 10 59 real_fix_dec_4bit_bytealigned_ls_dtype init (43), 10 60 real_flt_dec_4bit_bytealigned_dtype init (44), 10 61 cplx_fix_dec_4bit_bytealigned_ls_dtype init (45), 10 62 cplx_flt_dec_4bit_bytealigned_dtype init (46), 10 63 real_flt_hex_1_dtype init (47), 10 64 real_flt_hex_2_dtype init (48), 10 65 cplx_flt_hex_1_dtype init (49), 10 66 cplx_flt_hex_2_dtype init (50), 10 67 c_typeref_dtype init (54), 10 68 c_enum_dtype init (55), 10 69 c_enum_const_dtype init (56), 10 70 c_union_dtype init (57), 10 71 algol68_straight_dtype init (59), 10 72 algol68_format_dtype init (60), 10 73 algol68_array_descriptor_dtype init (61), 10 74 algol68_union_dtype init (62), 10 75 10 76 cobol_comp_6_dtype init (1), 10 77 cobol_comp_7_dtype init (1), 10 78 cobol_display_ls_dtype init (9), 10 79 cobol_structure_dtype init (17), 10 80 cobol_char_string_dtype init (21), 10 81 cobol_display_ls_overp_dtype init (29), 10 82 cobol_display_ts_overp_dtype init (30), 10 83 cobol_display_uns_dtype init (35), 10 84 cobol_display_ts_dtype init (36), 10 85 cobol_comp_8_uns_dtype init (38), /* digit aligned */ 10 86 cobol_comp_5_ts_dtype init (39), /* byte aligned */ 10 87 cobol_comp_5_uns_dtype init (40), 10 88 cobol_comp_8_ls_dtype init (41), /* digit aligned */ 10 89 real_flt_dec_extended_dtype init (81), /* 9-bit exponent */ 10 90 cplx_flt_dec_extended_dtype init (82), /* 9-bit exponent */ 10 91 real_flt_dec_generic_dtype init (83), /* generic float decimal */ 10 92 cplx_flt_dec_generic_dtype init (84), 10 93 real_flt_bin_generic_dtype init (85), /* generic float binary */ 10 94 cplx_flt_bin_generic_dtype init (86)) fixed bin internal static options (constant); 10 95 10 96 dcl (ft_integer_dtype init (1), 10 97 ft_real_dtype init (3), 10 98 ft_double_dtype init (4), 10 99 ft_complex_dtype init (7), 10 100 ft_complex_double_dtype init (8), 10 101 ft_external_dtype init (16), 10 102 ft_logical_dtype init (19), 10 103 ft_char_dtype init (21), 10 104 ft_hex_real_dtype init (47), 10 105 ft_hex_double_dtype init (48), 10 106 ft_hex_complex_dtype init (49), 10 107 ft_hex_complex_double_dtype init (50) 10 108 ) fixed bin internal static options (constant); 10 109 10 110 dcl (algol68_short_int_dtype init (1), 10 111 algol68_int_dtype init (1), 10 112 algol68_long_int_dtype init (2), 10 113 algol68_real_dtype init (3), 10 114 algol68_long_real_dtype init (4), 10 115 algol68_compl_dtype init (7), 10 116 algol68_long_compl_dtype init (8), 10 117 algol68_bits_dtype init (19), 10 118 algol68_bool_dtype init (19), 10 119 algol68_char_dtype init (21), 10 120 algol68_byte_dtype init (21), 10 121 algol68_struct_struct_char_dtype init (22), 10 122 algol68_struct_struct_bool_dtype init (20) 10 123 ) fixed bin internal static options (constant); 10 124 10 125 dcl (label_constant_runtime_dtype init (24), 10 126 int_entry_runtime_dtype init (25), 10 127 ext_entry_runtime_dtype init (26), 10 128 ext_procedure_runtime_dtype init (27), 10 129 picture_runtime_dtype init (63) 10 130 ) fixed bin internal static options (constant); 10 131 10 132 dcl (pascal_integer_dtype init (1), 10 133 pascal_real_dtype init (4), 10 134 pascal_label_dtype init (24), 10 135 pascal_internal_procedure_dtype init (25), 10 136 pascal_exportable_procedure_dtype init (26), 10 137 pascal_imported_procedure_dtype init (27), 10 138 pascal_typed_pointer_type_dtype init (64), 10 139 pascal_char_dtype init (65), 10 140 pascal_boolean_dtype init (66), 10 141 pascal_record_file_type_dtype init (67), 10 142 pascal_record_type_dtype init (68), 10 143 pascal_set_dtype init (69), 10 144 pascal_enumerated_type_dtype init (70), 10 145 pascal_enumerated_type_element_dtype init (71), 10 146 pascal_enumerated_type_instance_dtype init (72), 10 147 pascal_user_defined_type_dtype init (73), 10 148 pascal_user_defined_type_instance_dtype init (74), 10 149 pascal_text_file_dtype init (75), 10 150 pascal_procedure_type_dtype init (76), 10 151 pascal_variable_formal_parameter_dtype init (77), 10 152 pascal_value_formal_parameter_dtype init (78), 10 153 pascal_entry_formal_parameter_dtype init (79), 10 154 pascal_parameter_procedure_dtype init (80), 10 155 pascal_string_type_dtype init (87)) fixed bin int static options (constant); 10 156 10 157 10 158 /* END INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 1997 1998 11 1 /* BEGIN INCLUDE FILE ... pascal_symbol_node.incl.pl1 */ 11 2 11 3 /****^ HISTORY COMMENTS: 11 4* 1) change(86-09-15,JMAthane), approve(86-09-15,MCR7525), 11 5* audit(86-09-15,Martinson), install(86-11-12,MR12.0-1208): 11 6* Added size_is_encoded field in header. 11 7* END HISTORY COMMENTS */ 11 8 11 9 /* Written January 1983 by Melanie Weaver */ 11 10 /* Added size_is_encoded field in header May 85. JMAthane */ 11 11 11 12 dcl 1 pascal_symbol_node_header aligned based, 11 13 2 flags unaligned, /* indicate which pieces the node contains */ 11 14 3 version_flag bit (1) unaligned, /* always "0"b for post-version II PL/I format */ 11 15 3 aligned bit (1) unaligned, 11 16 3 packed bit (1) unaligned, 11 17 3 in_with_block bit (1) unaligned, 11 18 3 name_next bit (1) unaligned, 11 19 3 base_type_info bit (1) unaligned, 11 20 3 address bit (1) unaligned, 11 21 3 father_brother bit (1) unaligned, 11 22 3 son_level bit (1) unaligned, 11 23 3 father_type_successor bit (1) unaligned, 11 24 3 size bit (1) unaligned, 11 25 3 offset bit (1) unaligned, 11 26 3 subrange_limits bit (1) unaligned, 11 27 3 array_info bit (1) unaligned, 11 28 3 variant_info bit (1) unaligned, 11 29 3 size_is_encoded bit (1) unaligned, 11 30 3 pad bit (2) unaligned, 11 31 2 version fixed bin (17) unaligned, /* version of this node format */ 11 32 2 type fixed bin (17) unaligned, /* (extended) data type */ 11 33 2 type_offset fixed bin (18) unsigned unaligned; /* rel ptr to type node */ 11 34 11 35 dcl 1 pascal_name_next aligned based, 11 36 2 name fixed bin (18) unsigned unaligned, /* rel ptr to acc name */ 11 37 2 next_token fixed bin (18) unsigned unaligned; /* rel ptr to next of same class */ 11 38 11 39 dcl 1 pascal_base_type_info aligned based, 11 40 2 base_type fixed bin (17) unaligned, /* type of type */ 11 41 2 base_type_offset fixed bin (18) unsigned unaligned; 11 42 11 43 dcl 1 pascal_address aligned based, 11 44 2 location fixed bin (18) unsigned unaligned, /* location in storage class */ 11 45 2 class fixed bin (6) unsigned unaligned, /* storage class */ 11 46 2 use_digit bit (1) unaligned, 11 47 2 units bit (2) unaligned, /* addressing units */ 11 48 2 offset_is_encoded bit (1) unaligned, /* "1"b if pascal_offset is encoded */ 11 49 2 pad bit (8) unaligned; 11 50 11 51 dcl 1 pascal_father_brother aligned based, 11 52 2 father fixed bin (18) unsigned unaligned, /* rel ptr to father node */ 11 53 2 brother fixed bin (18) unsigned unaligned; /* rel ptr to brother node */ 11 54 11 55 dcl 1 pascal_son_level aligned based, 11 56 2 son fixed bin (18) unsigned unaligned, /* rel ptr to son node */ 11 57 2 level fixed bin (6) unsigned unaligned, /* record level; also enum. type elt. */ 11 58 2 pad bit (12) unaligned; 11 59 11 60 dcl 1 pascal_father_type_successor aligned based, 11 61 2 father_type fixed bin (17) unaligned, 11 62 2 successor fixed bin (18) unsigned unaligned; 11 63 11 64 dcl pascal_size fixed bin (35) based; /* precision, string size, etc. */ 11 65 11 66 dcl pascal_offset fixed bin (35) based; /* offset from address */ 11 67 11 68 dcl 1 pascal_subrange_limits aligned based, 11 69 2 flags aligned, 11 70 3 lower_bound_is_encoded bit (1) unaligned, 11 71 3 upper_bound_is_encoded bit (1) unaligned, 11 72 3 pad bit (34) unaligned, 11 73 2 subrange_lower_bound 11 74 fixed bin (35), 11 75 2 subrange_upper_bound 11 76 fixed bin (35); 11 77 11 78 dcl 1 pascal_array_info aligned based, /* info about array subscripts */ 11 79 2 access_info aligned, 11 80 3 ndims fixed bin (6) unsigned unaligned, /* number of dimensions */ 11 81 3 use_digit fixed bin (1) unsigned unaligned, /* if "1"b and units are half words, 11 82* units are really digits */ 11 83 3 array_units fixed bin (2) unsigned unaligned, 11 84 3 virtual_origin_is_encoded 11 85 bit (1) unaligned, 11 86 3 pad bit (26) unaligned, 11 87 2 virtual_origin fixed bin (35), 11 88 2 bounds (nd refer (pascal_array_info.access_info.ndims)) 11 89 aligned, 11 90 3 lower fixed bin (35), 11 91 3 upper fixed bin (35), 11 92 3 multiplier fixed bin (35), 11 93 3 subscript_type fixed bin (17) unaligned, 11 94 3 subscript_type_offset 11 95 fixed bin (18) unsigned unaligned, 11 96 3 flags aligned, 11 97 4 lower_is_encoded 11 98 bit (1) unaligned, 11 99 4 upper_is_encoded 11 100 bit (1) unaligned, 11 101 4 multiplier_is_encoded 11 102 bit (1) unaligned, 11 103 4 pad bit (33) unaligned; 11 104 11 105 dcl 1 pascal_variant_info aligned based, /* info to locate a record's variants */ 11 106 2 number_of_variants 11 107 fixed bin (17) unaligned, 11 108 2 pad bit (18) unaligned, 11 109 2 first_value_in_set fixed bin (35) unaligned, /* value corresponding to the first bit in set stings */ 11 110 2 case (nvariants refer 11 111 (pascal_variant_info.number_of_variants)), 11 112 3 set_offset fixed bin (18) unsigned unaligned, /* bit string specifies cases; 11 113* set's base type is this node's type */ 11 114 3 brother fixed bin (18) unsigned unaligned; /* rel ptr to brother for this variant */ 11 115 11 116 dcl 1 pascal_encoded_value aligned based, /* extended encoded value format */ 11 117 2 code bit (6) unaligned, /* tells how to interpret the other fields */ 11 118 2 (n1, n2) bit (6) unaligned, 11 119 2 n3 fixed bin (18) unsigned unaligned; 11 120 11 121 dcl nvariants fixed bin (17); 11 122 dcl nd fixed bin (6) unsigned; 11 123 11 124 11 125 11 126 /* END INCLUDE FILE ... pascal_symbol_node.incl.pl1 */ 1999 2000 12 1 /* BEGIN INCLUDE FILE ... encoded_precision.incl.pl1 12 2* 12 3* This is the format used by assign_ to encode the precision and scale of 12 4* arithmetic data into one word. This structure should be assigned (use unspec) 12 5* to a fixed bin (35). 12 6**/ 12 7 12 8 dcl 1 encoded_precision based aligned, 12 9 2 scale fixed bin (17) unal, 12 10 2 prec fixed bin (18) unsigned unal; 12 11 12 12 /* END INCLUDE FILE ... encoded_precision.incl.pl1 */ 2001 2002 13 1 /* BEGIN INCLUDE FILE pascal_gen_constants.incl.pl1 */ 13 2 13 3 dcl pascal_set bit (8 * 36) based unaligned; 13 4 13 5 dcl pascal_max_set_size int static options (constant) init (8 * 36); 13 6 13 7 dcl pascal_parameter_proc_size int static options (constant) init (72 * 3); 13 8 13 9 dcl (eoln_place_in_pascal_fsb init (27), 13 10 window_place_in_pascal_fsb init (38), 13 11 eof_place_in_pascal_fsb init (4)) fixed bin (35) int static options (constant); 13 12 13 13 /* END INCLUDE FILE pascal_gen_constants.incl.pl1 */ 2003 2004 14 1 /* BEGIN INCLUDE FILE ... computational_data.incl.pl1 14 2* 14 3* 12 July 79 JRDavis */ 14 4 14 5 /* this is the format of the structure given to assign_$computational_ 14 6* that describes the data to be assigned */ 14 7 14 8 dcl 1 computational_data aligned based, 14 9 2 address ptr aligned, /* to data */ 14 10 2 data_type fixed bin (17), /* standard descriptor type */ 14 11 2 flags aligned, 14 12 3 packed bit (1) unal, 14 13 3 pad bit (35) unal, 14 14 2 prec_or_length fixed bin (24), /* string length or arith prec */ 14 15 2 scale fixed bin (35), /* must be zero even if has no scale */ 14 16 2 picture_image_ptr ptr aligned; /* to picture image block */ 14 17 14 18 /* END INCLUDE FILE ... computational_data.incl.pl1 */ 2005 2006 15 1 /* BEGIN INCLUDE FILE runtime_symbol_info_.incl.pl1 */ 15 2 15 3 15 4 /****^ HISTORY COMMENTS: 15 5* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 15 6* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1208): 15 7* Added runtime_symbol_info_$subrange entry which was missing. Added 15 8* has_dimensions and has subrange_limits fields in type_info record. 15 9* Structure version numbers have not been changed since this change does not 15 10* affect existing programs. 15 11* END HISTORY COMMENTS */ 15 12 15 13 /* Declarations for using the various entry points in runtime_symbol_info_ */ 15 14 /* NOTE: These entries do not support PL/1 version 1. */ 15 15 15 16 /* Made structures aligned, removed variable extent from runtime_array_info.bounds 08/25/83 S. Herbst */ 15 17 /* Added version strings to structures 10/05/83 S. Herbst */ 15 18 /* Added has_dimensions and has_subrange_limits bits in type_info 15 19*Added subrange entry. JMAthane 08/31/84 */ 15 20 15 21 15 22 dcl runtime_symbol_info_$type entry (ptr, ptr, fixed bin (35)); 15 23 15 24 dcl 1 runtime_type_info aligned based, 15 25 2 version char (8), /* = "RUNTYP_1" */ 15 26 2 flags, 15 27 3 aligned bit (1) unal, 15 28 3 packed bit (1) unal, 15 29 3 size_is_encoded bit (1) unal, 15 30 3 has_dimensions bit (1) unal, 15 31 3 has_subrange_limits bit (1) unal, 15 32 3 pad bit (23) unal, 15 33 2 scale fixed bin (7) unal, 15 34 2 (type, base_type) fixed bin (18) unsigned unal, 15 35 2 (type_addr, base_type_addr) ptr, 15 36 2 size fixed bin (35); 15 37 15 38 dcl runtime_symbol_info_$father entry (ptr) returns (ptr); 15 39 15 40 dcl runtime_symbol_info_$brother entry (ptr) returns (ptr); 15 41 15 42 dcl runtime_symbol_info_$father_type entry (ptr) returns (ptr); 15 43 15 44 dcl runtime_symbol_info_$son entry (ptr) returns (ptr); 15 45 15 46 dcl runtime_symbol_info_$successor entry (ptr) returns (ptr); 15 47 15 48 dcl runtime_symbol_info_$name entry (ptr) returns (ptr); 15 49 15 50 dcl runtime_symbol_info_$level entry (ptr) returns (fixed bin); 15 51 15 52 dcl runtime_symbol_info_$next entry (ptr) returns (ptr); 15 53 15 54 dcl runtime_symbol_info_$address entry (ptr, ptr, fixed bin (35)); 15 55 15 56 dcl 1 runtime_address_info aligned based, 15 57 2 version char (8), /* = "RUNADR_1" */ 15 58 2 location fixed bin (18) unsigned unal, 15 59 2 class fixed bin (6) unsigned unal, 15 60 2 use_digit fixed bin (1) unsigned unal, 15 61 2 units fixed bin (2) unsigned unal, 15 62 2 offset_is_encoded bit (1) unal, 15 63 2 pad bit (8) unal, 15 64 2 offset fixed bin (35); 15 65 15 66 dcl runtime_symbol_info_$array_dims entry (ptr) returns (fixed bin); 15 67 15 68 dcl runtime_symbol_info_$array entry (ptr, ptr, fixed bin (35)); 15 69 15 70 dcl 1 runtime_array_info aligned based, 15 71 2 version char (8), /* = "RUNARY_1" */ 15 72 2 access_info aligned, 15 73 3 ndims fixed bin (6) unsigned unaligned, /* number of dimensions */ 15 74 3 use_digit fixed bin (1) unsigned unaligned, /* if "1"b and units are half words, 15 75* units are really digits */ 15 76 3 array_units fixed bin (2) unsigned unaligned, 15 77 3 virtual_origin_is_encoded 15 78 bit (1) unaligned, 15 79 3 pad bit (26) unaligned, 15 80 2 virtual_origin fixed bin (35), 15 81 2 bounds (16) 15 82 aligned, 15 83 3 flags aligned, 15 84 4 lower_is_encoded 15 85 bit (1) unaligned, 15 86 4 upper_is_encoded 15 87 bit (1) unaligned, 15 88 4 multiplier_is_encoded 15 89 bit (1) unaligned, 15 90 4 pad bit (33) unaligned, 15 91 3 lower fixed bin (35), 15 92 3 upper fixed bin (35), 15 93 3 multiplier fixed bin (35), 15 94 3 subscript_type fixed bin (35), 15 95 3 subscript_type_addr ptr; 15 96 15 97 dcl n_dims fixed bin; 15 98 15 99 dcl runtime_symbol_info_$n_variants entry (ptr) returns (fixed bin (35)); 15 100 15 101 dcl runtime_symbol_info_$variant entry (ptr, ptr, fixed bin (35)); 15 102 15 103 dcl 1 runtime_variant_info aligned based, 15 104 2 version char (8), /* = "RUNVAR_1" */ 15 105 2 number_of_variants fixed bin, 15 106 2 first_value_in_set fixed bin (35), /* value corresponding to the first bit in set stings */ 15 107 2 case (n_variants), 15 108 3 set_addr ptr, /* bit string specifies cases; 15 109* set's base type is this node's type */ 15 110 3 brother_addr ptr; /* ptr to brother for this variant */ 15 111 15 112 dcl n_variants fixed bin (35); 15 113 15 114 dcl runtime_symbol_info_$subrange entry (ptr, ptr, fixed bin (35)); 15 115 15 116 dcl 1 runtime_subrange_info based, 15 117 2 version char (8), /* = "RUNSUB_1" */ 15 118 2 flags aligned, 15 119 3 has_subrange_limits bit (1) unal, 15 120 3 lower_bound_is_encoded bit (1) unal, 15 121 3 upper_bound_is_encoded bit (1) unal, 15 122 3 pad bit (33) unal, 15 123 2 subrange_lower_bound fixed bin (35), 15 124 2 subrange_upper_bound fixed bin (35); 15 125 15 126 15 127 dcl RUNTIME_TYPE_INFO_VERSION_1 char (8) int static options (constant) init ("RUNTYP_1"); 15 128 dcl RUNTIME_ADDRESS_INFO_VERSION_1 char (8) int static options (constant) init ("RUNADR_1"); 15 129 dcl RUNTIME_ARRAY_INFO_VERSION_1 char (8) int static options (constant) init ("RUNARY_1"); 15 130 dcl RUNTIME_VARIANT_INFO_VERSION_1 char (8) int static options (constant) init ("RUNVAR_1"); 15 131 dcl RUNTIME_SUBRANGE_INFO_VERSION_1 char (8) int static options (constant) init ("RUNSUB_1"); 15 132 15 133 15 134 /* END INCLUDE FILE runtime_symbol_info_.incl.pl1 */ 2007 2008 16 1 /* BEGIN INCLUDE FILE ... system.incl.pl1 */ 16 2 16 3 /* Modified: 25 Apr 1979 by PCK to implemnt 4-bit decimal */ 16 4 16 5 dcl ( max_p_flt_bin_1 initial(27), 16 6 max_p_flt_bin_2 initial(63), 16 7 max_p_fix_bin_1 initial(35), 16 8 max_p_fix_bin_2 initial(71), 16 9 16 10 max_p_dec initial(59), 16 11 max_p_bin_or_dec initial (71), /* max (max_p_fix_bin_2, max_p_dec) */ 16 12 16 13 min_scale initial(-128), 16 14 max_scale initial(+127), 16 15 max_bit_string initial(9437184), 16 16 max_char_string initial(1048576), 16 17 max_area_size initial(262144), 16 18 min_area_size initial(28), 16 19 16 20 max_bit_string_constant initial (253), /* max length of bit literals */ 16 21 max_char_string_constant initial (254), /* max length of character literals */ 16 22 max_identifier_length initial (256), 16 23 max_number_of_dimensions initial (127), 16 24 16 25 max_length_precision initial(24), 16 26 max_offset_precision initial(24), /* 18 bits for word offset + 6 bits for bit offset */ 16 27 16 28 max_words_per_variable initial (262144), 16 29 16 30 bits_per_word initial(36), 16 31 bits_per_double initial(72), 16 32 packed_digits_per_character initial(2), 16 33 characters_per_half initial(2), 16 34 characters_per_word initial(4), 16 35 characters_per_double initial(8), 16 36 16 37 bits_per_character initial(9), 16 38 bits_per_half initial(18), 16 39 bits_per_decimal_digit initial(9), 16 40 bits_per_binary_exponent initial(8), 16 41 bits_per_packed_ptr initial(36), 16 42 words_per_packed_pointer initial(1), 16 43 16 44 words_per_fix_bin_1 initial(1), 16 45 words_per_fix_bin_2 initial(2), 16 46 words_per_flt_bin_1 initial(1), 16 47 words_per_flt_bin_2 initial(2), 16 48 words_per_varying_string_header initial(1), 16 49 words_per_offset initial(1), 16 50 words_per_pointer initial(2), 16 51 words_per_label_var initial(4), 16 52 words_per_entry_var initial(4), 16 53 words_per_file_var initial(4), 16 54 words_per_format initial(4), 16 55 words_per_condition_var initial(6), 16 56 16 57 max_index_register_value initial(262143), 16 58 max_signed_index_register_value initial(131071), 16 59 16 60 max_signed_xreg_precision initial(17), 16 61 max_uns_xreg_precision initial(18), 16 62 16 63 default_area_size initial(1024), 16 64 default_flt_bin_p initial(27), 16 65 default_fix_bin_p initial(17), 16 66 default_flt_dec_p initial(10), 16 67 default_fix_dec_p initial(7)) fixed bin(31) internal static options(constant); 16 68 16 69 dcl bits_per_digit initial(4.5) fixed bin(31,1) internal static options(constant); 16 70 16 71 dcl ( integer_type initial("010000000000000000000100000001100000"b), 16 72 dec_integer_type initial("010000000000000000000100000010100000"b), 16 73 pointer_type initial("000001000000000000000100000000000000"b), 16 74 real_type initial("001000000000000000000100000001100000"b), 16 75 complex_type initial("001000000000000000000100000001010000"b), 16 76 builtin_type initial("000000000000000010000000000000000000"b), 16 77 storage_block_type initial("000000000000100000000000000000000000"b), 16 78 arg_desc_type initial("000000000001000000000000000000000000"b), 16 79 local_label_var_type initial("000000001000000000000100000100001000"b), 16 80 entry_var_type initial("000000000100000000000000000000001000"b), 16 81 bit_type initial("000100000000000000000000000000000000"b), 16 82 char_type initial("000010000000000000000000000000000000"b)) bit(36) aligned int static 16 83 options(constant); 16 84 16 85 /* END INCLUDE FILE ... system.incl.pl1 */ 2009 17 1 /* BEGIN INCLUDE FILE its.incl.pl1 17 2* modified 27 July 79 by JRDavis to add its_unsigned 17 3* Internal format of ITS pointer, including ring-number field for follow-on processor */ 17 4 17 5 dcl 1 its based aligned, /* declaration for ITS type pointer */ 17 6 2 pad1 bit (3) unaligned, 17 7 2 segno bit (15) unaligned, /* segment number within the pointer */ 17 8 2 ringno bit (3) unaligned, /* ring number within the pointer */ 17 9 2 pad2 bit (9) unaligned, 17 10 2 its_mod bit (6) unaligned, /* should be 43(8) */ 17 11 17 12 2 offset bit (18) unaligned, /* word offset within the addressed segment */ 17 13 2 pad3 bit (3) unaligned, 17 14 2 bit_offset bit (6) unaligned, /* bit offset within the word */ 17 15 2 pad4 bit (3) unaligned, 17 16 2 mod bit (6) unaligned; /* further modification */ 17 17 17 18 dcl 1 itp based aligned, /* declaration for ITP type pointer */ 17 19 2 pr_no bit (3) unaligned, /* number of pointer register to use */ 17 20 2 pad1 bit (27) unaligned, 17 21 2 itp_mod bit (6) unaligned, /* should be 41(8) */ 17 22 17 23 2 offset bit (18) unaligned, /* word offset from pointer register word offset */ 17 24 2 pad2 bit (3) unaligned, 17 25 2 bit_offset bit (6) unaligned, /* bit offset relative to new word offset */ 17 26 2 pad3 bit (3) unaligned, 17 27 2 mod bit (6) unaligned; /* further modification */ 17 28 17 29 17 30 dcl 1 its_unsigned based aligned, /* just like its, but with unsigned binary */ 17 31 2 pad1 bit (3) unaligned, 17 32 2 segno fixed bin (15) unsigned unaligned, 17 33 2 ringno fixed bin (3) unsigned unaligned, 17 34 2 pad2 bit (9) unaligned, 17 35 2 its_mod bit (6) unaligned, 17 36 17 37 2 offset fixed bin (18) unsigned unaligned, 17 38 2 pad3 bit (3) unaligned, 17 39 2 bit_offset fixed bin (6) unsigned unaligned, 17 40 2 pad4 bit (3) unaligned, 17 41 2 mod bit (6) unaligned; 17 42 17 43 dcl 1 itp_unsigned based aligned, /* just like itp, but with unsigned binary where appropriate */ 17 44 2 pr_no fixed bin (3) unsigned unaligned, 17 45 2 pad1 bit (27) unaligned, 17 46 2 itp_mod bit (6) unaligned, 17 47 17 48 2 offset fixed bin (18) unsigned unaligned, 17 49 2 pad2 bit (3) unaligned, 17 50 2 bit_offset fixed bin (6) unsigned unaligned, 17 51 2 pad3 bit (3) unaligned, 17 52 2 mod bit (6) unaligned; 17 53 17 54 17 55 dcl ITS_MODIFIER bit (6) unaligned internal static options (constant) init ("43"b3); 17 56 dcl ITP_MODIFIER bit (6) unaligned internal static options (constant) init ("41"b3); 17 57 17 58 /* END INCLUDE FILE its.incl.pl1 */ 2010 2011 2012 end probe_get_value_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/17/90 0816.3 probe_get_value_.pl1 >spec>install>1044>probe_get_value_.pl1 1979 1 10/27/88 1439.2 probe_info.incl.pl1 >ldd>include>probe_info.incl.pl1 1981 2 11/26/79 1420.6 probe_tokens.incl.pl1 >ldd>include>probe_tokens.incl.pl1 1983 3 11/11/88 1701.5 probe_references.incl.pl1 >ldd>include>probe_references.incl.pl1 1985 4 11/26/79 1420.6 probe_source_info.incl.pl1 >ldd>include>probe_source_info.incl.pl1 1987 5 11/02/83 1945.0 probe_seg_info.incl.pl1 >ldd>include>probe_seg_info.incl.pl1 1989 6 11/26/79 1420.6 runtime_symbol.incl.pl1 >ldd>include>runtime_symbol.incl.pl1 1991 7 01/15/79 2302.9 acc.incl.pl1 >ldd>include>acc.incl.pl1 1993 8 10/26/88 1355.5 probe_operators.incl.pl1 >ldd>include>probe_operators.incl.pl1 1995 9 10/26/88 1355.5 probe_lang_types.incl.pl1 >ldd>include>probe_lang_types.incl.pl1 1997 10 10/26/88 1355.5 std_descriptor_types.incl.pl1 >ldd>include>std_descriptor_types.incl.pl1 1999 11 11/12/86 1848.0 pascal_symbol_node.incl.pl1 >ldd>include>pascal_symbol_node.incl.pl1 2001 12 07/11/79 1811.3 encoded_precision.incl.pl1 >ldd>include>encoded_precision.incl.pl1 2003 13 04/19/84 0941.6 pascal_gen_constants.incl.pl1 >ldd>include>pascal_gen_constants.incl.pl1 2005 14 11/01/79 1712.9 computational_data.incl.pl1 >ldd>include>computational_data.incl.pl1 2007 15 11/12/86 1848.0 runtime_symbol_info_.incl.pl1 >ldd>include>runtime_symbol_info_.incl.pl1 2009 16 12/07/83 1801.7 system.incl.pl1 >ldd>include>system.incl.pl1 2010 17 11/26/79 1420.6 its.incl.pl1 >ldd>include>its.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. ARROW constant bit(18) initial dcl 8-17 ref 327 407 901 954 1290 Base_addr 000352 automatic pointer dcl 859 set ref 1016* 1624* Block_ptr 000350 automatic pointer dcl 859 set ref 1011* 1333* 1624* 1624 1624 COBOL_lang_type constant fixed bin(17,0) initial dcl 9-17 ref 248 1970 COLON constant bit(18) initial dcl 8-17 ref 1123 1661 1818 COMMA constant bit(18) initial dcl 8-17 ref 818 941 979 1190 1539 1845 CONSTANT_TYPE constant bit(18) initial packed unaligned dcl 2-37 ref 307 480 894 C_INDIRECTION constant bit(18) initial dcl 8-17 ref 1661 1799 C_lang_type constant fixed bin(17,0) initial dcl 9-17 ref 313 327 407 498 760 DOLLAR_SIGN constant bit(18) initial dcl 8-17 ref 1904 1916 EXECUTE parameter bit(1) packed unaligned dcl 1674 set ref 1670 1696* 1727 FIELD_P parameter pointer dcl 1705 set ref 1702 1711 1712* 1723* 1731* 1736* 1736* 1736* 1736* 1746 1751 1752* 1752* FIELD_PTR parameter pointer dcl 1673 set ref 1670 1680* FORTRAN_lang_type constant fixed bin(17,0) initial dcl 9-17 ref 251 493 GREATER_THAN constant bit(18) initial dcl 8-17 ref 256 1904 1910 LEFT_BRACKET constant bit(18) initial dcl 8-17 ref 677 719 760 934 945 971 983 1058 1260 1509 1878 LEFT_PAREN constant bit(18) initial dcl 8-17 ref 758 815 916 926 997 1020 1251 LESS_THAN constant bit(18) initial dcl 8-17 ref 256 1904 1912 LOWER 000122 constant char(27) initial dcl 146 ref 741 813 Linkage_ptr 000354 automatic pointer dcl 859 set ref 1013* 1624* NAME_TYPE constant bit(18) initial packed unaligned dcl 2-37 ref 313 317 364 478 631 709 795 912 962 993 1328 1478 1924 1959 1970 OPERATOR_VALUES 000014 constant varying char(4) initial array dcl 8-43 set ref 321* 486* OR_BAR constant bit(18) initial dcl 8-17 ref 1904 PASCAL_ARROW constant bit(18) initial dcl 8-17 ref 954 1251 1391 PASCAL_lang_type constant fixed bin(17,0) initial dcl 9-17 ref 248 262 PERIOD constant bit(18) initial dcl 8-17 ref 574 706 960 1251 1475 1904 1914 P_bit_offset parameter fixed bin(35,0) dcl 1573 ref 1570 1579 1581 P_code parameter fixed bin(35,0) dcl 124 set ref 207 217 267* P_ct parameter pointer dcl 1656 ref 1653 1658 P_probe_info_ptr parameter pointer dcl 124 ref 207 217 224 P_ptr parameter pointer dcl 772 in procedure "qualifier_name" ref 769 776 P_ptr parameter pointer dcl 1572 in procedure "bitrel" ref 1570 1581 P_reference parameter structure level 1 dcl 124 set ref 207 217 330* 367* 394* 410* 498* 642* 669* 830* 899* 920* 1002* 1042* 1042* P_str parameter char packed unaligned dcl 1765 ref 1762 1767 1771 P_switches parameter bit(36) dcl 124 ref 207 211 RIGHT_BRACKET constant bit(18) initial dcl 8-17 ref 685 727 1173 1527 1555 1659 1870 1876 1880 RIGHT_PAREN constant bit(18) initial dcl 8-17 ref 823 1838 1851 RUNTIME_ADDRESS_INFO_VERSION_1 000010 constant char(8) initial packed unaligned dcl 15-128 ref 1729 RUNTIME_ARRAY_INFO_VERSION_1 000006 constant char(8) initial packed unaligned dcl 15-129 ref 1079 RUNTIME_TYPE_INFO_VERSION_1 000012 constant char(8) initial packed unaligned dcl 15-127 ref 893 1029 1239 1301 1433 1721 RUNTIME_VARIANT_INFO_VERSION_1 000004 constant char(8) initial packed unaligned dcl 15-130 ref 1688 Stack_ptr 000356 automatic pointer dcl 859 set ref 1012* 1624* TIMES constant bit(18) initial dcl 8-17 ref 1096 1661 1799 UPPER 000131 constant char(27) initial dcl 146 ref 741 813 acc based structure level 1 dcl 7-6 acc_str based structure level 1 packed packed unaligned dcl 294 access_info 2 000522 automatic structure level 2 dcl 1078 addr builtin function dcl 201 ref 382 382 384 384 661 661 663 663 1031 1031 1088 1088 1241 1241 1262 1262 1302 1302 1360 1360 1416 1416 1435 1435 1581 1690 1690 1723 1723 1731 1731 addrel builtin function dcl 201 ref 348 356 519 617 622 777 780 781 1459 address 3 based structure level 2 packed packed unaligned dcl 6-3 address_info 000125 automatic structure level 1 unaligned dcl 1709 set ref 1731 1731 address_ptr 4 based pointer level 2 in structure "reference_node" dcl 3-16 in procedure "probe_get_value_" set ref 607 address_ptr 4 parameter pointer level 2 in structure "P_reference" dcl 124 in procedure "probe_get_value_" set ref 233* 330 352 353* 392* 417 421 425 427* 471* 498 526* 526 608* 667* 1236* 1236* 1309 1312* 1312 1318* 1318 1321 1397 1400* 1400 1405* 1405 1408 1454 1455 1455 1455* 1459* 1459 1517* 1523 1648 1736* 1736* argument_list 117 parameter pointer level 3 in structure "P_reference" packed packed unaligned dcl 124 in procedure "probe_get_value_" set ref 242 580 argument_list 117 based pointer level 3 in structure "reference_node" packed packed unaligned dcl 3-16 in procedure "probe_get_value_" set ref 580* array_info 0(13) based bit(1) level 3 in structure "pascal_symbol_node_header" packed packed unaligned dcl 11-12 in procedure "probe_get_value_" set ref 1062 array_info 000522 automatic structure level 1 unaligned dcl 1078 in procedure "parse_ala_pascal" set ref 1088 1088 array_type_ptr 000520 automatic pointer dcl 886 set ref 1080* 1088* 1262* 1266* 1268 1268* array_units 2(07) 000522 automatic fixed bin(2,0) level 3 packed packed unsigned unaligned dcl 1078 set ref 1156 base_addr 6 parameter pointer level 2 dcl 124 set ref 235* 355* 417* 421* 425* 427* 439* 444* 448* 450* 458 458 458 458 1016 base_type 3(18) 000360 automatic fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 863 set ref 1038 1046 1246 1422 1440 base_type_addr 6 000360 automatic pointer level 2 dcl 863 set ref 1047 1247 1266 1423 1441 based_packed_ptr based pointer packed unaligned dcl 848 in procedure "parse_ala_pascal" ref 1312 1400 based_packed_ptr based pointer packed unaligned dcl 289 in procedure "parse_normal" ref 421 based_ptr based pointer dcl 288 in procedure "parse_normal" ref 371 417 425 526 based_ptr based pointer dcl 847 in procedure "parse_ala_pascal" ref 1318 1405 1455 1459 based_two based char(2) packed unaligned dcl 1957 ref 1961 bin builtin function dcl 201 ref 1736 1736 1736 1736 binary builtin function dcl 201 ref 321 486 bit_offset 1(21) based fixed bin(6,0) level 2 in structure "its_unsigned" packed packed unsigned unaligned dcl 17-30 in procedure "probe_get_value_" set ref 384* 384 663* 663 bit_offset 000516 automatic fixed bin(35,0) dcl 884 in procedure "parse_ala_pascal" set ref 1069* 1158* 1158 1236* bits 0(24) based structure level 2 in structure "runtime_symbol" packed packed unaligned dcl 6-3 in procedure "probe_get_value_" bits 1 based structure level 2 in structure "seg_info" dcl 5-9 in procedure "probe_get_value_" bits_per_character constant fixed bin(31,0) initial dcl 16-5 ref 1600 bits_per_half constant fixed bin(31,0) initial dcl 16-5 ref 1602 bits_per_word constant fixed bin(31,0) initial dcl 16-5 ref 1596 block_ptr 4 based pointer level 2 in structure "source_info" dcl 4-5 in procedure "probe_get_value_" ref 1011 block_ptr 4 based pointer level 2 in structure "ref_source_info" dcl 140 in procedure "probe_get_value_" set ref 244* 427* bounds 4 000522 automatic structure array level 2 dcl 1078 brother_addr 6 000100 automatic pointer array level 3 dcl 1686 set ref 1696* builtin 116(10) parameter bit(1) level 3 packed packed unaligned dcl 124 set ref 1006 c2 001026 automatic char(2) dcl 1958 set ref 1961* 1962 1962 1962 1962 c_ptr_to_char 116(11) parameter bit(1) level 3 packed packed unaligned dcl 124 set ref 531* c_typeref_dtype constant fixed bin(17,0) initial dcl 10-25 ref 344 515 614 616 case 4 000100 automatic structure array level 2 unaligned dcl 1686 char_dtype constant fixed bin(17,0) initial dcl 10-25 ref 523 527 540 class 3(18) based bit(4) level 3 packed packed unaligned dcl 6-3 ref 596 code 000103 automatic fixed bin(35,0) dcl 155 set ref 227* 267 272* 281* 330* 367* 394* 403* 410* 444* 445 448* 449 450* 454 458* 498* 593* 603* 642* 645* 669* 680* 682 722* 724 830* 899* 920* 922 935* 939 973* 977 1002* 1004 1031* 1033 1088* 1090 1207* 1210 1241* 1243 1262* 1264 1302* 1304 1360* 1362 1416* 1418 1435* 1437 1533* 1535 1541* 1544 1624* 1628 1690* 1692 1723* 1724 1731* 1733 1813* 1815 1822* 1824 1933* 1935 1936* constant based structure level 1 dcl 2-27 in procedure "probe_get_value_" constant 116(01) parameter bit(1) level 3 in structure "P_reference" packed packed unaligned dcl 124 in procedure "probe_get_value_" set ref 308* 414 450 530* 546* 895* constant_token_ptr 123 parameter pointer level 2 packed packed unaligned dcl 124 set ref 309* 896* convert builtin function dcl 201 ref 376 379 381 596 656 658 660 cross_section 116(02) parameter bit(1) level 3 packed packed unaligned dcl 124 set ref 1071* 1073 1082 1093 1120 1179 1235 1809* 1826* ct 000752 automatic pointer dcl 1656 in procedure "is_cross_section" set ref 1658* 1658* 1659 1661 1661 1661* 1664 ct 13 based pointer level 3 in structure "probe_info" packed packed unaligned dcl 1-18 in procedure "probe_get_value_" set ref 256 256 307 309 313 317 321 327 364 407 478 480 486 574 631 677 685 706 709 719 727 749 751 751 755 755 758 760 791 791 793 795 801 801 807 807 815 818 823 894 896 901 912 914 914 916 926 934 941 945 954 954 960 962 971 979 983 993 994 994 997 1020 1058 1071 1096 1123 1173 1190 1251 1251 1251 1260 1290 1328 1333 1333 1337 1337 1341 1341 1345 1345 1349 1349 1354 1354 1354 1381 1381 1381 1386 1386 1391 1475 1478 1502 1502 1502 1509 1527 1539 1555 1714 1714 1718 1718 1799 1799 1818 1838 1845 1851 1870 1876 1878 1880 1904 1904 1904 1904 1904 1910 1912 1914 1916 1922 1924 1929 1929 1929 1950* 1950 1970 1970 current_identifier_name based char packed unaligned dcl 2-42 set ref 1333 1337 1341 1345 1349 1354* 1381* 1386 current_indice 000517 automatic fixed bin(17,0) dcl 885 set ref 1081* 1095 1103 1107 1111 1128 1148 1150 1152 1267* 1267 current_source based structure level 1 dcl 4-13 current_token based structure level 1 dcl 2-45 cv_entry_ 000010 constant entry external dcl 169 ref 1933 descriptor 114 parameter fixed bin(35,0) level 2 dcl 124 set ref 1521* divide builtin function dcl 201 ref 379 658 dummy_entry 000106 automatic entry variable dcl 158 set ref 1933* ecode parameter fixed bin(35,0) dcl 279 ref 277 281 element_name 000414 automatic varying char(256) dcl 882 set ref 1070* 1165 1165 1168* 1168 1170* 1170 1175 1175 1179 1183* 1194* encoded parameter bit(1) packed unaligned dcl 1612 ref 1608 1621 end_token 14 based bit(18) level 3 dcl 1-18 ref 1922 entry_ptr 10 based pointer level 2 dcl 140 set ref 244* error_table_$badpath 000050 external static fixed bin(35,0) dcl 199 set ref 1925* execute 64 based bit(1) level 3 packed packed unaligned dcl 1-18 ref 420 443 901 911 expression_area based area(1024) dcl 1-95 ref 1512 1517 expression_area_ptr 63 based pointer level 3 packed packed unaligned dcl 1-18 ref 1512 1517 father 2 based bit(18) level 2 packed packed unaligned dcl 6-3 ref 780 field_ptr 000344 automatic pointer dcl 857 set ref 1487* 1488* 1493* 1494* final_ptr 000136 automatic pointer dcl 298 set ref 371* 382 382 384 384 392 first_ref 000330 automatic pointer dcl 851 set ref 1533* 1537* first_type 000340 automatic fixed bin(35,0) dcl 854 set ref 1533* 1546 first_type_ptr 000334 automatic pointer dcl 851 set ref 1533* 1546 first_value 000342 automatic fixed bin(35,0) dcl 854 set ref 1533* 1537* fixed builtin function dcl 201 ref 344 344 348 356 515 515 519 523 540 614 616 617 622 778 flags 2 000114 automatic structure level 2 in structure "type_info" packed packed unaligned dcl 1708 in procedure "scan_fields" flags 116 parameter structure level 2 in structure "P_reference" dcl 124 in procedure "probe_get_value_" set ref 230* 469* flags 116 based structure level 2 in structure "subscript" dcl 160 in procedure "probe_get_value_" flags 64 based structure level 2 in structure "probe_info" dcl 1-18 in procedure "probe_get_value_" flags based structure level 2 in structure "pascal_symbol_node_header" packed packed unaligned dcl 11-12 in procedure "probe_get_value_" flags 4 000522 automatic structure array level 3 in structure "array_info" dcl 1078 in procedure "parse_ala_pascal" found_ptr 000400 automatic pointer dcl 879 set ref 1333* ftag 0(30) based bit(6) level 2 packed packed unaligned dcl 887 ref 1455 function 116(03) parameter bit(1) level 3 packed packed unaligned dcl 124 set ref 1006 1841* got_args 000346 automatic bit(1) initial packed unaligned dcl 858 set ref 858* 918* 924 928* 931 999* 1007* 1018 1022* 1025 1050* have_generation 116(06) parameter bit(1) level 3 packed packed unaligned dcl 124 set ref 236* 692* 734* hbound builtin function dcl 201 ref 1790 header based structure level 2 in structure "operator" dcl 2-24 in procedure "probe_get_value_" header based structure level 2 in structure "current_token" dcl 2-45 in procedure "probe_get_value_" header based structure level 2 in structure "token" dcl 2-16 in procedure "probe_get_value_" i 000102 automatic fixed bin(17,0) dcl 1677 in procedure "scan_record" set ref 1695* 1696* i 000515 automatic fixed bin(17,0) dcl 883 in procedure "parse_ala_pascal" set ref 1092* 1095 1103 1107 1107 1107 1111 1111 1111 1128 1133 1133 1133 1133 1148 1150 1152 1160 1160 1168 1171* 1212 1212 1212 1212 1216 1216 1222 1222 1224 1224 1226 1226 id_ptr 000112 automatic pointer dcl 205 set ref 591 591 619 619 749* id_token based char packed unaligned dcl 166 ref 591 619 identifier based structure level 1 dcl 2-19 identifier_tokens_name based char packed unaligned dcl 163 set ref 751 755 791 801 807 914 994 1502* 1714 1718 1929* ignore_case 1 based bit(1) level 3 packed packed unaligned dcl 5-9 ref 251 index builtin function dcl 201 ref 493 invocation_level 125 parameter fixed bin(17,0) level 2 dcl 124 set ref 237* 680* 722* its_unsigned based structure level 1 dcl 17-30 language_type 21 based fixed bin(17,0) level 3 dcl 1-18 ref 248 248 251 262 313 327 407 493 498 760 1970 length builtin function dcl 203 in procedure "probe_get_value_" ref 619 619 751 751 801 801 801 1165 1165 1175 1715 1767 1767 length 6 based fixed bin(17,0) level 2 in structure "identifier" dcl 2-19 in procedure "probe_get_value_" ref 591 619 751 755 791 801 807 914 994 1333 1337 1341 1345 1349 1354 1354 1381 1381 1386 1502 1502 1714 1718 1929 1929 1959 level 0(12) based bit(6) level 2 packed packed unaligned dcl 6-3 ref 778 linkage_ptr 103 based pointer level 3 packed packed unaligned dcl 5-9 ref 427 1013 low 000371 automatic fixed bin(35,0) dcl 864 set ref 1158 1222* 1226 lower 5 000522 automatic fixed bin(35,0) array level 3 dcl 1078 set ref 1107* 1222* lower_is_encoded 4 000522 automatic bit(1) array level 4 packed packed unaligned dcl 1078 set ref 1107* 1222* make_lower 000104 automatic bit(1) dcl 156 set ref 248* 251* 254* 741 maxlength builtin function dcl 203 ref 751 801 1165 1175 1715 1767 mod builtin function dcl 302 ref 381 660 mult 000372 automatic fixed bin(35,0) dcl 864 set ref 1156* 1156* 1158 1224* multiplier 7 000522 automatic fixed bin(35,0) array level 3 dcl 1078 set ref 1224* multiplier_is_encoded 4(02) 000522 automatic bit(1) array level 4 packed packed unaligned dcl 1078 set ref 1224* n_arguments 121 parameter fixed bin(17,0) level 3 in structure "P_reference" dcl 124 in procedure "probe_get_value_" set ref 240* 470* 584 638* 1073* 1082* 1794* 1794 n_arguments 121 based fixed bin(17,0) level 3 in structure "reference_node" dcl 3-16 in procedure "probe_get_value_" set ref 584* n_dims 000116 automatic fixed bin(17,0) dcl 15-97 set ref 1064* 1082 1092 1171 1267 1268* 1273* 1274 n_subscripts 122 parameter fixed bin(17,0) level 3 in structure "P_reference" dcl 124 in procedure "probe_get_value_" set ref 239* 394 470* 582 637* 669 1008* 1073* 1082* 1790 1793 1793* n_subscripts 122 based fixed bin(17,0) level 3 in structure "reference_node" dcl 3-16 in procedure "probe_get_value_" set ref 582* n_variants 000117 automatic fixed bin(35,0) dcl 15-112 set ref 1682* 1683 1686 1695 name 12 parameter varying char(256) level 2 in structure "P_reference" dcl 124 in procedure "probe_get_value_" set ref 229* 310* 357* 434* 472* 493 493 493* 493 508* 619* 619 619 623* 629* 629 687* 707* 707 729* 741* 741 751 751 755* 755 791* 801 801 806* 806 807* 807 813* 813 897* 914* 994* 1053* 1070 1179* 1284* 1386* 1409* 1425* 1425 1453* 1453 1468* 1497* 1502* 1520* 1715 1715 1718* 1718 1767 1767 1771* 1771 1933 1936* name 12 based varying char(256) level 2 in structure "subscript" dcl 160 in procedure "probe_get_value_" set ref 1099* 1105* 1803* 1807* name 000212 automatic varying char(256) dcl 773 in procedure "qualifier_name" set ref 777* 781* 781 783 name 12 based varying char(256) level 2 in structure "reference_node" dcl 3-16 in procedure "probe_get_value_" set ref 591* 1643* name 1 based bit(18) level 2 in structure "runtime_symbol" packed packed unaligned dcl 6-3 in procedure "probe_get_value_" ref 356 622 777 781 name 7 based pointer level 2 in structure "identifier" packed packed unaligned dcl 2-19 in procedure "probe_get_value_" ref 591 619 751 755 791 801 807 914 994 1333 1337 1341 1345 1349 1354 1381 1386 1502 1714 1718 1929 1961 name_ptr 000130 automatic pointer dcl 297 in procedure "parse_normal" set ref 356* 357 357 name_ptr 000112 automatic pointer dcl 1707 in procedure "scan_fields" set ref 1712* 1713 1714 1715 name_ptr_2 000160 automatic pointer dcl 564 set ref 622* 623 623 ndims 0(18) based bit(6) level 2 packed packed unaligned dcl 6-3 ref 540 need_to_indirect_and_make_string 000101 automatic bit(1) initial packed unaligned dcl 132 set ref 132* 212* 506 554* 1870* new_high 000373 automatic fixed bin(35,0) dcl 864 set ref 1131* 1132 1133* 1147* 1152 new_low 000374 automatic fixed bin(35,0) dcl 864 set ref 1122* 1132 1133* 1147 1150 new_name 000403 automatic varying char(32) dcl 881 set ref 1160* 1165 1168 1170 next based pointer level 3 in structure "current_token" packed packed unaligned dcl 2-45 in procedure "probe_get_value_" ref 1664 next based pointer level 3 in structure "token" packed packed unaligned dcl 2-16 in procedure "probe_get_value_" ref 1950 1970 next_ref 000332 automatic pointer dcl 851 set ref 935* 973* 1121 1129 1207* 1541* 1552* next_type 000341 automatic fixed bin(35,0) dcl 854 set ref 935* 973* 1207* 1216 1541* 1546 next_type_ptr 000336 automatic pointer dcl 851 set ref 935* 973* 1207* 1216 1541* 1546 next_value 000343 automatic fixed bin(35,0) dcl 854 set ref 935* 973* 1122 1131 1158 1160* 1207* 1226 1226 1541* 1552* not_end_of_dims 001010 automatic bit(1) packed unaligned dcl 1865 set ref 1874* 1875 1888* null builtin function dcl 203 ref 232 233 234 235 244 326 330 342 350 353 354 355 372 402 427 427 439 471 498 507 525 543 572 596 605 613 649 1025 1045 1061 1148 1268 1309 1321 1336 1387 1393 1397 1408 1421 1450 1451 1454 1455 1455 1484 1579 1658 1679 1681 1711 1713 1828 1933 1933 null_entry_ 000100 constant entry external dcl 389 ref 390 num_chars based fixed bin(9,0) level 2 packed packed unsigned unaligned dcl 7-6 ref 777 781 1714 1715 number based fixed bin(17,0) level 2 in structure "ref_arg_list" dcl 136 in procedure "probe_get_value_" set ref 242* number based fixed bin(17,0) level 2 in structure "ref_subscripts" dcl 138 in procedure "probe_get_value_" set ref 243* 1073* 1082 1082* offset 5 based fixed bin(35,0) level 2 in structure "runtime_symbol" dcl 6-3 in procedure "probe_get_value_" ref 373 376 654 656 offset 3 000125 automatic fixed bin(35,0) level 2 in structure "address_info" dcl 1709 in procedure "scan_fields" set ref 1736* 1736* 1736* 1736* offset 1 based fixed bin(18,0) level 2 in structure "its_unsigned" packed packed unsigned unaligned dcl 17-30 in procedure "probe_get_value_" set ref 382* 382 661* 661 offset_bits 000164 automatic fixed bin(6,0) unsigned dcl 566 in procedure "get_unqualified_c_reference" set ref 656* 656 658 660* 660 660 663 offset_bits 000140 automatic fixed bin(6,0) unsigned dcl 300 in procedure "parse_normal" set ref 376* 376 379 381* 381 381 384 offset_dtype constant fixed bin(17,0) initial dcl 10-25 ref 427 offset_is_encoded 2(27) 000125 automatic bit(1) level 2 packed packed unaligned dcl 1709 set ref 1736* 1736* 1736* 1736* offset_words 000141 automatic fixed bin(18,0) unsigned dcl 301 in procedure "parse_normal" set ref 379* 379 382 offset_words 000165 automatic fixed bin(18,0) unsigned dcl 567 in procedure "get_unqualified_c_reference" set ref 658* 658 661 old_addr 000162 automatic pointer dcl 565 in procedure "get_unqualified_c_reference" set ref 572* 605 607* 608 661 661 663 663 667 old_addr 000134 automatic pointer dcl 298 in procedure "parse_normal" set ref 326* 352* 371 402 operator based structure level 1 dcl 2-24 optional_info 117 based structure level 2 in structure "reference_node" dcl 3-16 in procedure "probe_get_value_" optional_info 117 parameter structure level 2 in structure "P_reference" dcl 124 in procedure "probe_get_value_" original_class 000142 automatic fixed bin(6,0) unsigned dcl 303 set ref 305* 394* 596 596* 596 669* p based structure level 1 packed packed unaligned dcl 887 in procedure "parse_ala_pascal" p parameter pointer dcl 1956 in procedure "cobol_connector" ref 1954 1959 1959 1961 p 000210 automatic pointer dcl 772 in procedure "qualifier_name" set ref 776* 777 777 778 780* 780 780 781 781 packed 0(02) based bit(1) level 3 in structure "pascal_symbol_node_header" packed packed unaligned dcl 11-12 in procedure "probe_get_value_" set ref 1066 packed 2(01) 000114 automatic bit(1) level 3 in structure "type_info" packed packed unaligned dcl 1708 in procedure "scan_fields" set ref 1744 packed 116 parameter bit(1) level 3 in structure "P_reference" packed packed unaligned dcl 124 in procedure "probe_get_value_" set ref 421 529* 545* 1066* 1312 1519* 1744* pascal_boolean_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1346 pascal_char_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1350 1448 pascal_enumerated_type_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1376 pascal_enumerated_type_instance_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1377 pascal_integer_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1338 pascal_max_set_size constant fixed bin(17,0) initial dcl 13-5 ref 1642 pascal_procedure_type_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1036 pascal_real_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1342 pascal_record_file_type_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1364 1429 pascal_record_type_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1364 1485 1492 pascal_set based bit(288) packed unaligned dcl 13-3 set ref 1517 1518 1523* 1648* pascal_set_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1364 1515 pascal_symbol_node_header based structure level 1 dcl 11-12 set ref 1512 1514* pascal_text_file_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1446 pascal_typed_pointer_type_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1306 1364 1370 1394 pascal_user_defined_type_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1364 pascal_user_defined_type_instance_dtype constant fixed bin(17,0) initial dcl 10-132 ref 1294 1369 1511 path 116(09) parameter bit(1) level 3 packed packed unaligned dcl 124 set ref 1799 1940* pointer_dtype constant fixed bin(17,0) initial dcl 10-25 ref 336 344 415 421 512 515 901 1291 1312 pointers 76 based structure level 2 dcl 5-9 precision 115 parameter fixed bin(35,0) level 2 dcl 124 set ref 231* 528* 544* 1048* 1248* 1312 1339* 1343* 1347* 1351* 1370* 1374* 1378* 1400 1424* 1449* 1518* 1745* prev_ptr 000100 automatic pointer dcl 1676 set ref 1679* 1681 1682* 1690* 1751* probe_area_info 56 based structure level 2 dcl 1-18 probe_check_ptr_$check 000076 constant entry external dcl 293 ref 444 probe_check_ptr_$indirectable 000012 constant entry external dcl 172 ref 448 probe_create_reference_ 000024 constant entry external dcl 183 ref 577 1094 1101 1126 1796 1804 1819 probe_error_$malfunction 000016 constant entry external dcl 175 ref 64 probe_error_$record 000014 constant entry external dcl 174 ref 321 337 434 450 454 458 481 486 508 534 549 632 650 687 710 729 796 824 946 963 984 1053 1133 1183 1194 1218 1228 1254 1284 1296 1322 1329 1354 1381 1409 1468 1479 1497 1502 1548 1556 1643 1852 1891 1925 1936 probe_et_$bad_locator 000032 external static fixed bin(35,0) dcl 189 set ref 434* probe_et_$bad_operator 000034 external static fixed bin(35,0) dcl 189 set ref 321* probe_et_$bad_pointer 000036 external static fixed bin(35,0) dcl 189 set ref 415* probe_et_$dim_limit 000040 external static fixed bin(35,0) dcl 189 set ref 1790* probe_et_$null_ptr 000042 external static fixed bin(35,0) dcl 189 ref 454 probe_et_$recorded_message 000044 external static fixed bin(35,0) dcl 189 ref 272 probe_et_$too_long 000046 external static fixed bin(35,0) dcl 189 set ref 751* 801* 1165* 1175* 1715* 1767* probe_eval_$add_c_dims 000022 constant entry external dcl 180 ref 394 669 probe_eval_$evaluate 000020 constant entry external dcl 177 ref 330 367 410 498 593 642 830 899 920 1002 probe_get_$expression 000026 constant entry external dcl 184 ref 1813 1822 probe_get_$generation 000030 constant entry external dcl 186 ref 680 722 probe_info based structure level 1 dcl 1-18 probe_info_ptr 000114 automatic pointer dcl 1-86 set ref 224* 248 248 251 251 256 256 262 307 309 313 313 317 321* 321 327 327 330* 337* 364 367* 394* 407 407 410* 420 434* 443 450* 454* 458* 478 480 481* 486* 486 493 498 498* 508* 534* 549* 574 577* 593* 631 632* 642* 650* 669* 677 680* 685 687* 706 709 710* 719 722* 727 729* 749 751 751 755 755 758 760 760 791 791 793 795 796* 801 801 807 807 815 818 823 824* 830* 894 896 899* 901 901 911 912 914 914 916 920* 926 934 935* 941 945 946* 954 954 960 962 963* 971 973* 979 983 984* 993 994 994 997 1002* 1020 1042* 1053* 1058 1071 1094* 1096 1101* 1123 1126* 1133* 1173 1183* 1190 1194* 1207* 1218* 1228* 1251 1251 1251 1254* 1260 1284* 1290 1296* 1322* 1328 1329* 1333 1333 1337 1337 1341 1341 1345 1345 1349 1349 1354* 1354 1354 1354 1381* 1381 1381 1381 1386 1386 1391 1409* 1468* 1475 1478 1479* 1497* 1502* 1502 1502 1502 1509 1512 1517 1527 1533* 1539 1541* 1548* 1555 1556* 1643* 1714 1714 1718 1718 1796* 1799 1799 1804* 1813* 1818 1819* 1822* 1838 1845 1851 1852* 1870 1876 1878 1880 1891* 1904 1904 1904 1904 1904 1910 1912 1914 1916 1922 1922 1924 1925* 1929 1929 1929 1936* 1950 1950 1970 1970 1970 probe_invoke_$function 000112 constant entry external dcl 876 ref 1042 probe_pascal_$indice_id 000106 constant entry external dcl 871 ref 1133 1133 1160 probe_pascal_$indice_value 000110 constant entry external dcl 873 ref 935 973 1207 1533 1541 probe_pascal_$real_type 000102 constant entry external dcl 866 ref 1212 ptr builtin function dcl 1615 in procedure "decode" ref 1624 1624 ptr based pointer array level 2 in structure "sub_refs" dcl 142 in procedure "probe_get_value_" set ref 1095* 1103* 1128* 1148* 1790 1797* 1805* 1820* 1828* ptr_to_current_source 4 based pointer level 2 dcl 1-18 ref 251 random_info 17 based structure level 2 dcl 1-18 ref_arg_list based structure level 1 dcl 136 ref_ptr parameter pointer dcl 1640 ref 1636 1643 ref_source_info based structure level 1 dcl 140 ref_subscripts based structure level 1 dcl 138 reference_arg_list based structure level 1 dcl 3-59 reference_node based structure level 1 dcl 3-16 set ref 593* 1121* 1121 1129* 1129 1813* 1822* reference_subscripts based structure level 1 dcl 3-64 result 000100 automatic fixed bin(35,0) dcl 1619 set ref 1624* 1630 runtime_address_info based structure level 1 dcl 15-56 runtime_array_info based structure level 1 dcl 15-70 runtime_symbol based structure level 1 dcl 6-3 runtime_symbol_info_$address 000062 constant entry external dcl 15-54 ref 1731 runtime_symbol_info_$array 000066 constant entry external dcl 15-68 ref 1088 runtime_symbol_info_$array_dims 000064 constant entry external dcl 15-66 ref 1064 1268 runtime_symbol_info_$brother 000054 constant entry external dcl 15-40 ref 1752 runtime_symbol_info_$n_variants 000070 constant entry external dcl 15-99 ref 1682 runtime_symbol_info_$name 000060 constant entry external dcl 15-48 ref 1712 runtime_symbol_info_$son 000056 constant entry external dcl 15-44 ref 1487 1493 runtime_symbol_info_$type 000052 constant entry external dcl 15-22 ref 1031 1241 1262 1302 1360 1416 1435 1723 runtime_symbol_info_$variant 000072 constant entry external dcl 15-101 ref 1690 runtime_type_info based structure level 1 dcl 15-24 runtime_variant_info based structure level 1 dcl 15-103 s_ptr 000156 automatic pointer dcl 563 set ref 611* 613 614 616 617* 617 617 622 622 647* 649 654 654 656 seg_info based structure level 1 dcl 5-9 seg_info_ptr 12 based pointer level 2 in structure "ref_source_info" dcl 140 in procedure "probe_get_value_" ref 427 seg_info_ptr 12 based pointer level 2 in structure "current_source" dcl 4-13 in procedure "probe_get_value_" ref 251 seg_info_ptr 12 based pointer level 2 in structure "source_info" dcl 4-5 in procedure "probe_get_value_" ref 1013 simple 0(26) based bit(1) level 3 packed packed unaligned dcl 6-3 ref 373 654 size 10 000360 automatic fixed bin(35,0) level 2 in structure "type_info" dcl 863 in procedure "parse_ala_pascal" set ref 1048 1248 1424 size builtin function dcl 850 in procedure "parse_ala_pascal" ref 1518 size 10 000114 automatic fixed bin(35,0) level 2 in structure "type_info" dcl 1708 in procedure "scan_fields" set ref 1745 son 2(18) based bit(18) level 2 packed packed unaligned dcl 6-3 ref 344 348 512 519 617 source_info based structure level 1 dcl 4-5 source_info_ptr 10 parameter pointer level 2 dcl 124 set ref 244 244 244 427 427 427 680* 722* 1011 1012 1013 stack_ptr 6 based pointer level 2 in structure "ref_source_info" dcl 140 in procedure "probe_get_value_" set ref 244* 427* stack_ptr 6 based pointer level 2 in structure "source_info" dcl 4-5 in procedure "probe_get_value_" ref 1012 star_extent 116(05) based bit(1) level 3 packed packed unaligned dcl 160 set ref 1098* 1104* 1802* 1806* steps 000402 automatic fixed bin(17,0) dcl 880 set ref 1333* str based structure level 1 packed packed unaligned dcl 1575 str_len based fixed bin(9,0) level 2 packed packed unsigned unaligned dcl 294 ref 357 357 623 623 str_name 0(09) based char level 2 packed packed unaligned dcl 294 ref 357 623 string 0(09) based char level 2 packed packed unaligned dcl 7-6 ref 777 781 1714 stu_$decode_runtime_value_extended 000114 constant entry external dcl 1616 ref 1624 stu_$find_runtime_symbol 000104 constant entry external dcl 868 ref 1333 stu_$offset_to_pointer 000074 constant entry external dcl 291 ref 427 sub_no 000772 automatic fixed bin(17,0) dcl 1788 set ref 1793* 1797 1805 1820 1828 sub_refs based structure level 1 dcl 142 subp 000770 automatic pointer dcl 1787 in procedure "get_dim" set ref 1796* 1797 1802 1803 1804* 1805 1806 1807 1813 1819* 1820 1822 subp 000376 automatic pointer dcl 878 in procedure "parse_ala_pascal" set ref 1094* 1095 1098 1099 1101* 1103 1104 1105 1121 1126* 1128 1129 subscript based structure level 1 dcl 160 subscript_ptr 120 based pointer level 3 in structure "reference_node" packed packed unaligned dcl 3-16 in procedure "probe_get_value_" set ref 578* subscript_ptr 120 parameter pointer level 3 in structure "P_reference" packed packed unaligned dcl 124 in procedure "probe_get_value_" set ref 243 578 1073 1082 1082 1107 1111 1150 1152 subscript_reference_ptrs based structure level 1 dcl 3-69 subscript_refs_ptr 124 parameter pointer level 2 in structure "P_reference" packed packed unaligned dcl 124 in procedure "probe_get_value_" set ref 586 1095 1103 1128 1148 1790 1797 1805 1820 1828 subscript_refs_ptr 124 based pointer level 2 in structure "reference_node" packed packed unaligned dcl 3-16 in procedure "probe_get_value_" set ref 586* subscript_type 10 000522 automatic fixed bin(35,0) array level 3 dcl 1078 set ref 1133* 1133* 1160* 1212* 1212* 1216 subscript_type_addr 12 000522 automatic pointer array level 3 dcl 1078 set ref 1133* 1133* 1160* 1212* 1212* 1216 substr builtin function dcl 203 set ref 321 357 458 458 458 458 486 493 493 619 623 1648* switches 000100 automatic bit(36) packed unaligned dcl 131 set ref 211* 221* 330 367 394 410 498 593 642 669 830 899 920 1002 symbol_ptr parameter pointer level 2 in structure "P_reference" dcl 124 in procedure "probe_get_value_" set ref 232* 342 343 350* 372 373 373 376 427* 454* 458* 507 512 515 515 519* 519 519 523 525* 540 543* 647 1045* 1387* 1421* 1451* 1493* 1746* symbol_ptr based pointer level 2 in structure "reference_node" dcl 3-16 in procedure "probe_get_value_" set ref 596 596 611 symbp parameter pointer dcl 1613 set ref 1608 1624* t_ref 000154 automatic pointer dcl 563 set ref 577* 578 580 582 584 586 591 593 596 596 607 611 target based bit(1) level 2 packed packed unaligned dcl 1575 set ref 1581 temp_created 000152 automatic bit(1) packed unaligned dcl 562 set ref 571* 576 588* token based structure level 1 dcl 2-16 token_header based structure level 1 dcl 2-4 token_info 12 based structure level 2 dcl 1-18 translate builtin function dcl 203 ref 741 813 tsp 000132 automatic pointer dcl 298 set ref 343* 344 344 344 348* 348 348 356 356 type 3 000360 automatic fixed bin(18,0) level 2 in structure "type_info" packed packed unsigned unaligned dcl 863 in procedure "parse_ala_pascal" set ref 1036 1306 1364 1364 1364 1364 1364 1370 1376 type 1 based fixed bin(17,0) level 2 in structure "pascal_symbol_node_header" packed packed unaligned dcl 11-12 in procedure "probe_get_value_" set ref 1394 1429 1485 1515* type 3 000114 automatic fixed bin(18,0) level 2 in structure "type_info" packed packed unsigned unaligned dcl 1708 in procedure "scan_fields" set ref 1742 type 113 parameter fixed bin(35,0) level 2 in structure "P_reference" dcl 124 in procedure "probe_get_value_" set ref 238* 336 351* 415 421 427 512 527* 540 901 1046* 1246* 1291 1294 1312 1338* 1342* 1346* 1350* 1369* 1377* 1422* 1440* 1446 1448* 1492 1511* 1742* type 2 based bit(18) level 3 in structure "current_token" dcl 2-45 in procedure "probe_get_value_" ref 313 317 321 478 480 486 901 912 916 926 934 941 945 954 954 960 962 971 979 983 993 997 1020 1058 1096 1123 1173 1190 1251 1251 1251 1260 1328 1391 1475 1478 1509 1527 1539 1555 1659 1661 1661 1661 type 0(06) based bit(6) level 2 in structure "runtime_symbol" packed packed unaligned dcl 6-3 in procedure "probe_get_value_" ref 344 344 515 515 523 614 616 type 2 based bit(18) level 3 in structure "operator" dcl 2-24 in procedure "probe_get_value_" ref 685 727 1818 1838 1851 type 2 based bit(18) level 3 in structure "token" dcl 2-16 in procedure "probe_get_value_" ref 256 256 307 327 364 407 574 631 677 706 709 719 758 760 795 815 818 823 894 1290 1799 1799 1845 1870 1876 1878 1880 1904 1904 1904 1904 1904 1910 1912 1914 1916 1922 1924 1959 1970 type_addr 4 000114 automatic pointer level 2 dcl 1708 set ref 1743 type_info 000114 automatic structure level 1 unaligned dcl 1708 in procedure "scan_fields" set ref 1723 1723 type_info 000360 automatic structure level 1 unaligned dcl 863 in procedure "parse_ala_pascal" set ref 1031 1031 1241 1241 1262 1262 1302 1302 1360 1360 1416 1416 1435 1435 type_ptr 2 parameter pointer level 2 dcl 124 set ref 234* 354* 1025 1031* 1047* 1061 1062 1064* 1066 1080 1107* 1111* 1222* 1224* 1226* 1241* 1247* 1302* 1333* 1336 1360* 1393 1394 1416* 1423* 1429 1435* 1441* 1450* 1484 1485 1487* 1512* 1514 1515 1743* unit_code parameter fixed bin(2,0) unsigned dcl 1591 ref 1586 1594 units 2(25) 000125 automatic fixed bin(2,0) level 2 packed packed unsigned unaligned dcl 1709 set ref 1736 1736 1736 1736 unspec builtin function dcl 203 set ref 221* 458 458 458 458 1514* upper 6 000522 automatic fixed bin(35,0) array level 3 dcl 1078 set ref 1111* 1226* upper_is_encoded 4(01) 000522 automatic bit(1) array level 4 packed packed unaligned dcl 1078 set ref 1111* 1226* val parameter fixed bin(35,0) dcl 1639 ref 1636 1642 1648 value parameter fixed bin(35,0) dcl 1611 in procedure "decode" set ref 1608 1621 1624* value 1 based fixed bin(24,0) array level 2 in structure "ref_subscripts" dcl 138 in procedure "probe_get_value_" set ref 1107* 1111* 1150* 1152* value parameter fixed bin(35,0) dcl 1589 in procedure "convert_units" ref 1586 1596 1598 1600 1602 variant_info 000100 automatic structure level 1 unaligned dcl 1686 set ref 1690 1690 verify builtin function dcl 203 ref 493 version 000125 automatic char(8) level 2 in structure "address_info" packed packed unaligned dcl 1709 in procedure "scan_fields" set ref 1729* version 000522 automatic char(8) level 2 in structure "array_info" packed packed unaligned dcl 1078 in procedure "parse_ala_pascal" set ref 1079* version 000100 automatic char(8) level 2 in structure "variant_info" packed packed unaligned dcl 1686 in begin block on line 1683 set ref 1688* version 000114 automatic char(8) level 2 in structure "type_info" packed packed unaligned dcl 1708 in procedure "scan_fields" set ref 1721* version 000360 automatic char(8) level 2 in structure "type_info" packed packed unaligned dcl 863 in procedure "parse_ala_pascal" set ref 893* 1029* 1239* 1301* 1433* want_value 000102 automatic bit(1) dcl 153 set ref 210* 220* 330* 367* 410* 498* 593* 642* 830* 899* 920* 1002* 1040 1309 1397 1488 window_place_in_pascal_fsb constant fixed bin(35,0) initial dcl 13-9 ref 1459 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ALGOL68_lang_type internal static fixed bin(17,0) initial dcl 9-17 ALM_lang_type internal static fixed bin(17,0) initial dcl 9-17 AMPERSAND internal static bit(18) initial dcl 8-17 C_EQUAL internal static bit(18) initial dcl 8-17 C_LEFT_SHIFT internal static bit(18) initial dcl 8-17 C_NOT_EQUAL internal static bit(18) initial dcl 8-17 C_RIGHT_SHIFT internal static bit(18) initial dcl 8-17 EQUALS internal static bit(18) initial dcl 8-17 ITP_MODIFIER internal static bit(6) initial packed unaligned dcl 17-56 ITS_MODIFIER internal static bit(6) initial packed unaligned dcl 17-55 MINUS internal static bit(18) initial dcl 8-17 NEW_LINE internal static bit(18) initial dcl 8-17 NOT_EQUALS internal static bit(18) initial dcl 8-17 NOT_GREATER_THAN internal static bit(18) initial dcl 8-17 NOT_LESS_THAN internal static bit(18) initial dcl 8-17 NOT_SIGN internal static bit(18) initial dcl 8-17 OPERATOR_TYPE internal static bit(18) initial packed unaligned dcl 2-37 OTHER_lang_type internal static fixed bin(17,0) initial dcl 9-17 PASCAL_ASSIGN internal static bit(18) initial dcl 8-17 PASCAL_RANGE internal static bit(18) initial dcl 8-17 PERCENT internal static bit(18) initial dcl 8-17 PL1_lang_type internal static fixed bin(17,0) initial dcl 9-17 PLUS internal static bit(18) initial dcl 8-17 QUESTION_MARK internal static bit(18) initial dcl 8-17 RUNTIME_SUBRANGE_INFO_VERSION_1 internal static char(8) initial packed unaligned dcl 15-131 SEMI_COLON internal static bit(18) initial dcl 8-17 SLASH internal static bit(18) initial dcl 8-17 UNKNOWN_lang_type internal static fixed bin(17,0) initial dcl 9-17 algol68_array_descriptor_dtype internal static fixed bin(17,0) initial dcl 10-25 algol68_bits_dtype internal static fixed bin(17,0) initial dcl 10-110 algol68_bool_dtype internal static fixed bin(17,0) initial dcl 10-110 algol68_byte_dtype internal static fixed bin(17,0) initial dcl 10-110 algol68_char_dtype internal static fixed bin(17,0) initial dcl 10-110 algol68_compl_dtype internal static fixed bin(17,0) initial dcl 10-110 algol68_format_dtype internal static fixed bin(17,0) initial dcl 10-25 algol68_int_dtype internal static fixed bin(17,0) initial dcl 10-110 algol68_long_compl_dtype internal static fixed bin(17,0) initial dcl 10-110 algol68_long_int_dtype internal static fixed bin(17,0) initial dcl 10-110 algol68_long_real_dtype internal static fixed bin(17,0) initial dcl 10-110 algol68_real_dtype internal static fixed bin(17,0) initial dcl 10-110 algol68_short_int_dtype internal static fixed bin(17,0) initial dcl 10-110 algol68_straight_dtype internal static fixed bin(17,0) initial dcl 10-25 algol68_struct_struct_bool_dtype internal static fixed bin(17,0) initial dcl 10-110 algol68_struct_struct_char_dtype internal static fixed bin(17,0) initial dcl 10-110 algol68_union_dtype internal static fixed bin(17,0) initial dcl 10-25 area_dtype internal static fixed bin(17,0) initial dcl 10-25 arg_desc_type internal static bit(36) initial dcl 16-71 bit_dtype internal static fixed bin(17,0) initial dcl 10-25 bit_type internal static bit(36) initial dcl 16-71 bits_per_binary_exponent internal static fixed bin(31,0) initial dcl 16-5 bits_per_decimal_digit internal static fixed bin(31,0) initial dcl 16-5 bits_per_digit internal static fixed bin(31,1) initial dcl 16-69 bits_per_double internal static fixed bin(31,0) initial dcl 16-5 bits_per_packed_ptr internal static fixed bin(31,0) initial dcl 16-5 builtin_type internal static bit(36) initial dcl 16-71 c_enum_const_dtype internal static fixed bin(17,0) initial dcl 10-25 c_enum_dtype internal static fixed bin(17,0) initial dcl 10-25 c_union_dtype internal static fixed bin(17,0) initial dcl 10-25 char_type internal static bit(36) initial dcl 16-71 characters_per_double internal static fixed bin(31,0) initial dcl 16-5 characters_per_half internal static fixed bin(31,0) initial dcl 16-5 characters_per_word internal static fixed bin(31,0) initial dcl 16-5 cobol_char_string_dtype internal static fixed bin(17,0) initial dcl 10-25 cobol_comp_5_ts_dtype internal static fixed bin(17,0) initial dcl 10-25 cobol_comp_5_uns_dtype internal static fixed bin(17,0) initial dcl 10-25 cobol_comp_6_dtype internal static fixed bin(17,0) initial dcl 10-25 cobol_comp_7_dtype internal static fixed bin(17,0) initial dcl 10-25 cobol_comp_8_ls_dtype internal static fixed bin(17,0) initial dcl 10-25 cobol_comp_8_uns_dtype internal static fixed bin(17,0) initial dcl 10-25 cobol_display_ls_dtype internal static fixed bin(17,0) initial dcl 10-25 cobol_display_ls_overp_dtype internal static fixed bin(17,0) initial dcl 10-25 cobol_display_ts_dtype internal static fixed bin(17,0) initial dcl 10-25 cobol_display_ts_overp_dtype internal static fixed bin(17,0) initial dcl 10-25 cobol_display_uns_dtype internal static fixed bin(17,0) initial dcl 10-25 cobol_structure_dtype internal static fixed bin(17,0) initial dcl 10-25 complex_type internal static bit(36) initial dcl 16-71 computational_data based structure level 1 dcl 14-8 cplx_fix_bin_1_dtype internal static fixed bin(17,0) initial dcl 10-25 cplx_fix_bin_2_dtype internal static fixed bin(17,0) initial dcl 10-25 cplx_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 10-25 cplx_fix_dec_9bit_ls_dtype internal static fixed bin(17,0) initial dcl 10-25 cplx_flt_bin_1_dtype internal static fixed bin(17,0) initial dcl 10-25 cplx_flt_bin_2_dtype internal static fixed bin(17,0) initial dcl 10-25 cplx_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 10-25 cplx_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 10-25 cplx_flt_dec_9bit_dtype internal static fixed bin(17,0) initial dcl 10-25 cplx_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 10-25 cplx_flt_dec_generic_dtype internal static fixed bin(17,0) initial dcl 10-25 cplx_flt_hex_1_dtype internal static fixed bin(17,0) initial dcl 10-25 cplx_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 10-25 current_constant based structure level 1 dcl 2-44 dec_integer_type internal static bit(36) initial dcl 16-71 default_area_size internal static fixed bin(31,0) initial dcl 16-5 default_fix_bin_p internal static fixed bin(31,0) initial dcl 16-5 default_fix_dec_p internal static fixed bin(31,0) initial dcl 16-5 default_flt_bin_p internal static fixed bin(31,0) initial dcl 16-5 default_flt_dec_p internal static fixed bin(31,0) initial dcl 16-5 encoded_precision based structure level 1 dcl 12-8 encoded_value based structure level 1 dcl 6-70 entry_dtype internal static fixed bin(17,0) initial dcl 10-25 entry_var_type internal static bit(36) initial dcl 16-71 eof_place_in_pascal_fsb internal static fixed bin(35,0) initial dcl 13-9 eoln_place_in_pascal_fsb internal static fixed bin(35,0) initial dcl 13-9 ext_entry_runtime_dtype internal static fixed bin(17,0) initial dcl 10-125 ext_procedure_runtime_dtype internal static fixed bin(17,0) initial dcl 10-125 file_dtype internal static fixed bin(17,0) initial dcl 10-25 ft_char_dtype internal static fixed bin(17,0) initial dcl 10-96 ft_complex_double_dtype internal static fixed bin(17,0) initial dcl 10-96 ft_complex_dtype internal static fixed bin(17,0) initial dcl 10-96 ft_double_dtype internal static fixed bin(17,0) initial dcl 10-96 ft_external_dtype internal static fixed bin(17,0) initial dcl 10-96 ft_hex_complex_double_dtype internal static fixed bin(17,0) initial dcl 10-96 ft_hex_complex_dtype internal static fixed bin(17,0) initial dcl 10-96 ft_hex_double_dtype internal static fixed bin(17,0) initial dcl 10-96 ft_hex_real_dtype internal static fixed bin(17,0) initial dcl 10-96 ft_integer_dtype internal static fixed bin(17,0) initial dcl 10-96 ft_logical_dtype internal static fixed bin(17,0) initial dcl 10-96 ft_real_dtype internal static fixed bin(17,0) initial dcl 10-96 initial_source based structure level 1 dcl 4-14 int_entry_runtime_dtype internal static fixed bin(17,0) initial dcl 10-125 integer_type internal static bit(36) initial dcl 16-71 itp based structure level 1 dcl 17-18 itp_unsigned based structure level 1 dcl 17-43 its based structure level 1 dcl 17-5 label_constant_runtime_dtype internal static fixed bin(17,0) initial dcl 10-125 label_dtype internal static fixed bin(17,0) initial dcl 10-25 local_label_var_type internal static bit(36) initial dcl 16-71 max_area_size internal static fixed bin(31,0) initial dcl 16-5 max_bit_string internal static fixed bin(31,0) initial dcl 16-5 max_bit_string_constant internal static fixed bin(31,0) initial dcl 16-5 max_char_string internal static fixed bin(31,0) initial dcl 16-5 max_char_string_constant internal static fixed bin(31,0) initial dcl 16-5 max_identifier_length internal static fixed bin(31,0) initial dcl 16-5 max_index_register_value internal static fixed bin(31,0) initial dcl 16-5 max_length_precision internal static fixed bin(31,0) initial dcl 16-5 max_number_of_dimensions internal static fixed bin(31,0) initial dcl 16-5 max_offset_precision internal static fixed bin(31,0) initial dcl 16-5 max_p_bin_or_dec internal static fixed bin(31,0) initial dcl 16-5 max_p_dec internal static fixed bin(31,0) initial dcl 16-5 max_p_fix_bin_1 internal static fixed bin(31,0) initial dcl 16-5 max_p_fix_bin_2 internal static fixed bin(31,0) initial dcl 16-5 max_p_flt_bin_1 internal static fixed bin(31,0) initial dcl 16-5 max_p_flt_bin_2 internal static fixed bin(31,0) initial dcl 16-5 max_scale internal static fixed bin(31,0) initial dcl 16-5 max_signed_index_register_value internal static fixed bin(31,0) initial dcl 16-5 max_signed_xreg_precision internal static fixed bin(31,0) initial dcl 16-5 max_uns_xreg_precision internal static fixed bin(31,0) initial dcl 16-5 max_words_per_variable internal static fixed bin(31,0) initial dcl 16-5 min_area_size internal static fixed bin(31,0) initial dcl 16-5 min_scale internal static fixed bin(31,0) initial dcl 16-5 nd automatic fixed bin(6,0) unsigned dcl 11-122 nvariants automatic fixed bin(17,0) dcl 11-121 official_language_names internal static char(32) initial array packed unaligned dcl 9-27 packed_digits_per_character internal static fixed bin(31,0) initial dcl 16-5 palatable_language_names internal static char(32) initial array packed unaligned dcl 9-30 pascal_address based structure level 1 dcl 11-43 pascal_array_info based structure level 1 dcl 11-78 pascal_base_type_info based structure level 1 dcl 11-39 pascal_encoded_value based structure level 1 dcl 11-116 pascal_entry_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 10-132 pascal_enumerated_type_element_dtype internal static fixed bin(17,0) initial dcl 10-132 pascal_exportable_procedure_dtype internal static fixed bin(17,0) initial dcl 10-132 pascal_father_brother based structure level 1 dcl 11-51 pascal_father_type_successor based structure level 1 dcl 11-60 pascal_imported_procedure_dtype internal static fixed bin(17,0) initial dcl 10-132 pascal_internal_procedure_dtype internal static fixed bin(17,0) initial dcl 10-132 pascal_label_dtype internal static fixed bin(17,0) initial dcl 10-132 pascal_name_next based structure level 1 dcl 11-35 pascal_offset based fixed bin(35,0) dcl 11-66 pascal_parameter_proc_size internal static fixed bin(17,0) initial dcl 13-7 pascal_parameter_procedure_dtype internal static fixed bin(17,0) initial dcl 10-132 pascal_size based fixed bin(35,0) dcl 11-64 pascal_son_level based structure level 1 dcl 11-55 pascal_string_type_dtype internal static fixed bin(17,0) initial dcl 10-132 pascal_subrange_limits based structure level 1 dcl 11-68 pascal_value_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 10-132 pascal_variable_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 10-132 pascal_variant_info based structure level 1 dcl 11-105 picture_runtime_dtype internal static fixed bin(17,0) initial dcl 10-125 pointer_type internal static bit(36) initial dcl 16-71 probe_area based area(1024) dcl 1-93 probe_info_version internal static fixed bin(17,0) initial dcl 1-88 probe_info_version_1 internal static fixed bin(17,0) initial dcl 1-90 real_fix_bin_1_dtype internal static fixed bin(17,0) initial dcl 10-25 real_fix_bin_1_uns_dtype internal static fixed bin(17,0) initial dcl 10-25 real_fix_bin_2_dtype internal static fixed bin(17,0) initial dcl 10-25 real_fix_bin_2_uns_dtype internal static fixed bin(17,0) initial dcl 10-25 real_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 10-25 real_fix_dec_4bit_bytealigned_uns_dtype internal static fixed bin(17,0) initial dcl 10-25 real_fix_dec_4bit_ls_dtype internal static fixed bin(17,0) initial dcl 10-25 real_fix_dec_4bit_ts_dtype internal static fixed bin(17,0) initial dcl 10-25 real_fix_dec_4bit_uns_dtype internal static fixed bin(17,0) initial dcl 10-25 real_fix_dec_9bit_ls_dtype internal static fixed bin(17,0) initial dcl 10-25 real_fix_dec_9bit_ls_overp_dtype internal static fixed bin(17,0) initial dcl 10-25 real_fix_dec_9bit_ts_dtype internal static fixed bin(17,0) initial dcl 10-25 real_fix_dec_9bit_ts_overp_dtype internal static fixed bin(17,0) initial dcl 10-25 real_fix_dec_9bit_uns_dtype internal static fixed bin(17,0) initial dcl 10-25 real_flt_bin_1_dtype internal static fixed bin(17,0) initial dcl 10-25 real_flt_bin_2_dtype internal static fixed bin(17,0) initial dcl 10-25 real_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 10-25 real_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 10-25 real_flt_dec_4bit_dtype internal static fixed bin(17,0) initial dcl 10-25 real_flt_dec_9bit_dtype internal static fixed bin(17,0) initial dcl 10-25 real_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 10-25 real_flt_dec_generic_dtype internal static fixed bin(17,0) initial dcl 10-25 real_flt_hex_1_dtype internal static fixed bin(17,0) initial dcl 10-25 real_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 10-25 real_type internal static bit(36) initial dcl 16-71 runtime_block based structure level 1 dcl 6-38 runtime_bound based structure level 1 unaligned dcl 6-33 runtime_subrange_info based structure level 1 unaligned dcl 15-116 runtime_symbol_info_$father 000000 constant entry external dcl 15-38 runtime_symbol_info_$father_type 000000 constant entry external dcl 15-42 runtime_symbol_info_$level 000000 constant entry external dcl 15-50 runtime_symbol_info_$next 000000 constant entry external dcl 15-52 runtime_symbol_info_$subrange 000000 constant entry external dcl 15-114 runtime_symbol_info_$successor 000000 constant entry external dcl 15-46 runtime_token based structure level 1 dcl 6-63 scratch_area based area(1024) dcl 1-92 seg_info_nfiles automatic fixed bin(17,0) dcl 5-47 storage_block_type internal static bit(36) initial dcl 16-71 structure_dtype internal static fixed bin(17,0) initial dcl 10-25 varying_bit_dtype internal static fixed bin(17,0) initial dcl 10-25 varying_char_dtype internal static fixed bin(17,0) initial dcl 10-25 words_per_condition_var internal static fixed bin(31,0) initial dcl 16-5 words_per_entry_var internal static fixed bin(31,0) initial dcl 16-5 words_per_file_var internal static fixed bin(31,0) initial dcl 16-5 words_per_fix_bin_1 internal static fixed bin(31,0) initial dcl 16-5 words_per_fix_bin_2 internal static fixed bin(31,0) initial dcl 16-5 words_per_flt_bin_1 internal static fixed bin(31,0) initial dcl 16-5 words_per_flt_bin_2 internal static fixed bin(31,0) initial dcl 16-5 words_per_format internal static fixed bin(31,0) initial dcl 16-5 words_per_label_var internal static fixed bin(31,0) initial dcl 16-5 words_per_offset internal static fixed bin(31,0) initial dcl 16-5 words_per_packed_pointer internal static fixed bin(31,0) initial dcl 16-5 words_per_pointer internal static fixed bin(31,0) initial dcl 16-5 words_per_varying_string_header internal static fixed bin(31,0) initial dcl 16-5 work_area based area(1024) dcl 1-94 NAMES DECLARED BY EXPLICIT CONTEXT. GOT_PATH 012743 constant label dcl 1933 ref 1922 RECORDED_MESSAGE 001326 constant label dcl 272 ref 323 340 436 463 483 488 510 537 552 634 652 689 712 731 798 826 949 965 987 1056 1143 1186 1197 1220 1230 1258 1287 1299 1324 1331 1356 1383 1412 1472 1482 1500 1505 1550 1558 1646 1854 1893 1926 1937 SOME_ERROR 001323 constant label dcl 267 ref 274 282 404 445 682 724 908 922 939 977 1004 1033 1090 1210 1243 1264 1304 1362 1418 1437 1535 1544 1628 1692 1724 1733 1815 1824 add 012077 constant entry internal dcl 1762 ref 1910 1912 1914 1916 1918 1929 arrow_found_check 005115 constant label dcl 956 ref 907 arrow_found_execute 007056 constant label dcl 1291 ref 901 bad_locator 007065 constant label dcl 1296 ref 1306 bitrel 011115 constant entry internal dcl 1570 ref 1236 1736 bump_ct 013042 constant entry internal dcl 1948 ref 311 362 474 630 678 693 708 720 735 756 792 794 809 816 819 828 898 915 942 951 956 961 967 980 989 995 1060 1115 1124 1174 1191 1261 1327 1388 1426 1464 1477 1525 1529 1540 1561 1747 1808 1821 1837 1840 1847 1856 1868 1877 1879 1920 1931 cobol_connector 013055 constant entry internal dcl 1954 ref 793 1970 continue_subarray 005637 constant label dcl 1082 ref 1276 continue_to_check 004774 constant label dcl 924 ref 952 958 968 continue_to_parse 005367 constant label dcl 1018 ref 1279 1389 1427 1465 1748 convert_units 011136 constant entry internal dcl 1586 ref 1156 1736 1736 decode 011166 constant entry internal dcl 1608 ref 1107 1111 1222 1224 1226 1736 1736 1736 1736 disgruntled 001333 constant entry internal dcl 277 ref 415 751 801 1165 1175 1715 1767 1790 end_of_parsing 010670 constant label dcl 1565 ref 931 1530 1562 file_window_join 010062 constant label dcl 1451 ref 1442 fill_set 011247 constant entry internal dcl 1636 ref 1537 1552 get_c_brackets 012470 constant entry internal dcl 1862 ref 760 get_dim 012143 constant entry internal dcl 1776 ref 817 820 1844 1848 1873 1886 get_indice_value 010671 constant entry internal dcl 1203 ref 1119 1125 get_level 004102 constant entry internal dcl 746 ref 569 640 704 714 get_parens 012370 constant entry internal dcl 1834 ref 758 917 927 998 1021 1942 get_pathname 012603 constant entry internal dcl 1900 ref 256 get_unqualified_c_reference 003123 constant entry internal dcl 559 ref 313 366 get_unqualified_reference 003672 constant entry internal dcl 701 ref 317 478 is_cross_section 011320 constant entry internal dcl 1653 ref 1071 looks_like_cobol 013112 constant entry internal dcl 1968 ref 260 next_dim 006443 constant label dcl 1171 ref 1116 next_elem 005174 constant label dcl 973 ref 981 next_indice 005016 constant label dcl 935 ref 943 no_field_name 010176 constant label dcl 1479 no_more_specs 006714 constant label dcl 1254 ref 1274 not_a_proc 005475 constant label dcl 1053 ref 1036 not_a_ptr 010125 constant label dcl 1468 ref 1429 not_a_record 010313 constant label dcl 1497 ref 1485 not_an_array 007016 constant label dcl 1284 ref 1062 parse_ala_cobol 004300 constant entry internal dcl 787 ref 260 parse_ala_pascal 004615 constant entry internal dcl 834 ref 262 parse_normal 001347 constant entry internal dcl 285 ref 265 probe_get_value_ 001077 constant entry external dcl 62 probe_get_value_$reference 001144 constant entry external dcl 217 probe_get_value_$value 001120 constant entry external dcl 207 qualifier_name 004170 constant entry internal dcl 769 ref 454 458 scan_fields 011531 constant entry internal dcl 1702 ref 1680 scan_record 011372 constant entry internal dcl 1670 ref 1488 1494 1696 start 001160 constant label dcl 224 ref 214 222 units_case 000000 constant label array(0:3) dcl 1596 ref 1594 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 14360 14476 13634 14370 Length 15370 13634 116 655 524 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME probe_get_value_ 1121 external procedure is an external procedure. disgruntled 64 internal procedure is called by several nonquick procedures. parse_normal internal procedure shares stack frame of external procedure probe_get_value_. get_unqualified_c_reference internal procedure shares stack frame of external procedure probe_get_value_. get_unqualified_reference internal procedure shares stack frame of external procedure probe_get_value_. get_level internal procedure shares stack frame of external procedure probe_get_value_. qualifier_name internal procedure shares stack frame of external procedure probe_get_value_. parse_ala_cobol internal procedure shares stack frame of external procedure probe_get_value_. parse_ala_pascal internal procedure shares stack frame of external procedure probe_get_value_. get_indice_value internal procedure shares stack frame of external procedure probe_get_value_. bitrel 64 internal procedure is called by several nonquick procedures. convert_units 64 internal procedure is called by several nonquick procedures. decode 88 internal procedure is called by several nonquick procedures. fill_set internal procedure shares stack frame of external procedure probe_get_value_. is_cross_section internal procedure shares stack frame of external procedure probe_get_value_. scan_record 129 internal procedure is called by several nonquick procedures. begin block on line 1683 78 begin block uses auto adjustable storage. scan_fields internal procedure shares stack frame of internal procedure scan_record. add internal procedure shares stack frame of external procedure probe_get_value_. get_dim internal procedure shares stack frame of external procedure probe_get_value_. get_parens internal procedure shares stack frame of external procedure probe_get_value_. get_c_brackets internal procedure shares stack frame of external procedure probe_get_value_. get_pathname internal procedure shares stack frame of external procedure probe_get_value_. bump_ct 64 internal procedure is called by several nonquick procedures. cobol_connector internal procedure shares stack frame of external procedure probe_get_value_. looks_like_cobol internal procedure shares stack frame of external procedure probe_get_value_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME begin block on line 1683 000100 variant_info begin block on line 1683 decode 000100 result decode probe_get_value_ 000100 switches probe_get_value_ 000101 need_to_indirect_and_make_string probe_get_value_ 000102 want_value probe_get_value_ 000103 code probe_get_value_ 000104 make_lower probe_get_value_ 000106 dummy_entry probe_get_value_ 000112 id_ptr probe_get_value_ 000114 probe_info_ptr probe_get_value_ 000116 n_dims probe_get_value_ 000117 n_variants probe_get_value_ 000130 name_ptr parse_normal 000132 tsp parse_normal 000134 old_addr parse_normal 000136 final_ptr parse_normal 000140 offset_bits parse_normal 000141 offset_words parse_normal 000142 original_class parse_normal 000152 temp_created get_unqualified_c_reference 000154 t_ref get_unqualified_c_reference 000156 s_ptr get_unqualified_c_reference 000160 name_ptr_2 get_unqualified_c_reference 000162 old_addr get_unqualified_c_reference 000164 offset_bits get_unqualified_c_reference 000165 offset_words get_unqualified_c_reference 000210 p qualifier_name 000212 name qualifier_name 000330 first_ref parse_ala_pascal 000332 next_ref parse_ala_pascal 000334 first_type_ptr parse_ala_pascal 000336 next_type_ptr parse_ala_pascal 000340 first_type parse_ala_pascal 000341 next_type parse_ala_pascal 000342 first_value parse_ala_pascal 000343 next_value parse_ala_pascal 000344 field_ptr parse_ala_pascal 000346 got_args parse_ala_pascal 000350 Block_ptr parse_ala_pascal 000352 Base_addr parse_ala_pascal 000354 Linkage_ptr parse_ala_pascal 000356 Stack_ptr parse_ala_pascal 000360 type_info parse_ala_pascal 000371 low parse_ala_pascal 000372 mult parse_ala_pascal 000373 new_high parse_ala_pascal 000374 new_low parse_ala_pascal 000376 subp parse_ala_pascal 000400 found_ptr parse_ala_pascal 000402 steps parse_ala_pascal 000403 new_name parse_ala_pascal 000414 element_name parse_ala_pascal 000515 i parse_ala_pascal 000516 bit_offset parse_ala_pascal 000517 current_indice parse_ala_pascal 000520 array_type_ptr parse_ala_pascal 000522 array_info parse_ala_pascal 000752 ct is_cross_section 000770 subp get_dim 000772 sub_no get_dim 001010 not_end_of_dims get_c_brackets 001026 c2 cobol_connector scan_record 000100 prev_ptr scan_record 000102 i scan_record 000112 name_ptr scan_fields 000114 type_info scan_fields 000125 address_info scan_fields THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_l_a r_g_a r_ne_as alloc_char_temp cat_realloc_chars enter_begin_block leave_begin_block call_ext_out_desc call_ext_out call_int_this call_int_other return_mac tra_ext_1 alloc_auto_adj mpfx2 mdfx1 shorten_stack ext_entry int_entry op_alloc_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cv_entry_ null_entry_ probe_check_ptr_$check probe_check_ptr_$indirectable probe_create_reference_ probe_error_$malfunction probe_error_$record probe_eval_$add_c_dims probe_eval_$evaluate probe_get_$expression probe_get_$generation probe_invoke_$function probe_pascal_$indice_id probe_pascal_$indice_value probe_pascal_$real_type runtime_symbol_info_$address runtime_symbol_info_$array runtime_symbol_info_$array_dims runtime_symbol_info_$brother runtime_symbol_info_$n_variants runtime_symbol_info_$name runtime_symbol_info_$son runtime_symbol_info_$type runtime_symbol_info_$variant stu_$decode_runtime_value_extended stu_$find_runtime_symbol stu_$offset_to_pointer THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badpath probe_et_$bad_locator probe_et_$bad_operator probe_et_$bad_pointer probe_et_$dim_limit probe_et_$null_ptr probe_et_$recorded_message probe_et_$too_long LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 132 001073 62 001076 64 001105 65 001112 207 001113 210 001131 211 001133 212 001136 214 001137 217 001140 220 001155 221 001156 222 001157 224 001160 227 001164 229 001165 230 001167 231 001223 232 001224 233 001226 234 001227 235 001230 236 001231 237 001233 238 001234 239 001235 240 001236 242 001237 243 001241 244 001243 248 001252 251 001263 254 001273 256 001274 260 001305 262 001314 265 001322 267 001323 269 001325 272 001326 274 001331 277 001332 281 001340 282 001344 285 001347 305 001350 307 001351 308 001357 309 001363 310 001366 311 001373 312 001377 313 001400 317 001411 321 001415 323 001442 326 001443 327 001445 330 001460 336 001507 337 001514 340 001541 342 001542 343 001546 344 001551 348 001574 349 001577 350 001600 351 001603 352 001605 353 001607 354 001610 355 001611 356 001612 357 001617 360 001645 362 001646 364 001652 366 001657 367 001660 371 001702 372 001705 373 001712 376 001721 379 001722 381 001724 382 001730 384 001735 390 001745 392 001752 394 001756 400 002005 402 002006 403 002012 404 002013 407 002014 410 002027 414 002051 415 002056 417 002070 418 002075 420 002076 421 002102 425 002117 427 002123 434 002160 436 002201 438 002202 439 002203 443 002205 444 002211 445 002224 448 002226 449 002241 450 002243 454 002303 458 002353 463 002430 469 002431 470 002467 471 002471 472 002473 474 002474 478 002500 480 002510 481 002512 483 002537 486 002540 488 002600 491 002601 493 002602 498 002650 506 002677 507 002701 508 002706 510 002740 512 002741 515 002752 519 002770 522 002775 523 002776 525 003002 526 003004 527 003010 528 003012 529 003014 530 003016 531 003020 532 003022 534 003023 537 003050 539 003051 540 003052 543 003062 544 003064 545 003066 546 003070 547 003072 549 003073 552 003120 554 003121 557 003122 559 003123 569 003124 571 003125 572 003126 574 003130 576 003136 577 003140 578 003151 580 003156 582 003160 584 003162 586 003164 588 003166 591 003170 593 003204 596 003225 603 003241 605 003242 607 003246 608 003251 611 003254 613 003257 614 003263 616 003273 617 003304 618 003311 619 003312 622 003323 623 003331 629 003345 630 003356 631 003362 632 003370 634 003415 637 003416 638 003421 640 003422 642 003423 645 003445 647 003446 649 003452 650 003456 652 003503 654 003504 656 003511 658 003512 660 003514 661 003520 663 003525 667 003535 669 003540 673 003567 677 003570 678 003572 680 003576 682 003615 685 003617 687 003625 689 003660 692 003661 693 003665 699 003671 701 003672 704 003673 706 003674 707 003702 708 003713 709 003717 710 003725 712 003752 714 003753 715 003754 719 003755 720 003757 722 003763 724 004002 727 004004 729 004012 731 004045 734 004046 735 004052 741 004056 743 004100 746 004102 749 004103 751 004106 755 004125 756 004144 758 004150 760 004160 765 004167 769 004170 776 004172 777 004175 778 004212 780 004217 781 004224 782 004266 783 004270 787 004300 791 004301 792 004316 793 004322 794 004332 795 004336 796 004344 798 004371 801 004372 806 004410 807 004433 809 004461 811 004466 813 004467 815 004507 816 004515 817 004521 818 004522 819 004530 820 004534 821 004535 823 004536 824 004540 826 004565 828 004566 830 004572 832 004614 834 004615 858 004616 893 004617 894 004621 895 004627 896 004633 897 004636 898 004643 899 004647 901 004671 907 004710 908 004711 911 004712 912 004716 914 004721 915 004734 916 004740 917 004745 918 004746 920 004750 922 004772 924 004774 926 004776 927 005003 928 005004 931 005006 934 005010 935 005016 939 005037 941 005041 942 005047 943 005053 945 005054 946 005056 949 005103 951 005104 952 005110 954 005111 956 005115 958 005121 960 005122 961 005124 962 005130 963 005136 965 005163 967 005164 968 005170 970 005171 971 005172 973 005174 977 005215 979 005217 980 005225 981 005231 983 005232 984 005234 987 005261 989 005262 991 005266 993 005267 994 005272 995 005305 997 005311 998 005316 999 005317 1002 005321 1004 005343 1006 005345 1007 005352 1008 005353 1011 005354 1012 005357 1013 005361 1016 005364 1018 005367 1020 005371 1021 005376 1022 005377 1025 005401 1029 005411 1031 005413 1033 005430 1036 005432 1038 005436 1040 005441 1042 005444 1045 005460 1046 005463 1047 005467 1048 005471 1050 005473 1051 005474 1053 005475 1056 005533 1058 005534 1060 005541 1061 005545 1062 005553 1064 005556 1066 005567 1069 005576 1070 005577 1071 005604 1073 005621 1079 005632 1080 005634 1081 005636 1082 005637 1088 005652 1090 005667 1092 005671 1093 005701 1094 005706 1095 005717 1096 005727 1098 005736 1099 005740 1101 005745 1103 005756 1104 005764 1105 005766 1107 005773 1111 006021 1115 006054 1116 006060 1119 006061 1120 006062 1121 006067 1122 006074 1123 006076 1124 006104 1125 006110 1126 006111 1128 006122 1129 006132 1131 006136 1132 006140 1133 006142 1143 006234 1145 006235 1147 006236 1148 006237 1150 006247 1152 006257 1154 006261 1156 006262 1158 006300 1160 006313 1165 006332 1168 006346 1170 006406 1171 006443 1173 006447 1174 006455 1175 006461 1179 006473 1181 006522 1183 006524 1186 006555 1188 006556 1190 006557 1191 006565 1192 006571 1194 006572 1197 006623 1200 006624 1235 006626 1236 006633 1239 006645 1241 006647 1243 006666 1246 006670 1247 006675 1248 006677 1249 006701 1251 006702 1254 006714 1258 006741 1260 006742 1261 006744 1262 006750 1264 006765 1266 006767 1267 006771 1268 006773 1273 007011 1274 007012 1276 007014 1279 007015 1284 007016 1287 007047 1290 007050 1291 007056 1294 007063 1296 007065 1299 007112 1301 007113 1302 007115 1304 007132 1306 007134 1309 007140 1312 007151 1318 007171 1321 007174 1322 007200 1324 007230 1327 007231 1328 007235 1329 007243 1331 007270 1333 007271 1336 007332 1337 007341 1338 007353 1339 007355 1340 007357 1341 007360 1342 007364 1343 007366 1344 007370 1345 007371 1346 007375 1347 007377 1348 007401 1349 007402 1350 007406 1351 007410 1352 007412 1354 007413 1356 007452 1358 007453 1360 007454 1362 007471 1364 007473 1369 007510 1370 007514 1374 007522 1375 007523 1376 007524 1377 007526 1378 007532 1379 007534 1381 007535 1383 007574 1386 007575 1387 007634 1388 007637 1389 007643 1391 007644 1393 007647 1394 007655 1397 007663 1400 007672 1405 007704 1408 007707 1409 007713 1412 007747 1416 007750 1418 007765 1421 007767 1422 007772 1423 007776 1424 010000 1425 010002 1426 010011 1427 010015 1429 010016 1433 010020 1435 010022 1437 010037 1440 010041 1441 010046 1442 010050 1446 010051 1448 010054 1449 010056 1450 010060 1451 010062 1453 010065 1454 010075 1455 010101 1459 010115 1464 010120 1465 010124 1468 010125 1472 010156 1475 010157 1477 010164 1478 010170 1479 010176 1482 010223 1484 010224 1485 010232 1487 010237 1488 010250 1491 010263 1492 010264 1493 010267 1494 010300 1495 010312 1497 010313 1500 010344 1502 010345 1505 010415 1507 010416 1509 010417 1511 010421 1512 010425 1514 010436 1515 010441 1517 010443 1518 010454 1519 010456 1520 010460 1521 010465 1523 010466 1525 010471 1527 010475 1529 010503 1530 010507 1533 010510 1535 010531 1537 010533 1539 010535 1540 010544 1541 010550 1544 010571 1546 010573 1548 010602 1550 010627 1552 010630 1553 010632 1555 010633 1556 010635 1558 010662 1561 010663 1562 010667 1565 010670 1203 010671 1207 010672 1210 010713 1212 010715 1216 010735 1218 010745 1220 010772 1222 010773 1224 011011 1226 011033 1228 011065 1230 011112 1232 011113 1570 011114 1579 011122 1581 011130 1586 011135 1594 011143 1596 011146 1598 011152 1600 011155 1602 011161 1608 011165 1621 011173 1624 011204 1628 011235 1630 011243 1636 011247 1642 011251 1643 011254 1646 011310 1648 011311 1650 011317 1653 011320 1658 011322 1659 011332 1661 011344 1664 011360 1665 011363 1670 011371 1679 011377 1680 011401 1681 011410 1682 011414 1683 011426 1686 011434 1688 011444 1690 011447 1692 011465 1695 011474 1696 011510 1697 011524 1698 011527 1700 011530 1702 011531 1711 011533 1712 011541 1713 011552 1714 011556 1715 011577 1718 011617 1721 011662 1723 011665 1724 011704 1727 011712 1729 011720 1731 011723 1733 011742 1736 011750 1742 012025 1743 012033 1744 012035 1745 012042 1746 012044 1747 012050 1748 012055 1751 012060 1752 012064 1753 012075 1754 012076 1762 012077 1767 012110 1771 012124 1773 012142 1776 012143 1790 012144 1793 012160 1794 012166 1796 012167 1797 012200 1799 012207 1802 012223 1803 012225 1804 012232 1805 012243 1806 012251 1807 012253 1808 012260 1809 012264 1810 012270 1813 012271 1815 012304 1818 012306 1819 012314 1820 012325 1821 012333 1822 012337 1824 012352 1826 012354 1827 012360 1828 012361 1831 012367 1834 012370 1837 012371 1838 012375 1840 012403 1841 012407 1842 012413 1844 012414 1845 012415 1847 012424 1848 012430 1849 012431 1851 012432 1852 012435 1854 012462 1856 012463 1859 012467 1862 012470 1868 012471 1870 012475 1873 012506 1874 012507 1875 012511 1876 012514 1877 012522 1878 012526 1879 012534 1880 012540 1885 012546 1886 012547 1887 012550 1888 012551 1889 012552 1891 012553 1893 012600 1895 012601 1897 012602 1900 012603 1904 012604 1910 012622 1912 012632 1914 012642 1916 012652 1918 012662 1920 012667 1922 012673 1924 012701 1925 012704 1926 012721 1929 012722 1931 012736 1932 012742 1933 012743 1935 013004 1936 013007 1937 013032 1940 013033 1942 013037 1944 013040 1948 013041 1950 013047 1951 013054 1954 013055 1959 013057 1961 013067 1962 013074 1965 013110 1968 013112 1970 013114 1974 013140 ----------------------------------------------------------- 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