COMPILATION LISTING OF SEGMENT display_data_ Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-17_1930.96_Mon_mdt Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* *********************************************************** */ 8 9 10 /****^ HISTORY COMMENTS: 11* 1) change(88-05-20,WAAnderson), approve(88-09-30,MCR7952), 12* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 13* Modified code in the internal procedure 'set_globals_for_probe' to allow 14* more than one level of indirection to be printed. Modified the internal 15* procedure 'get_symbol_name' to return a null string if the first character 16* in the name is a !. Modified the internal procedure 'do_symbol_and_sons' 17* to print a single value if the 'son_ptr' is not null, the symbol type is 18* pointer and the language is C. 19* 2) change(88-05-20,WAAnderson), approve(88-09-30,MCR7952), 20* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 21* Changed code in the internal proc 'set_globals_for_probe' to allow 22* various levels of C_INDIRECTION to be printed. Changed code in the 23* internal proc 'do_symbol_and_sons' to print only one symbol if: 24* A) the 'son_ptr' is not null, 25* B) the symbol type is pointer and 26* C) the language is C. 27* Modified the internal proc 'get_symbol_name' to strip off any leading 28* underscores in the symbol name. 29* 3) change(88-05-27,WAAnderson), approve(88-09-30,MCR7952), 30* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 31* Added code to test the reference node field 'subscript_ptr' for a 32* null value. This pointer is set to null when the reference node 33* represents the result of the & operator in C. 34* 4) change(88-06-01,WAAnderson), approve(88-09-30,MCR7952), 35* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 36* Changed 'get_string_info' to get the number of characters to be printed. 37* The length is determined by the character offset of the first null 38* character relative to the address supplied. If a null is not encountered 39* within the first 256 characters, 256 is used. 40* 5) change(88-07-20,WAAnderson), approve(88-09-30,MCR7952), 41* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 42* Modified 'get_value_info' to compute the offset of a structure element 43* and add it to the base address. 44* 6) change(88-07-20,WAAnderson), approve(88-09-30,MCR7952), 45* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 46* The 'globals.calculate_address' value is always set to "0"b in 47* 'set_globals_for_probe'. 48* 7) change(88-08-15,WAAnderson), approve(88-09-30,MCR7952), 49* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 50* Added code in 'get_value_info' to compute and add the offset of each array 51* element for symbols occuring within structures or unions but being 52* printed individually. 53* 8) change(88-08-26,WAAnderson), approve(88-09-30,MCR7952), 54* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 55* Added enum type support by including the procedure 'display_c_enum'. 56* 9) change(88-08-26,WAAnderson), approve(88-09-30,MCR7952), 57* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 58* Added support for subranges of aggregates. 59* 10) change(88-09-07,WAAnderson), approve(88-09-30,MCR7952), 60* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 61* Added format control comment to make the source more readable. 62* 11) change(88-10-28,WAAnderson), approve(88-10-28,MCR7952), 63* audit(88-11-03,RWaters), install(88-11-11,MR12.2-1210): 64* Added code to evaluate character pointers as decribed in the MTB. 65* 66* Consider the following declaration: 67* 68* char *ptr; 69* 70* The following are possilbe references to the pointer 'ptr' and the 71* manner in which the reference is interpreted by probe: 72* 73* *ptr - refers to a single character at the address specified 74* by the contents of 'ptr'. 75* ptr - refers to the address in 'ptr'. 76* ptr[] - refers to the contiguous series of characters beginning 77* with the character specified by the address in 'ptr' 78* and ending with the first occurence of a null. 79* ptr[N] - refers to the single character whose address is computed 80* by taking the contents of 'ptr' and adding N bytes to that 81* address. 82* ptr[N:M] - refers to the characters from ptr+N to ptr+M where 83* N and M are byte offsets. 84* 12) change(88-10-28,WAAnderson), approve(88-10-28,MCR7952), 85* audit(88-11-03,RWaters), install(88-11-11,MR12.2-1210): 86* Took the code immediately following the 'for_probe' entrypoint and made it 87* an internal procedure. Now the 'for_azm' and 'for_probe' entrypoints both 88* call this procedure. The 'for_azm' entrypoint passes a flag that indicates 89* the only action to take is initialize the variables referenced throughout 90* display_data_. The new procedure is called 'common_c_setup'. 91* END HISTORY COMMENTS */ 92 93 /* format: style1,insnl,ifthendo,indthenelse,^indnoniterdo,^inditerdo,indcom,^indthenbegin,^indprocbody,ind2,ll78,initcol0,dclind4,idind24,struclvlind1,comcol41 */ 94 95 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 96 97 display_data_: 98 proc (); 99 100 return; 101 102 /* * DISPLAY_DATA_ -- Display data according to runtime symbol table info. 103* * $FOR_PROBE -- Display all Multics language datatypes, for use by 104* * probe. 105* * $FOR_AZM -- Display PL/I datatypes, for use by analyze_multics, 106* * providing specialized interpretations as 107* * appropriate. 108* * 109* * Modification history: 110* * 04 Mar 85, Steve Herbst: 111* * Fixed some string-formatting bugs and reinstated printing fb>52 as 112* * dtm for azm. 113* * 27 Feb 85, Steve Herbst: 114* * Fixed to print null string as "". 115* * 29 Nov 84, Steve Herbst: 116* * Fixed to handle "size" by skipping to next structure element. 117* * 16 Jul 84, S. Herbst: 118* * Fixed $for_azm to set global.azm_info_ptr from input arg 119* * (ala azm_display_data_). 120* * 24 Jun 84, B. Braun: 121* * Fixed bug incorrectly reporting the base addr of a substructure. 122* * 21 May 84, S. Herbst: 123* * "modes truncate_strings", do truncation & trimming to all lang 124* * strings. 125* * 09 Feb 84, S. Herbst: 126* * Changed to handle hexfp, extended, generic types. 127* * 02 Nov 83, S. Herbst: 128* * Fixed bug that reversed array indices while printing. 129* * 11 Oct 83, S. Herbst: 130* * Changed algorithm for printing duplicate array elements - 131* * "A (n) and/through A (m) = value" 132* * 06 Oct 83, S. Herbst: 133* * Added version strings to runtime_symbol_info_ structures. 134* * 14 Aug 83, WOS: 135* * Retrofitted Pascal changes into display_data_. Required fixing 136* * all places where "constant" symbols might be referenced to check 137* * for value_symbol_ptr = null. 138* * 03 Aug 83, WOS: 139* * Renamed entypoints to display_data_$for_probe, $for_azm. 140* * 20 Jun 83, J. M. Athane: 141* * Modified for Pascal (as probe_print_value_). Calls 142* * probe_print_pascal_$value for typical Pascal values. Uses 143* * runtime_symbol_info_ subroutine instead of runtime_symbol 144* * structure. 145* * 11 Jun 83, WOS: 146* * Added "apropos" feature (matching names) 147* * 10 Jun 83, WOS: 148* * Added bit(1) summary output for azm, fixed integers to display 149* * with full precision, added clock heuristic for azm and long 150* * integers. 151* * 09 Jun 83, WOS: 152* * Added compact output mode for azm. 153* * 04 Jun 83, WOS: 154* * Added duplicate suppression for arrays. 155* * 02 Jun 83, WOS: 156* * Merged constant printing back into main line so constants could 157* * be printed using the usual heuristics. 158* * 01 Jun 83, WOS: 159* * Clever (octal/hex) bitstring printer. 160* * 31 May 83, WOS: 161* * Converted to display_data_ for analyze_multics. 162* * 01 Jan 83, S. Herbst: 163* * Limit string printout to 200 characters. 164* * 27 Jul 82, S. Herbst: 165* * Diagnose zero extent arrays. 166* * 26 Apr 82, S. Herbst: 167* * Display strings properly for Fortran (using " or '). 168* * 17 Dec 81, S. Herbst: 169* * Check for overlength (out of bounds) string lengths. 170* * 28 Sep 81, S. Herbst: 171* * Diagnose invalid refer extents (<= 0). 172* * 09 Sep 81, S. Herbst: 173* * Print formerly inhibited subscripts for non-top-level structure 174* * references. 175* * 24 Aug 81, Steve Herbst: 176* * Requote character strings, fix bugs. 177* * 31 Jul 81, Melanie B. Weaver: 178* * Print names of algol68 data types. 179* * 15 Sep 79, JRD: 180* * Treat constants differently from symbols, COBOL fixes, allow 181* * negative scale factor. 182* * 12 Jul 79, JRD: 183* * For 4.2 probe. 184* * 01 Jun 79, JRD: 185* * Abbreviate [pd] for pointers. 186* * 08 Mar 79, JRD: 187* * Remember that precision of strings may exceed 16383. 188* * 12 Jan 79, JRD: 189* * First real probe version. 190* * 22 Sep 78, James R. Davis: 191* * Initial coding. 192* */ 193 194 dcl P_iocb_ptr parameter pointer; 195 dcl P_display_format parameter bit (*) aligned; 196 dcl P_match_names (*) parameter char (*) varying; 197 dcl P_match_name_count parameter fixed bin; 198 dcl P_amu_info_ptr parameter pointer; 199 dcl P_data_ptr parameter pointer; 200 dcl P_data_size parameter fixed bin (18); 201 dcl P_start_ptr parameter pointer; 202 dcl P_symbol_ptr parameter pointer; 203 dcl P_subscripts (2, *) parameter fixed bin (24); 204 dcl P_n_subscripts parameter fixed bin; 205 dcl P_code parameter fixed bin (35); 206 dcl P_probe_info_ptr parameter pointer; 207 dcl 1 P_reference parameter aligned like reference_node; 208 209 dcl STRING_LIMIT fixed bin internal static 210 options (constant) init (200); 211 dcl MINIMUM_TRIM fixed bin internal static 212 options (constant) init (20); 213 214 dcl 1 global aligned automatic, 215 /* Global info for internal procedures */ 216 2 output_info aligned, /* Info about output format */ 217 3 output_switch pointer init (null ()), 218 /* Switch for printing */ 219 3 line_length fixed bin init (72), 220 /* max length of output lines */ 221 3 short_names bit (1) aligned init ("0"b), 222 /* whether to print names in short form or long form */ 223 3 compress_output bit (1) aligned init ("0"b), 224 /* whether to collect bits, put multiple things on a line */ 225 3 use_match_names bit (1) aligned init ("0"b), 226 /* whether to pay attention to P_match_names */ 227 228 2 amu_info_ptr pointer init (null ()), 229 /* name/address translation info for $for_azm */ 230 2 orig_symbolp pointer init (null ()), 231 /* pointer to original symbol node */ 232 2 blockp pointer init (null ()), 233 /* block symbol was dcl 'd in */ 234 235 2 base_ptr pointer init (null ()), 236 /* the original address of the data */ 237 2 max_offset fixed bin (18) init (262143), 238 /* Maximum offset allowed for data */ 239 2 start_ptr pointer init (null ()), 240 /* The alleged address where the display started */ 241 2 n_orig_indices fixed bin,/* Number of original indices we were given */ 242 243 2 stackp pointer init (null ()), 244 /* to the stack frame for this variable */ 245 2 linkp pointer init (null ()), 246 /* to the Linkage section */ 247 248 2 probe_options aligned, /* Things used only by probe */ 249 3 language_type fixed bin init (PL1_lang_type), 250 /* language type for deciding how to print things */ 251 3 probe_sw bit (1) aligned init ("0"b), 252 /* "1"b => probe_print_value_ */ 253 3 octal_sw bit (1) aligned init ("0"b), 254 /* if we print in octal */ 255 3 invert_sw bit (1) aligned init ("0"b), 256 /* FORTRAN arrays are backwards */ 257 3 calculate_address bit (1) aligned init ("0"b), 258 /* used to decide to print name */ 259 3 truncate_strings bit (1) aligned init ("0"b), 260 /* probe "mode truncate_strings" */ 261 3 print_names bit (1) aligned init ("0"b), 262 /* whether to print symbol names */ 263 3 no_handle_faults_sw bit (1) aligned init ("0"b), 264 /* whether to allow "size" to be signalled */ 265 266 2 variable_info aligned, /* Things which vary as we traverse structures and arrays */ 267 3 n_bounds fixed bin,/* Number of total array bounds in use */ 268 3 bounds (2, 16) fixed bin (24), 269 /* Current array bounds */ 270 3 indices (16) fixed bin (24), 271 /* full subscripts needed to get address */ 272 273 3 father (64) pointer; 274 /* to symbol node for every level of a structure */ 275 276 dcl 1 output_info_template aligned internal static options (constant), 277 /* Information about output buffering */ 278 2 header aligned, 279 3 on_bits, /* pointers to the lsits of bit names */ 280 4 first pointer init (null ()), 281 /* for printing when we've finished */ 282 4 last pointer init (null ()), 283 3 off_bits, 284 4 first pointer init (null ()), 285 4 last pointer init (null ()), 286 287 2 buffer char (300) varying init (""); 288 /* The actual buffer */ 289 290 dcl dont_print_me_this_time bit (1); 291 292 dcl 1 bit_buffer aligned based, 293 /* Structure used when accumulating bits */ 294 2 str char (300) varying, 295 2 next pointer; 296 297 dcl 1 global_output_info aligned like output_info_template automatic; 298 299 dcl error_code fixed bin (35); 300 /* global error code */ 301 dcl done_with_pascal bit (1); /* return value from probe_print_pascal_$value */ 302 dcl level_1_c_struct_ndims fixed bin; 303 dcl level_1_c_struct_dims_ptr 304 ptr; 305 dcl print_the_data bit (1); 306 dcl double_override bit (1); 307 308 dcl system_area_ptr pointer; 309 dcl system_area area aligned based (system_area_ptr); 310 311 dcl probe_et_$dim_limit fixed bin (35) external static; 312 dcl probe_et_$recorded_message 313 fixed bin (35) external static; 314 dcl probe_et_$no_address fixed bin (35) external static; 315 316 dcl iox_$user_output pointer external static; 317 dcl sys_info$max_seg_size fixed bin (19) external static; 318 319 dcl probe_error_$record entry options (variable); 320 dcl get_size_in_bits_ entry (fixed bin, fixed bin (35), 321 bit (1) aligned) returns (fixed bin); 322 dcl probe_increment_indices_ 323 entry (bit (1) aligned, (*) fixed bin (24), 324 (2, *) fixed bin (24), fixed bin, 325 bit (1) aligned, bit (1) aligned); 326 dcl probe_modes_mgr_$excludep 327 entry (pointer, pointer) 328 returns (bit (1) aligned); 329 dcl probe_print_pascal_$value 330 entry (pointer, pointer, fixed bin (35), 331 bit (1)); 332 333 dcl assign_$computational_ entry (ptr, ptr, fixed bin (35)); 334 dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, 335 char (100) aligned); 336 dcl date_time_$format entry (char (*), fixed bin (71), char (*), 337 char (*)) returns (char (250) var); 338 dcl display_file_value_ entry (pointer, file, fixed bin (35)); 339 dcl format_pointer_$its entry (pointer, bit (1) aligned, pointer) 340 returns (char (256) varying); 341 dcl format_pointer_$packed entry (unaligned pointer, bit (1) aligned, 342 pointer) returns (char (256) varying); 343 dcl get_line_length_$switch entry (pointer, fixed bin (35)) 344 returns (fixed bin); 345 dcl get_system_free_area_ entry () returns (pointer); 346 dcl ioa_$ioa_switch entry options (variable); 347 dcl ioa_$ioa_switch_nnl entry options (variable); 348 dcl ioa_$rsnnl entry options (variable); 349 dcl requote_string_ entry (char (*)) returns (char (*)); 350 dcl stu_$block_dcld_in entry (pointer) returns (pointer); 351 dcl stu_$decode_runtime_value_extended 352 entry (fixed bin (35), 353 pointer, pointer, pointer, pointer, pointer, 354 pointer, fixed bin (35)) 355 returns (fixed bin (35)); 356 dcl stu_$get_runtime_address 357 entry (pointer, pointer, 358 pointer, pointer, pointer, pointer, pointer) 359 returns (pointer); 360 dcl stu_$offset_to_pointer entry (pointer, pointer, 361 pointer, pointer, pointer, pointer) 362 returns (pointer); 363 dcl stu_$find_runtime_symbol 364 entry (ptr, char (*) aligned, ptr, fixed bin) 365 returns (pointer); 366 dcl valid_decimal_ entry (fixed bin, pointer, fixed bin (35)) 367 returns (bit (1) aligned); 368 369 dcl TOP_LEVEL bit (1) aligned internal static 370 options (constant) init ("1"b); 371 dcl NOT_TOP_LEVEL bit (1) aligned internal static 372 options (constant) init ("0"b); 373 374 dcl (addr, addrel, binary, character, clock, convert, copy, divide, high) 375 builtin; 376 dcl (hbound, fixed, index, length, low, ltrim, max, maxlength, min, mod) 377 builtin; 378 dcl (null, nullo, pointer, rel, rtrim, substr, translate, unspec) 379 builtin; 380 381 dcl (conversion, overflow, sub_error_) 382 condition; 383 384 385 386 common_c_setup: 387 proc (azm_entry); 388 389 dcl azm_entry bit (1); 390 dcl temp_stuff_ptr ptr; 391 392 double_override = "0"b; 393 394 if P_code = 1 | P_reference.flags.c_sub_c_ptr then do; 395 print_the_data = "1"b; 396 double_override = "1"b; 397 P_code = 0; 398 end; 399 else print_the_data = "0"b; 400 401 level_1_c_struct_ndims = 0; 402 level_1_c_struct_dims_ptr = null (); 403 404 if (azm_entry | P_probe_info_ptr->probe_info.language_type ^= C_lang_type) 405 then return; 406 407 if (P_reference.symbol_ptr ^= null ()) then do; 408 temp_stuff_ptr = P_reference.symbol_ptr; 409 do while (fixed (temp_stuff_ptr -> runtime_symbol.type) = pointer_dtype 410 | 411 fixed (temp_stuff_ptr -> runtime_symbol.type) = c_typeref_dtype); 412 temp_stuff_ptr = 413 addrel (temp_stuff_ptr, 414 fixed (temp_stuff_ptr -> runtime_symbol.son)); 415 end; 416 if fixed (temp_stuff_ptr -> runtime_symbol.type) = structure_dtype | 417 fixed (temp_stuff_ptr -> runtime_symbol.type) = c_union_dtype 418 then 419 double_override = "1"b; 420 if ((fixed (P_reference.symbol_ptr -> runtime_symbol.type) 421 = structure_dtype | 422 fixed (P_reference.symbol_ptr -> runtime_symbol.type) 423 = c_union_dtype) & 424 P_probe_info_ptr -> probe_info.language_type = C_lang_type & 425 P_reference.n_subscripts = 0) then do; 426 427 begin; 428 429 dcl nameptr ptr; 430 dcl steps fixed bin; 431 dcl found_ptr ptr; 432 dcl t_ptr ptr; 433 434 nameptr = 435 addrel (P_reference.symbol_ptr, 436 fixed (P_reference.symbol_ptr -> runtime_symbol.name)); 437 if (P_reference.name 438 ^= 439 substr (nameptr -> acc.string, 1, nameptr -> acc.num_chars)) 440 then do; 441 t_ptr = 442 stu_$find_runtime_symbol (P_reference.source_info_ptr 443 -> source_info.block_ptr, (P_reference.name), found_ptr, 444 steps); 445 if (t_ptr ^= null ()) 446 then 447 if (^t_ptr -> runtime_symbol.bits.simple) then do; 448 level_1_c_struct_ndims = 449 convert (level_1_c_struct_ndims, 450 t_ptr -> runtime_symbol.ndims); 451 level_1_c_struct_dims_ptr = t_ptr; 452 end; 453 end; 454 end; 455 end; 456 end; 457 458 end common_c_setup; 459 460 display_data_$for_azm: 461 entry (P_iocb_ptr, P_display_format, P_match_names, P_match_name_count, 462 P_amu_info_ptr, 463 P_data_ptr, P_data_size, P_start_ptr, P_symbol_ptr, 464 P_subscripts, P_n_subscripts, P_code); 465 466 call common_c_setup ("1"b); /* "0"b for probe, "1"b for azm */ 467 call set_globals_for_azm (); 468 goto COMMON; 469 470 471 472 display_data_$for_probe: 473 entry (P_probe_info_ptr, P_reference, P_code); 474 475 call common_c_setup ("0"b); /* "0"b for probe, "1"b for azm */ 476 call set_globals_for_probe (); 477 478 if (probe_info.language_type = PASCAL_lang_type) then do; 479 call probe_print_pascal_$value (probe_info_ptr, addr (P_reference), 480 P_code, done_with_pascal); 481 if done_with_pascal 482 then return; /* Otherwise, fall through and do our usual thing */ 483 end; 484 485 goto COMMON; 486 487 488 COMMON: 489 system_area_ptr = get_system_free_area_ (); 490 491 global.line_length = get_line_length_$switch (global.output_switch, (0)); 492 493 global_output_info.header = output_info_template.header; 494 global_output_info.buffer = copy (" ", 2); 495 496 dont_print_me_this_time = "0"b; 497 498 if (level_1_c_struct_ndims > 0) then do; 499 begin; 500 501 dcl inxs (level_1_c_struct_ndims) fixed bin; 502 dcl (level_1_c_struct_inx0, level_1_c_struct_inx1, 503 level_1_c_struct_inx2) 504 fixed bin; 505 dcl total_number_of_elements 506 fixed bin; 507 508 inxs (*) = 0; 509 total_number_of_elements = 0; 510 do level_1_c_struct_inx0 = 1 to level_1_c_struct_ndims; 511 total_number_of_elements = 512 total_number_of_elements 513 + level_1_c_struct_dims_ptr 514 -> runtime_symbol.bounds (level_1_c_struct_inx0).upper + 1; 515 end; 516 517 P_reference.address_ptr = 518 addrel (P_reference.address_ptr, -1 * 519 divide (level_1_c_struct_dims_ptr 520 -> runtime_symbol.bounds (1).multiplier, 521 36, 17, 0)); 522 523 do level_1_c_struct_inx0 = 1 to total_number_of_elements; 524 call ioa_$ioa_switch_nnl (probe_info.output_switch, "^/^a ", 525 P_reference.name); 526 do level_1_c_struct_inx1 = 1 to level_1_c_struct_ndims; 527 call ioa_$ioa_switch_nnl (probe_info.output_switch, "[^d]", 528 inxs (level_1_c_struct_inx1)); 529 end; 530 P_reference.address_ptr = 531 addrel (P_reference.address_ptr, 532 divide (level_1_c_struct_dims_ptr 533 -> runtime_symbol.bounds (1).multiplier, 534 36, 17, 0)); 535 536 dont_print_me_this_time = "1"b; 537 538 call print_symbol (global.orig_symbolp, 539 global.n_orig_indices, TOP_LEVEL, addr (global_output_info), 540 (P_reference.address_ptr)); 541 542 inxs (level_1_c_struct_ndims) = inxs (level_1_c_struct_ndims) + 1; 543 level_1_c_struct_inx2 = level_1_c_struct_ndims; 544 do while (level_1_c_struct_inx2 > 0); 545 if inxs (level_1_c_struct_inx2) 546 > level_1_c_struct_dims_ptr 547 -> runtime_symbol.bounds (level_1_c_struct_inx2).upper 548 then do; 549 inxs (level_1_c_struct_inx2) = 0; 550 if (level_1_c_struct_inx2 > 1) 551 then 552 inxs (level_1_c_struct_inx2 - 1) = 553 inxs (level_1_c_struct_inx2 - 1) + 1; 554 end; 555 level_1_c_struct_inx2 = level_1_c_struct_inx2 - 1; 556 end; 557 end; 558 end; 559 end; 560 561 else call print_symbol (global.orig_symbolp, 562 global.n_orig_indices, TOP_LEVEL, addr (global_output_info), 563 (P_reference.address_ptr)); 564 565 P_code = 0; 566 return; 567 568 569 FATAL_ERROR: 570 P_code = error_code; 571 return; 572 573 set_globals_for_azm: 574 proc (); 575 576 577 dcl idx fixed bin; 578 579 580 global.output_switch = P_iocb_ptr; 581 if (global.output_switch = null ()) 582 then global.output_switch = iox_$user_output; 583 584 global.amu_info_ptr = P_amu_info_ptr; 585 global.probe_sw = "0"b; 586 global.octal_sw = "0"b; /* azm never uses silly probe octal hack */ 587 global.invert_sw = "0"b; /* azm always uses PL/I subscripts */ 588 589 global.base_ptr = P_data_ptr; 590 global.max_offset = binary (rel (P_data_ptr), 18) + P_data_size - 1; 591 global.start_ptr = P_start_ptr; 592 593 global.language_type = PL1_lang_type; 594 global.stackp = null (); /* Can't use these, 'cause stu_ can't hack with amu_ */ 595 global.linkp = null (); 596 597 global.blockp = stu_$block_dcld_in (P_symbol_ptr); 598 global.orig_symbolp = P_symbol_ptr; 599 600 global.calculate_address = "1"b; /* Since we're always doing structures */ 601 global.truncate_strings = "0"b; 602 global.print_names = "1"b; /* Actually, we mimic probe "short" mode */ 603 global.short_names = "1"b; 604 605 global.no_handle_faults_sw = "0"b; 606 607 global.n_bounds = P_n_subscripts; 608 global.n_orig_indices = P_n_subscripts; 609 610 do idx = 1 to global.n_bounds; 611 global.bounds (*, idx) = P_subscripts (*, idx); 612 global.indices (idx) = global.bounds (1, idx); 613 end; 614 615 call set_display_format (1, global.compress_output); 616 617 global.use_match_names = "0"b; 618 if (hbound (P_match_names, 1) > 0) & (P_match_name_count > 0) 619 then 620 if (P_match_names (1) ^= "") then do; 621 global.use_match_names = "1"b; 622 global.short_names = "0"b; 623 end; 624 return; 625 626 end set_globals_for_azm; 627 628 set_display_format: 629 proc (P_bit_idx, P_bit); 630 631 632 dcl P_bit_idx fixed bin parameter; 633 dcl P_bit bit (1) aligned parameter; 634 635 if (P_bit_idx <= length (P_display_format)) 636 then 637 P_bit = substr (P_display_format, P_bit_idx, 1); 638 else P_bit = "0"b; 639 return; 640 641 end set_display_format; 642 643 set_globals_for_probe: 644 proc (); 645 646 647 dcl idx fixed bin; 648 649 dcl 1 ref_subscripts aligned based (P_reference.subscript_ptr) 650 like reference_subscripts; 651 652 653 probe_info_ptr = P_probe_info_ptr; 654 655 global.output_switch = probe_info.output_switch; 656 657 global.probe_sw = "1"b; 658 global.octal_sw = P_reference.flags.octal; 659 global.blockp = P_reference.source_info_ptr -> source_info.block_ptr; 660 661 if global.blockp ^= null 662 then 663 global.invert_sw = global.blockp -> runtime_block.fortran; 664 else global.invert_sw = "0"b; /* we wont have arrays, anyway, but be safe */ 665 666 global.stackp = P_reference.source_info_ptr -> source_info.stack_ptr; 667 global.linkp = 668 P_reference.source_info_ptr -> source_info.seg_info_ptr 669 -> seg_info.linkage_ptr; 670 671 global.base_ptr = P_reference.base_addr; 672 global.max_offset = 262143; /* We don't get told where it ends */ 673 global.start_ptr = global.base_ptr; 674 global.orig_symbolp = P_reference.symbol_ptr; 675 global.language_type = probe_info.language_type; 676 677 if (global.orig_symbolp = null ()) 678 then /* For probe builtins, etc. */ 679 global.calculate_address = "0"b; 680 else if P_reference.cross_section & probe_info.language_type ^= C_lang_type 681 then 682 global.calculate_address = "1"b; 683 else if (P_reference.type = structure_dtype 684 & probe_info.language_type ^= C_lang_type) 685 then 686 global.calculate_address = "1"b; 687 else if ((P_reference.type = structure_dtype | 688 P_reference.type = c_union_dtype) /* union */ & 689 probe_info.language_type = C_lang_type) 690 then 691 global.calculate_address = "0"b; 692 else if (runtime_symbol_info_$son (global.orig_symbolp) ^= null ()) & 693 (probe_info.language_type ^= PASCAL_lang_type) & 694 (probe_info.language_type ^= C_lang_type) 695 then 696 /* Don't chase the sons of pointers in C */ 697 global.calculate_address = "1"b; 698 /* COBOL structure, probably */ 699 else global.calculate_address = "0"b; 700 if P_reference.symbol_ptr = null () 701 then /* No symbol? Won't work, nohow */ 702 global.print_names = "0"b; 703 else if P_reference.flags.constant 704 then /* constants have no names */ 705 global.print_names = "0"b; 706 else if (probe_modes.value_print = LONG_mode_type) 707 then 708 global.print_names = "1"b; /* ALWAYS */ 709 else if (probe_modes.value_print = SHORT_mode_type) 710 then 711 global.print_names = global.calculate_address; 712 else global.print_names = "0"b; /* NEVER (brief mode) */ 713 714 global.truncate_strings = probe_modes.truncate_strings; 715 if (probe_modes.qualification = BRIEF_mode_type) 716 then 717 global.short_names = "1"b; 718 else if (probe_modes.qualification = SHORT_mode_type) 719 then 720 global.short_names = "1"b; 721 else if (probe_info.language_type = COBOL_lang_type) 722 then 723 global.short_names = "1"b; /* Always short for COBOL, though I have no idea why */ 724 else global.short_names = "0"b; 725 726 global.use_match_names = "0"b; 727 728 global.no_handle_faults_sw = 729 probe_info.static_info_ptr -> probe_static_info.no_handle_faults_sw; 730 731 if probe_info.language_type ^= PASCAL_lang_type 732 & P_reference.subscript_ptr ^= null () 733 then 734 do idx = 1 to ref_subscripts.number; 735 if (P_reference.n_subscripts = 0) 736 & (ref_subscripts.value (2, idx) < ref_subscripts.value (1, idx)) 737 then 738 call ioa_$ioa_switch (global.output_switch, 739 "Warning: extent ^d is zero.", idx); 740 global.indices (idx) = ref_subscripts.value (1, idx); 741 global.bounds (1, idx) = ref_subscripts.value (1, idx); 742 if ^P_reference.cross_section 743 then /* Since only first subscript will be set in this case */ 744 global.bounds (2, idx) = ref_subscripts.value (1, idx); 745 else global.bounds (2, idx) = ref_subscripts.value (2, idx); 746 end; 747 748 if (P_reference.subscript_ptr ^= null ()) then do; 749 global.n_bounds = ref_subscripts.number; 750 global.n_orig_indices = ref_subscripts.number; 751 end; 752 else do; 753 global.n_bounds = 0; 754 global.n_orig_indices = 0; 755 end; 756 return; 757 758 end set_globals_for_probe; 759 760 ref_node_not_struct_or_union: 761 proc () returns (bit (1)); 762 dcl t_ptr ptr; 763 764 if (probe_info.language_type ^= C_lang_type) 765 then return ("0"b); 766 767 t_ptr = P_reference.symbol_ptr; 768 if t_ptr = null 769 then return ("0"b); 770 771 do while (fixed (t_ptr -> runtime_symbol.type) = pointer_dtype | 772 fixed (t_ptr -> runtime_symbol.type) = c_typeref_dtype); 773 t_ptr = addrel (t_ptr, fixed (t_ptr -> runtime_symbol.son)); 774 end; 775 if (fixed (t_ptr -> runtime_symbol.type) = structure_dtype) 776 then return ("0"b); 777 else if (fixed (t_ptr -> runtime_symbol.type) = c_union_dtype) 778 then return ("0"b); 779 return ("1"b); 780 781 end ref_node_not_struct_or_union; 782 783 print_symbol: 784 proc (P_value_symbol_ptr, P_inherited_dims, P_top_level_sw, 785 P_output_info_ptr, inherited_addr); 786 787 788 /* This is the interface to the actual data display routine. We may be 789* printing a structure, in which case the necessary recursive tree walking 790* is here-in implemented. This involves printing full cross-sections of 791* any arrays we run into. */ 792 793 dcl P_value_symbol_ptr pointer parameter; 794 /* to runtime_symbol node */ 795 dcl P_inherited_dims fixed bin parameter; 796 dcl P_top_level_sw bit (1) aligned parameter; 797 dcl P_output_info_ptr pointer parameter; 798 dcl inherited_addr pointer parameter; 799 dcl 1 parent_output_info aligned like output_info_template 800 based (P_output_info_ptr); 801 802 /* This is all global information about the value we're going to print; mostly, 803* it gets inherited by display_single_value. */ 804 805 dcl (value_symbol_ptr, previous_value_symbol_ptr, this_value_symbol_ptr) 806 pointer; 807 dcl (value_ptr, previous_value_ptr, this_value_ptr) 808 pointer; 809 dcl 1 (value_info, previous_value_info, this_value_info) 810 like runtime_type_info; 811 /* NOTE: This must be dcld without explicit alignment */ 812 dcl 1 (value_data_info, previous_value_data_info, this_value_data_info) 813 aligned like data_type_info_$info; 814 dcl (previous_value_indices, this_value_indices) 815 (16) fixed bin (24); 816 /* copies of global.indices */ 817 dcl value_name char (256) varying; 818 dcl (previous_value_name, this_value_name, starting_name) 819 char (256); 820 dcl (previous_real_value_ptr, real_value_ptr) 821 pointer; /* If we're working on a copy, this is the real address */ 822 823 dcl ndims fixed bin;/* total number of dims we have */ 824 dcl my_dims fixed bin;/* how many dims we have originated */ 825 dcl first_dim fixed bin; 826 dcl my_bounds (2, 16) fixed bin (24); 827 dcl (ele_num, levels_of_pointer_indir) 828 fixed bin; 829 dcl my_father_is_a_typeref bit (1); 830 dcl override bit (1); 831 dcl my_real_name_ptr ptr; 832 833 /* This is a general-purpose buffer for collecting output. It's dcld here 834* only in order to avoid having multiple copies of it in loads of internal 835* procedures. It should always be filled and written immediately. */ 836 837 dcl value_str char (500) varying; 838 dcl old_value_symbol_ptr ptr; 839 dcl fixed builtin; 840 841 ele_num = 0; 842 my_father_is_a_typeref = "0"b; 843 my_real_name_ptr = null (); 844 value_symbol_ptr = P_value_symbol_ptr; 845 846 /* First, check for probe constants. A probe constant is a value constructed 847* by probe as the result of an expression. It has no symbol node associated 848* with it (which is how we tell what it is), never has dimensions, and only 849* uses a restricted set of datatypes. Thus, we catch it the first time here 850* and just return. This is done here because display_single_value is quick, 851* and internal to print_symbol. This check is only made when the entrypoint 852* for probe is called; otherwise, it is an error. */ 853 854 if global.probe_sw & (value_symbol_ptr = null ()) then do; 855 /* Probe constant */ 856 call display_probe_constant (); 857 return; /* All done */ 858 end; 859 860 if ^global.no_handle_faults_sw 861 then 862 on size 863 begin; /* if "size" occurs, skip to next element */ 864 call ioa_$ioa_switch (global.output_switch, 865 "Size condition occurred evaluating ^a", 866 get_unsubscripted_name ()); 867 go to PRINT_SYMBOL_RETURN; 868 end; 869 870 call setup_subscripts (); 871 872 levels_of_pointer_indir = 0; 873 my_father_is_a_typeref = "0"b; 874 my_real_name_ptr = null (); 875 old_value_symbol_ptr = value_symbol_ptr; 876 override = "0"b; 877 do while ((fixed (value_symbol_ptr -> runtime_symbol.type) = pointer_dtype | 878 fixed (value_symbol_ptr -> runtime_symbol.type) = c_typeref_dtype) & 879 probe_info.language_type = C_lang_type); 880 if (my_real_name_ptr = null ()) then do; 881 my_real_name_ptr = value_symbol_ptr; 882 my_father_is_a_typeref = "1"b; 883 end; 884 if (fixed (value_symbol_ptr -> runtime_symbol.type) = pointer_dtype) 885 then 886 levels_of_pointer_indir = levels_of_pointer_indir + 1; 887 value_symbol_ptr = 888 addrel (value_symbol_ptr, 889 fixed (value_symbol_ptr -> runtime_symbol.son)); 890 if (fixed (value_symbol_ptr -> runtime_symbol.type) = char_dtype 891 & ^P_reference.flags.c_sub_c_ptr & ^double_override) 892 then 893 override = "1"b; 894 end; 895 if (levels_of_pointer_indir > 0 & (^print_the_data | override) 896 & probe_info.language_type = C_lang_type) then do; 897 value_symbol_ptr = old_value_symbol_ptr; 898 levels_of_pointer_indir = 0; 899 end; 900 901 override = "0"b; 902 call print_cross_section (); 903 904 if P_top_level_sw 905 then /* If this is the end, finish it */ 906 call finish_output (addr (parent_output_info), "1"b); 907 908 PRINT_SYMBOL_RETURN: 909 return; 910 911 setup_subscripts: 912 proc (); 913 914 915 dcl idx fixed bin;/* do loop index only */ 916 dcl symbol_ptr ptr; /* pointer to symbol node */ 917 dcl my_idx fixed bin; 918 dcl symbol_level fixed bin; 919 dcl first_level fixed bin; 920 921 922 923 ndims = runtime_symbol_info_$array_dims (value_symbol_ptr); 924 925 if (probe_info.language_type = C_lang_type & ndims = 0) then do; 926 my_dims = 0; 927 return; 928 end; 929 930 if (ndims > hbound (global.indices, 1)) then do; 931 /* Too many dimensions to print successfully */ 932 error_code = probe_et_$dim_limit; 933 goto FATAL_ERROR; 934 end; 935 936 if P_top_level_sw 937 then /* Use any that we got from our caller */ 938 my_dims = ndims; /* without disturbing those parts of global.bounds */ 939 else my_dims = ndims - P_inherited_dims; 940 /* how many do we contribute */ 941 942 first_dim = ndims - my_dims + 1; /* First one we manipulate */ 943 944 /* What follows here is a gross kludge, because runtime_array_info does not use refer extents properly, 945* or even have its variable extent named reasonably. Instead, it is called n_dims, no doubt to the 946* great confusion of all concerned. */ 947 948 n_dims = ndims; /* Hope that scope-of-names works */ 949 950 begin; 951 952 dcl 1 value_array_info like runtime_array_info; 953 /* ADJUSTABLE AUTOMATIC */ 954 /* NOTE: This must be dcld without explicit alignment */ 955 956 value_array_info.version = RUNTIME_ARRAY_INFO_VERSION_1; 957 958 call runtime_symbol_info_$array (value_symbol_ptr, 959 addr (value_array_info), error_code); 960 if error_code ^= 0 961 then call cannot_get_address (); 962 963 do idx = (P_inherited_dims + 1) to ndims; 964 /* Fill in our own bounds */ 965 global.bounds (1, idx) = decode (value_array_info.bounds (idx).lower, 966 value_array_info.bounds (idx).lower_is_encoded); 967 global.bounds (2, idx) = decode (value_array_info.bounds (idx).upper, 968 value_array_info.bounds (idx).upper_is_encoded); 969 global.indices (idx) = global.bounds (1, idx); 970 end; 971 972 end; /* Kludge begin block */ 973 974 my_idx = 1; /* Copy the appropriate part of the global bounds */ 975 do idx = first_dim to ndims; /* and index info into our local copies */ 976 my_bounds (*, my_idx) = global.bounds (*, idx); 977 978 if (my_bounds (2, my_idx) < my_bounds (1, my_idx)) 979 then 980 call ioa_$ioa_switch (global.output_switch, 981 "Warning: extent ^d of ^a is zero.", 982 idx, get_unsubscripted_name ()); 983 my_idx = my_idx + 1; 984 end; 985 986 if P_top_level_sw 987 then first_level = 1; 988 else first_level = runtime_symbol_info_$level (value_symbol_ptr); 989 symbol_level = max (1, runtime_symbol_info_$level (value_symbol_ptr)); 990 991 symbol_ptr = value_symbol_ptr; 992 993 do idx = symbol_level to first_level by -1; 994 global.father (idx) = symbol_ptr; 995 symbol_ptr = runtime_symbol_info_$father (symbol_ptr); 996 end; 997 return; 998 999 end setup_subscripts; 1000 1001 decode: 1002 proc (encoded_val, is_encoded) returns (fixed bin (35)); 1003 1004 1005 dcl encoded_val fixed bin (35) parameter; 1006 dcl is_encoded bit (1) unaligned parameter; 1007 1008 dcl result fixed bin (35); 1009 1010 1011 if ^is_encoded 1012 then 1013 return (encoded_val); 1014 1015 result = stu_$decode_runtime_value_extended (encoded_val, 1016 global.blockp, global.stackp, global.linkp, 1017 pointer (global.blockp, 0), global.base_ptr, value_symbol_ptr, 1018 error_code); 1019 1020 if (error_code ^= 0) & ^global.probe_sw then do; 1021 call ioa_$ioa_switch (global.output_switch, 1022 "^5x^vxerror: Cannot decode size/bounds of ^a.", 1023 indentation (), get_unsubscripted_name ()); 1024 error_code = 0; /* There's no sensible code here; let our caller */ 1025 goto FATAL_ERROR; /* think it worked, since there's nothing to do */ 1026 end; 1027 1028 else if (error_code ^= 0) 1029 then goto FATAL_ERROR; /* Let probe figure it out */ 1030 return (result); 1031 1032 end decode; 1033 1034 display_probe_constant: 1035 proc (); 1036 1037 1038 /* This procedure sets the usual global variables, fakes up a symbol 1039* node and calls display_single_value. Since probe constants are never 1040* arrays or structures, no attention is paid to subscripts or recursion 1041* for structure elements here */ 1042 1043 dcl 1 ep like encoded_precision; 1044 1045 value_ptr = P_reference.address_ptr; 1046 unspec (value_info) = ""b; 1047 1048 value_info.type = P_reference.type; 1049 value_info.base_type = value_info.type; 1050 value_data_info = data_type_info_$info (value_info.type); 1051 1052 value_info.packed = P_reference.flags.packed; 1053 unspec (ep) = unspec (P_reference.precision); 1054 /* Unpack arithmetic precision and scale, if need be */ 1055 value_info.scale = ep.scale; 1056 if (value_info.scale ^= 0) 1057 then value_info.size = ep.prec; 1058 else value_info.size = P_reference.precision; 1059 1060 1061 value_info.type_addr = null (); /* I don't know what these are, but they look like they */ 1062 value_info.base_type_addr = null (); /* will work better as null pointers than as zeros */ 1063 1064 value_symbol_ptr = null (); 1065 1066 call display_single_value (); 1067 return; 1068 1069 end display_probe_constant; 1070 1071 print_cross_section: 1072 proc (); 1073 1074 1075 /* This procedure prints the contents of the current array cross-section. 1076* It also implements the recursing for printing the immediate sons of a 1077* structure element. For reasons I don't understand, it only increments 1078* subscripts PL/I-style, even if it's printing for Fortran. It used to 1079* check in MR9.1, but this was removed in MR10.1. */ 1080 1081 dcl done bit (1) aligned; 1082 dcl first_time_sw bit (1) aligned; 1083 /* First time for cross-section */ 1084 dcl same_count fixed bin; 1085 dcl dont_print bit (1) aligned; 1086 1087 dcl value_size fixed bin (24); 1088 dcl this_value bit (value_size) based (this_value_ptr); 1089 dcl previous_value bit (value_size) based (previous_value_ptr); 1090 1091 /* This array is used to increment a subset of the indices in the global 1092* subscript array. It uses based(addr) due to a PL/I bug preventing 1093* the use of the defined attribute in this context. */ 1094 1095 dcl my_indices (my_dims) fixed bin (24) 1096 based (addr (global.indices (first_dim))); 1097 1098 1099 this_value_symbol_ptr = value_symbol_ptr; 1100 1101 call get_value_info (); /* get info for first time */ 1102 1103 if ignore_this_element (dont_print) then do; 1104 /* If anything in the cross-section is ignored, */ 1105 return; /* it's always ignored. */ 1106 end; 1107 1108 first_time_sw = "1"b; 1109 value_size = 0; 1110 done = "0"b; 1111 1112 do while (^done); 1113 1114 if first_time_sw then do; 1115 first_time_sw = "0"b; 1116 starting_name = this_value_name; 1117 same_count = 1; 1118 end; 1119 1120 else do; 1121 if value_size = 0 1122 then /* set this once for the loop */ 1123 value_size = 1124 bitno (this_value_ptr) - bitno (previous_value_ptr); 1125 if this_value ^= previous_value then do; 1126 /* time to print something */ 1127 1128 call use_previous_value (); 1129 1130 call do_symbol_and_sons (starting_name, previous_value_name, 1131 same_count, dont_print); 1132 1133 starting_name = this_value_name; 1134 same_count = 0; 1135 end; 1136 1137 else same_count = same_count + 1; 1138 end; 1139 1140 previous_value_name = this_value_name; 1141 previous_value_ptr = this_value_ptr; 1142 previous_value_symbol_ptr = this_value_symbol_ptr; 1143 previous_real_value_ptr = real_value_ptr; 1144 unspec (previous_value_info) = unspec (this_value_info); 1145 unspec (previous_value_data_info) = unspec (this_value_data_info); 1146 previous_value_indices = this_value_indices; 1147 1148 if (my_dims = 0) 1149 then done = "1"b; /* Not a cross-section */ 1150 else call probe_increment_indices_ ("0"b, 1151 /* Always PL/I */ 1152 my_indices, my_bounds, my_dims, done, ("0"b)); 1153 ele_num = ele_num + 1; 1154 1155 if ^done 1156 then call get_value_info (); 1157 1158 end; 1159 1160 call use_previous_value (); 1161 1162 call do_symbol_and_sons (starting_name, previous_value_name, same_count, 1163 dont_print); 1164 return; 1165 1166 end print_cross_section; 1167 1168 get_value_info: 1169 proc (); 1170 1171 dcl offset_bits fixed bin (6) unsigned; 1172 dcl offset_words fixed bin (18) unsigned; 1173 dcl fixed builtin; 1174 dcl i fixed bin; 1175 dcl based_ptr ptr based; 1176 dcl temp_ptr ptr; 1177 1178 /* Get information about the value to be printed. The address calculation 1179* stuff here is purely an efficiency hack; we could always recalculate 1180* it, but if probe already gave us the address (which it can for scalars 1181* only), we may as well use that, instead. */ 1182 1183 this_value_info.version = RUNTIME_TYPE_INFO_VERSION_1; 1184 1185 call runtime_symbol_info_$type (this_value_symbol_ptr, 1186 addr (this_value_info), error_code); 1187 if error_code ^= 0 then do; 1188 call use_this_value (); 1189 call cannot_get_address (); 1190 end; 1191 1192 this_value_data_info = data_type_info_$info (this_value_info.type); 1193 1194 if global.calculate_address 1195 then /* must recalculate address */ 1196 this_value_ptr = stu_$get_runtime_address (global.blockp, 1197 this_value_symbol_ptr, global.stackp, global.linkp, 1198 global.blockp, global.base_ptr, addr (global.indices)); 1199 1200 else this_value_ptr = inherited_addr; 1201 if (my_father_is_a_typeref) 1202 then 1203 temp_ptr = my_real_name_ptr; 1204 else temp_ptr = this_value_symbol_ptr; 1205 1206 if (^ref_node_not_struct_or_union () & 1207 probe_info.language_type = C_lang_type) then do; 1208 if (temp_ptr ^= null ()) then do; 1209 if (^temp_ptr -> runtime_symbol.bits.simple) then do; 1210 offset_bits = 0; 1211 if (temp_ptr -> runtime_symbol.offset ^= 0 1212 & my_real_name_ptr ^= P_reference.symbol_ptr) 1213 then 1214 offset_bits = 1215 convert (offset_bits, 1216 temp_ptr -> runtime_symbol.offset); 1217 if (fixed (temp_ptr -> runtime_symbol.ndims) > 0) then do; 1218 offset_bits = 1219 offset_bits 1220 + ele_num 1221 * 1222 get_size_in_bits_ ( 1223 fixed (temp_ptr -> runtime_symbol.type), 1224 temp_ptr -> runtime_symbol.size, 1225 (temp_ptr -> runtime_symbol.bits.packed)); 1226 end; 1227 offset_words = 1228 convert (offset_words, divide (offset_bits, 36, 17, 0)); 1229 offset_bits = convert (offset_bits, mod (offset_bits, 36)); 1230 addr (this_value_ptr) -> its_unsigned.offset = 1231 addr (this_value_ptr) -> its_unsigned.offset 1232 + offset_words; 1233 addr (this_value_ptr) -> its_unsigned.bit_offset = 1234 addr (this_value_ptr) -> its_unsigned.bit_offset 1235 + offset_bits; 1236 1237 1238 end; 1239 end; 1240 end; 1241 else if my_dims > 0 & probe_info.language_type = C_lang_type then do; 1242 if (temp_ptr ^= null ()) then do; 1243 if (^temp_ptr -> runtime_symbol.bits.simple) then do; 1244 offset_bits = 0; 1245 if (fixed (temp_ptr -> runtime_symbol.ndims) > 0) then do; 1246 offset_bits = 1247 offset_bits 1248 + ele_num 1249 * 1250 get_size_in_bits_ ( 1251 fixed (temp_ptr -> runtime_symbol.type), 1252 temp_ptr -> runtime_symbol.size, 1253 (temp_ptr -> runtime_symbol.bits.packed)); 1254 end; 1255 offset_words = 1256 convert (offset_words, divide (offset_bits, 36, 17, 0)); 1257 offset_bits = convert (offset_bits, mod (offset_bits, 36)); 1258 addr (this_value_ptr) -> its_unsigned.offset = 1259 addr (this_value_ptr) -> its_unsigned.offset 1260 + offset_words; 1261 addr (this_value_ptr) -> its_unsigned.bit_offset = 1262 addr (this_value_ptr) -> its_unsigned.bit_offset 1263 + offset_bits; 1264 1265 1266 end; 1267 end; 1268 end; 1269 1270 if (probe_info.language_type = C_lang_type) 1271 then 1272 do i = 1 to levels_of_pointer_indir; 1273 this_value_ptr = this_value_ptr -> based_ptr; 1274 end; 1275 1276 real_value_ptr = addbitoffset (global.start_ptr, 1277 (bitno (this_value_ptr) - bitno (global.base_ptr))); 1278 1279 this_value_indices = global.indices; 1280 1281 call use_this_value (); 1282 1283 this_value_name = get_symbol_name (); 1284 value_name = rtrim (this_value_name); 1285 1286 if (this_value_ptr = null ()) & (this_value_info.type ^= structure_dtype) 1287 then 1288 call cannot_get_address (); /* for instance, when a thunk cannot be evaluated */ 1289 return; 1290 1291 end get_value_info; 1292 1293 ignore_this_element: 1294 proc (P_dont_print) returns (bit (1) aligned); 1295 1296 1297 dcl P_dont_print bit (1) aligned parameter; 1298 /* Set to suppress printing of extra structure levels */ 1299 1300 dcl 1 element_name aligned 1301 based ( 1302 runtime_symbol_info_$name ( 1303 this_value_symbol_ptr)), 1304 2 len fixed bin (9) unsigned unaligned, 1305 2 str char (0 refer (element_name.len)) unaligned; 1306 dcl idx fixed bin; 1307 dcl fixed builtin; 1308 1309 1310 P_dont_print = "0"b; /* This is only important when using match names */ 1311 1312 if global.probe_sw then do; 1313 if ^probe_modes.use_exclude_names 1314 then return ("0"b); 1315 else return ( 1316 probe_modes_mgr_$excludep (probe_info_ptr, 1317 addr (element_name))); 1318 end; 1319 1320 if global.use_match_names then do; 1321 do idx = 1 to P_match_name_count; 1322 if (index (this_value_name, P_match_names (idx)) ^= 0) then do; 1323 return ("0"b); 1324 end; 1325 end; 1326 1327 if (runtime_symbol_info_$son (this_value_symbol_ptr) ^= null () 1328 & (fixed (this_value_symbol_ptr -> runtime_symbol.type) 1329 ^= pointer_dtype | 1330 fixed (this_value_symbol_ptr -> runtime_symbol.type) 1331 ^= c_typeref_dtype)) 1332 then do; /* Keep looking, but quietly */ 1333 P_dont_print = "1"b; 1334 return ("0"b); 1335 end; 1336 return ("1"b); /* No matches, so ignore it */ 1337 end; 1338 1339 /* Otherwise, azm uses a fixed heuristic */ 1340 if (element_name.len < 3) 1341 then return ("0"b); 1342 if (substr (element_name.str, 1, 3) = "pad") 1343 then return ("1"b); 1344 if (substr (element_name.str, 1, 3) = "mbz") 1345 then return ("1"b); 1346 if (element_name.len < 6) 1347 then return ("0"b); 1348 if (substr (element_name.str, 1, 6) = "unused") 1349 then return ("1"b); 1350 if (element_name.len < 8) 1351 then return ("0"b); 1352 if (substr (element_name.str, 1, 8) = "unusable") 1353 then return ("1"b); 1354 return ("0"b); 1355 1356 end ignore_this_element; 1357 1358 cannot_get_address: 1359 proc (); 1360 1361 1362 1363 /* This is called when it turns out that the current symbol cannot be located 1364* for some reason; the usual one is that a thunk cannot be evaluated because 1365* the necessary pointers are not available (this is always the case for 1366* display_data_, and sometimes the case for probe). In any case, when this 1367* happens, we've done all we can, and we just punt. */ 1368 1369 if global.probe_sw then do; 1370 call probe_error_$record (probe_info_ptr, 1371 probe_et_$no_address, get_symbol_name ()); 1372 error_code = probe_et_$recorded_message; 1373 end; 1374 1375 else do; 1376 1377 call finish_output (addr (parent_output_info), "1"b); 1378 /* Finish anything waiting at this level */ 1379 call ioa_$ioa_switch (global.output_switch, 1380 "^5xerror: Cannot get address of ^a.", get_symbol_name ()); 1381 error_code = 0; /* There's no sensible code here; let our caller */ 1382 end; /* think it worked, since there's nothing to do */ 1383 1384 goto FATAL_ERROR; 1385 1386 end cannot_get_address; 1387 1388 use_previous_value: 1389 proc (); 1390 1391 1392 value_symbol_ptr = previous_value_symbol_ptr; 1393 unspec (value_info) = unspec (previous_value_info); 1394 unspec (value_data_info) = unspec (previous_value_data_info); 1395 value_ptr = previous_value_ptr; 1396 real_value_ptr = previous_real_value_ptr; 1397 global.indices = previous_value_indices; 1398 ele_num = ele_num - 1; 1399 end use_previous_value; 1400 1401 1402 1403 1404 use_this_value: 1405 proc (); 1406 1407 1408 value_symbol_ptr = this_value_symbol_ptr; 1409 unspec (value_info) = unspec (this_value_info); 1410 unspec (value_data_info) = unspec (this_value_data_info); 1411 value_ptr = this_value_ptr; 1412 global.indices = this_value_indices; 1413 end use_this_value; 1414 1415 do_symbol_and_sons: 1416 proc (P_first_name, P_last_name, P_count, P_dont_print); 1417 1418 1419 dcl (P_first_name, P_last_name) 1420 char (*); 1421 dcl P_count fixed bin; 1422 dcl P_dont_print bit (1) aligned parameter; 1423 1424 dcl symbol_ptr pointer; 1425 dcl fixed builtin; 1426 1427 1428 dcl 1 my_output_info aligned like output_info_template automatic; 1429 1430 dummy_node: 1431 proc (s_ptr) returns (bit (1)); 1432 1433 dcl s_ptr parameter ptr; 1434 dcl name_ptr ptr; 1435 1436 name_ptr = addrel (s_ptr, fixed (s_ptr -> runtime_symbol.name)); 1437 1438 if (substr (name_ptr -> acc.string, 1, 1) = "!") 1439 then return ("1"b); 1440 else return ("0"b); 1441 1442 end dummy_node; 1443 1444 /* The P_dont_print flag is intended to suppress output for substructures which 1445* don't match the substring selections, but should be traversed anyway in 1446* order to find interesting elements. */ 1447 1448 if P_count = 1 1449 then value_name = rtrim (P_first_name); 1450 else call ioa_$rsnnl ("^a ^[and^;through^] ^a", value_name, 1451 length (value_name), 1452 P_first_name, P_count = 2, P_last_name); 1453 1454 if ^P_dont_print 1455 then call display_single_value (); 1456 1457 /* We have a 'son' but the value my not be a structure. It may be a C 1458* indirect value. If the value is a pointer or typeref, ignore the son. */ 1459 1460 if (runtime_symbol_info_$son (value_symbol_ptr) = null () | 1461 fixed (value_symbol_ptr -> runtime_symbol.type) = pointer_dtype | 1462 fixed (value_symbol_ptr -> runtime_symbol.type) = c_typeref_dtype | 1463 fixed (value_symbol_ptr -> runtime_symbol.type) = c_enum_dtype) 1464 then do; 1465 return; /* not a structure */ 1466 end; 1467 1468 /* This symbol may have 0 to N sons. The first son is found by an 18 bit 1469* offset (son), and the others are linked by 18 bit offsets from previous 1470* son (brother). Let symbol_offset take on, first the offset of my son, 1471* then the offset of each brother of that son. 0 means end of chain */ 1472 1473 my_output_info.header = output_info_template.header; 1474 my_output_info.buffer = copy (" ", next_indentation ()); 1475 1476 1477 do symbol_ptr = runtime_symbol_info_$son (value_symbol_ptr) 1478 repeat (runtime_symbol_info_$brother (symbol_ptr)) 1479 while (symbol_ptr ^= null ()); 1480 1481 if (^dummy_node (symbol_ptr)) 1482 then 1483 call print_symbol (symbol_ptr, ndims, NOT_TOP_LEVEL, 1484 addr (my_output_info), (value_ptr)); 1485 end; 1486 1487 call finish_output (addr (my_output_info), "1"b); 1488 return; 1489 1490 end do_symbol_and_sons; 1491 1492 display_single_value: 1493 proc (); 1494 1495 1496 /* All knowledge about the internal representation of data is here, as is all 1497* knowledge of the formats that data are printed in. This procedure works 1498* entirely on values inherited from print_symbol */ 1499 1500 1501 if (binary (rel (value_ptr), 18) > global.max_offset) then do; 1502 call finish_output (addr (parent_output_info), "1"b); 1503 call ioa_$ioa_switch (global.output_switch, 1504 "^5xerror: ^a is outside the supplied data.", 1505 get_symbol_name ()); 1506 1507 error_code = 0; /* There's no sensible code here; let our caller */ 1508 goto FATAL_ERROR; /* think it worked, since there's nothing to do */ 1509 end; 1510 1511 if value_data_info.arithmetic 1512 then call display_arithmetic (); 1513 else if value_data_info.char_string 1514 then call display_char_string (); 1515 else if value_data_info.bit_string 1516 then call display_bit_string (); 1517 else if (value_info.type = picture_runtime_dtype) 1518 then call display_picture (); 1519 else if (value_info.type = pointer_dtype) 1520 then call display_pointer (); 1521 else if (value_info.type = offset_dtype) 1522 then call display_offset (); 1523 else if (value_info.type = label_constant_runtime_dtype) 1524 then call display_label_constant (); 1525 else if (value_info.type = label_dtype) | (value_info.type = entry_dtype) 1526 then 1527 call display_label_or_entry (); 1528 else if (value_info.type = file_dtype) 1529 then call display_file (); 1530 else if (value_info.type = int_entry_runtime_dtype) 1531 | (value_info.type = ext_procedure_runtime_dtype) 1532 | (value_info.type = ext_entry_runtime_dtype) 1533 then 1534 call display_entry_constant (); 1535 else if (value_info.type = structure_dtype) 1536 then call display_structure (); 1537 else if (value_info.type = c_union_dtype) 1538 then call display_structure (); 1539 else if (value_info.type = c_enum_dtype) 1540 then 1541 call display_c_enum (); 1542 else if (value_info.type = c_enum_const_dtype) 1543 then 1544 call display_arithmetic (); 1545 else call display_undisplayable (); 1546 1547 NONFATAL_ERROR: 1548 return; 1549 1550 display_arithmetic: 1551 proc (); 1552 1553 1554 dcl TEN_YEARS fixed bin (71) int static 1555 options (constant) init (315360000000000); 1556 dcl 1 (source, target) aligned like computational_data; 1557 dcl precision fixed bin; 1558 dcl invalid_decimal_data bit (9 * precision) based (value_ptr); 1559 dcl long_message char (100) aligned; 1560 dcl short_message char (8) aligned; 1561 dcl (fb71, hexfp_space) fixed bin (71); 1562 dcl code fixed bin (35); 1563 1564 1565 precision = decode (value_info.size, value_info.size_is_encoded); 1566 1567 if value_data_info.decimal 1568 then 1569 if ^valid_decimal_ ((value_info.type), value_ptr, (precision)) 1570 then do; 1571 call ioa_$rsnnl ("[invalid decimal data @ ^p] ""^.3b""b3", 1572 value_str, (0), real_value_ptr, invalid_decimal_data); 1573 1574 call write_value_str (); 1575 return; 1576 end; 1577 1578 unspec (source) = "0"b; 1579 source.address = value_ptr; 1580 source.data_type = value_info.type; 1581 source.packed = value_info.packed; 1582 source.prec_or_length = precision; 1583 source.scale = value_info.scale; 1584 source.picture_image_ptr = null; 1585 1586 if source.data_type = real_flt_dec_generic_dtype 1587 | source.data_type = cplx_flt_dec_generic_dtype then do; 1588 /* don't print generic's tremendous precision */ 1589 unspec (target) = "0"b; 1590 target.address = addr (hexfp_space); 1591 if source.data_type = real_flt_dec_generic_dtype 1592 then target.data_type = real_flt_hex_1_dtype; 1593 else target.data_type = cplx_flt_hex_1_dtype; 1594 target.prec_or_length = 27; /* use a constant? */ 1595 target.picture_image_ptr = null; 1596 1597 call assign_$computational_ (addr (target), addr (source), code); 1598 if code = 0 1599 then source = target; /* print hex instead if conversion worked */ 1600 end; 1601 1602 unspec (target) = "0"b; 1603 target.address = addr (value_str); 1604 target.data_type = varying_char_dtype; 1605 target.prec_or_length = maxlength (value_str); 1606 target.picture_image_ptr = null; 1607 1608 on conversion go to CONVERSION_ERROR; 1609 on overflow go to CONVERSION_ERROR; 1610 on size go to CONVERSION_ERROR; 1611 1612 call assign_$computational_ (addr (target), addr (source), code); 1613 if code ^= 0 then do; 1614 CONVERSION_ERROR: 1615 call write_value_name (); 1616 1617 call convert_status_code_ (code, short_message, long_message); 1618 call ioa_$ioa_switch (global.output_switch, "^a", long_message); 1619 end; 1620 else do; 1621 value_str = ltrim (value_str); 1622 1623 if ^global.probe_sw & value_data_info.fixed & ^value_data_info.complex & 1624 value_info.scale = 0 & precision >= 52 then do; 1625 1626 unspec (target) = "0"b; 1627 target.address = addr (fb71); 1628 target.data_type = real_fix_bin_2_dtype; 1629 target.prec_or_length = 71; 1630 target.picture_image_ptr = null; 1631 1632 call assign_$computational_ (addr (target), addr (source), 0); 1633 1634 if fb71 > (clock () - TEN_YEARS) & fb71 < (clock () + TEN_YEARS) 1635 then do; 1636 /* might be a date-time; is within 10 yr of now */ 1637 on sub_error_ go to SKIP_DTM; 1638 value_str = 1639 value_str || " " 1640 || date_time_$format ("iso_long_date_time", fb71, "", ""); 1641 end; 1642 end; 1643 SKIP_DTM: 1644 call write_value_str (); 1645 end; 1646 return; 1647 1648 end display_arithmetic; 1649 1650 display_c_enum: 1651 proc (); 1652 1653 dcl (sym_addr, t_ptr, name_ptr) 1654 ptr; 1655 dcl not_found bit (1); 1656 dcl based_int fixed bin (35) based; 1657 1658 t_ptr = value_symbol_ptr; 1659 not_found = "1"b; 1660 do while (not_found & t_ptr ^= null ()); 1661 if (fixed (t_ptr -> runtime_symbol.type) = c_enum_const_dtype) then do; 1662 sym_addr = stu_$get_runtime_address (global.blockp, 1663 t_ptr, global.stackp, global.linkp, 1664 global.blockp, global.base_ptr, addr (global.indices)); 1665 if sym_addr -> based_int = P_reference.address_ptr -> based_int 1666 then do; 1667 name_ptr = addrel (t_ptr, fixed (t_ptr -> runtime_symbol.name)); 1668 call ioa_$ioa_switch (probe_info.output_switch, "^a", 1669 substr (name_ptr -> acc.string, 1, name_ptr -> acc.num_chars) 1670 ); 1671 not_found = "0"b; 1672 end; 1673 else do; 1674 if (fixed (t_ptr -> runtime_symbol.brother) = 0) 1675 then t_ptr = null (); 1676 else t_ptr = 1677 addrel (t_ptr, 1678 fixed (t_ptr -> runtime_symbol.brother)); 1679 end; 1680 end; 1681 else do; 1682 if (fixed (t_ptr -> runtime_symbol.son) = 0) 1683 then t_ptr = null (); 1684 else t_ptr = addrel (t_ptr, fixed (t_ptr -> runtime_symbol.son)); 1685 end; 1686 end; 1687 if not_found then do; 1688 call ioa_$ioa_switch (probe_info.output_switch, 1689 "Warning: The value for this enumerated value is out of range."); 1690 value_info.type = real_fix_bin_1_dtype; 1691 value_info.size = 35; 1692 value_info.scale = 0; 1693 call display_arithmetic (); 1694 end; 1695 end display_c_enum; 1696 1697 display_picture: 1698 proc (); 1699 1700 1701 dcl picture_ptr pointer; 1702 dcl picture_len fixed bin (35); 1703 dcl picture_string char (picture_len) based (picture_ptr); 1704 1705 1706 call get_string_info (9, picture_ptr, picture_len); 1707 1708 value_str = """" || picture_string || """"; 1709 call write_value_str (); 1710 return; 1711 1712 end display_picture; 1713 1714 display_char_string: 1715 proc (); 1716 1717 1718 dcl (amount_trimmed, str_len, trimmed_len) 1719 fixed bin (35); 1720 dcl str_ptr pointer; 1721 dcl based_string char (str_len) based (str_ptr); 1722 dcl trim_str char (32) varying; 1723 dcl truncated_sw bit (1); 1724 dcl quote_char char (1); 1725 1726 if language (COBOL_lang_type) 1727 then 1728 if (value_symbol_ptr ^= null ()) 1729 then /* In case it's a constant */ 1730 if (runtime_symbol_info_$son (value_symbol_ptr) ^= null ()) 1731 then do; 1732 call display_structure (); 1733 /* COBOL structures are strings;ase */ 1734 return; 1735 end; 1736 1737 call get_string_info (9, str_ptr, str_len); 1738 1739 if str_len > MINIMUM_TRIM then do; /* "foo" || (165)" ", etc. */ 1740 if substr (based_string, str_len, 1) = " " 1741 then 1742 trimmed_len = length (rtrim (based_string, " ")); 1743 else if substr (based_string, str_len, 1) = low (1) 1744 then 1745 trimmed_len = length (rtrim (based_string, low (1))); 1746 else if substr (based_string, str_len, 1) = high (1) 1747 then 1748 trimmed_len = length (rtrim (based_string, high (1))); 1749 else trimmed_len = str_len; 1750 1751 if str_len - trimmed_len < MINIMUM_TRIM 1752 then trimmed_len = str_len; 1753 end; 1754 else trimmed_len = str_len; 1755 1756 amount_trimmed = str_len - trimmed_len; 1757 1758 if trimmed_len > STRING_LIMIT & global.truncate_strings then do; 1759 /* "mode truncate_strings" */ 1760 truncated_sw = "1"b; 1761 trimmed_len = STRING_LIMIT; 1762 end; 1763 else truncated_sw = "0"b; 1764 1765 quote_char = """"; 1766 if language (FORTRAN_lang_type) | language (PASCAL_lang_type) 1767 then 1768 if index (substr (based_string, 1, trimmed_len), "'") = 0 1769 then quote_char = "'"; 1770 1771 if amount_trimmed > 0 then do; 1772 if trimmed_len > 0 1773 then trim_str = " || "; 1774 else trim_str = ""; 1775 trim_str = trim_str || "("; 1776 trim_str = trim_str || ltrim (character (amount_trimmed)); 1777 trim_str = trim_str || ")"; 1778 trim_str = trim_str || quote_char; 1779 trim_str = trim_str || substr (based_string, str_len, 1); 1780 trim_str = trim_str || quote_char; 1781 end; 1782 else trim_str = ""; 1783 1784 call write_value_name (); 1785 1786 if trimmed_len = 0 1787 then 1788 call ioa_$ioa_switch (global.output_switch, "^[^a^;""""^]", 1789 trim_str ^= "", trim_str); 1790 1791 else if quote_char = """" 1792 then 1793 call ioa_$ioa_switch (global.output_switch, "^a^[ ^]^a", 1794 requote_string_ (substr (based_string, 1, trimmed_len)), 1795 truncated_sw, trim_str); 1796 1797 else call ioa_$ioa_switch (global.output_switch, "'^a'^[ ^]^a", 1798 substr (based_string, 1, trimmed_len), truncated_sw, trim_str); 1799 return; 1800 1801 end display_char_string; 1802 1803 display_bit_string: 1804 proc (); 1805 1806 1807 dcl str_len fixed bin (35); 1808 dcl str_ptr pointer; 1809 dcl bit_string bit (str_len) based (str_ptr); 1810 1811 dcl FORTRAN_LOGICAL (0:1) char (8) internal static 1812 options (constant) init 1813 (".FALSE.", ".TRUE."); 1814 dcl BIT_IOA_STRING (4) char (12) varying internal static 1815 options (constant) init 1816 ("""^.b""b", "^.3b", """^.3b""b3", """^.4b""b4") 1817 ; 1818 1819 dcl bit_radix fixed bin; 1820 dcl truncated_sw bit (1); 1821 1822 1823 call get_string_info (1, str_ptr, str_len); 1824 1825 if language (FORTRAN_lang_type) & (str_len = 1) then do; 1826 value_str = FORTRAN_LOGICAL (binary (bit_string, 1)); 1827 call write_value_str (); 1828 return; 1829 end; 1830 1831 if str_len > STRING_LIMIT & global.truncate_strings then do; 1832 truncated_sw = "1"b; 1833 str_len = STRING_LIMIT; 1834 end; 1835 else truncated_sw = "0"b; 1836 1837 /* In compressed output format, if we're given a single bit, we save it up for 1838* later and print out all the flags in two groups ("ON" and "OFF"). */ 1839 1840 if global.compress_output & (str_len = 1) & (value_info.type = bit_dtype) 1841 then do; 1842 call add_bit (bit_string, value_name); 1843 return; 1844 end; 1845 1846 /* For PL/I, we try to be clever, and display bitstrings in a useful format: 1847* octal, if appropriate, try hexadecimal next, and, all else failing, as bits. 1848* NOTE: This is sort of a crock, in that it uses 2 to mean "raw octal", 1849* instead of "b2". This is done so that the "does-it-fit-in-the-buffer" 1850* test will work without further hacking. */ 1851 1852 if global.octal_sw 1853 then bit_radix = 2; 1854 else if (mod (str_len, 3) = 0) 1855 then bit_radix = 3; 1856 else if (mod (str_len, 4) = 0) & (str_len <= 64) & (str_len > 4) 1857 then bit_radix = 4; 1858 else bit_radix = 1; 1859 1860 if divide (str_len, bit_radix, 24, 0) < maxlength (value_str) - 20 then do; 1861 call ioa_$rsnnl (BIT_IOA_STRING (bit_radix) || "^[ ^]", value_str, 1862 (0), 1863 bit_string, truncated_sw); 1864 call write_value_str (); 1865 end; 1866 else do; 1867 call write_value_name (); 1868 call ioa_$ioa_switch (global.output_switch, 1869 BIT_IOA_STRING (bit_radix) || "^[ ^]", 1870 bit_string, truncated_sw); 1871 end; 1872 return; 1873 1874 add_bit: 1875 proc (P_bits, P_name); 1876 1877 1878 dcl P_bits bit (*) unaligned; 1879 dcl P_name char (*) varying; 1880 1881 dcl bitbufp pointer; 1882 dcl 1 bitbuf aligned like bit_buffer based (bitbufp); 1883 dcl this_bit bit (1) aligned; 1884 dcl max_len fixed bin; 1885 dcl new_len fixed bin; 1886 1887 1888 this_bit = substr (P_bits, 1, 1); 1889 1890 bitbufp = get_bitbuf (this_bit, "0"b); 1891 1892 if (length (bitbuf.str) > 0) then do; 1893 max_len = global.line_length - (indentation () + 5); 1894 new_len = length (bitbuf.str) + length (value_name) + 2; 1895 if (new_len > max_len) then do; 1896 bitbuf.str = bitbuf.str || ","; 1897 /* End the last one with a comma */ 1898 bitbufp = get_bitbuf (this_bit, "1"b); 1899 /* See if it can fit, get a new buffer if not */ 1900 end; 1901 end; 1902 1903 if (length (bitbuf.str) > 0) 1904 then 1905 bitbuf.str = bitbuf.str || ", "; 1906 bitbuf.str = bitbuf.str || value_name; 1907 return; 1908 1909 get_bitbuf: 1910 proc (P_bit, P_create_sw) returns (pointer); 1911 1912 1913 1914 dcl a_temp_pointer pointer; 1915 dcl P_bit bit (1) aligned parameter; 1916 dcl P_create_sw bit (1) aligned parameter; 1917 1918 /* This is just an interface to find_or_create_bitbuf, passing the appropriate 1919* pointers from parent_output_info. */ 1920 1921 if (P_bit = "1"b) 1922 then 1923 a_temp_pointer = find_or_create_bitbuf (P_create_sw, 1924 parent_output_info.on_bits.first, 1925 parent_output_info.on_bits.last); 1926 1927 else a_temp_pointer = find_or_create_bitbuf (P_create_sw, 1928 parent_output_info.off_bits.first, 1929 parent_output_info.off_bits.last); 1930 1931 return (a_temp_pointer); 1932 1933 1934 find_or_create_bitbuf: 1935 proc (P_create_sw, P_first, P_last) returns (pointer); 1936 1937 dcl P_create_sw bit (1) aligned parameter; 1938 dcl P_first pointer parameter; 1939 dcl P_last pointer parameter; 1940 1941 dcl bufp pointer; 1942 1943 /* This procedure either finds the last bit buffer, or creates one and threads 1944* it into the list. One is always created if the list is empty; otherwise, 1945* one is created if P_create_sw specifies it. */ 1946 1947 1948 if P_create_sw | (P_first = null ()) then do; 1949 allocate bit_buffer in (system_area) set (bufp); 1950 bufp -> bit_buffer.str = ""; 1951 bufp -> bit_buffer.next = null (); 1952 if (P_first = null ()) 1953 then P_first = bufp; 1954 else P_last -> bit_buffer.next = bufp; 1955 P_last = bufp; 1956 end; 1957 1958 else bufp = P_last; 1959 return (bufp); 1960 end find_or_create_bitbuf; 1961 1962 1963 end get_bitbuf; 1964 1965 1966 end add_bit; 1967 1968 1969 end display_bit_string; 1970 1971 get_string_info: 1972 proc (bits_per_char, str_ptr, str_len); 1973 1974 1975 dcl bits_per_char float bin parameter; 1976 dcl str_ptr pointer parameter; 1977 dcl str_len fixed bin (35) parameter; 1978 1979 dcl max_len fixed bin (35); 1980 dcl chars_per_word float bin; 1981 dcl based_varying_len fixed bin (35) based (value_ptr); 1982 1983 if value_data_info.varying 1984 then str_ptr = addrel (value_ptr, 1); 1985 else str_ptr = value_ptr; 1986 1987 chars_per_word = 36 / bits_per_char; 1988 value_str = ""; /* If there is a problem, we will put an error message here */ 1989 1990 if (value_info.type = picture_runtime_dtype) 1991 then 1992 str_len = 1993 pointer (value_symbol_ptr, 1994 decode (value_info.size, value_info.size_is_encoded)) 1995 -> picture_image.varlength; 1996 1997 else if value_data_info.varying then do; 1998 max_len = decode (value_info.size, value_info.size_is_encoded); 1999 str_len = based_varying_len; /* get length word */ 2000 if (str_len > max_len) 2001 then 2002 call ioa_$rsnnl ("[varying length ^d is > dcld maximum ^d.]", 2003 value_str, (0), str_len, max_len); 2004 end; 2005 2006 else str_len = decode (value_info.size, value_info.size_is_encoded); 2007 2008 if (language (C_lang_type) & P_reference.type = pointer_dtype 2009 & P_reference.precision > 0) then do; 2010 str_len = P_reference.precision; 2011 end; 2012 else if language (C_lang_type) 2013 & (value_info.size > 1 | my_real_name_ptr ^= null ()) then do; 2014 begin; 2015 dcl end_not_found bit (1) init ("1"b); 2016 dcl based_ints (0:255) fixed bin (9) unsigned 2017 unaligned based (str_ptr); 2018 dcl max_len fixed bin (24); 2019 2020 if (my_real_name_ptr ^= null ()) 2021 then max_len = 256; 2022 else max_len = value_info.size - 1; 2023 do str_len = 0 to max_len while (end_not_found); 2024 if based_ints (str_len) = 0 then do; 2025 end_not_found = "0"b; 2026 str_len = str_len - 1; 2027 end; 2028 end; 2029 end; 2030 end; 2031 if (str_len < 0) 2032 then 2033 call ioa_$rsnnl ("[length ^d is less than zero.]", 2034 value_str, (0), str_len); 2035 2036 else if ((binary (rel (str_ptr), 18) + (str_len / chars_per_word)) 2037 > sys_info$max_seg_size) 2038 then 2039 call ioa_$rsnnl ("[length ^d is past end of the segment.]", 2040 value_str, (0), str_len); 2041 2042 else if ((binary (rel (str_ptr), 18) + (str_len / chars_per_word)) 2043 > global.max_offset) 2044 then 2045 call ioa_$rsnnl ("[length ^d is past end of available data.]", 2046 value_str, (0), str_len); 2047 2048 if (value_str ^= "") then do; 2049 call write_value_str (); 2050 goto NONFATAL_ERROR; 2051 end; 2052 return; 2053 2054 end get_string_info; 2055 2056 display_pointer: 2057 proc (); 2058 2059 2060 dcl based_ptr pointer based (value_ptr); 2061 dcl based_packed_ptr pointer unaligned based (value_ptr); 2062 2063 2064 if value_info.packed 2065 then 2066 value_str = format_pointer_$packed 2067 (based_packed_ptr, "1"b, global.amu_info_ptr); 2068 2069 else value_str = 2070 format_pointer_$its (based_ptr, "1"b, global.amu_info_ptr); 2071 2072 call write_value_str (); 2073 return; 2074 2075 end display_pointer; 2076 2077 display_offset: 2078 proc (); 2079 2080 2081 dcl offset_ptr pointer; 2082 dcl based_offset offset based (value_ptr); 2083 dcl 1 offset_overlay, 2084 2 word fixed bin (18) unsigned unaligned, 2085 2 bit fixed bin (18) unsigned unaligned; 2086 2087 2088 offset_ptr = stu_$offset_to_pointer (global.blockp, value_symbol_ptr, 2089 value_ptr, global.stackp, global.linkp, global.blockp); 2090 2091 if (offset_ptr ^= null ()) 2092 then 2093 value_str = 2094 format_pointer_$its (offset_ptr, "1"b, global.amu_info_ptr); 2095 2096 else if (based_offset = nullo ()) 2097 then 2098 value_str = "null offset"; 2099 2100 else do; 2101 unspec (offset_overlay) = unspec (based_offset); 2102 call ioa_$rsnnl ("word offset: ^o bit offset: ^d", 2103 value_str, (0), offset_overlay.word, offset_overlay.bit); 2104 end; 2105 2106 call write_value_str (); 2107 return; 2108 2109 end display_offset; 2110 2111 display_label_constant: 2112 proc (); 2113 2114 2115 call ioa_$rsnnl ("^a|^o", value_str, (0), 2116 format_pointer_$its (value_ptr, "1"b, global.amu_info_ptr), 2117 binary (rel (value_ptr), 18)); 2118 call write_value_str (); 2119 return; 2120 2121 end display_label_constant; 2122 2123 2124 2125 display_entry_constant: 2126 proc (); 2127 2128 2129 value_str = format_pointer_$its (value_ptr, "1"b, global.amu_info_ptr); 2130 call write_value_str (); 2131 return; 2132 2133 end display_entry_constant; 2134 2135 display_label_or_entry: 2136 proc (); 2137 2138 2139 dcl based_label label variable based (value_ptr); 2140 dcl 1 label aligned, 2141 2 place pointer, 2142 2 frame pointer; 2143 2144 2145 unspec (label) = unspec (based_label); 2146 call ioa_$rsnnl ("^a :: ^p", value_str, (0), 2147 format_pointer_$its (label.place, "1"b, global.amu_info_ptr), 2148 label.frame); 2149 call write_value_str (); 2150 return; 2151 2152 end display_label_or_entry; 2153 2154 2155 display_file: 2156 proc (); 2157 2158 2159 dcl based_file file variable based (value_ptr); 2160 2161 2162 call display_file_value_ (global.output_switch, based_file, (0)); 2163 return; 2164 2165 end display_file; 2166 2167 display_structure: 2168 proc (); 2169 2170 2171 /* To display a structure, we always give the structure name a line of its 2172* own before the recursing starts to print out the next level. This is 2173* only really important for compressed output mode, since otherwise, every 2174* value gets a line of its own anyway. This does its own printing because 2175* it's far easier to do that than to make write_value_str any hairier. */ 2176 2177 /* It is a side-effect of this next call that the last line of output (say, 2178* for level 3) before a substructure (say, level 4) is printed will not end 2179* in a comma, even if there are more scalar elements yet to be printed (at 2180* level 3). I happen to think this is reasonably aesthetic, and better than 2181* including that lonesome comma, but it would be easy to change by adding 2182* another parameter to the finish_output call. */ 2183 2184 2185 call finish_output (addr (parent_output_info), "0"b); 2186 2187 call ioa_$ioa_switch (global.output_switch, 2188 "^vx^a^[^31t@ ^p", indentation (), 2189 value_name, ^global.probe_sw, real_value_ptr); 2190 return; 2191 2192 end display_structure; 2193 2194 display_undisplayable: 2195 proc (); 2196 2197 2198 dcl message char (40); 2199 2200 2201 if (value_info.type = area_dtype) 2202 then message = "an area"; 2203 else if (value_info.type = algol68_straight_dtype) 2204 then message = "an algol68 straight"; 2205 else if (value_info.type = algol68_format_dtype) 2206 then message = "an algol68 format"; 2207 else if (value_info.type = algol68_array_descriptor_dtype) 2208 then 2209 message = "an algol68 array descriptor"; 2210 else if (value_info.type = algol68_union_dtype) 2211 then message = "an algol68 union"; 2212 else message = "data type " || ltrim (character (value_info.type)); 2213 2214 call ioa_$rsnnl ("[can't display value of ^a @ ^p]", 2215 value_str, (0), message, real_value_ptr); 2216 call write_value_str (); 2217 2218 end display_undisplayable; 2219 2220 end display_single_value; 2221 2222 language: 2223 proc (lang_type) returns (bit (1) aligned); 2224 2225 2226 dcl lang_type fixed bin parameter; 2227 2228 /* This procedure appears in two places in order for it to be quick in both of 2229* them. Clearly, it's not very complicated. */ 2230 return (global.language_type = lang_type); 2231 2232 end language; 2233 2234 get_symbol_name: 2235 proc () returns (char (256) varying); 2236 2237 2238 dcl name_string char (256) varying; 2239 dcl father_idx fixed bin; 2240 dcl start_level fixed bin; 2241 dcl sym_dim fixed bin;/* number of dims a symbol owns */ 2242 dcl running_dims fixed bin;/* total dims of all fathers */ 2243 dcl my_level fixed bin; 2244 dcl total_dims fixed bin;/* total number of subscripts on this identifier */ 2245 2246 dcl father_dims fixed bin; 2247 dcl element_symbol_ptr pointer; 2248 dcl 1 element_name aligned 2249 based ( 2250 runtime_symbol_info_$name (element_symbol_ptr)), 2251 2 len fixed bin (9) unsigned unaligned, 2252 2 str char (0 refer (element_name.len)) unaligned; 2253 2254 2255 sym_dim = runtime_symbol_info_$array_dims (value_symbol_ptr); 2256 name_string = ""; 2257 2258 if (language (C_lang_type) & dont_print_me_this_time) then do; 2259 dont_print_me_this_time = "0"b; 2260 return (name_string); 2261 end; 2262 2263 if language (FORTRAN_lang_type) then do; 2264 element_symbol_ptr = value_symbol_ptr; 2265 name_string = element_name.str; 2266 call add_dims (sym_dim, 1, -1); /* FORTRAN is backwards */ 2267 end; /* FORTRAN name */ 2268 2269 else if global.short_names then do; 2270 element_symbol_ptr = value_symbol_ptr; 2271 2272 if my_real_name_ptr ^= null () 2273 then 2274 element_symbol_ptr = my_real_name_ptr; 2275 2276 /* Without this test for null, big headaches. */ 2277 2278 if (runtime_symbol_info_$name (element_symbol_ptr) ^= null ()) 2279 then do; 2280 if (P_reference.type ^= structure_dtype & 2281 P_reference.type ^= c_union_dtype & 2282 my_real_name_ptr = null () 2283 & probe_info.language_type = C_lang_type) 2284 then 2285 name_string = name_string || P_reference.name; 2286 else 2287 name_string = name_string || element_name.str; 2288 end; 2289 else name_string = P_reference.name; 2290 2291 if language (COBOL_lang_type) 2292 then name_string = translate (name_string, "-", "_"); 2293 2294 my_level = runtime_symbol_info_$level (element_symbol_ptr); 2295 total_dims = runtime_symbol_info_$array_dims (element_symbol_ptr); 2296 if P_top_level_sw 2297 then father_dims = 0; 2298 2299 /* This global.father array is a mess. C seems to reference values 2300* in this array that have not been initialized. */ 2301 2302 else if (my_level > 1 & probe_info.language_type ^= C_lang_type) 2303 then do; /* we are in structure, there is a global.father */ 2304 if global.father (my_level - 1) ^= null () 2305 then 2306 father_dims = 2307 runtime_symbol_info_$array_dims (global 2308 .father (my_level - 1)); 2309 end; 2310 else father_dims = 0; 2311 call add_dims ((father_dims + 1), total_dims, 1); 2312 end; /* COBOL or BRIEF or SHORT */ 2313 2314 else do; 2315 start_level = max (1, runtime_symbol_info_$level (value_symbol_ptr)); 2316 /* for level 0 symbol, name stored in first */ 2317 running_dims = 0; 2318 do father_idx = 1 to start_level; 2319 element_symbol_ptr = global.father (father_idx); 2320 2321 name_string = name_string || element_name.str; 2322 sym_dim = 2323 runtime_symbol_info_$array_dims (element_symbol_ptr) 2324 - running_dims; 2325 call add_dims ((running_dims + 1), 2326 (running_dims + sym_dim), 1); 2327 running_dims = running_dims + sym_dim; 2328 if (father_idx < start_level) 2329 then /* there are more names ahead */ 2330 name_string = name_string || "."; 2331 end; 2332 end; /* end long naming */ 2333 2334 if (probe_info.language_type = C_lang_type 2335 & substr (name_string, 1, 1) = "!") 2336 then 2337 name_string = ""; 2338 2339 2340 return (name_string); 2341 2342 /* This entry just returns a name which can be used in messages */ 2343 2344 get_unsubscripted_name: 2345 entry () returns (char (256) varying); 2346 2347 name_string = ""; 2348 2349 start_level = max (1, runtime_symbol_info_$level (value_symbol_ptr)); 2350 /* for level 0 symbol, name stored in first */ 2351 2352 do father_idx = 1 to start_level; 2353 element_symbol_ptr = global.father (father_idx); 2354 name_string = name_string || element_name.str; 2355 name_string = name_string || "."; 2356 end; 2357 2358 element_symbol_ptr = value_symbol_ptr; 2359 name_string = name_string || element_name.str; 2360 return (name_string); 2361 2362 2363 2364 add_dims: 2365 proc (first, last, increment); 2366 2367 2368 dcl first fixed bin parameter; 2369 dcl last fixed bin parameter; 2370 dcl increment fixed bin parameter; 2371 2372 dcl dim_idx fixed bin; 2373 2374 /* Add dimension string to name_string if need be. The test sees whether there 2375* are any dimensions in the range to be added */ 2376 2377 2378 if ((increment * (last - first)) < 0) then do; 2379 return; 2380 end; 2381 2382 if (probe_info.language_type ^= C_lang_type) then do; 2383 name_string = name_string || " ("; 2384 do dim_idx = first to last by increment; 2385 name_string = name_string || 2386 ltrim (rtrim (character (global.indices (dim_idx)))); 2387 if (dim_idx ^= last) 2388 then name_string = name_string || ","; 2389 end; 2390 2391 name_string = name_string || ")"; 2392 end; 2393 else do; 2394 name_string = name_string || "["; 2395 do dim_idx = first to last by increment; 2396 name_string = name_string || 2397 ltrim (rtrim (character (global.indices (dim_idx)))); 2398 if (dim_idx ^= last) 2399 then name_string = name_string || "]["; 2400 end; 2401 2402 name_string = name_string || "]"; 2403 end; 2404 return; 2405 2406 end add_dims; 2407 2408 end get_symbol_name; 2409 2410 write_value_str: 2411 proc (); 2412 2413 2414 dcl delimiter char (32) varying; 2415 dcl value_len fixed bin; 2416 dcl max_len fixed bin; 2417 dcl buf_len fixed bin; 2418 dcl ind_len fixed bin; 2419 dcl include_value bit (1) aligned; 2420 2421 2422 include_value = "1"b; 2423 2424 if ^global.print_names then do; /* Get scalars out of the way quickly */ 2425 call ioa_$ioa_switch (global.output_switch, "^a", value_str); 2426 return; 2427 end; 2428 2429 goto COMMON; 2430 2431 2432 write_value_name: 2433 entry (); 2434 2435 2436 include_value = "0"b; 2437 2438 if ^global.print_names then do; 2439 return; 2440 end; 2441 2442 goto COMMON; 2443 2444 2445 COMMON: 2446 if global.probe_sw 2447 then delimiter = probe_modes.value_separator; 2448 else delimiter = " = "; 2449 2450 value_len = length (value_name) + length (delimiter); 2451 if include_value 2452 then value_len = value_len + length (value_str); 2453 2454 ind_len = indentation (); /* For efficiency only */ 2455 2456 if ^global.compress_output then do; 2457 call ioa_$ioa_switch_nnl (global.output_switch, 2458 "^vx^va^va^[^/^5x^vx^;^s^]^[^a^/^]", ind_len, 2459 length (value_name), value_name, 2460 length (delimiter), delimiter, 2461 ((value_len > 72) & include_value), ind_len, 2462 include_value, value_str); 2463 return; 2464 end; 2465 2466 buf_len = length (parent_output_info.buffer); 2467 max_len = global.line_length; 2468 2469 if ^include_value then do; 2470 2471 /* In this case, we've been asked not to include the value, on the presumption 2472* that it is a rather long string. So, we just print out the current buffer 2473* contents, possibly inserting a newline if the value name itself is too 2474* long for the current line. */ 2475 2476 call ioa_$ioa_switch_nnl (global.output_switch, 2477 "^va^[, ^]^[^/^vx^;^s^]^va^va", 2478 buf_len, parent_output_info.buffer, (buf_len > 0), 2479 ((buf_len + value_len + 2) > max_len), ind_len, 2480 length (value_name), value_name, 2481 length (delimiter), delimiter); 2482 2483 parent_output_info.buffer = copy (" ", indentation ()); 2484 return; /* Empty the buffer */ 2485 end; 2486 2487 if ((buf_len + value_len + 2) < max_len) then do; 2488 2489 /* In this case, the whole thing is small enough to fit in the current buffer, 2490* so we just append it and return, knowing that it will get printed later */ 2491 2492 if (parent_output_info.buffer ^= "") 2493 then /* Something there already */ 2494 parent_output_info.buffer = parent_output_info.buffer || ", "; 2495 parent_output_info.buffer = parent_output_info.buffer || value_name; 2496 parent_output_info.buffer = parent_output_info.buffer || delimiter; 2497 parent_output_info.buffer = parent_output_info.buffer || value_str; 2498 return; 2499 end; 2500 2501 /* If it didn't fit, then we'll just go to the next line and print the stuff */ 2502 2503 if (buf_len > 0) 2504 then /* Print the current buffer if it has any contents */ 2505 call ioa_$ioa_switch (global.output_switch, "^va,", 2506 buf_len, parent_output_info.buffer); 2507 2508 parent_output_info.buffer = copy (" ", ind_len); 2509 /* Empty the buffer */ 2510 2511 if ((value_len + 2) < max_len) then do; 2512 /* If it will fit, put it in */ 2513 parent_output_info.buffer = parent_output_info.buffer || value_name; 2514 parent_output_info.buffer = parent_output_info.buffer || delimiter; 2515 parent_output_info.buffer = parent_output_info.buffer || value_str; 2516 return; 2517 end; 2518 2519 /* Otherwise, write it out now, and leave the buffer empty */ 2520 2521 call ioa_$ioa_switch (global.output_switch, 2522 "^vx^va^va^[^/^5x^vx^;^s^]^a", 2523 ind_len, length (value_name), value_name, 2524 length (delimiter), delimiter, 2525 ((value_len + 2) > max_len), ind_len, 2526 value_str); 2527 return; 2528 2529 end write_value_str; 2530 2531 indentation: 2532 proc () returns (fixed bin); 2533 2534 dcl a_temp_value fixed bin; 2535 a_temp_value = 2536 get_indentation (runtime_symbol_info_$level (value_symbol_ptr)); 2537 return (a_temp_value); 2538 end indentation; 2539 2540 2541 next_indentation: 2542 proc () returns (fixed bin); 2543 2544 dcl a_temp_value fixed bin; 2545 a_temp_value = 2546 get_indentation (1 + runtime_symbol_info_$level (value_symbol_ptr)); 2547 return (a_temp_value); 2548 end next_indentation; 2549 2550 2551 get_indentation: 2552 proc (P_level) returns (fixed bin); 2553 2554 2555 dcl P_level fixed bin (6) parameter; 2556 2557 dcl amount fixed bin; 2558 dcl MAX_INDENT fixed bin internal static 2559 options (constant) init (12); 2560 2561 2562 if ^global.short_names | language (C_lang_type) then do; 2563 return (0); 2564 end; 2565 2566 amount = binary (P_level, 6) - 1; 2567 amount = max (amount, 0) * 2; 2568 amount = min (amount, MAX_INDENT); 2569 return (amount); 2570 2571 end get_indentation; 2572 2573 finish_output: 2574 proc (P_output_info_ptr, P_finish_bits); 2575 2576 2577 dcl P_output_info_ptr pointer parameter; 2578 dcl 1 finish_output_info aligned like output_info_template 2579 based (P_output_info_ptr); 2580 dcl P_finish_bits bit (1) aligned parameter; 2581 2582 2583 if ^global.compress_output then do; 2584 return; /* nothing to do */ 2585 end; 2586 2587 if (finish_output_info.buffer ^= "") 2588 then 2589 call ioa_$ioa_switch (global.output_switch, 2590 "^a", finish_output_info.buffer); 2591 2592 if P_finish_bits 2593 then call finish_bits (); 2594 2595 finish_output_info.buffer = copy (" ", indentation ()); 2596 /* for safety's sake */ 2597 return; 2598 2599 finish_bits: 2600 proc (); 2601 2602 2603 /* This procedure writes out the contents of any of the bit flag buffers we 2604* may have allocated, and frees them as it does so. */ 2605 2606 2607 call write_bitbufs ("ON:", 2608 finish_output_info.on_bits.first, 2609 finish_output_info.on_bits.last); 2610 2611 call write_bitbufs ("OFF:", 2612 finish_output_info.off_bits.first, 2613 finish_output_info.off_bits.last); 2614 return; 2615 2616 2617 2618 write_bitbufs: 2619 proc (P_name, P_first, P_last); 2620 2621 2622 dcl P_name char (4) parameter; 2623 dcl P_first pointer parameter; 2624 dcl P_last pointer parameter; 2625 2626 dcl bitbufp pointer; 2627 dcl 1 bitbuf aligned like bit_buffer based (bitbufp); 2628 dcl lastp pointer; 2629 2630 2631 lastp = null (); 2632 do bitbufp = P_first repeat (bitbuf.next) while (bitbufp ^= null ()); 2633 if (lastp ^= null ()) 2634 then free lastp -> bitbuf; 2635 call ioa_$ioa_switch (global.output_switch, 2636 "^vx^[^5a^;^5x^s^]^a", next_indentation (), 2637 (bitbufp = P_first), P_name, bitbuf.str); 2638 lastp = bitbufp; 2639 end; 2640 2641 if (lastp ^= null ()) 2642 then free lastp -> bitbuf; 2643 P_first = null (); 2644 P_last = null (); 2645 return; 2646 2647 end write_bitbufs; 2648 2649 end finish_bits; 2650 2651 end finish_output; 2652 2653 end print_symbol; 2654 2655 bitno: 2656 proc (p) returns (fixed bin (24)); 2657 2658 2659 dcl p pointer parameter; 2660 dcl o fixed bin (24) parameter; 2661 dcl 1 itsp aligned like its_unsigned; 2662 dcl bito fixed bin (24); 2663 dcl bitp pointer; 2664 dcl mod builtin; 1 1 /* BEGIN INCLUDE FILE its.incl.pl1 1 2* modified 27 July 79 by JRDavis to add its_unsigned 1 3* Internal format of ITS pointer, including ring-number field for follow-on processor */ 1 4 1 5 dcl 1 its based aligned, /* declaration for ITS type pointer */ 1 6 2 pad1 bit (3) unaligned, 1 7 2 segno bit (15) unaligned, /* segment number within the pointer */ 1 8 2 ringno bit (3) unaligned, /* ring number within the pointer */ 1 9 2 pad2 bit (9) unaligned, 1 10 2 its_mod bit (6) unaligned, /* should be 43(8) */ 1 11 1 12 2 offset bit (18) unaligned, /* word offset within the addressed segment */ 1 13 2 pad3 bit (3) unaligned, 1 14 2 bit_offset bit (6) unaligned, /* bit offset within the word */ 1 15 2 pad4 bit (3) unaligned, 1 16 2 mod bit (6) unaligned; /* further modification */ 1 17 1 18 dcl 1 itp based aligned, /* declaration for ITP type pointer */ 1 19 2 pr_no bit (3) unaligned, /* number of pointer register to use */ 1 20 2 pad1 bit (27) unaligned, 1 21 2 itp_mod bit (6) unaligned, /* should be 41(8) */ 1 22 1 23 2 offset bit (18) unaligned, /* word offset from pointer register word offset */ 1 24 2 pad2 bit (3) unaligned, 1 25 2 bit_offset bit (6) unaligned, /* bit offset relative to new word offset */ 1 26 2 pad3 bit (3) unaligned, 1 27 2 mod bit (6) unaligned; /* further modification */ 1 28 1 29 1 30 dcl 1 its_unsigned based aligned, /* just like its, but with unsigned binary */ 1 31 2 pad1 bit (3) unaligned, 1 32 2 segno fixed bin (15) unsigned unaligned, 1 33 2 ringno fixed bin (3) unsigned unaligned, 1 34 2 pad2 bit (9) unaligned, 1 35 2 its_mod bit (6) unaligned, 1 36 1 37 2 offset fixed bin (18) unsigned unaligned, 1 38 2 pad3 bit (3) unaligned, 1 39 2 bit_offset fixed bin (6) unsigned unaligned, 1 40 2 pad4 bit (3) unaligned, 1 41 2 mod bit (6) unaligned; 1 42 1 43 dcl 1 itp_unsigned based aligned, /* just like itp, but with unsigned binary where appropriate */ 1 44 2 pr_no fixed bin (3) unsigned unaligned, 1 45 2 pad1 bit (27) unaligned, 1 46 2 itp_mod bit (6) unaligned, 1 47 1 48 2 offset fixed bin (18) unsigned unaligned, 1 49 2 pad2 bit (3) unaligned, 1 50 2 bit_offset fixed bin (6) unsigned unaligned, 1 51 2 pad3 bit (3) unaligned, 1 52 2 mod bit (6) unaligned; 1 53 1 54 1 55 dcl ITS_MODIFIER bit (6) unaligned internal static options (constant) init ("43"b3); 1 56 dcl ITP_MODIFIER bit (6) unaligned internal static options (constant) init ("41"b3); 1 57 1 58 /* END INCLUDE FILE its.incl.pl1 */ 2665 2666 2667 /* This procedure can be flushed when this gets back to MIT */ 2668 2669 unspec (itsp) = unspec (p); 2670 return (36 * itsp.offset + itsp.bit_offset); 2671 2672 2673 addbitoffset: 2674 entry (p, o) returns (pointer); 2675 2676 2677 unspec (itsp) = unspec (p); 2678 bito = 36 * itsp.offset + itsp.bit_offset; 2679 bito = bito + o; 2680 itsp.offset = divide (bito, 36, 18, 0); 2681 itsp.bit_offset = mod (bito, 36); 2682 unspec (bitp) = unspec (itsp); 2683 return (bitp); 2684 2685 end bitno; 2686 2687 2 1 /* BEGIN INCLUDE FILE probe_info.incl.pl1 */ 2 2 2 3 2 4 2 5 /****^ HISTORY COMMENTS: 2 6* 1) change(88-10-24,WAAnderson), approve(88-10-24,MCR7952), 2 7* audit(88-10-24,RWaters), install(88-10-27,MR12.2-1194): 2 8* Added field 'retry_using_main' to add new C feature. 2 9* END HISTORY COMMENTS */ 2 10 2 11 2 12 /* Created: 04/22/79 W. Olin Sibert, from subsystem_info 2 13* Modified: 22 Sept 79 JRd to remove: default (ptr & (auto|based)) init (null ()); 2 14* Added flags.setting_break 08/22/83 Steve Herbst 2 15* Added flags.executing_quit_request 01/15/85 Steve Herbst 2 16**/ 2 17 2 18 dcl 1 probe_info aligned based (probe_info_ptr), /* standard data for a probe invocation */ 2 19 2 probe_info_version fixed bin, /* version of this structure */ 2 20 2 21 2 static_info_ptr pointer unaligned, /* pointer to static information structure */ 2 22 2 modes_ptr pointer unaligned, /* pointer to probe_modes structure */ 2 23 2 24 2 ptr_to_current_source ptr, /* current_source is based on this */ 2 25 2 ptr_to_initial_source ptr, /* initial_source is based on this */ 2 26 2 machine_cond_ptr pointer, /* pointer to machine conditions, if we faulted to get here */ 2 27 2 28 2 token_info aligned, /* information about token chain currently being processed */ 2 29 3 first_token pointer unaligned, /* first token in chain */ 2 30 3 ct pointer unaligned, /* pointer to current token; updated in MANY places */ 2 31 3 end_token bit (18) aligned, /* token type at which to stop scanning token chain */ 2 32 3 buffer_ptr pointer unaligned, /* pointer to input buffer */ 2 33 3 buffer_lth fixed bin (21), /* and length */ 2 34 2 35 2 random_info aligned, 2 36 3 current_stack_frame pointer unaligned, /* stack frame pointer for frame in which probe was invoked */ 2 37 3 input_type fixed bin, /* current input type */ 2 38 3 language_type fixed bin, /* current language being processed */ 2 39 3 return_method fixed bin, /* how we should return after exiting probe */ 2 40 3 entry_method fixed bin, /* how we got here in the first place */ 2 41 3 pad1 (19) bit (36) aligned, 2 42 2 43 2 break_info, /* break info -- only interesting if we got here via a break */ 2 44 3 break_slot_ptr pointer, /* pointer to break slot -- non-null IFF at a break */ 2 45 3 last_break_slot_ptr pointer unaligned, /* pointer to previous break slot, not presently used */ 2 46 3 break_reset bit (1) aligned, /* this break has been reset by somebody further on */ 2 47 3 real_break_return_loc pointer, /* where to REALLY return to, modulo previous bit */ 2 48 2 49 2 probe_area_info, /* information about various probe areas */ 2 50 3 break_segment_ptr pointer unaligned, /* pointer to Personid.probe */ 2 51 3 break_area_ptr pointer unaligned, /* pointer to area in break segment */ 2 52 3 scratch_area_ptr pointer unaligned, /* pointer to probe scratch seg in process dir */ 2 53 3 probe_area_ptr pointer unaligned, /* This area lasts as long as an invocation of probe. */ 2 54 3 work_area_ptr pointer unaligned, /* This area lasts as long as the current request line */ 2 55 3 expression_area_ptr pointer unaligned, /* This area lasts as long as the current command */ 2 56 2 57 2 flags aligned, /* this, in particular, should be saved and restored correctly */ 2 58 (3 execute, /* "1"b => execute requests, "0"b => just check syntax */ 2 59 3 in_listener, /* ON => in probe listener loop */ 2 60 3 executing_request, /* ON => executing a request */ 2 61 3 in_interpret_line, /* executing in probe_listen_$interpret_line */ 2 62 3 setting_break, /* executing "after" or "before": check syntax of "if" */ 2 63 3 executing_quit_request, /* to prevent error looping during "quit" request */ 2 64 3 pad (30)) bit (1) unaligned, 2 65 2 66 2 io_switches, /* switches probe will do normal I/O on */ 2 67 3 input_switch pointer, 2 68 3 output_switch pointer, 2 69 2 70 2 error_info, /* information about the last error saved for later printing */ 2 71 3 error_code fixed bin (35), 2 72 3 error_message char (300) varying, 2 73 2 74 2 listener_info, /* internal use by probe listener */ 2 75 3 request_name character (32) varying, /* primary name of the request being processed */ 2 76 3 abort_probe_label label variable, 2 77 3 abort_line_label label variable, 2 78 3 depth fixed binary, /* count of active invocations of probe */ 2 79 3 previous pointer unaligned, /* -> previous invocation's info */ 2 80 3 next pointer unaligned, 2 81 2 82 2 end_of_probe_info pointer aligned, 2 83 2 retry_using_main fixed bin aligned; 2 84 2 85 2 86 dcl probe_info_ptr pointer; 2 87 2 88 dcl probe_info_version fixed bin static options (constant) initial (1); 2 89 2 90 dcl probe_info_version_1 fixed bin static options (constant) initial (1); 2 91 2 92 dcl scratch_area area based (probe_info.scratch_area_ptr); 2 93 dcl probe_area area based (probe_info.probe_area_ptr); 2 94 dcl work_area area based (probe_info.work_area_ptr); 2 95 dcl expression_area area based (probe_info.expression_area_ptr); 2 96 2 97 /* END INCLUDE FILE probe_info.incl.pl1 */ 2688 2689 3 1 /* BEGIN INCLUDE FILE probe_static_info.incl.pl1 */ 3 2 3 3 /* * This include file describes per-process information about probe, such 3 4* * as various options available and the info directories and modes. 3 5* * 3 6* * Created: 06/06/79 W. Olin Sibert */ 3 7 3 8 dcl 1 probe_static_info aligned based (probe_info.static_info_ptr), /* per-process data about probe */ 3 9 2 probe_info_version fixed bin, /* same as probe_info.probe_info_version */ 3 10 3 11 2 version aligned, 3 12 3 major_version fixed bin, 3 13 3 minor_version fixed bin, 3 14 3 version_string char (32) unaligned, /* like "4.3f, patch 1" */ 3 15 3 16 2 name char (32) unaligned, /* "probe" */ 3 17 2 prompt character (40) varying, /* prompt for reading requests */ 3 18 2 switches, 3 19 3 brief_sw bit (1) unaligned, /* briefer break messages, no header (default OFF) */ 3 20 3 no_handle_faults_sw bit (1) unaligned, /* don't handle bad ptr faults (default OFF) */ 3 21 3 recursive_breaks_sw bit (1) unaligned, /* don't ignore recursive breaks in probe */ 3 22 3 prompt_on_sw bit (1) unaligned, /* prompt for request lines */ 3 23 3 switch_pad bit (32) unaligned, 3 24 3 25 2 scratch_segment_ptr pointer, /* pointer to probe_scratch_ -- always valid */ 3 26 2 break_segment_ptr pointer, /* pointer to Person.breaks -- valid only if needed */ 3 27 3 28 2 seg_info_offset_ptr pointer, /* pointer to seg_info_offset array */ 3 29 3 30 2 probe_segno bit (18), /* segment number of probe itself */ 3 31 2 last_break_segno bit (18), /* segment number of last interrupted program */ 3 32 3 33 2 stack_info aligned, /* information about the stack trace in probe_scratch_ */ 3 34 3 level_chain pointer unaligned, /* first level frame entry pointer */ 3 35 3 max_level fixed bin, /* number of stack levels */ 3 36 3 flags aligned, 3 37 (4 good_stack, 3 38 4 traced_with_all, /* whether the stack trace includes support frames */ 3 39 4 pad1 (34)) bit (1) unaligned, 3 40 3 41 2 modes_ptr pointer unaligned, /* pointer to modes -- same as probe_info.modes_ptr */ 3 42 3 43 2 request_table_info aligned, /* info for request definitions */ 3 44 3 array_ptr pointer, /* pointer to array of request table pointers */ 3 45 3 array_size fixed bin, /* number of elements in use */ 3 46 3 array_max_size fixed bin, /* max number of elements in array */ 3 47 3 using_internal_array bit (1) aligned, /* whether or not we are using the array in probe_static_info */ 3 48 3 49 2 io_switches, /* switches probe does its I/O on */ 3 50 3 input_switch pointer, 3 51 3 output_switch pointer, 3 52 3 (private_input_sw, private_output_sw) bit (1) aligned, 3 53 /* created by ids, ods and should be destroyed */ 3 54 3 55 2 info_directory_info aligned, /* info about info directories */ 3 56 3 array_ptr pointer, 3 57 3 array_size fixed bin, 3 58 3 array_max_size fixed bin, 3 59 3 using_internal_array bit (1) aligned, 3 60 3 61 2 exclude_name_info aligned, /* info for exclude array used in printing values */ 3 62 3 array_ptr pointer, 3 63 3 array_size fixed bin, 3 64 3 array_max_size fixed bin, 3 65 3 using_internal_array bit (1) aligned, 3 66 3 67 2 null_seg_info_ptr pointer unaligned, /* pointer to the "null" seg_info block */ 3 68 3 69 2 initial_arrays, /* initial versions of various arrays */ 3 70 3 request_table_ptr_array (10) pointer aligned, 3 71 3 info_directory_name_array (3) char (168) unaligned, 3 72 3 exclude_name_array (6) char (32) unaligned, 3 73 3 74 2 metering_info, /* last values for "mode meter" */ 3 75 3 last_clock fixed bin (71), 3 76 3 last_vclock fixed bin (71), 3 77 3 last_page_faults fixed bin, 3 78 3 79 2 end_of_probe_static_info fixed bin; 3 80 3 81 3 82 dcl 1 probe_seg_info_array aligned based (probe_static_info.seg_info_offset_ptr), 3 83 2 count fixed bin, /* number of entries in seg_info_offset array */ 3 84 2 seg_info_offset (0 : seg_info_offset_count refer (probe_seg_info_array.count)) bit (18) aligned; 3 85 3 86 dcl seg_info_offset_count fixed bin; /* one less than the number of info_offsets */ 3 87 3 88 dcl probe_request_tables (probe_static_info.request_table_info.array_max_size) /* array of request table pointers */ 3 89 pointer aligned based (probe_static_info.request_table_info.array_ptr); 3 90 3 91 dcl probe_info_directories (probe_static_info.info_directory_info.array_max_size) /* array of info directories */ 3 92 char (168) unaligned based (probe_static_info.info_directory_info.array_ptr); 3 93 3 94 dcl probe_exclude_names (probe_static_info.exclude_name_info.array_max_size) /* array of exclude names */ 3 95 char (168) unaligned based (probe_static_info.exclude_name_info.array_ptr); 3 96 3 97 /* END INCLUDE FILE probe_static_info.incl.pl1 */ 2690 2691 4 1 /* BEGIN INCLUDE FILE probe_references.incl.pl1 */ 4 2 4 3 /****^ HISTORY COMMENTS: 4 4* 1) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 4 5* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 4 6* Added new field (c_symbol) for C-Probe support. 4 7* 2) change(88-10-28,WAAnderson), approve(88-10-28,MCR7952), 4 8* audit(88-10-31,RWaters), install(88-11-11,MR12.2-1210): 4 9* Added new field (c_sub_c_ptr) for C-Probe_support. 4 10* END HISTORY COMMENTS */ 4 11 4 12 /* Split out of probe_tokens, 04/22/79 WOS */ 4 13 /* modified for probe variables Feb 19 80 JRD */ 4 14 /* Modified June 83 JMAthane to add "type_ptr" and "builtin" fields */ 4 15 4 16 dcl 1 reference_node aligned based, /* information about a reference */ 4 17 2 symbol_ptr pointer aligned, /* to symbol table entry for reference */ 4 18 2 type_ptr pointer aligned, /* to symbol table entry for type (null if none) */ 4 19 2 address_ptr pointer aligned, /* to location of variable */ 4 20 2 base_addr pointer aligned, /* pointer on which whole symbol is based */ 4 21 2 source_info_ptr pointer aligned, /* to symbol structure for reference */ 4 22 4 23 2 name char (256) unaligned varying, /* symbol name */ 4 24 4 25 2 type fixed bin (35), /* data type */ 4 26 2 descriptor fixed bin (35), /* type || packed */ 4 27 2 precision fixed bin (35), /* scale and precision */ 4 28 2 flags, 4 29 3 packed bit (1) unal, /* data is in packed format */ 4 30 3 constant bit (1) unal, /* data is really a constant */ 4 31 3 cross_section bit (1) unal, /* reference is an array cross-section */ 4 32 3 function bit (1) unal, /* reference is function value */ 4 33 3 octal bit (1) unal, /* indicates that this is the octal bif */ 4 34 3 star_extent bit (1) unal, /* reference is a star subscript for father */ 4 35 3 have_generation bit (1) unal, /* this reference has an explicitly specified generation */ 4 36 3 pseudo_var bit (1) unal, /* it is ok to assign to it */ 4 37 3 probe_variable bit (1) unal, 4 38 3 path bit (1) unal, /* it's a pathname/virtual entry */ 4 39 3 builtin bit (1) unal, /* probe builtinvalue */ 4 40 3 c_ptr_to_char bit (1) unal, 4 41 3 c_sub_c_ptr bit (1) unal, 4 42 3 pad2 bit (23) unal, 4 43 4 44 2 optional_info, /* information which may or may not be present */ 4 45 3 argument_list pointer unaligned, /* pointer to reference_arg_list */ 4 46 3 subscript_ptr pointer unaligned, /* pointer to reference_subscripts */ 4 47 3 n_arguments fixed bin, /* number of arguments in argument list */ 4 48 3 n_subscripts fixed bin, /* number of subscripts present */ 4 49 4 50 2 constant_token_ptr pointer unaligned, /* pointer to constant token if this is a constant */ 4 51 2 subscript_refs_ptr pointer unaligned, /* pointer to array of subscript reference node pointers */ 4 52 2 invocation_level fixed bin, /* invocation level number ("[-17]") for this reference */ 4 53 2 probe_var_info_ptr ptr unal, /* only if flags.probe_variable */ 4 54 2 c_symbol_ptr ptr unal, 4 55 2 pad1 (9) pointer unaligned, 4 56 2 end_of_reference_node pointer aligned; 4 57 4 58 4 59 dcl 1 reference_arg_list aligned based, /* argument list; based on reference.argument_list */ 4 60 2 number fixed bin, /* number of arguments actually present */ 4 61 2 node (16) pointer aligned; /* reference node pointers for each argument */ 4 62 4 63 4 64 dcl 1 reference_subscripts aligned based, /* subscript array; based on reference.subscript_ptr */ 4 65 2 number fixed bin, /* number actually present */ 4 66 2 value (2, 16) fixed bin (24); /* values for lower and upper bound for each */ 4 67 4 68 4 69 dcl 1 subscript_reference_ptrs aligned based, /* array of pointers to subscript reference nodes */ 4 70 2 ptr (2, 16) pointer aligned; 4 71 4 72 /* END INCLUDE FILE probe_references.incl.pl1 */ 2692 2693 5 1 /* BEGIN INCLUDE FILE ... probe_source_info.incl.pl1 5 2* 5 3* James R. Davis 2 July 79 */ 5 4 5 5 dcl 1 source_info based aligned, 5 6 2 stmnt_map_entry_index fixed bin, /* index in stmnt map for this stmnt */ 5 7 2 instruction_ptr ptr, /* to last instruction executed */ 5 8 2 block_ptr ptr, /* to runtime_block node */ 5 9 2 stack_ptr ptr, /* to a stack frame */ 5 10 2 entry_ptr ptr, /* to entry seq. for this proc */ 5 11 2 seg_info_ptr ptr; /* to seg_info */ 5 12 5 13 dcl 1 current_source aligned like source_info based (probe_info.ptr_to_current_source); 5 14 dcl 1 initial_source aligned like source_info based (probe_info.ptr_to_initial_source); 5 15 5 16 /* END INCLUDE FILE ... probe_source_info.incl.pl1 */ 2694 2695 6 1 /* BEGIN INCLUDE FILE ... probe_seg_info.incl.pl1 6 2* 6 3* 25 June 79 JRDavis 6 4* 6 5* Modified 7 April 1983, TO - Add fields for character offset/line 6 6* correction per file. 6 7**/ 6 8 6 9 dcl 1 seg_info based aligned, /* place to remember information about object seg */ 6 10 2 language_type fixed bin, /* language of source program */ 6 11 2 bits aligned, 6 12 3 ignore_case bit (1) unal, 6 13 3 bound_segment bit (1) unaligned, 6 14 3 component bit (1) unaligned, 6 15 3 pad bit (33) unal, 6 16 2 names, /* where to find it */ 6 17 3 directory_name character (168) unal, /* what directory */ 6 18 3 entry_name character (32) unal, /* what segment */ 6 19 3 segname character (32) unal, /* procedure segname definition */ 6 20 2 identifier fixed bin (71), /* time of object creation */ 6 21 2 pointers, /* location of various parts of segment */ 6 22 3 symbol_header_ptr ptr unal, /* to symbol section */ 6 23 3 original_source_ptr ptr unal, /* to segment source map */ 6 24 3 statement_map_ptr ptr unal, /* to segment statement map */ 6 25 3 break_info ptr unal, /* for unbound segments, and start of chain for 6 26* bound ones, -> break_map !obsolete, I think! */ 6 27 3 chain ptr unal, /* to entry for next component if bound */ 6 28 3 linkage_ptr ptr unal, /* to linkage section */ 6 29 2 bounds aligned, /* structure of bounds information */ 6 30 3 text_bounds, 6 31 4 start fixed bin (35), 6 32 4 end fixed bin (35), 6 33 3 symbol_bounds, 6 34 4 start fixed bin (35), 6 35 4 end fixed bin (35), 6 36 2 map_size fixed bin, /* size of statement map */ 6 37 2 error_code fixed bin (35), /* errors encoutered while getting info, are recorded here */ 6 38 2 bound_create_time fixed bin (71), /* time seg containing was bound or compiled. */ 6 39 2 bound_sym_header ptr unal, /* to sym. section header for bound seg */ 6 40 2 pad (1) fixed bin (35), 6 41 6 42 2 nfiles fixed bin, 6 43 2 per_file (seg_info_nfiles refer (seg_info.nfiles)), 6 44 3 file_pointers ptr unal, 6 45 3 break_line (0:3) fixed bin (18) unsigned unaligned; 6 46 6 47 dcl seg_info_nfiles fixed bin; /* for allocation purposes */ 6 48 6 49 6 50 /* END INCLUDE FILE ... probe_seg_info.incl.pl1 */ 2696 2697 7 1 /* BEGIN INCLUDE FILE ... probe_data_type_names.incl.pl1 7 2* 7 3* Extracted from psi.pl1 by JRDavis 15 Sept 79 7 4* This crude gem is used by probe_print_arglist_ 7 5* algol68 type names added 7/31/81 by MBW 7 6* Added pascal data type names 10/18/83 S. Herbst 7 7* Added hex floating point, extended, and generic types 02/08/84 S. Herbst 7 8* 7 9**/ 7 10 7 11 dcl type_name (0:80) char (40) static options (constant) init ( 7 12 "bad type 0", /* 0 */ 7 13 "fixed bin", /* 1 */ 7 14 "fixed bin", /* 2 */ 7 15 "float bin", /* 3 */ 7 16 "float bin", /* 4 */ 7 17 "complex fixed bin", /* 5 */ 7 18 "complex fixed bin", /* 6 */ 7 19 "complex float bin", /* 7 */ 7 20 "complex float bin", /* 8 */ 7 21 "fixed dec", /* 9 */ 7 22 "float dec", /* 10 */ 7 23 "complex fixed dec", /* 11 */ 7 24 "complex float dec", /* 12 */ 7 25 "pointer", /* 13 */ 7 26 "offset", /* 14 */ 7 27 "label variable", /* 15 */ 7 28 "entry variable", /* 16 */ 7 29 "structure", /* 17 */ 7 30 "area", /* 18 */ 7 31 "bit", /* 19 */ 7 32 "varying bit", /* 20 */ 7 33 "char", /* 21 */ 7 34 "varying char", /* 22 */ 7 35 "file", /* 23 */ 7 36 "label constant", /* 24 */ 7 37 "internal entry ", /* 25 */ 7 38 "external entry", /* 26 */ 7 39 "external procedure", /* 27 */ 7 40 "bad type 28", /* 28 */ 7 41 "overpunched ls", /* 29 */ 7 42 "overpunched ts", /* 30 */ 7 43 "bad type 31", /* 31 */ 7 44 "bad type 32", /* 32 */ 7 45 "unsigned binary", /* 33 */ 7 46 "unsigned binary", /* 34 */ 7 47 "unsigned dec", /* 35 */ 7 48 "fixed dec ts", /* 36 */ 7 49 "bad type 37", /* 37 */ 7 50 "fixed dec digit uns", /* 38 */ 7 51 "fixed dec digit ts", /* 39 */ 7 52 "bad type 40", /* 40 */ 7 53 "fixed dec digit ls", /* 41 */ 7 54 "float dec digit", /* 42 */ 7 55 "fixed dec byte", /* 43 */ 7 56 "float dec byte ", /* 44 */ 7 57 "cmplx fixed dec byte", /* 45 */ 7 58 "cmplx float dec byte", /* 46 */ 7 59 "float hex", /* 47 */ 7 60 "float hex", /* 48 */ 7 61 "complex float hex", /* 49 */ 7 62 "complex float hex", /* 50 */ 7 63 "bad type 51", /* 51 */ 7 64 "bad type 52", /* 52 */ 7 65 "bad type 53", /* 53 */ 7 66 "bad type 54", /* 54 */ 7 67 "bad type 55", /* 55 */ 7 68 "bad type 56", /* 56 */ 7 69 "bad type 57", /* 57 */ 7 70 "bad type 58", /* 58 */ 7 71 "algol68 straight", /* 59 */ 7 72 "algol68 format", /* 60 */ 7 73 "algol68 array descriptor", /* 61 */ 7 74 "algol68 union", /* 62 */ 7 75 "picture", /* 63 */ 7 76 "pascal typed pointer type", /* 64 */ 7 77 "pascal char", /* 65 */ 7 78 "pascal boolean", /* 66 */ 7 79 "pascal record file type", /* 67 */ 7 80 "pascal record type", /* 68 */ 7 81 "pascal set type", /* 69 */ 7 82 "pascal enumerated type", /* 70 */ 7 83 "pascal enumerated type element", /* 71 */ 7 84 "pascal enumerated type instance", /* 72 */ 7 85 "pascal user defined type", /* 73 */ 7 86 "pascal user defined type instance", /* 74 */ 7 87 "pascal text file", /* 75 */ 7 88 "pascal procedure type", /* 76 */ 7 89 "pascal variable formal parameter", /* 77 */ 7 90 "pascal value formal parameter", /* 78 */ 7 91 "pascal entry formal parameter", /* 79 */ 7 92 "pascal parameter procedure" /* 80 */ 7 93 ); 7 94 7 95 7 96 /* END INCLUDE FILE probe_data_type_names.incl.pl1 */ 2698 2699 8 1 /* BEGIN INCLUDE FILE ... probe_modes.incl.pl1 8 2* 8 3* this structure is part of the per-user data base, which alledgedly is 8 4* kept in person_id.probe no probe code other than probe_modes_mgr_ 8 5* should set these modes, or refer to them BY NAME in communication 8 6* with the user I do not even promise a one-to-one correspondance 8 7* between the modes the user can set and the names here 8 8* 8 9* James R. Davis 12 July 79 */ 8 10 /* Added meter 09/23/82 S. Herbst */ 8 11 /* Added truncate_strings 05/21/84 S. Herbst */ 8 12 8 13 8 14 dcl 1 probe_modes aligned based (probe_info.modes_ptr), 8 15 2 len_modes, 8 16 3 error_messages fixed bin, /* for use by probe_error_ */ 8 17 3 qualification fixed bin, /* for use by probe_print_value_ */ 8 18 3 value_print fixed bin, /* for probe_print_value_ */ 8 19 3 pad (5) fixed bin, /* for use by probe_mxyzptlk */ 8 20 2 value_separator char (32) varying, 8 21 2 bits, 8 22 3 use_exclude_names bit (1) unal, 8 23 3 debug_modes_set bit (1) unaligned, /* whether any of the *MAGIC* modes are set */ 8 24 3 ignore_faults bit (1) unaligned, 8 25 3 octal_bitstrings bit (1) unal, /* for Olin Sibert */ 8 26 3 catch_errors bit (1) unaligned, /* calls to probe_error_ will call cu_$cl */ 8 27 3 catch_error_once bit (1) unaligned, /* next call to probe_error_ will call cu_$cl */ 8 28 3 debug_breaks bit (1) unaligned, /* causes various things to happen at breakpoints */ 8 29 3 use_prompt bit (1) unaligned, /* whether to use the prompt */ 8 30 3 debug bit (1) unaligned, /* controls printing of random debugging information */ 8 31 3 meter bit (1) unaligned, /* controls printing of time, vcpu, pf's at halt */ 8 32 3 truncate_strings bit (1) unaligned, /* controls value req printing only 1st 200 chars/bits */ 8 33 3 pad bit (25) unaligned; 8 34 8 35 dcl (BRIEF_mode_type init (1), 8 36 SHORT_mode_type init (2), 8 37 LONG_mode_type init (3)) fixed bin internal static options (constant); 8 38 8 39 /* END INCLUDE FILE ... probe_modes.incl.pl1 */ 8 40 2700 2701 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 */ 2702 2703 10 1 /* BEGIN INCLUDE FILE --- acc.incl.pl1 10 2* 10 3*James R. Davis 21 Nov 78 10 4**/ 10 5 10 6 dcl 1 acc based aligned, 10 7 2 num_chars fixed bin (9) unsigned unaligned, 10 8 2 string char (0 refer (acc.num_chars)) unaligned; 10 9 10 10 /* END INCLUDE FILE --- acc.incl.pl1 */ 2704 2705 11 1 /* BEGIN INCLUDE FILE ... computational_data.incl.pl1 11 2* 11 3* 12 July 79 JRDavis */ 11 4 11 5 /* this is the format of the structure given to assign_$computational_ 11 6* that describes the data to be assigned */ 11 7 11 8 dcl 1 computational_data aligned based, 11 9 2 address ptr aligned, /* to data */ 11 10 2 data_type fixed bin (17), /* standard descriptor type */ 11 11 2 flags aligned, 11 12 3 packed bit (1) unal, 11 13 3 pad bit (35) unal, 11 14 2 prec_or_length fixed bin (24), /* string length or arith prec */ 11 15 2 scale fixed bin (35), /* must be zero even if has no scale */ 11 16 2 picture_image_ptr ptr aligned; /* to picture image block */ 11 17 11 18 /* END INCLUDE FILE ... computational_data.incl.pl1 */ 2706 2707 12 1 /* BEGIN INCLUDE FILE ... data_type_info_.incl.pl1 12 2* 12 3* attributes of each Multics data type. You may not rely on the dimension never exceeding 64 12 4* James R. Davis 6 Apr 79 12 5* Modified JMAthane June 83 to add "type" bit field 12 6* Upped bound from 64 to 80 10/18/83 S. Herbst 12 7* Added "hex" and "generic" bits 01/23/84 S. Herbst 12 8* Upped bound from 80 to 86 01/81/84 R. Gray 12 9* Upper bound from 86 to 87 JMAthane (for Pascal strings type dtype) 12 10**/ 12 11 12 12 12 13 /****^ HISTORY COMMENTS: 12 14* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 12 15* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1208): 12 16* The data_type_info array now has 87 entries instead of 86 due to 12 17* introduction of pascal_string_type_dtype. 12 18* END HISTORY COMMENTS */ 12 19 12 20 dcl data_type_info_$version_number fixed bin external static; 12 21 dcl data_type_info_this_version fixed bin internal static options (constant) init (1); 12 22 12 23 dcl 1 data_type_info_$info (87) aligned external static, 12 24 2 computational bit (1) unal, 12 25 2 arithmetic bit (1) unal, 12 26 2 arithmetic_attributes unal, /* only valid if arithmetic */ 12 27 3 fixed bit (1) unal, /* PL/I type */ 12 28 3 complex bit (1) unal, /* PL/I mode */ 12 29 3 decimal bit (1) unal, /* PL/I base */ 12 30 3 signed bit (1) unal, 12 31 3 trailing_sign bit (1) unal, /* only valid if signed */ 12 32 3 decimal_attributes unal, /* only valid if decimal */ 12 33 4 packed_dec bit (1) unal, /* 4 bits per digit or 9 */ 12 34 4 digit_aligned bit (1) unal, /* valid for packed_dec only */ 12 35 4 overpunched bit (1) unal, 12 36 2 char_string bit (1) unal, /* valid for non-arithmetic */ 12 37 2 bit_string bit (1) unal, /* valid for non-arithmetic */ 12 38 2 varying bit (1) unal, /* for bit or char only */ 12 39 2 type bit (1) unal, /* this symbol is a type */ 12 40 2 hex bit (1) unal, /* a hexadecimal type (eg., hex floating point) */ 12 41 2 generic bit (1) unal, /* eg., real_flt_dec_generic_dtype */ 12 42 2 pad bit (20) unal; 12 43 12 44 dcl data_type_info_$ninebit_sign_chars char (2) external static; 12 45 dcl data_type_info_$ninebit_digit_chars char (10) external static; 12 46 dcl data_type_info_$ninebit_overpunched_sign_chars char (22) external static; 12 47 12 48 dcl data_type_info_$max_decimal_precision fixed bin external static; 12 49 dcl data_type_info_$max_float_binary_precision fixed bin external static; 12 50 dcl data_type_info_$max_fixed_binary_precision fixed bin external static; 12 51 12 52 12 53 /* END INCLUDE FILE ... data_type_info_.incl.pl1 */ 2708 2709 13 1 /* BEGIN INCLUDE FILE ... encoded_precision.incl.pl1 13 2* 13 3* This is the format used by assign_ to encode the precision and scale of 13 4* arithmetic data into one word. This structure should be assigned (use unspec) 13 5* to a fixed bin (35). 13 6**/ 13 7 13 8 dcl 1 encoded_precision based aligned, 13 9 2 scale fixed bin (17) unal, 13 10 2 prec fixed bin (18) unsigned unal; 13 11 13 12 /* END INCLUDE FILE ... encoded_precision.incl.pl1 */ 2710 2711 14 1 /* BEGIN INCLUDE FILE ... picture_image.incl.pl1 14 2* 14 3* James R. Davis 12 Mar 79 14 4**/ 14 5 14 6 dcl 1 picture_image aligned based, 14 7 2 type fixed bin (8) unal, 14 8 2 prec fixed bin (8) unal, /* precision or length of associated value */ 14 9 2 scale fixed bin (8) unal, /* for both fixed and float pictures, 14 10* =ndigits after "v" - scale_factor */ 14 11 2 piclength fixed bin (8) unal, /* length of picture_constant.chars, <64 14 12* =length of normalized-picture-string */ 14 13 2 varlength fixed bin (8) unal, /* length of pictured variable in chars, <64 14 14* =length of normalized_picture_string - "k" and "v" */ 14 15 2 scalefactor fixed bin (8) unal, /* value of pict-sc-f, -256<=x<256 */ 14 16 2 explength fixed bin (8) unal, /* length of exp field for float */ 14 17 2 drift_character char (1) unal, 14 18 2 chars char (0 refer (picture_image.piclength)) aligned; 14 19 14 20 dcl ( 14 21 picture_char_type init (24), 14 22 picture_realfix_type init (25), 14 23 picture_complexfix_type 14 24 init (26), 14 25 picture_realflo_type init (27), 14 26 picture_complexflo_type 14 27 init (28) 14 28 ) fixed bin (8) unal static internal options (constant); 14 29 14 30 /* END INCLUDE FILE ... picture_image.incl.pl1 */ 2712 2713 15 1 /* BEGIN INCLUDE FILE ... runtime_symbol.incl.pl1 ... Modified 07/79 */ 15 2 15 3 dcl 1 runtime_symbol aligned based, 15 4 2 flag unal bit(1), /* always "1"b for Version II */ 15 5 2 use_digit unal bit(1), /* if "1"b and units are half words units are really digits */ 15 6 2 array_units unal bit(2), 15 7 2 units unal bit(2), /* addressing units */ 15 8 2 type unal bit(6), /* data type */ 15 9 2 level unal bit(6), /* structure level */ 15 10 2 ndims unal bit(6), /* number of dimensions */ 15 11 2 bits unal, 15 12 3 aligned bit(1), 15 13 3 packed bit(1), 15 14 3 simple bit(1), 15 15 2 skip unal bit(1), 15 16 2 scale unal bit(8), /* arithmetic scale factor */ 15 17 2 name unal bit(18), /* rel ptr to acc name */ 15 18 2 brother unal bit(18), /* rel ptr to brother entry */ 15 19 2 father unal bit(18), /* rel ptr to father entry */ 15 20 2 son unal bit(18), /* rel ptr to son entry */ 15 21 2 address unal, 15 22 3 location bit(18), /* location in storage class */ 15 23 3 class bit(4), /* storage class */ 15 24 3 next bit(14), /* rel ptr to next of same class */ 15 25 2 size fixed bin(35), /* encoded string|arith size */ 15 26 2 offset fixed bin(35), /* encoded offset from address */ 15 27 2 virtual_org fixed bin(35), 15 28 2 bounds(1), 15 29 3 lower fixed bin(35), /* encoded lower bound */ 15 30 3 upper fixed bin(35), /* encoded upper bound */ 15 31 3 multiplier fixed bin(35); /* encoded multiplier */ 15 32 15 33 dcl 1 runtime_bound based, 15 34 2 lower fixed bin(35), 15 35 2 upper fixed bin(35), 15 36 2 multiplier fixed bin(35); 15 37 15 38 dcl 1 runtime_block aligned based, 15 39 2 flag unal bit(1), /* always "1"b for Version II */ 15 40 2 quick unal bit(1), /* "1"b if quick block */ 15 41 2 fortran unal bit(1), /* "1"b if fortran program */ 15 42 2 standard unal bit(1), /* "1"b if program has std obj segment */ 15 43 2 owner_flag unal bit(1), /* "1"b if block has valid owner field */ 15 44 2 skip unal bit(1), 15 45 2 type unal bit(6), /* = 0 for a block node */ 15 46 2 number unal bit(6), /* begin block number */ 15 47 2 start unal bit(18), /* rel ptr to start of symbols */ 15 48 2 name unal bit(18), /* rel ptr to name of proc */ 15 49 2 brother unal bit(18), /* rel ptr to brother block */ 15 50 2 father unal bit(18), /* rel ptr to father block */ 15 51 2 son unal bit(18), /* rel ptr to son block */ 15 52 2 map unal, 15 53 3 first bit(18), /* rel ptr to first word of map */ 15 54 3 last bit(18), /* rel ptr to last word of map */ 15 55 2 entry_info unal bit(18), /* info about entry of quick block */ 15 56 2 header unal bit(18), /* rel ptr to symbol header */ 15 57 2 chain(4) unal bit(18), /* chain(i) is rel ptr to first symbol 15 58* on start list with length >= 2**i */ 15 59 2 token(0:5) unal bit(18), /* token(i) is rel ptr to first token 15 60* on list with length >= 2 ** i */ 15 61 2 owner unal bit(18); /* rel ptr to owner block */ 15 62 15 63 dcl 1 runtime_token aligned based, 15 64 2 next unal bit(18), /* rel ptr to next token */ 15 65 2 dcl unal bit(18), /* rel ptr to first dcl of this token */ 15 66 2 name, /* ACC */ 15 67 3 size unal unsigned fixed bin (9), /* number of chars in token */ 15 68 3 string unal char(n refer(runtime_token.size)); 15 69 15 70 dcl 1 encoded_value aligned based, 15 71 2 flag bit (2) unal, 15 72 2 code bit (4) unal, 15 73 2 n1 bit (6) unal, 15 74 2 n2 bit (6) unal, 15 75 2 n3 bit (18) unal; 15 76 15 77 /* END INCLUDE FILE ... runtime_symbol.incl.pl1 */ 2714 2715 16 1 /* BEGIN INCLUDE FILE runtime_symbol_info_.incl.pl1 */ 16 2 16 3 16 4 /****^ HISTORY COMMENTS: 16 5* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 16 6* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1208): 16 7* Added runtime_symbol_info_$subrange entry which was missing. Added 16 8* has_dimensions and has subrange_limits fields in type_info record. 16 9* Structure version numbers have not been changed since this change does not 16 10* affect existing programs. 16 11* END HISTORY COMMENTS */ 16 12 16 13 /* Declarations for using the various entry points in runtime_symbol_info_ */ 16 14 /* NOTE: These entries do not support PL/1 version 1. */ 16 15 16 16 /* Made structures aligned, removed variable extent from runtime_array_info.bounds 08/25/83 S. Herbst */ 16 17 /* Added version strings to structures 10/05/83 S. Herbst */ 16 18 /* Added has_dimensions and has_subrange_limits bits in type_info 16 19*Added subrange entry. JMAthane 08/31/84 */ 16 20 16 21 16 22 dcl runtime_symbol_info_$type entry (ptr, ptr, fixed bin (35)); 16 23 16 24 dcl 1 runtime_type_info aligned based, 16 25 2 version char (8), /* = "RUNTYP_1" */ 16 26 2 flags, 16 27 3 aligned bit (1) unal, 16 28 3 packed bit (1) unal, 16 29 3 size_is_encoded bit (1) unal, 16 30 3 has_dimensions bit (1) unal, 16 31 3 has_subrange_limits bit (1) unal, 16 32 3 pad bit (23) unal, 16 33 2 scale fixed bin (7) unal, 16 34 2 (type, base_type) fixed bin (18) unsigned unal, 16 35 2 (type_addr, base_type_addr) ptr, 16 36 2 size fixed bin (35); 16 37 16 38 dcl runtime_symbol_info_$father entry (ptr) returns (ptr); 16 39 16 40 dcl runtime_symbol_info_$brother entry (ptr) returns (ptr); 16 41 16 42 dcl runtime_symbol_info_$father_type entry (ptr) returns (ptr); 16 43 16 44 dcl runtime_symbol_info_$son entry (ptr) returns (ptr); 16 45 16 46 dcl runtime_symbol_info_$successor entry (ptr) returns (ptr); 16 47 16 48 dcl runtime_symbol_info_$name entry (ptr) returns (ptr); 16 49 16 50 dcl runtime_symbol_info_$level entry (ptr) returns (fixed bin); 16 51 16 52 dcl runtime_symbol_info_$next entry (ptr) returns (ptr); 16 53 16 54 dcl runtime_symbol_info_$address entry (ptr, ptr, fixed bin (35)); 16 55 16 56 dcl 1 runtime_address_info aligned based, 16 57 2 version char (8), /* = "RUNADR_1" */ 16 58 2 location fixed bin (18) unsigned unal, 16 59 2 class fixed bin (6) unsigned unal, 16 60 2 use_digit fixed bin (1) unsigned unal, 16 61 2 units fixed bin (2) unsigned unal, 16 62 2 offset_is_encoded bit (1) unal, 16 63 2 pad bit (8) unal, 16 64 2 offset fixed bin (35); 16 65 16 66 dcl runtime_symbol_info_$array_dims entry (ptr) returns (fixed bin); 16 67 16 68 dcl runtime_symbol_info_$array entry (ptr, ptr, fixed bin (35)); 16 69 16 70 dcl 1 runtime_array_info aligned based, 16 71 2 version char (8), /* = "RUNARY_1" */ 16 72 2 access_info aligned, 16 73 3 ndims fixed bin (6) unsigned unaligned, /* number of dimensions */ 16 74 3 use_digit fixed bin (1) unsigned unaligned, /* if "1"b and units are half words, 16 75* units are really digits */ 16 76 3 array_units fixed bin (2) unsigned unaligned, 16 77 3 virtual_origin_is_encoded 16 78 bit (1) unaligned, 16 79 3 pad bit (26) unaligned, 16 80 2 virtual_origin fixed bin (35), 16 81 2 bounds (16) 16 82 aligned, 16 83 3 flags aligned, 16 84 4 lower_is_encoded 16 85 bit (1) unaligned, 16 86 4 upper_is_encoded 16 87 bit (1) unaligned, 16 88 4 multiplier_is_encoded 16 89 bit (1) unaligned, 16 90 4 pad bit (33) unaligned, 16 91 3 lower fixed bin (35), 16 92 3 upper fixed bin (35), 16 93 3 multiplier fixed bin (35), 16 94 3 subscript_type fixed bin (35), 16 95 3 subscript_type_addr ptr; 16 96 16 97 dcl n_dims fixed bin; 16 98 16 99 dcl runtime_symbol_info_$n_variants entry (ptr) returns (fixed bin (35)); 16 100 16 101 dcl runtime_symbol_info_$variant entry (ptr, ptr, fixed bin (35)); 16 102 16 103 dcl 1 runtime_variant_info aligned based, 16 104 2 version char (8), /* = "RUNVAR_1" */ 16 105 2 number_of_variants fixed bin, 16 106 2 first_value_in_set fixed bin (35), /* value corresponding to the first bit in set stings */ 16 107 2 case (n_variants), 16 108 3 set_addr ptr, /* bit string specifies cases; 16 109* set's base type is this node's type */ 16 110 3 brother_addr ptr; /* ptr to brother for this variant */ 16 111 16 112 dcl n_variants fixed bin (35); 16 113 16 114 dcl runtime_symbol_info_$subrange entry (ptr, ptr, fixed bin (35)); 16 115 16 116 dcl 1 runtime_subrange_info based, 16 117 2 version char (8), /* = "RUNSUB_1" */ 16 118 2 flags aligned, 16 119 3 has_subrange_limits bit (1) unal, 16 120 3 lower_bound_is_encoded bit (1) unal, 16 121 3 upper_bound_is_encoded bit (1) unal, 16 122 3 pad bit (33) unal, 16 123 2 subrange_lower_bound fixed bin (35), 16 124 2 subrange_upper_bound fixed bin (35); 16 125 16 126 16 127 dcl RUNTIME_TYPE_INFO_VERSION_1 char (8) int static options (constant) init ("RUNTYP_1"); 16 128 dcl RUNTIME_ADDRESS_INFO_VERSION_1 char (8) int static options (constant) init ("RUNADR_1"); 16 129 dcl RUNTIME_ARRAY_INFO_VERSION_1 char (8) int static options (constant) init ("RUNARY_1"); 16 130 dcl RUNTIME_VARIANT_INFO_VERSION_1 char (8) int static options (constant) init ("RUNVAR_1"); 16 131 dcl RUNTIME_SUBRANGE_INFO_VERSION_1 char (8) int static options (constant) init ("RUNSUB_1"); 16 132 16 133 16 134 /* END INCLUDE FILE runtime_symbol_info_.incl.pl1 */ 2716 2717 17 1 /* BEGIN INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 17 2 17 3 17 4 /****^ HISTORY COMMENTS: 17 5* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 17 6* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1208): 17 7* Added pascal_string_type_dtype descriptor type. Its number is 87. 17 8* Objects of this type are PASCAL string types. 17 9* 2) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 17 10* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 17 11* Added the new C types. 17 12* END HISTORY COMMENTS */ 17 13 17 14 /* This include file defines mnemonic names for the Multics 17 15* standard descriptor types, using both pl1 and cobol terminology. 17 16* PG 780613 17 17* JRD 790530 17 18* JRD 791016 17 19* MBW 810731 17 20* TGO 830614 Add hex types. 17 21* Modified June 83 JMAthane to add PASCAL data types 17 22* TGO 840120 Add float dec extended and generic, float binary generic 17 23**/ 17 24 17 25 dcl (real_fix_bin_1_dtype init (1), 17 26 real_fix_bin_2_dtype init (2), 17 27 real_flt_bin_1_dtype init (3), 17 28 real_flt_bin_2_dtype init (4), 17 29 cplx_fix_bin_1_dtype init (5), 17 30 cplx_fix_bin_2_dtype init (6), 17 31 cplx_flt_bin_1_dtype init (7), 17 32 cplx_flt_bin_2_dtype init (8), 17 33 real_fix_dec_9bit_ls_dtype init (9), 17 34 real_flt_dec_9bit_dtype init (10), 17 35 cplx_fix_dec_9bit_ls_dtype init (11), 17 36 cplx_flt_dec_9bit_dtype init (12), 17 37 pointer_dtype init (13), 17 38 offset_dtype init (14), 17 39 label_dtype init (15), 17 40 entry_dtype init (16), 17 41 structure_dtype init (17), 17 42 area_dtype init (18), 17 43 bit_dtype init (19), 17 44 varying_bit_dtype init (20), 17 45 char_dtype init (21), 17 46 varying_char_dtype init (22), 17 47 file_dtype init (23), 17 48 real_fix_dec_9bit_ls_overp_dtype init (29), 17 49 real_fix_dec_9bit_ts_overp_dtype init (30), 17 50 real_fix_bin_1_uns_dtype init (33), 17 51 real_fix_bin_2_uns_dtype init (34), 17 52 real_fix_dec_9bit_uns_dtype init (35), 17 53 real_fix_dec_9bit_ts_dtype init (36), 17 54 real_fix_dec_4bit_uns_dtype init (38), /* digit-aligned */ 17 55 real_fix_dec_4bit_ts_dtype init (39), /* byte-aligned */ 17 56 real_fix_dec_4bit_bytealigned_uns_dtype init (40), /* COBOL */ 17 57 real_fix_dec_4bit_ls_dtype init (41), /* digit-aligned */ 17 58 real_flt_dec_4bit_dtype init (42), /* digit-aligned */ 17 59 real_fix_dec_4bit_bytealigned_ls_dtype init (43), 17 60 real_flt_dec_4bit_bytealigned_dtype init (44), 17 61 cplx_fix_dec_4bit_bytealigned_ls_dtype init (45), 17 62 cplx_flt_dec_4bit_bytealigned_dtype init (46), 17 63 real_flt_hex_1_dtype init (47), 17 64 real_flt_hex_2_dtype init (48), 17 65 cplx_flt_hex_1_dtype init (49), 17 66 cplx_flt_hex_2_dtype init (50), 17 67 c_typeref_dtype init (54), 17 68 c_enum_dtype init (55), 17 69 c_enum_const_dtype init (56), 17 70 c_union_dtype init (57), 17 71 algol68_straight_dtype init (59), 17 72 algol68_format_dtype init (60), 17 73 algol68_array_descriptor_dtype init (61), 17 74 algol68_union_dtype init (62), 17 75 17 76 cobol_comp_6_dtype init (1), 17 77 cobol_comp_7_dtype init (1), 17 78 cobol_display_ls_dtype init (9), 17 79 cobol_structure_dtype init (17), 17 80 cobol_char_string_dtype init (21), 17 81 cobol_display_ls_overp_dtype init (29), 17 82 cobol_display_ts_overp_dtype init (30), 17 83 cobol_display_uns_dtype init (35), 17 84 cobol_display_ts_dtype init (36), 17 85 cobol_comp_8_uns_dtype init (38), /* digit aligned */ 17 86 cobol_comp_5_ts_dtype init (39), /* byte aligned */ 17 87 cobol_comp_5_uns_dtype init (40), 17 88 cobol_comp_8_ls_dtype init (41), /* digit aligned */ 17 89 real_flt_dec_extended_dtype init (81), /* 9-bit exponent */ 17 90 cplx_flt_dec_extended_dtype init (82), /* 9-bit exponent */ 17 91 real_flt_dec_generic_dtype init (83), /* generic float decimal */ 17 92 cplx_flt_dec_generic_dtype init (84), 17 93 real_flt_bin_generic_dtype init (85), /* generic float binary */ 17 94 cplx_flt_bin_generic_dtype init (86)) fixed bin internal static options (constant); 17 95 17 96 dcl (ft_integer_dtype init (1), 17 97 ft_real_dtype init (3), 17 98 ft_double_dtype init (4), 17 99 ft_complex_dtype init (7), 17 100 ft_complex_double_dtype init (8), 17 101 ft_external_dtype init (16), 17 102 ft_logical_dtype init (19), 17 103 ft_char_dtype init (21), 17 104 ft_hex_real_dtype init (47), 17 105 ft_hex_double_dtype init (48), 17 106 ft_hex_complex_dtype init (49), 17 107 ft_hex_complex_double_dtype init (50) 17 108 ) fixed bin internal static options (constant); 17 109 17 110 dcl (algol68_short_int_dtype init (1), 17 111 algol68_int_dtype init (1), 17 112 algol68_long_int_dtype init (2), 17 113 algol68_real_dtype init (3), 17 114 algol68_long_real_dtype init (4), 17 115 algol68_compl_dtype init (7), 17 116 algol68_long_compl_dtype init (8), 17 117 algol68_bits_dtype init (19), 17 118 algol68_bool_dtype init (19), 17 119 algol68_char_dtype init (21), 17 120 algol68_byte_dtype init (21), 17 121 algol68_struct_struct_char_dtype init (22), 17 122 algol68_struct_struct_bool_dtype init (20) 17 123 ) fixed bin internal static options (constant); 17 124 17 125 dcl (label_constant_runtime_dtype init (24), 17 126 int_entry_runtime_dtype init (25), 17 127 ext_entry_runtime_dtype init (26), 17 128 ext_procedure_runtime_dtype init (27), 17 129 picture_runtime_dtype init (63) 17 130 ) fixed bin internal static options (constant); 17 131 17 132 dcl (pascal_integer_dtype init (1), 17 133 pascal_real_dtype init (4), 17 134 pascal_label_dtype init (24), 17 135 pascal_internal_procedure_dtype init (25), 17 136 pascal_exportable_procedure_dtype init (26), 17 137 pascal_imported_procedure_dtype init (27), 17 138 pascal_typed_pointer_type_dtype init (64), 17 139 pascal_char_dtype init (65), 17 140 pascal_boolean_dtype init (66), 17 141 pascal_record_file_type_dtype init (67), 17 142 pascal_record_type_dtype init (68), 17 143 pascal_set_dtype init (69), 17 144 pascal_enumerated_type_dtype init (70), 17 145 pascal_enumerated_type_element_dtype init (71), 17 146 pascal_enumerated_type_instance_dtype init (72), 17 147 pascal_user_defined_type_dtype init (73), 17 148 pascal_user_defined_type_instance_dtype init (74), 17 149 pascal_text_file_dtype init (75), 17 150 pascal_procedure_type_dtype init (76), 17 151 pascal_variable_formal_parameter_dtype init (77), 17 152 pascal_value_formal_parameter_dtype init (78), 17 153 pascal_entry_formal_parameter_dtype init (79), 17 154 pascal_parameter_procedure_dtype init (80), 17 155 pascal_string_type_dtype init (87)) fixed bin int static options (constant); 17 156 17 157 17 158 /* END INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 2718 2719 18 1 /* BEGIN INCLUDE FILE its.incl.pl1 18 2* modified 27 July 79 by JRDavis to add its_unsigned 18 3* Internal format of ITS pointer, including ring-number field for follow-on processor */ 18 4 18 5 dcl 1 its based aligned, /* declaration for ITS type pointer */ 18 6 2 pad1 bit (3) unaligned, 18 7 2 segno bit (15) unaligned, /* segment number within the pointer */ 18 8 2 ringno bit (3) unaligned, /* ring number within the pointer */ 18 9 2 pad2 bit (9) unaligned, 18 10 2 its_mod bit (6) unaligned, /* should be 43(8) */ 18 11 18 12 2 offset bit (18) unaligned, /* word offset within the addressed segment */ 18 13 2 pad3 bit (3) unaligned, 18 14 2 bit_offset bit (6) unaligned, /* bit offset within the word */ 18 15 2 pad4 bit (3) unaligned, 18 16 2 mod bit (6) unaligned; /* further modification */ 18 17 18 18 dcl 1 itp based aligned, /* declaration for ITP type pointer */ 18 19 2 pr_no bit (3) unaligned, /* number of pointer register to use */ 18 20 2 pad1 bit (27) unaligned, 18 21 2 itp_mod bit (6) unaligned, /* should be 41(8) */ 18 22 18 23 2 offset bit (18) unaligned, /* word offset from pointer register word offset */ 18 24 2 pad2 bit (3) unaligned, 18 25 2 bit_offset bit (6) unaligned, /* bit offset relative to new word offset */ 18 26 2 pad3 bit (3) unaligned, 18 27 2 mod bit (6) unaligned; /* further modification */ 18 28 18 29 18 30 dcl 1 its_unsigned based aligned, /* just like its, but with unsigned binary */ 18 31 2 pad1 bit (3) unaligned, 18 32 2 segno fixed bin (15) unsigned unaligned, 18 33 2 ringno fixed bin (3) unsigned unaligned, 18 34 2 pad2 bit (9) unaligned, 18 35 2 its_mod bit (6) unaligned, 18 36 18 37 2 offset fixed bin (18) unsigned unaligned, 18 38 2 pad3 bit (3) unaligned, 18 39 2 bit_offset fixed bin (6) unsigned unaligned, 18 40 2 pad4 bit (3) unaligned, 18 41 2 mod bit (6) unaligned; 18 42 18 43 dcl 1 itp_unsigned based aligned, /* just like itp, but with unsigned binary where appropriate */ 18 44 2 pr_no fixed bin (3) unsigned unaligned, 18 45 2 pad1 bit (27) unaligned, 18 46 2 itp_mod bit (6) unaligned, 18 47 18 48 2 offset fixed bin (18) unsigned unaligned, 18 49 2 pad2 bit (3) unaligned, 18 50 2 bit_offset fixed bin (6) unsigned unaligned, 18 51 2 pad3 bit (3) unaligned, 18 52 2 mod bit (6) unaligned; 18 53 18 54 18 55 dcl ITS_MODIFIER bit (6) unaligned internal static options (constant) init ("43"b3); 18 56 dcl ITP_MODIFIER bit (6) unaligned internal static options (constant) init ("41"b3); 18 57 18 58 /* END INCLUDE FILE its.incl.pl1 */ 2720 2721 end display_data_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/17/00 1930.9 display_data_.pl1 >udd>sm>ds>w>ml>display_data_.pl1 2665 1 11/26/79 1420.6 its.incl.pl1 >ldd>incl>its.incl.pl1 2688 2 10/27/88 1439.2 probe_info.incl.pl1 >ldd>incl>probe_info.incl.pl1 2690 3 11/12/82 1724.3 probe_static_info.incl.pl1 >ldd>incl>probe_static_info.incl.pl1 2692 4 11/11/88 1701.5 probe_references.incl.pl1 >ldd>incl>probe_references.incl.pl1 2694 5 11/26/79 1420.6 probe_source_info.incl.pl1 >ldd>incl>probe_source_info.incl.pl1 2696 6 11/02/83 1945.0 probe_seg_info.incl.pl1 >ldd>incl>probe_seg_info.incl.pl1 2698 7 12/04/84 2112.1 probe_data_type_names.incl.pl1 >ldd>incl>probe_data_type_names.incl.pl1 2700 8 12/04/84 2112.2 probe_modes.incl.pl1 >ldd>incl>probe_modes.incl.pl1 2702 9 10/26/88 1355.5 probe_lang_types.incl.pl1 >ldd>incl>probe_lang_types.incl.pl1 2704 10 01/15/79 2302.9 acc.incl.pl1 >ldd>incl>acc.incl.pl1 2706 11 11/01/79 1712.9 computational_data.incl.pl1 >ldd>incl>computational_data.incl.pl1 2708 12 11/12/86 1848.0 data_type_info_.incl.pl1 >ldd>incl>data_type_info_.incl.pl1 2710 13 07/11/79 1811.3 encoded_precision.incl.pl1 >ldd>incl>encoded_precision.incl.pl1 2712 14 06/28/79 1304.8 picture_image.incl.pl1 >ldd>incl>picture_image.incl.pl1 2714 15 11/26/79 1420.6 runtime_symbol.incl.pl1 >ldd>incl>runtime_symbol.incl.pl1 2716 16 11/12/86 1848.0 runtime_symbol_info_.incl.pl1 >ldd>incl>runtime_symbol_info_.incl.pl1 2718 17 10/26/88 1355.5 std_descriptor_types.incl.pl1 >ldd>incl>std_descriptor_types.incl.pl1 2720 18 11/26/79 1420.6 its.incl.pl1 >ldd>incl>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. BIT_IOA_STRING 000124 constant varying char(12) initial array dcl 1814 ref 1861 1868 BRIEF_mode_type constant fixed bin(17,0) initial dcl 8-35 ref 715 COBOL_lang_type 000253 constant fixed bin(17,0) initial dcl 9-17 set ref 721 1726* 2291* C_lang_type 000260 constant fixed bin(17,0) initial dcl 9-17 set ref 404 420 680 683 687 692 764 877 895 925 1206 1241 1270 2008* 2012* 2258* 2280 2302 2334 2382 2562* FORTRAN_LOGICAL 000144 constant char(8) initial array packed unaligned dcl 1811 ref 1826 FORTRAN_lang_type 000254 constant fixed bin(17,0) initial dcl 9-17 set ref 1766* 1825* 2263* LONG_mode_type constant fixed bin(17,0) initial dcl 8-35 ref 706 MAX_INDENT constant fixed bin(17,0) initial dcl 2558 ref 2568 MINIMUM_TRIM constant fixed bin(17,0) initial dcl 211 ref 1739 1751 NOT_TOP_LEVEL 000241 constant bit(1) initial dcl 371 set ref 1481* PASCAL_lang_type 000251 constant fixed bin(17,0) initial dcl 9-17 set ref 478 692 731 1766* PL1_lang_type constant fixed bin(17,0) initial dcl 9-17 ref 214 593 P_amu_info_ptr parameter pointer dcl 198 ref 460 584 P_bit parameter bit(1) dcl 1915 in procedure "get_bitbuf" ref 1909 1921 P_bit parameter bit(1) dcl 633 in procedure "set_display_format" set ref 628 635* 638* P_bit_idx parameter fixed bin(17,0) dcl 632 ref 628 635 635 P_bits parameter bit packed unaligned dcl 1878 ref 1874 1888 P_code parameter fixed bin(35,0) dcl 205 set ref 394 397* 460 472 479* 565* 569* P_count parameter fixed bin(17,0) dcl 1421 ref 1415 1448 1450 P_create_sw parameter bit(1) dcl 1916 in procedure "get_bitbuf" set ref 1909 1921* 1927* P_create_sw parameter bit(1) dcl 1937 in procedure "find_or_create_bitbuf" ref 1934 1948 P_data_ptr parameter pointer dcl 199 ref 460 589 590 P_data_size parameter fixed bin(18,0) dcl 200 ref 460 590 P_display_format parameter bit dcl 195 ref 460 635 635 P_dont_print parameter bit(1) dcl 1422 in procedure "do_symbol_and_sons" ref 1415 1454 P_dont_print parameter bit(1) dcl 1297 in procedure "ignore_this_element" set ref 1293 1310* 1333* P_finish_bits parameter bit(1) dcl 2580 ref 2573 2592 P_first parameter pointer dcl 2623 in procedure "write_bitbufs" set ref 2618 2632 2635 2643* P_first parameter pointer dcl 1938 in procedure "find_or_create_bitbuf" set ref 1934 1948 1952 1952* P_first_name parameter char packed unaligned dcl 1419 set ref 1415 1448 1450* P_inherited_dims parameter fixed bin(17,0) dcl 795 ref 783 939 963 P_iocb_ptr parameter pointer dcl 194 ref 460 580 P_last parameter pointer dcl 2624 in procedure "write_bitbufs" set ref 2618 2644* P_last parameter pointer dcl 1939 in procedure "find_or_create_bitbuf" set ref 1934 1954 1955* 1958 P_last_name parameter char packed unaligned dcl 1419 set ref 1415 1450* P_level parameter fixed bin(6,0) dcl 2555 ref 2551 2566 P_match_name_count parameter fixed bin(17,0) dcl 197 ref 460 618 1321 P_match_names parameter varying char array dcl 196 ref 460 618 618 1322 P_n_subscripts parameter fixed bin(17,0) dcl 204 ref 460 607 608 P_name parameter char(4) packed unaligned dcl 2622 in procedure "write_bitbufs" set ref 2618 2635* P_name parameter varying char dcl 1879 in procedure "add_bit" ref 1874 P_output_info_ptr parameter pointer dcl 797 in procedure "print_symbol" ref 783 904 904 1377 1377 1502 1502 1921 1921 1927 1927 2185 2185 2466 2476 2483 2492 2492 2492 2495 2495 2496 2496 2497 2497 2503 2508 2513 2513 2514 2514 2515 2515 P_output_info_ptr parameter pointer dcl 2577 in procedure "finish_output" ref 2573 2587 2587 2595 2607 2607 2611 2611 P_probe_info_ptr parameter pointer dcl 206 ref 404 420 472 653 P_reference parameter structure level 1 dcl 207 set ref 472 479 479 P_start_ptr parameter pointer dcl 201 ref 460 591 P_subscripts parameter fixed bin(24,0) array dcl 203 ref 460 611 P_symbol_ptr parameter pointer dcl 202 set ref 460 597* 598 P_top_level_sw parameter bit(1) dcl 796 ref 783 904 936 986 2296 P_value_symbol_ptr parameter pointer dcl 793 ref 783 844 RUNTIME_ARRAY_INFO_VERSION_1 000152 constant char(8) initial packed unaligned dcl 16-129 ref 956 RUNTIME_TYPE_INFO_VERSION_1 000154 constant char(8) initial packed unaligned dcl 16-127 ref 1183 SHORT_mode_type constant fixed bin(17,0) initial dcl 8-35 ref 709 718 STRING_LIMIT constant fixed bin(17,0) initial dcl 209 ref 1758 1761 1831 1833 TEN_YEARS 000150 constant fixed bin(71,0) initial dcl 1554 ref 1634 1634 TOP_LEVEL 000242 constant bit(1) initial dcl 369 set ref 538* 561* a_temp_pointer 001730 automatic pointer dcl 1914 set ref 1921* 1927* 1931 a_temp_value 000100 automatic fixed bin(17,0) dcl 2534 in procedure "indentation" set ref 2535* 2537 a_temp_value 002066 automatic fixed bin(17,0) dcl 2544 in procedure "next_indentation" set ref 2545* 2547 acc based structure level 1 dcl 10-6 access_info 2 001132 automatic structure level 2 dcl 952 addr builtin function dcl 374 ref 479 479 538 538 561 561 904 904 958 958 1150 1185 1185 1194 1194 1230 1230 1233 1233 1258 1258 1261 1261 1315 1315 1377 1377 1481 1481 1487 1487 1502 1502 1590 1597 1597 1597 1597 1603 1612 1612 1612 1612 1627 1632 1632 1632 1632 1662 1662 2185 2185 addrel builtin function dcl 374 ref 412 434 517 530 773 887 1436 1667 1676 1684 1983 address 000100 automatic pointer level 2 in structure "source" dcl 1556 in procedure "display_arithmetic" set ref 1579* address 000110 automatic pointer level 2 in structure "target" dcl 1556 in procedure "display_arithmetic" set ref 1590* 1603* 1627* address_ptr 4 parameter pointer level 2 dcl 207 set ref 517* 517 530* 530 538 561 1045 1665 algol68_array_descriptor_dtype constant fixed bin(17,0) initial dcl 17-25 ref 2207 algol68_format_dtype constant fixed bin(17,0) initial dcl 17-25 ref 2205 algol68_straight_dtype constant fixed bin(17,0) initial dcl 17-25 ref 2203 algol68_union_dtype constant fixed bin(17,0) initial dcl 17-25 ref 2210 amount 000100 automatic fixed bin(17,0) dcl 2557 set ref 2566* 2567* 2567 2568* 2568 2569 amount_trimmed 001650 automatic fixed bin(35,0) dcl 1718 set ref 1756* 1771 1776 amu_info_ptr 6 000100 automatic pointer initial level 2 dcl 214 set ref 214* 584* 2064* 2069* 2091* 2115* 2129* 2146* area_dtype constant fixed bin(17,0) initial dcl 17-25 ref 2201 arithmetic 0(01) 000161 automatic bit(1) level 2 packed packed unaligned dcl 812 set ref 1511 arithmetic_attributes 0(02) 000161 automatic structure level 2 packed packed unaligned dcl 812 assign_$computational_ 000034 constant entry external dcl 333 ref 1597 1612 1632 azm_entry parameter bit(1) packed unaligned dcl 389 ref 386 404 base_addr 6 parameter pointer level 2 dcl 207 set ref 671 base_ptr 14 000100 automatic pointer initial level 2 dcl 214 set ref 214* 589* 671* 673 1015* 1194* 1276* 1662* base_type 3(18) 000124 automatic fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 809 set ref 1049* base_type_addr 6 000124 automatic pointer level 2 dcl 809 set ref 1062* based_file based file variable dcl 2159 set ref 2162* based_int based fixed bin(35,0) dcl 1656 ref 1665 1665 based_ints based fixed bin(9,0) array packed unsigned unaligned dcl 2016 ref 2024 based_label based label variable dcl 2139 ref 2145 based_offset based offset dcl 2082 ref 2096 2101 based_packed_ptr based pointer packed unaligned dcl 2061 set ref 2064* based_ptr based pointer dcl 1175 in procedure "get_value_info" ref 1273 based_ptr based pointer dcl 2060 in procedure "display_pointer" set ref 2069* based_string based char packed unaligned dcl 1721 ref 1740 1740 1743 1743 1746 1746 1766 1779 1791 1791 1797 1797 based_varying_len based fixed bin(35,0) dcl 1981 ref 1999 binary builtin function dcl 374 ref 590 1501 1826 2036 2042 2115 2115 2566 bit 0(18) 001774 automatic fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 2083 set ref 2102* bit_buffer based structure level 1 dcl 292 set ref 1949 bit_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1840 bit_offset 1(21) 002124 automatic fixed bin(6,0) level 2 in structure "itsp" packed packed unsigned unaligned dcl 2661 in procedure "bitno" set ref 2670 2678 2681* bit_offset 1(21) based fixed bin(6,0) level 2 in structure "its_unsigned" packed packed unsigned unaligned dcl 18-30 in procedure "display_data_" set ref 1233* 1233 1261* 1261 bit_radix 001704 automatic fixed bin(17,0) dcl 1819 set ref 1852* 1854* 1856* 1858* 1860 1861 1868 bit_string 0(11) 000161 automatic bit(1) level 2 in structure "value_data_info" packed packed unaligned dcl 812 in procedure "print_symbol" set ref 1515 bit_string based bit packed unaligned dcl 1809 in procedure "display_bit_string" set ref 1826 1842* 1861* 1868* bitbuf based structure level 1 dcl 2627 in procedure "write_bitbufs" set ref 2633 2641 bitbuf based structure level 1 dcl 1882 in procedure "add_bit" bitbufp 002112 automatic pointer dcl 2626 in procedure "write_bitbufs" set ref 2632* 2632* 2635 2635 2638* 2639 bitbufp 001714 automatic pointer dcl 1881 in procedure "add_bit" set ref 1890* 1892 1894 1896 1896 1898* 1903 1903 1903 1906 1906 bito 002126 automatic fixed bin(24,0) dcl 2662 set ref 2678* 2679* 2679 2680 2681 bitp 002130 automatic pointer dcl 2663 set ref 2682* 2683 bits 21 based structure level 2 in structure "probe_modes" dcl 8-14 in procedure "display_data_" bits 0(24) based structure level 2 in structure "runtime_symbol" packed packed unaligned dcl 15-3 in procedure "display_data_" bits_per_char parameter float bin(27) dcl 1975 ref 1971 1987 block_ptr 4 based pointer level 2 dcl 5-5 set ref 441* 659 blockp 12 000100 automatic pointer initial level 2 dcl 214 set ref 214* 597* 659* 661 661 1015* 1015 1015 1194* 1194* 1662* 1662* 2088* 2088* bounds 41 000100 automatic fixed bin(24,0) array level 3 in structure "global" dcl 214 in procedure "display_data_" set ref 611* 612 741* 742* 745* 965* 967* 969 976 bounds 7 based structure array level 2 in structure "runtime_symbol" dcl 15-3 in procedure "display_data_" bounds 4 001132 automatic structure array level 2 in structure "value_array_info" dcl 952 in begin block on line 950 brother 1(18) based bit(18) level 2 packed packed unaligned dcl 15-3 ref 1674 1676 buf_len 000113 automatic fixed bin(17,0) dcl 2417 set ref 2466* 2476* 2476 2476 2487 2503 2503* buffer 10 000424 automatic varying char(300) initial level 2 in structure "global_output_info" dcl 297 in procedure "display_data_" set ref 297* 494* buffer 10 based varying char(300) initial level 2 in structure "finish_output_info" dcl 2578 in procedure "finish_output" set ref 2587 2587* 2595* buffer 10 001450 automatic varying char(300) initial level 2 in structure "my_output_info" dcl 1428 in procedure "do_symbol_and_sons" set ref 1428* 1474* buffer 10 based varying char(300) initial level 2 in structure "parent_output_info" dcl 799 in procedure "print_symbol" set ref 2466 2476* 2483* 2492 2492* 2492 2495* 2495 2496* 2496 2497* 2497 2503* 2508* 2513* 2513 2514* 2514 2515* 2515 bufp 001740 automatic pointer dcl 1941 set ref 1949* 1950 1951 1952 1954 1955 1958* 1959 c_enum_const_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1542 1661 c_enum_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1460 1539 c_sub_c_ptr 116(12) parameter bit(1) level 3 packed packed unaligned dcl 207 set ref 394 890 c_typeref_dtype constant fixed bin(17,0) initial dcl 17-25 ref 409 771 877 1327 1460 c_union_dtype constant fixed bin(17,0) initial dcl 17-25 ref 416 420 687 777 1537 2280 calculate_address 34 000100 automatic bit(1) initial level 3 dcl 214 set ref 214* 600* 677* 680* 683* 687* 692* 699* 709 1194 char_dtype constant fixed bin(17,0) initial dcl 17-25 ref 890 char_string 0(10) 000161 automatic bit(1) level 2 packed packed unaligned dcl 812 set ref 1513 character builtin function dcl 374 ref 1776 2212 2385 2396 chars_per_word 001751 automatic float bin(27) dcl 1980 set ref 1987* 2036 2042 clock builtin function dcl 374 ref 1634 1634 code 000160 automatic fixed bin(35,0) dcl 1562 set ref 1597* 1598 1612* 1613 1617* complex 0(03) 000161 automatic bit(1) level 3 packed packed unaligned dcl 812 set ref 1623 compress_output 4 000100 automatic bit(1) initial level 3 dcl 214 set ref 214* 615* 1840 2456 2583 computational_data based structure level 1 dcl 11-8 constant 116(01) parameter bit(1) level 3 packed packed unaligned dcl 207 set ref 703 conversion 000000 stack reference condition dcl 381 ref 1608 convert builtin function dcl 374 ref 448 1211 1227 1229 1255 1257 convert_status_code_ 000036 constant entry external dcl 334 ref 1617 copy builtin function dcl 374 ref 494 1474 2483 2508 2595 cplx_flt_dec_generic_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1586 cplx_flt_hex_1_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1593 cross_section 116(02) parameter bit(1) level 3 packed packed unaligned dcl 207 set ref 680 742 data_type 2 000100 automatic fixed bin(17,0) level 2 in structure "source" dcl 1556 in procedure "display_arithmetic" set ref 1580* 1586 1586 1591 data_type 2 000110 automatic fixed bin(17,0) level 2 in structure "target" dcl 1556 in procedure "display_arithmetic" set ref 1591* 1593* 1604* 1628* data_type_info_$info 000100 external static structure array level 1 dcl 12-23 ref 1050 1192 date_time_$format 000040 constant entry external dcl 336 ref 1638 decimal 0(04) 000161 automatic bit(1) level 3 packed packed unaligned dcl 812 set ref 1567 delimiter 000100 automatic varying char(32) dcl 2414 set ref 2445* 2448* 2450 2457 2457 2457* 2476 2476 2476* 2496 2514 2521 2521 2521* dim_idx 000222 automatic fixed bin(17,0) dcl 2372 set ref 2384* 2385 2387* 2395* 2396 2398* display_file_value_ 000042 constant entry external dcl 338 ref 2162 divide builtin function dcl 374 ref 517 530 1227 1255 1860 2680 done 001362 automatic bit(1) dcl 1081 set ref 1110* 1112 1148* 1150* 1155 done_with_pascal 000551 automatic bit(1) packed unaligned dcl 301 set ref 479* 481 dont_print 001365 automatic bit(1) dcl 1085 set ref 1103* 1130* 1162* dont_print_me_this_time 000422 automatic bit(1) packed unaligned dcl 290 set ref 496* 536* 2258 2259* double_override 000557 automatic bit(1) packed unaligned dcl 306 set ref 392* 396* 416* 890 ele_num 000675 automatic fixed bin(17,0) dcl 827 set ref 841* 1153* 1153 1218 1246 1398* 1398 element_name based structure level 1 dcl 2248 in procedure "get_symbol_name" element_name based structure level 1 dcl 1300 in procedure "ignore_this_element" set ref 1315 1315 element_symbol_ptr 000210 automatic pointer dcl 2247 set ref 2264* 2265* 2270* 2272* 2278* 2286* 2294* 2295* 2319* 2321* 2322* 2353* 2354* 2358* 2359* encoded_precision based structure level 1 dcl 13-8 encoded_val parameter fixed bin(35,0) dcl 1005 set ref 1001 1011 1015* end_not_found 001752 automatic bit(1) initial packed unaligned dcl 2015 set ref 2015* 2023 2025* entry_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1525 ep 001352 automatic structure level 1 packed packed unaligned dcl 1043 set ref 1053* error_code 000550 automatic fixed bin(35,0) dcl 299 set ref 569 932* 958* 960 1015* 1020 1024* 1028 1185* 1187 1372* 1381* 1507* ext_entry_runtime_dtype constant fixed bin(17,0) initial dcl 17-125 ref 1530 ext_procedure_runtime_dtype constant fixed bin(17,0) initial dcl 17-125 ref 1530 father 122 000100 automatic pointer array level 3 dcl 214 set ref 994* 2304 2304* 2319 2353 father_dims 000207 automatic fixed bin(17,0) dcl 2246 set ref 2296* 2304* 2310* 2311 father_idx 000201 automatic fixed bin(17,0) dcl 2239 set ref 2318* 2319 2328* 2352* 2353* fb71 000154 automatic fixed bin(71,0) dcl 1561 set ref 1627 1634 1634 1638* file_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1528 finish_output_info based structure level 1 dcl 2578 first based pointer initial level 4 in structure "finish_output_info" dcl 2578 in procedure "finish_output" set ref 2607* first parameter fixed bin(17,0) dcl 2368 in procedure "add_dims" ref 2364 2378 2384 2395 first 4 based pointer initial level 4 in structure "parent_output_info" dcl 799 in procedure "print_symbol" set ref 1927* first 4 001450 automatic pointer initial level 4 in structure "my_output_info" dcl 1428 in procedure "do_symbol_and_sons" set ref 1428* first 000424 automatic pointer initial level 4 in structure "global_output_info" dcl 297 in procedure "display_data_" set ref 297* first 001450 automatic pointer initial level 4 in structure "my_output_info" dcl 1428 in procedure "do_symbol_and_sons" set ref 1428* first 4 000424 automatic pointer initial level 4 in structure "global_output_info" dcl 297 in procedure "display_data_" set ref 297* first based pointer initial level 4 in structure "parent_output_info" dcl 799 in procedure "print_symbol" set ref 1921* first 4 based pointer initial level 4 in structure "finish_output_info" dcl 2578 in procedure "finish_output" set ref 2611* first_dim 000634 automatic fixed bin(17,0) dcl 825 set ref 942* 975 1150 first_level 001126 automatic fixed bin(17,0) dcl 919 set ref 986* 988* 993 first_time_sw 001363 automatic bit(1) dcl 1082 set ref 1108* 1114 1115* fixed 0(02) 000161 automatic bit(1) level 3 in structure "value_data_info" packed packed unaligned dcl 812 in procedure "print_symbol" set ref 1623 fixed builtin function dcl 1307 in procedure "ignore_this_element" ref 1327 1327 fixed builtin function dcl 839 in procedure "print_symbol" ref 877 877 884 887 890 1661 1667 1674 1676 1682 1684 fixed builtin function dcl 1173 in procedure "get_value_info" ref 1217 1218 1218 1245 1246 1246 fixed builtin function dcl 376 in procedure "display_data_" ref 409 409 412 416 416 420 420 434 771 771 773 775 777 fixed builtin function dcl 1425 in procedure "do_symbol_and_sons" ref 1436 1460 1460 1460 flags 4 001132 automatic structure array level 3 in structure "value_array_info" dcl 952 in begin block on line 950 flags 3 000100 automatic structure level 2 in structure "source" dcl 1556 in procedure "display_arithmetic" flags 116 parameter structure level 2 in structure "P_reference" dcl 207 in procedure "display_data_" flags 2 000124 automatic structure level 2 in structure "value_info" packed packed unaligned dcl 809 in procedure "print_symbol" format_pointer_$its 000044 constant entry external dcl 339 ref 2069 2091 2115 2129 2146 format_pointer_$packed 000046 constant entry external dcl 341 ref 2064 fortran 0(02) based bit(1) level 2 packed packed unaligned dcl 15-38 ref 661 found_ptr 000604 automatic pointer dcl 431 set ref 441* frame 2 002020 automatic pointer level 2 dcl 2140 set ref 2146* get_line_length_$switch 000050 constant entry external dcl 343 ref 491 get_size_in_bits_ 000024 constant entry external dcl 320 ref 1218 1246 get_system_free_area_ 000052 constant entry external dcl 345 ref 488 global 000100 automatic structure level 1 dcl 214 global_output_info 000424 automatic structure level 1 dcl 297 set ref 538 538 561 561 hbound builtin function dcl 376 ref 618 930 header based structure level 2 in structure "parent_output_info" dcl 799 in procedure "print_symbol" header 000424 automatic structure level 2 in structure "global_output_info" dcl 297 in procedure "display_data_" set ref 493* header 000000 constant structure level 2 in structure "output_info_template" dcl 276 in procedure "display_data_" ref 493 1473 header based structure level 2 in structure "finish_output_info" dcl 2578 in procedure "finish_output" header 001450 automatic structure level 2 in structure "my_output_info" dcl 1428 in procedure "do_symbol_and_sons" set ref 1473* hexfp_space 000156 automatic fixed bin(71,0) dcl 1561 set ref 1590 high builtin function dcl 374 ref 1746 1746 i 001400 automatic fixed bin(17,0) dcl 1174 set ref 1270* idx 000616 automatic fixed bin(17,0) dcl 577 in procedure "set_globals_for_azm" set ref 610* 611 611 612 612* idx 001414 automatic fixed bin(17,0) dcl 1306 in procedure "ignore_this_element" set ref 1321* 1322* idx 000636 automatic fixed bin(17,0) dcl 647 in procedure "set_globals_for_probe" set ref 731* 735 735 735* 740 740 741 741 742 742 745 745* idx 001120 automatic fixed bin(17,0) dcl 915 in procedure "setup_subscripts" set ref 963* 965 965 965 967 967 967 969 969* 975* 976 978* 993* 994* include_value 000115 automatic bit(1) dcl 2419 set ref 2422* 2436* 2451 2457 2457* 2469 increment parameter fixed bin(17,0) dcl 2370 ref 2364 2378 2384 2395 ind_len 000114 automatic fixed bin(17,0) dcl 2418 set ref 2454* 2457* 2457* 2476* 2508 2521* 2521* index builtin function dcl 376 ref 1322 1766 indices 101 000100 automatic fixed bin(24,0) array level 3 dcl 214 set ref 612* 740* 930 969* 1150 1194 1194 1279 1397* 1412* 1662 1662 2385 2396 inherited_addr parameter pointer dcl 798 ref 783 1200 int_entry_runtime_dtype constant fixed bin(17,0) initial dcl 17-125 ref 1530 invalid_decimal_data based bit packed unaligned dcl 1558 set ref 1571* invert_sw 33 000100 automatic bit(1) initial level 3 dcl 214 set ref 214* 587* 661* 664* inxs 000100 automatic fixed bin(17,0) array dcl 501 set ref 508* 527* 542* 542 545 549* 550* 550 io_switches 66 based structure level 2 dcl 2-18 ioa_$ioa_switch 000054 constant entry external dcl 346 ref 735 864 978 1021 1379 1503 1618 1668 1688 1786 1791 1797 1868 2187 2425 2503 2521 2587 2635 ioa_$ioa_switch_nnl 000056 constant entry external dcl 347 ref 524 527 2457 2476 ioa_$rsnnl 000060 constant entry external dcl 348 ref 1450 1571 1861 2000 2031 2036 2042 2102 2115 2146 2214 iox_$user_output 000016 external static pointer dcl 316 ref 581 is_encoded parameter bit(1) packed unaligned dcl 1006 ref 1001 1011 its_unsigned based structure level 1 dcl 1-30 in procedure "bitno" its_unsigned based structure level 1 dcl 18-30 in procedure "display_data_" itsp 002124 automatic structure level 1 dcl 2661 set ref 2669* 2677* 2682 label 002020 automatic structure level 1 dcl 2140 set ref 2145* label_constant_runtime_dtype constant fixed bin(17,0) initial dcl 17-125 ref 1523 label_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1525 lang_type parameter fixed bin(17,0) dcl 2226 ref 2222 2230 language_type 30 000100 automatic fixed bin(17,0) initial level 3 in structure "global" dcl 214 in procedure "display_data_" set ref 214* 593* 675* 2230 language_type 21 based fixed bin(17,0) level 3 in structure "probe_info" dcl 2-18 in procedure "display_data_" ref 404 420 478 675 680 683 687 692 692 721 731 764 877 895 925 1206 1241 1270 2280 2302 2334 2382 last 2 000424 automatic pointer initial level 4 in structure "global_output_info" dcl 297 in procedure "display_data_" set ref 297* last 6 000424 automatic pointer initial level 4 in structure "global_output_info" dcl 297 in procedure "display_data_" set ref 297* last 6 001450 automatic pointer initial level 4 in structure "my_output_info" dcl 1428 in procedure "do_symbol_and_sons" set ref 1428* last 2 001450 automatic pointer initial level 4 in structure "my_output_info" dcl 1428 in procedure "do_symbol_and_sons" set ref 1428* last 6 based pointer initial level 4 in structure "parent_output_info" dcl 799 in procedure "print_symbol" set ref 1927* last parameter fixed bin(17,0) dcl 2369 in procedure "add_dims" ref 2364 2378 2384 2387 2395 2398 last 2 based pointer initial level 4 in structure "finish_output_info" dcl 2578 in procedure "finish_output" set ref 2607* last 6 based pointer initial level 4 in structure "finish_output_info" dcl 2578 in procedure "finish_output" set ref 2611* last 2 based pointer initial level 4 in structure "parent_output_info" dcl 799 in procedure "print_symbol" set ref 1921* lastp 002114 automatic pointer dcl 2628 set ref 2631* 2633 2633 2638* 2641 2641 len based fixed bin(9,0) level 2 in structure "element_name" packed packed unsigned unaligned dcl 1300 in procedure "ignore_this_element" set ref 1340 1342 1344 1346 1348 1350 1352 len based fixed bin(9,0) level 2 in structure "element_name" packed packed unsigned unaligned dcl 2248 in procedure "get_symbol_name" ref 2265 2286 2321 2354 2359 len_modes based structure level 2 dcl 8-14 length builtin function dcl 376 ref 635 1450 1450 1740 1743 1746 1892 1894 1894 1903 2450 2450 2451 2457 2457 2457 2457 2466 2476 2476 2476 2476 2521 2521 2521 2521 level_1_c_struct_dims_ptr 000554 automatic pointer dcl 303 set ref 402* 451* 511 517 530 545 level_1_c_struct_inx0 000100 automatic fixed bin(17,0) dcl 502 set ref 510* 511* 523* level_1_c_struct_inx1 000101 automatic fixed bin(17,0) dcl 502 set ref 526* 527* level_1_c_struct_inx2 000102 automatic fixed bin(17,0) dcl 502 set ref 543* 544 545 545 549 550 550 550 555* 555 level_1_c_struct_ndims 000552 automatic fixed bin(17,0) dcl 302 set ref 401* 448* 448 498 501 510 526 542 542 543 levels_of_pointer_indir 000676 automatic fixed bin(17,0) dcl 827 set ref 872* 884* 884 895 898* 1270 line_length 2 000100 automatic fixed bin(17,0) initial level 3 dcl 214 set ref 214* 491* 1893 2467 linkage_ptr 103 based pointer level 3 packed packed unaligned dcl 6-9 ref 667 linkp 26 000100 automatic pointer initial level 2 dcl 214 set ref 214* 595* 667* 1015* 1194* 1662* 2088* long_message 000121 automatic char(100) dcl 1559 set ref 1617* 1618* low builtin function dcl 376 ref 1743 1743 lower 5 001132 automatic fixed bin(35,0) array level 3 dcl 952 set ref 965* lower_is_encoded 4 001132 automatic bit(1) array level 4 packed packed unaligned dcl 952 set ref 965* ltrim builtin function dcl 376 ref 1621 1776 2212 2385 2396 max builtin function dcl 376 ref 989 2315 2349 2567 max_len 001753 automatic fixed bin(24,0) dcl 2018 in begin block on line 2014 set ref 2020* 2022* 2023 max_len 001717 automatic fixed bin(17,0) dcl 1884 in procedure "add_bit" set ref 1893* 1895 max_len 000112 automatic fixed bin(17,0) dcl 2416 in procedure "write_value_str" set ref 2467* 2476 2487 2511 2521 max_len 001750 automatic fixed bin(35,0) dcl 1979 in procedure "get_string_info" set ref 1998* 2000 2000* max_offset 16 000100 automatic fixed bin(18,0) initial level 2 dcl 214 set ref 214* 590* 672* 1501 2042 maxlength builtin function dcl 376 ref 1605 1860 message 002046 automatic char(40) packed unaligned dcl 2198 set ref 2201* 2203* 2205* 2207* 2210* 2212* 2214* min builtin function dcl 376 ref 2568 mod builtin function dcl 376 in procedure "display_data_" ref 1229 1257 1854 1856 mod builtin function dcl 2664 in procedure "bitno" ref 2681 modes_ptr 2 based pointer level 2 packed packed unaligned dcl 2-18 ref 706 709 714 715 718 1313 2445 multiplier 11 based fixed bin(35,0) array level 3 dcl 15-3 ref 517 530 my_bounds 000635 automatic fixed bin(24,0) array dcl 826 set ref 976* 978 978 1150* my_dims 000633 automatic fixed bin(17,0) dcl 824 set ref 926* 936* 939* 942 1148 1150 1150* 1241 my_father_is_a_typeref 000677 automatic bit(1) packed unaligned dcl 829 set ref 842* 873* 882* 1201 my_idx 001124 automatic fixed bin(17,0) dcl 917 set ref 974* 976 978 978 983* 983 my_indices based fixed bin(24,0) array dcl 1095 set ref 1150* my_level 000205 automatic fixed bin(17,0) dcl 2243 set ref 2294* 2302 2304 2304 my_output_info 001450 automatic structure level 1 dcl 1428 set ref 1481 1481 1487 1487 my_real_name_ptr 000702 automatic pointer dcl 831 set ref 843* 874* 880 881* 1201 1211 2012 2020 2272 2272 2280 n_bounds 40 000100 automatic fixed bin(17,0) level 3 dcl 214 set ref 607* 610 749* 753* n_dims 000564 automatic fixed bin(17,0) dcl 16-97 set ref 948* n_orig_indices 22 000100 automatic fixed bin(17,0) level 2 dcl 214 set ref 538* 561* 608* 750* 754* n_subscripts 122 parameter fixed bin(17,0) level 3 dcl 207 set ref 420 735 name 1 based bit(18) level 2 in structure "runtime_symbol" packed packed unaligned dcl 15-3 in procedure "display_data_" ref 434 1436 1667 name 12 parameter varying char(256) level 2 in structure "P_reference" dcl 207 in procedure "display_data_" set ref 437 441 524* 2280 2289 name_ptr 001624 automatic pointer dcl 1653 in procedure "display_c_enum" set ref 1667* 1668 1668 1668 1668 name_ptr 001602 automatic pointer dcl 1434 in procedure "dummy_node" set ref 1436* 1438 name_string 000100 automatic varying char(256) dcl 2238 set ref 2256* 2260 2265* 2280* 2280 2286* 2286 2289* 2291* 2291 2321* 2321 2328* 2328 2334 2334* 2340 2347* 2354* 2354 2355* 2355 2359* 2359 2360 2383* 2383 2385* 2385 2387* 2387 2391* 2391 2394* 2394 2396* 2396 2398* 2398 2402* 2402 nameptr 000600 automatic pointer dcl 429 set ref 434* 437 437 ndims 0(18) based bit(6) level 2 in structure "runtime_symbol" packed packed unaligned dcl 15-3 in procedure "display_data_" ref 448 1217 1245 ndims 2 001132 automatic fixed bin(6,0) level 3 in structure "value_array_info" packed packed unsigned unaligned dcl 952 in begin block on line 950 set ref 963 ndims 000632 automatic fixed bin(17,0) dcl 823 in procedure "print_symbol" set ref 923* 925 930 936 939 942 948 975 1481* new_len 001720 automatic fixed bin(17,0) dcl 1885 set ref 1894* 1895 next 114 based pointer level 2 in structure "bit_buffer" dcl 292 in procedure "display_data_" set ref 1951* 1954* next 114 based pointer level 2 in structure "bitbuf" dcl 2627 in procedure "write_bitbufs" ref 2639 no_handle_faults_sw 37 000100 automatic bit(1) initial level 3 in structure "global" dcl 214 in procedure "display_data_" set ref 214* 605* 728* 860 no_handle_faults_sw 36(01) based bit(1) level 3 in structure "probe_static_info" packed packed unaligned dcl 3-8 in procedure "display_data_" ref 728 not_found 001626 automatic bit(1) packed unaligned dcl 1655 set ref 1659* 1660 1671* 1687 null builtin function dcl 378 ref 214 214 214 214 214 214 214 214 297 297 297 297 402 407 445 581 594 595 661 677 692 700 731 748 768 843 854 874 880 1061 1062 1064 1208 1242 1286 1327 1428 1428 1428 1428 1460 1477 1584 1595 1606 1630 1660 1674 1682 1726 1726 1948 1951 1952 2012 2020 2091 2272 2278 2280 2304 2631 2632 2633 2641 2643 2644 nullo builtin function dcl 378 ref 2096 num_chars based fixed bin(9,0) level 2 packed packed unsigned unaligned dcl 10-6 ref 437 437 1438 1668 1668 1668 1668 number based fixed bin(17,0) level 2 dcl 649 ref 731 749 750 o parameter fixed bin(24,0) dcl 2660 ref 2673 2679 octal 116(04) parameter bit(1) level 3 packed packed unaligned dcl 207 set ref 658 octal_sw 32 000100 automatic bit(1) initial level 3 dcl 214 set ref 214* 586* 658* 1852 off_bits 4 001450 automatic structure level 3 in structure "my_output_info" dcl 1428 in procedure "do_symbol_and_sons" off_bits 4 based structure level 3 in structure "finish_output_info" dcl 2578 in procedure "finish_output" off_bits 4 based structure level 3 in structure "parent_output_info" dcl 799 in procedure "print_symbol" off_bits 4 000424 automatic structure level 3 in structure "global_output_info" dcl 297 in procedure "display_data_" offset 1 based fixed bin(18,0) level 2 in structure "its_unsigned" packed packed unsigned unaligned dcl 18-30 in procedure "display_data_" set ref 1230* 1230 1258* 1258 offset 5 based fixed bin(35,0) level 2 in structure "runtime_symbol" dcl 15-3 in procedure "display_data_" ref 1211 1211 offset 1 002124 automatic fixed bin(18,0) level 2 in structure "itsp" packed packed unsigned unaligned dcl 2661 in procedure "bitno" set ref 2670 2678 2680* offset_bits 001376 automatic fixed bin(6,0) unsigned dcl 1171 set ref 1210* 1211* 1211 1218* 1218 1227 1229* 1229 1229 1233 1244* 1246* 1246 1255 1257* 1257 1257 1261 offset_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1521 offset_overlay 001774 automatic structure level 1 packed packed unaligned dcl 2083 set ref 2101* offset_ptr 001772 automatic pointer dcl 2081 set ref 2088* 2091 2091* offset_words 001377 automatic fixed bin(18,0) unsigned dcl 1172 set ref 1227* 1227 1230 1255* 1255 1258 old_value_symbol_ptr 001102 automatic pointer dcl 838 set ref 875* 897 on_bits 001450 automatic structure level 3 in structure "my_output_info" dcl 1428 in procedure "do_symbol_and_sons" on_bits based structure level 3 in structure "finish_output_info" dcl 2578 in procedure "finish_output" on_bits based structure level 3 in structure "parent_output_info" dcl 799 in procedure "print_symbol" on_bits 000424 automatic structure level 3 in structure "global_output_info" dcl 297 in procedure "display_data_" optional_info 117 parameter structure level 2 dcl 207 orig_symbolp 10 000100 automatic pointer initial level 2 dcl 214 set ref 214* 538* 561* 598* 674* 677 692* output_info 000100 automatic structure level 2 dcl 214 output_info_template 000000 constant structure level 1 dcl 276 output_switch 70 based pointer level 3 in structure "probe_info" dcl 2-18 in procedure "display_data_" set ref 524* 527* 655 1668* 1688* output_switch 000100 automatic pointer initial level 3 in structure "global" dcl 214 in procedure "display_data_" set ref 214* 491* 580* 581 581* 655* 735* 864* 978* 1021* 1379* 1503* 1618* 1786* 1791* 1797* 1868* 2162* 2187* 2425* 2457* 2476* 2503* 2521* 2587* 2635* overflow 000000 stack reference condition dcl 381 ref 1609 override 000700 automatic bit(1) packed unaligned dcl 830 set ref 876* 890* 895 901* p parameter pointer dcl 2659 ref 2655 2669 2673 2677 packed 2(01) 000124 automatic bit(1) level 3 in structure "value_info" packed packed unaligned dcl 809 in procedure "print_symbol" set ref 1052* 1581 2064 packed 116 parameter bit(1) level 3 in structure "P_reference" packed packed unaligned dcl 207 in procedure "display_data_" set ref 1052 packed 3 000100 automatic bit(1) level 3 in structure "source" packed packed unaligned dcl 1556 in procedure "display_arithmetic" set ref 1581* packed 0(25) based bit(1) level 3 in structure "runtime_symbol" packed packed unaligned dcl 15-3 in procedure "display_data_" ref 1218 1246 parent_output_info based structure level 1 dcl 799 set ref 904 904 1377 1377 1502 1502 2185 2185 picture_image based structure level 1 dcl 14-6 picture_image_ptr 6 000110 automatic pointer level 2 in structure "target" dcl 1556 in procedure "display_arithmetic" set ref 1595* 1606* 1630* picture_image_ptr 6 000100 automatic pointer level 2 in structure "source" dcl 1556 in procedure "display_arithmetic" set ref 1584* picture_len 001640 automatic fixed bin(35,0) dcl 1702 set ref 1706* 1708 picture_ptr 001636 automatic pointer dcl 1701 set ref 1706* 1708 picture_runtime_dtype constant fixed bin(17,0) initial dcl 17-125 ref 1517 1990 picture_string based char packed unaligned dcl 1703 ref 1708 place 002020 automatic pointer level 2 dcl 2140 set ref 2146* pointer builtin function dcl 378 ref 1015 1015 1990 pointer_dtype constant fixed bin(17,0) initial dcl 17-25 ref 409 771 877 884 1327 1460 1519 2008 pointers 76 based structure level 2 dcl 6-9 prec 0(18) 001352 automatic fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 1043 set ref 1056 prec_or_length 4 000100 automatic fixed bin(24,0) level 2 in structure "source" dcl 1556 in procedure "display_arithmetic" set ref 1582* prec_or_length 4 000110 automatic fixed bin(24,0) level 2 in structure "target" dcl 1556 in procedure "display_arithmetic" set ref 1594* 1605* 1629* precision 115 parameter fixed bin(35,0) level 2 in structure "P_reference" dcl 207 in procedure "display_data_" set ref 1053 1058 2008 2010 precision 000120 automatic fixed bin(17,0) dcl 1557 in procedure "display_arithmetic" set ref 1565* 1567 1571 1571 1582 1623 previous_real_value_ptr 000626 automatic pointer dcl 820 set ref 1143* 1396 previous_value based bit packed unaligned dcl 1089 ref 1125 previous_value_data_info 000162 automatic structure level 1 dcl 812 set ref 1145* 1394 previous_value_indices 000164 automatic fixed bin(24,0) array dcl 814 set ref 1146* 1397 previous_value_info 000136 automatic structure level 1 unaligned dcl 809 set ref 1144* 1393 previous_value_name 000325 automatic char(256) packed unaligned dcl 818 set ref 1130* 1140* 1162* previous_value_ptr 000120 automatic pointer dcl 807 set ref 1121* 1125 1141* 1395 previous_value_symbol_ptr 000112 automatic pointer dcl 805 set ref 1142* 1392 print_names 36 000100 automatic bit(1) initial level 3 dcl 214 set ref 214* 602* 700* 703* 706* 709* 712* 2424 2438 print_the_data 000556 automatic bit(1) packed unaligned dcl 305 set ref 395* 399* 895 probe_error_$record 000022 constant entry external dcl 319 ref 1370 probe_et_$dim_limit 000010 external static fixed bin(35,0) dcl 311 ref 932 probe_et_$no_address 000014 external static fixed bin(35,0) dcl 314 set ref 1370* probe_et_$recorded_message 000012 external static fixed bin(35,0) dcl 312 ref 1372 probe_increment_indices_ 000026 constant entry external dcl 322 ref 1150 probe_info based structure level 1 dcl 2-18 probe_info_ptr 000562 automatic pointer dcl 2-86 set ref 478 479* 524 527 653* 655 675 680 683 687 692 692 706 709 714 715 718 721 728 731 764 877 895 925 1206 1241 1270 1313 1315* 1370* 1668 1688 2280 2302 2334 2382 2445 probe_modes based structure level 1 dcl 8-14 probe_modes_mgr_$excludep 000030 constant entry external dcl 326 ref 1315 probe_options 30 000100 automatic structure level 2 dcl 214 probe_print_pascal_$value 000032 constant entry external dcl 329 ref 479 probe_static_info based structure level 1 dcl 3-8 probe_sw 31 000100 automatic bit(1) initial level 3 dcl 214 set ref 214* 585* 657* 854 1020 1312 1369 1623 2187 2445 qualification 1 based fixed bin(17,0) level 3 dcl 8-14 ref 715 718 quote_char 001670 automatic char(1) packed unaligned dcl 1724 set ref 1765* 1766* 1778 1780 1791 random_info 17 based structure level 2 dcl 2-18 real_fix_bin_1_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1690 real_fix_bin_2_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1628 real_flt_dec_generic_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1586 1591 real_flt_hex_1_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1591 real_value_ptr 000630 automatic pointer dcl 820 set ref 1143 1276* 1396* 1571* 2187* 2214* ref_subscripts based structure level 1 dcl 649 reference_node based structure level 1 dcl 4-16 reference_subscripts based structure level 1 dcl 4-64 rel builtin function dcl 378 ref 590 1501 2036 2042 2115 2115 requote_string_ 000062 constant entry external dcl 349 ref 1791 result 000100 automatic fixed bin(35,0) dcl 1008 set ref 1015* 1030 rtrim builtin function dcl 378 ref 1284 1448 1740 1743 1746 2385 2396 running_dims 000204 automatic fixed bin(17,0) dcl 2242 set ref 2317* 2322 2325 2325 2327* 2327 runtime_array_info based structure level 1 dcl 16-70 runtime_block based structure level 1 dcl 15-38 runtime_symbol based structure level 1 dcl 15-3 runtime_symbol_info_$array 000120 constant entry external dcl 16-68 ref 958 runtime_symbol_info_$array_dims 000116 constant entry external dcl 16-66 ref 923 2255 2295 2304 2322 runtime_symbol_info_$brother 000106 constant entry external dcl 16-40 ref 1485 runtime_symbol_info_$father 000104 constant entry external dcl 16-38 ref 995 runtime_symbol_info_$level 000114 constant entry external dcl 16-50 ref 988 989 2294 2315 2349 2535 2535 2545 runtime_symbol_info_$name 000112 constant entry external dcl 16-48 ref 1315 1315 1340 1342 1344 1346 1348 1350 1352 2265 2278 2286 2321 2354 2359 runtime_symbol_info_$son 000110 constant entry external dcl 16-44 ref 692 1327 1460 1477 1726 runtime_symbol_info_$type 000102 constant entry external dcl 16-22 ref 1185 runtime_type_info based structure level 1 dcl 16-24 s_ptr parameter pointer dcl 1433 ref 1430 1436 1436 same_count 001364 automatic fixed bin(17,0) dcl 1084 set ref 1117* 1130* 1134* 1137* 1137 1162* scale 5 000100 automatic fixed bin(35,0) level 2 in structure "source" dcl 1556 in procedure "display_arithmetic" set ref 1583* scale 001352 automatic fixed bin(17,0) level 2 in structure "ep" packed packed unaligned dcl 1043 in procedure "display_probe_constant" set ref 1055 scale 2(28) 000124 automatic fixed bin(7,0) level 2 in structure "value_info" packed packed unaligned dcl 809 in procedure "print_symbol" set ref 1055* 1056 1583 1623 1692* seg_info based structure level 1 dcl 6-9 seg_info_ptr 12 based pointer level 2 dcl 5-5 ref 667 short_message 000152 automatic char(8) dcl 1560 set ref 1617* short_names 3 000100 automatic bit(1) initial level 3 dcl 214 set ref 214* 603* 622* 715* 718* 721* 724* 2269 2562 simple 0(26) based bit(1) level 3 packed packed unaligned dcl 15-3 ref 445 1209 1243 size 4 based fixed bin(35,0) level 2 in structure "runtime_symbol" dcl 15-3 in procedure "display_data_" set ref 1218* 1246* size 10 000124 automatic fixed bin(35,0) level 2 in structure "value_info" dcl 809 in procedure "print_symbol" set ref 1056* 1058* 1565* 1691* 1990* 1998* 2006* 2012 2022 size 12 based fixed bin(35,0) level 2 in structure "runtime_type_info" dcl 16-24 in procedure "display_data_" ref 860 1610 size_is_encoded 2(02) 000124 automatic bit(1) level 3 packed packed unaligned dcl 809 set ref 1565* 1990* 1998* 2006* son 2(18) based bit(18) level 2 packed packed unaligned dcl 15-3 ref 412 773 887 1682 1684 source 000100 automatic structure level 1 dcl 1556 set ref 1578* 1597 1597 1598* 1612 1612 1632 1632 source_info based structure level 1 dcl 5-5 source_info_ptr 10 parameter pointer level 2 dcl 207 set ref 441 659 666 667 stack_ptr 6 based pointer level 2 dcl 5-5 ref 666 stackp 24 000100 automatic pointer initial level 2 dcl 214 set ref 214* 594* 666* 1015* 1194* 1662* 2088* start_level 000202 automatic fixed bin(17,0) dcl 2240 set ref 2315* 2318 2328 2349* 2352 start_ptr 20 000100 automatic pointer initial level 2 dcl 214 set ref 214* 591* 673* 1276* starting_name 000525 automatic char(256) packed unaligned dcl 818 set ref 1116* 1130* 1133* 1162* static_info_ptr 1 based pointer level 2 packed packed unaligned dcl 2-18 ref 728 steps 000602 automatic fixed bin(17,0) dcl 430 set ref 441* str based varying char(300) level 2 in structure "bitbuf" dcl 1882 in procedure "add_bit" set ref 1892 1894 1896* 1896 1903 1903* 1903 1906* 1906 str 0(09) based char level 2 in structure "element_name" packed packed unaligned dcl 2248 in procedure "get_symbol_name" ref 2265 2286 2321 2354 2359 str based varying char(300) level 2 in structure "bitbuf" dcl 2627 in procedure "write_bitbufs" set ref 2635* str based varying char(300) level 2 in structure "bit_buffer" dcl 292 in procedure "display_data_" set ref 1950* str 0(09) based char level 2 in structure "element_name" packed packed unaligned dcl 1300 in procedure "ignore_this_element" set ref 1342 1344 1348 1352 str_len parameter fixed bin(35,0) dcl 1977 in procedure "get_string_info" set ref 1971 1990* 1999* 2000 2000* 2006* 2010* 2023* 2024 2026* 2026* 2031 2031* 2036 2036* 2042 2042* str_len 001700 automatic fixed bin(35,0) dcl 1807 in procedure "display_bit_string" set ref 1823* 1825 1826 1831 1833* 1840 1842 1842 1854 1856 1856 1856 1860 1861 1861 1868 1868 str_len 001651 automatic fixed bin(35,0) dcl 1718 in procedure "display_char_string" set ref 1737* 1739 1740 1740 1740 1743 1743 1743 1746 1746 1746 1749 1751 1751 1754 1756 1766 1779 1779 1791 1791 1797 1797 str_ptr 001702 automatic pointer dcl 1808 in procedure "display_bit_string" set ref 1823* 1826 1842 1861 1868 str_ptr 001654 automatic pointer dcl 1720 in procedure "display_char_string" set ref 1737* 1740 1740 1743 1743 1746 1746 1766 1779 1791 1791 1797 1797 str_ptr parameter pointer dcl 1976 in procedure "get_string_info" set ref 1971 1983* 1985* 2024 2036 2042 string 0(09) based char level 2 packed packed unaligned dcl 10-6 ref 437 1438 1668 1668 structure_dtype constant fixed bin(17,0) initial dcl 17-25 ref 416 420 683 687 775 1286 1535 2280 stu_$block_dcld_in 000064 constant entry external dcl 350 ref 597 stu_$decode_runtime_value_extended 000066 constant entry external dcl 351 ref 1015 stu_$find_runtime_symbol 000074 constant entry external dcl 363 ref 441 stu_$get_runtime_address 000070 constant entry external dcl 356 ref 1194 1662 stu_$offset_to_pointer 000072 constant entry external dcl 360 ref 2088 sub_error_ 000000 stack reference condition dcl 381 ref 1637 subscript_ptr 120 parameter pointer level 3 packed packed unaligned dcl 207 set ref 731 731 735 735 740 741 742 745 748 749 750 substr builtin function dcl 378 ref 437 635 1342 1344 1348 1352 1438 1668 1668 1740 1743 1746 1766 1779 1791 1791 1797 1797 1888 2334 switches 36 based structure level 2 dcl 3-8 sym_addr 001620 automatic pointer dcl 1653 set ref 1662* 1665 sym_dim 000203 automatic fixed bin(17,0) dcl 2241 set ref 2255* 2266* 2322* 2325 2327 symbol_level 001125 automatic fixed bin(17,0) dcl 918 set ref 989* 993 symbol_ptr parameter pointer level 2 in structure "P_reference" dcl 207 in procedure "display_data_" set ref 407 408 420 420 434 434 674 700 767 1211 symbol_ptr 001446 automatic pointer dcl 1424 in procedure "do_symbol_and_sons" set ref 1477* 1477* 1481* 1481* 1485* symbol_ptr 001122 automatic pointer dcl 916 in procedure "setup_subscripts" set ref 991* 994 995* 995* sys_info$max_seg_size 000020 external static fixed bin(19,0) dcl 317 ref 2036 system_area based area(1024) dcl 309 ref 1949 system_area_ptr 000560 automatic pointer dcl 308 set ref 488* 1949 t_ptr 000606 automatic pointer dcl 432 in begin block on line 427 set ref 441* 445 445 448 451 t_ptr 000106 automatic pointer dcl 762 in procedure "ref_node_not_struct_or_union" set ref 767* 768 771 771 773* 773 773 775 777 t_ptr 001622 automatic pointer dcl 1653 in procedure "display_c_enum" set ref 1658* 1660 1661 1662* 1667 1667 1674 1674* 1676* 1676 1676 1682 1682* 1684* 1684 1684 target 000110 automatic structure level 1 dcl 1556 set ref 1589* 1597 1597 1598 1602* 1612 1612 1626* 1632 1632 temp_ptr 001402 automatic pointer dcl 1176 set ref 1201* 1204* 1208 1209 1211 1211 1217 1218 1218 1218 1218 1242 1243 1245 1246 1246 1246 1246 temp_stuff_ptr 000576 automatic pointer dcl 390 set ref 408* 409 409 412* 412 412 416 416 this_bit 001716 automatic bit(1) dcl 1883 set ref 1888* 1890* 1898* this_value based bit packed unaligned dcl 1088 ref 1125 this_value_data_info 000163 automatic structure level 1 dcl 812 set ref 1145 1192* 1410 this_value_indices 000204 automatic fixed bin(24,0) array dcl 814 set ref 1146 1279* 1412 this_value_info 000150 automatic structure level 1 unaligned dcl 809 set ref 1144 1185 1185 1409 this_value_name 000425 automatic char(256) packed unaligned dcl 818 set ref 1116 1133 1140 1283* 1284 1322 this_value_ptr 000122 automatic pointer dcl 807 set ref 1121* 1125 1141 1194* 1200* 1230 1230 1233 1233 1258 1258 1261 1261 1273* 1273 1276* 1286 1411 this_value_symbol_ptr 000114 automatic pointer dcl 805 set ref 1099* 1142 1185* 1194* 1204 1315* 1315* 1327* 1327 1327 1340* 1342* 1344* 1346* 1348* 1350* 1352* 1408 total_dims 000206 automatic fixed bin(17,0) dcl 2244 set ref 2295* 2311* total_number_of_elements 000103 automatic fixed bin(17,0) dcl 505 set ref 509* 511* 511 523 translate builtin function dcl 378 ref 2291 trim_str 001656 automatic varying char(32) dcl 1722 set ref 1772* 1774* 1775* 1775 1776* 1776 1777* 1777 1778* 1778 1779* 1779 1780* 1780 1782* 1786 1786* 1791* 1797* trimmed_len 001652 automatic fixed bin(35,0) dcl 1718 set ref 1740* 1743* 1746* 1749* 1751 1751* 1754* 1756 1758 1761* 1766 1772 1786 1791 1791 1797 1797 truncate_strings 35 000100 automatic bit(1) initial level 3 in structure "global" dcl 214 in procedure "display_data_" set ref 214* 601* 714* 1758 1831 truncate_strings 21(10) based bit(1) level 3 in structure "probe_modes" packed packed unaligned dcl 8-14 in procedure "display_data_" ref 714 truncated_sw 001705 automatic bit(1) packed unaligned dcl 1820 in procedure "display_bit_string" set ref 1832* 1835* 1861* 1868* truncated_sw 001667 automatic bit(1) packed unaligned dcl 1723 in procedure "display_char_string" set ref 1760* 1763* 1791* 1797* type 3 000150 automatic fixed bin(18,0) level 2 in structure "this_value_info" packed packed unsigned unaligned dcl 809 in procedure "print_symbol" set ref 1192 1286 type 113 parameter fixed bin(35,0) level 2 in structure "P_reference" dcl 207 in procedure "display_data_" set ref 683 687 687 1048 2008 2280 2280 type 3 000124 automatic fixed bin(18,0) level 2 in structure "value_info" packed packed unsigned unaligned dcl 809 in procedure "print_symbol" set ref 1048* 1049 1050 1517 1519 1521 1523 1525 1525 1528 1530 1530 1530 1535 1537 1539 1542 1567 1580 1690* 1840 1990 2201 2203 2205 2207 2210 2212 type 0(06) based bit(6) level 2 in structure "runtime_symbol" packed packed unaligned dcl 15-3 in procedure "display_data_" ref 409 409 416 416 420 420 771 771 775 777 877 877 884 890 1218 1218 1246 1246 1327 1327 1460 1460 1460 1661 type_addr 4 000124 automatic pointer level 2 dcl 809 set ref 1061* unspec builtin function dcl 378 set ref 1046* 1053* 1053 1144* 1144 1145* 1145 1393* 1393 1394* 1394 1409* 1409 1410* 1410 1578* 1589* 1602* 1626* 2101* 2101 2145* 2145 2669* 2669 2677* 2677 2682* 2682 upper 6 001132 automatic fixed bin(35,0) array level 3 in structure "value_array_info" dcl 952 in begin block on line 950 set ref 967* upper 10 based fixed bin(35,0) array level 3 in structure "runtime_symbol" dcl 15-3 in procedure "display_data_" ref 511 545 upper_is_encoded 4(01) 001132 automatic bit(1) array level 4 packed packed unaligned dcl 952 set ref 967* use_exclude_names 21 based bit(1) level 3 packed packed unaligned dcl 8-14 ref 1313 use_match_names 5 000100 automatic bit(1) initial level 3 dcl 214 set ref 214* 617* 621* 726* 1320 valid_decimal_ 000076 constant entry external dcl 366 ref 1567 value 1 based fixed bin(24,0) array level 2 dcl 649 ref 735 735 740 741 742 745 value_array_info 001132 automatic structure level 1 unaligned dcl 952 set ref 958 958 value_data_info 000161 automatic structure level 1 dcl 812 set ref 1050* 1394* 1410* value_info 000124 automatic structure level 1 unaligned dcl 809 set ref 1046* 1393* 1409* value_len 000111 automatic fixed bin(17,0) dcl 2415 set ref 2450* 2451* 2451 2457 2476 2487 2511 2521 value_name 000224 automatic varying char(256) dcl 817 set ref 1284* 1448* 1450* 1450 1450 1842* 1894 1906 2187* 2450 2457 2457 2457* 2476 2476 2476* 2495 2513 2521 2521 2521* value_print 2 based fixed bin(17,0) level 3 dcl 8-14 ref 706 709 value_ptr 000116 automatic pointer dcl 807 set ref 1045* 1395* 1411* 1481 1501 1567* 1571 1579 1983 1985 1999 2064 2069 2088* 2096 2101 2115* 2115 2115 2129* 2145 2162 value_separator 10 based varying char(32) level 2 dcl 8-14 ref 2445 value_size 001366 automatic fixed bin(24,0) dcl 1087 set ref 1109* 1121 1121* 1125 1125 value_str 000704 automatic varying char(500) dcl 837 set ref 1571* 1603 1605 1621* 1621 1638* 1638 1708* 1826* 1860 1861* 1988* 2000* 2031* 2036* 2042* 2048 2064* 2069* 2091* 2096* 2102* 2115* 2129* 2146* 2214* 2425* 2451 2457* 2497 2515 2521* value_symbol_ptr 000110 automatic pointer dcl 805 set ref 844* 854 875 877 877 881 884 887* 887 887 890 897* 923* 958* 988* 989* 991 1015* 1064* 1099 1392* 1408* 1460* 1460 1460 1460 1477* 1658 1726 1726* 1990 2088* 2255* 2264 2270 2315* 2349* 2358 2535* 2535* 2545* variable_info 40 000100 automatic structure level 2 dcl 214 varlength 1 based fixed bin(8,0) level 2 packed packed unaligned dcl 14-6 ref 1990 varying 0(12) 000161 automatic bit(1) level 2 packed packed unaligned dcl 812 set ref 1983 1997 varying_char_dtype constant fixed bin(17,0) initial dcl 17-25 ref 1604 version 000150 automatic char(8) level 2 in structure "this_value_info" packed packed unaligned dcl 809 in procedure "print_symbol" set ref 1183* version 001132 automatic char(8) level 2 in structure "value_array_info" packed packed unaligned dcl 952 in begin block on line 950 set ref 956* word 001774 automatic fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 2083 set ref 2102* 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 ITP_MODIFIER internal static bit(6) initial packed unaligned dcl 1-56 in procedure "bitno" ITP_MODIFIER internal static bit(6) initial packed unaligned dcl 18-56 in procedure "display_data_" ITS_MODIFIER internal static bit(6) initial packed unaligned dcl 18-55 in procedure "display_data_" ITS_MODIFIER internal static bit(6) initial packed unaligned dcl 1-55 in procedure "bitno" OTHER_lang_type internal static fixed bin(17,0) initial dcl 9-17 RUNTIME_ADDRESS_INFO_VERSION_1 internal static char(8) initial packed unaligned dcl 16-128 RUNTIME_SUBRANGE_INFO_VERSION_1 internal static char(8) initial packed unaligned dcl 16-131 RUNTIME_VARIANT_INFO_VERSION_1 internal static char(8) initial packed unaligned dcl 16-130 UNKNOWN_lang_type internal static fixed bin(17,0) initial dcl 9-17 algol68_bits_dtype internal static fixed bin(17,0) initial dcl 17-110 algol68_bool_dtype internal static fixed bin(17,0) initial dcl 17-110 algol68_byte_dtype internal static fixed bin(17,0) initial dcl 17-110 algol68_char_dtype internal static fixed bin(17,0) initial dcl 17-110 algol68_compl_dtype internal static fixed bin(17,0) initial dcl 17-110 algol68_int_dtype internal static fixed bin(17,0) initial dcl 17-110 algol68_long_compl_dtype internal static fixed bin(17,0) initial dcl 17-110 algol68_long_int_dtype internal static fixed bin(17,0) initial dcl 17-110 algol68_long_real_dtype internal static fixed bin(17,0) initial dcl 17-110 algol68_real_dtype internal static fixed bin(17,0) initial dcl 17-110 algol68_short_int_dtype internal static fixed bin(17,0) initial dcl 17-110 algol68_struct_struct_bool_dtype internal static fixed bin(17,0) initial dcl 17-110 algol68_struct_struct_char_dtype internal static fixed bin(17,0) initial dcl 17-110 cobol_char_string_dtype internal static fixed bin(17,0) initial dcl 17-25 cobol_comp_5_ts_dtype internal static fixed bin(17,0) initial dcl 17-25 cobol_comp_5_uns_dtype internal static fixed bin(17,0) initial dcl 17-25 cobol_comp_6_dtype internal static fixed bin(17,0) initial dcl 17-25 cobol_comp_7_dtype internal static fixed bin(17,0) initial dcl 17-25 cobol_comp_8_ls_dtype internal static fixed bin(17,0) initial dcl 17-25 cobol_comp_8_uns_dtype internal static fixed bin(17,0) initial dcl 17-25 cobol_display_ls_dtype internal static fixed bin(17,0) initial dcl 17-25 cobol_display_ls_overp_dtype internal static fixed bin(17,0) initial dcl 17-25 cobol_display_ts_dtype internal static fixed bin(17,0) initial dcl 17-25 cobol_display_ts_overp_dtype internal static fixed bin(17,0) initial dcl 17-25 cobol_display_uns_dtype internal static fixed bin(17,0) initial dcl 17-25 cobol_structure_dtype internal static fixed bin(17,0) initial dcl 17-25 cplx_fix_bin_1_dtype internal static fixed bin(17,0) initial dcl 17-25 cplx_fix_bin_2_dtype internal static fixed bin(17,0) initial dcl 17-25 cplx_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 17-25 cplx_fix_dec_9bit_ls_dtype internal static fixed bin(17,0) initial dcl 17-25 cplx_flt_bin_1_dtype internal static fixed bin(17,0) initial dcl 17-25 cplx_flt_bin_2_dtype internal static fixed bin(17,0) initial dcl 17-25 cplx_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 17-25 cplx_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 17-25 cplx_flt_dec_9bit_dtype internal static fixed bin(17,0) initial dcl 17-25 cplx_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 17-25 cplx_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 17-25 current_source based structure level 1 dcl 5-13 data_type_info_$max_decimal_precision external static fixed bin(17,0) dcl 12-48 data_type_info_$max_fixed_binary_precision external static fixed bin(17,0) dcl 12-50 data_type_info_$max_float_binary_precision external static fixed bin(17,0) dcl 12-49 data_type_info_$ninebit_digit_chars external static char(10) packed unaligned dcl 12-45 data_type_info_$ninebit_overpunched_sign_chars external static char(22) packed unaligned dcl 12-46 data_type_info_$ninebit_sign_chars external static char(2) packed unaligned dcl 12-44 data_type_info_$version_number external static fixed bin(17,0) dcl 12-20 data_type_info_this_version internal static fixed bin(17,0) initial dcl 12-21 encoded_value based structure level 1 dcl 15-70 expression_area based area(1024) dcl 2-95 ft_char_dtype internal static fixed bin(17,0) initial dcl 17-96 ft_complex_double_dtype internal static fixed bin(17,0) initial dcl 17-96 ft_complex_dtype internal static fixed bin(17,0) initial dcl 17-96 ft_double_dtype internal static fixed bin(17,0) initial dcl 17-96 ft_external_dtype internal static fixed bin(17,0) initial dcl 17-96 ft_hex_complex_double_dtype internal static fixed bin(17,0) initial dcl 17-96 ft_hex_complex_dtype internal static fixed bin(17,0) initial dcl 17-96 ft_hex_double_dtype internal static fixed bin(17,0) initial dcl 17-96 ft_hex_real_dtype internal static fixed bin(17,0) initial dcl 17-96 ft_integer_dtype internal static fixed bin(17,0) initial dcl 17-96 ft_logical_dtype internal static fixed bin(17,0) initial dcl 17-96 ft_real_dtype internal static fixed bin(17,0) initial dcl 17-96 initial_source based structure level 1 dcl 5-14 itp based structure level 1 dcl 18-18 in procedure "display_data_" itp based structure level 1 dcl 1-18 in procedure "bitno" itp_unsigned based structure level 1 dcl 18-43 in procedure "display_data_" itp_unsigned based structure level 1 dcl 1-43 in procedure "bitno" its based structure level 1 dcl 18-5 in procedure "display_data_" its based structure level 1 dcl 1-5 in procedure "bitno" n_variants automatic fixed bin(35,0) dcl 16-112 official_language_names internal static char(32) initial array packed unaligned dcl 9-27 palatable_language_names internal static char(32) initial array packed unaligned dcl 9-30 pascal_boolean_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_char_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_entry_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_enumerated_type_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_enumerated_type_element_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_enumerated_type_instance_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_exportable_procedure_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_imported_procedure_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_integer_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_internal_procedure_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_label_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_parameter_procedure_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_procedure_type_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_real_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_record_file_type_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_record_type_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_set_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_string_type_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_text_file_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_typed_pointer_type_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_user_defined_type_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_user_defined_type_instance_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_value_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 17-132 pascal_variable_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 17-132 picture_char_type internal static fixed bin(8,0) initial packed unaligned dcl 14-20 picture_complexfix_type internal static fixed bin(8,0) initial packed unaligned dcl 14-20 picture_complexflo_type internal static fixed bin(8,0) initial packed unaligned dcl 14-20 picture_realfix_type internal static fixed bin(8,0) initial packed unaligned dcl 14-20 picture_realflo_type internal static fixed bin(8,0) initial packed unaligned dcl 14-20 probe_area based area(1024) dcl 2-93 probe_exclude_names based char(168) array packed unaligned dcl 3-94 probe_info_directories based char(168) array packed unaligned dcl 3-91 probe_info_version internal static fixed bin(17,0) initial dcl 2-88 probe_info_version_1 internal static fixed bin(17,0) initial dcl 2-90 probe_request_tables based pointer array dcl 3-88 probe_seg_info_array based structure level 1 dcl 3-82 real_fix_bin_1_uns_dtype internal static fixed bin(17,0) initial dcl 17-25 real_fix_bin_2_uns_dtype internal static fixed bin(17,0) initial dcl 17-25 real_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 17-25 real_fix_dec_4bit_bytealigned_uns_dtype internal static fixed bin(17,0) initial dcl 17-25 real_fix_dec_4bit_ls_dtype internal static fixed bin(17,0) initial dcl 17-25 real_fix_dec_4bit_ts_dtype internal static fixed bin(17,0) initial dcl 17-25 real_fix_dec_4bit_uns_dtype internal static fixed bin(17,0) initial dcl 17-25 real_fix_dec_9bit_ls_dtype internal static fixed bin(17,0) initial dcl 17-25 real_fix_dec_9bit_ls_overp_dtype internal static fixed bin(17,0) initial dcl 17-25 real_fix_dec_9bit_ts_dtype internal static fixed bin(17,0) initial dcl 17-25 real_fix_dec_9bit_ts_overp_dtype internal static fixed bin(17,0) initial dcl 17-25 real_fix_dec_9bit_uns_dtype internal static fixed bin(17,0) initial dcl 17-25 real_flt_bin_1_dtype internal static fixed bin(17,0) initial dcl 17-25 real_flt_bin_2_dtype internal static fixed bin(17,0) initial dcl 17-25 real_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 17-25 real_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 17-25 real_flt_dec_4bit_dtype internal static fixed bin(17,0) initial dcl 17-25 real_flt_dec_9bit_dtype internal static fixed bin(17,0) initial dcl 17-25 real_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 17-25 real_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 17-25 reference_arg_list based structure level 1 dcl 4-59 runtime_address_info based structure level 1 dcl 16-56 runtime_bound based structure level 1 unaligned dcl 15-33 runtime_subrange_info based structure level 1 unaligned dcl 16-116 runtime_symbol_info_$address 000000 constant entry external dcl 16-54 runtime_symbol_info_$father_type 000000 constant entry external dcl 16-42 runtime_symbol_info_$n_variants 000000 constant entry external dcl 16-99 runtime_symbol_info_$next 000000 constant entry external dcl 16-52 runtime_symbol_info_$subrange 000000 constant entry external dcl 16-114 runtime_symbol_info_$successor 000000 constant entry external dcl 16-46 runtime_symbol_info_$variant 000000 constant entry external dcl 16-101 runtime_token based structure level 1 dcl 15-63 runtime_variant_info based structure level 1 dcl 16-103 scratch_area based area(1024) dcl 2-92 seg_info_nfiles automatic fixed bin(17,0) dcl 6-47 seg_info_offset_count automatic fixed bin(17,0) dcl 3-86 subscript_reference_ptrs based structure level 1 dcl 4-69 type_name internal static char(40) initial array packed unaligned dcl 7-11 varying_bit_dtype internal static fixed bin(17,0) initial dcl 17-25 work_area based area(1024) dcl 2-94 NAMES DECLARED BY EXPLICIT CONTEXT. COMMON 001141 constant label dcl 488 in procedure "display_data_" ref 468 485 COMMON 013431 constant label dcl 2445 in procedure "write_value_str" ref 2429 2442 CONVERSION_ERROR 006364 constant label dcl 1614 ref 1608 1609 1610 FATAL_ERROR 001503 constant label dcl 569 ref 933 1025 1028 1384 1508 NONFATAL_ERROR 006020 constant label dcl 1547 ref 2050 PRINT_SYMBOL_RETURN 003104 constant label dcl 908 ref 867 SKIP_DTM 006656 constant label dcl 1643 ref 1637 add_bit 010262 constant entry internal dcl 1874 ref 1842 add_dims 013050 constant entry internal dcl 2364 ref 2266 2311 2325 addbitoffset 014661 constant entry internal dcl 2673 ref 1276 bitno 014627 constant entry internal dcl 2655 ref 1121 1121 1276 1276 cannot_get_address 005123 constant entry internal dcl 1358 ref 960 1189 1286 common_c_setup 001506 constant entry internal dcl 386 ref 466 475 decode 003452 constant entry internal dcl 1001 ref 965 967 1565 1990 1998 2006 display_arithmetic 006022 constant entry internal dcl 1550 ref 1511 1542 1693 display_bit_string 007740 constant entry internal dcl 1803 ref 1515 display_c_enum 006664 constant entry internal dcl 1650 ref 1539 display_char_string 007153 constant entry internal dcl 1714 ref 1513 display_data_ 001015 constant entry external dcl 97 display_data_$for_azm 001035 constant entry external dcl 460 display_data_$for_probe 001073 constant entry external dcl 472 display_entry_constant 011517 constant entry internal dcl 2125 ref 1530 display_file 011643 constant entry internal dcl 2155 ref 1528 display_label_constant 011432 constant entry internal dcl 2111 ref 1523 display_label_or_entry 011552 constant entry internal dcl 2135 ref 1525 display_offset 011275 constant entry internal dcl 2077 ref 1521 display_picture 007105 constant entry internal dcl 1697 ref 1517 display_pointer 011211 constant entry internal dcl 2056 ref 1519 display_probe_constant 003620 constant entry internal dcl 1034 ref 856 display_single_value 005627 constant entry internal dcl 1492 ref 1066 1454 display_structure 011662 constant entry internal dcl 2167 ref 1535 1537 1732 display_undisplayable 011746 constant entry internal dcl 2194 ref 1545 do_symbol_and_sons 005276 constant entry internal dcl 1415 ref 1130 1162 dummy_node 005600 constant entry internal dcl 1430 ref 1481 find_or_create_bitbuf 010455 constant entry internal dcl 1934 ref 1921 1927 finish_bits 014450 constant entry internal dcl 2599 ref 2592 finish_output 014353 constant entry internal dcl 2573 ref 904 1377 1487 1502 2185 get_bitbuf 010404 constant entry internal dcl 1909 ref 1890 1898 get_indentation 014302 constant entry internal dcl 2551 ref 2535 2545 get_string_info 010521 constant entry internal dcl 1971 ref 1706 1737 1823 get_symbol_name 012132 constant entry internal dcl 2234 ref 1283 1370 1379 1503 get_unsubscripted_name 012705 constant entry internal dcl 2344 ref 864 978 1021 get_value_info 004074 constant entry internal dcl 1168 ref 1101 1155 ignore_this_element 004544 constant entry internal dcl 1293 ref 1103 indentation 014212 constant entry internal dcl 2531 ref 1021 1021 1893 2187 2187 2454 2483 2595 language 012114 constant entry internal dcl 2222 ref 1726 1766 1766 1825 2008 2012 2258 2263 2291 2562 next_indentation 014247 constant entry internal dcl 2541 ref 1474 2635 2635 print_cross_section 003700 constant entry internal dcl 1071 ref 902 print_symbol 002647 constant entry internal dcl 783 ref 538 561 1481 ref_node_not_struct_or_union 002541 constant entry internal dcl 760 ref 1206 set_display_format 002133 constant entry internal dcl 628 ref 615 set_globals_for_azm 001736 constant entry internal dcl 573 ref 467 set_globals_for_probe 002152 constant entry internal dcl 643 ref 476 setup_subscripts 003105 constant entry internal dcl 911 ref 870 use_previous_value 005234 constant entry internal dcl 1388 ref 1128 1160 use_this_value 005257 constant entry internal dcl 1404 ref 1188 1281 write_bitbufs 014510 constant entry internal dcl 2618 ref 2607 2611 write_value_name 013415 constant entry internal dcl 2432 ref 1614 1784 1867 write_value_str 013354 constant entry internal dcl 2410 ref 1574 1643 1709 1827 1864 2049 2072 2106 2118 2130 2149 2216 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 16304 16426 15415 16314 Length 17334 15415 122 671 666 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME display_data_ 518 external procedure is an external procedure. common_c_setup internal procedure shares stack frame of external procedure display_data_. begin block on line 427 begin block shares stack frame of external procedure display_data_. begin block on line 499 96 begin block uses auto adjustable storage. set_globals_for_azm internal procedure shares stack frame of external procedure display_data_. set_display_format internal procedure shares stack frame of external procedure display_data_. set_globals_for_probe internal procedure shares stack frame of external procedure display_data_. ref_node_not_struct_or_union internal procedure shares stack frame of internal procedure print_symbol. print_symbol 2446 internal procedure enables or reverts conditions. on unit on line 860 160 on unit setup_subscripts internal procedure shares stack frame of internal procedure print_symbol. begin block on line 950 begin block shares stack frame of internal procedure print_symbol. decode 178 internal procedure is called by several nonquick procedures. display_probe_constant internal procedure shares stack frame of internal procedure print_symbol. print_cross_section internal procedure shares stack frame of internal procedure print_symbol. get_value_info internal procedure shares stack frame of internal procedure print_symbol. ignore_this_element internal procedure shares stack frame of internal procedure print_symbol. cannot_get_address internal procedure shares stack frame of internal procedure print_symbol. use_previous_value internal procedure shares stack frame of internal procedure print_symbol. use_this_value internal procedure shares stack frame of internal procedure print_symbol. do_symbol_and_sons internal procedure shares stack frame of internal procedure print_symbol. dummy_node internal procedure shares stack frame of internal procedure print_symbol. display_single_value internal procedure shares stack frame of internal procedure print_symbol. display_arithmetic 242 internal procedure enables or reverts conditions. on unit on line 1608 64 on unit on unit on line 1609 64 on unit on unit on line 1610 64 on unit on unit on line 1637 64 on unit display_c_enum internal procedure shares stack frame of internal procedure print_symbol. display_picture internal procedure shares stack frame of internal procedure print_symbol. display_char_string internal procedure shares stack frame of internal procedure print_symbol. display_bit_string internal procedure shares stack frame of internal procedure print_symbol. add_bit internal procedure shares stack frame of internal procedure print_symbol. get_bitbuf internal procedure shares stack frame of internal procedure print_symbol. find_or_create_bitbuf internal procedure shares stack frame of internal procedure print_symbol. get_string_info internal procedure shares stack frame of internal procedure print_symbol. begin block on line 2014 begin block shares stack frame of internal procedure print_symbol. display_pointer internal procedure shares stack frame of internal procedure print_symbol. display_offset internal procedure shares stack frame of internal procedure print_symbol. display_label_constant internal procedure shares stack frame of internal procedure print_symbol. display_entry_constant internal procedure shares stack frame of internal procedure print_symbol. display_label_or_entry internal procedure shares stack frame of internal procedure print_symbol. display_file internal procedure shares stack frame of internal procedure print_symbol. display_structure internal procedure shares stack frame of internal procedure print_symbol. display_undisplayable internal procedure shares stack frame of internal procedure print_symbol. language 64 internal procedure is called by several nonquick procedures. get_symbol_name 178 internal procedure is called by several nonquick procedures. add_dims internal procedure shares stack frame of internal procedure get_symbol_name. write_value_str 140 internal procedure is called by several nonquick procedures. indentation 82 internal procedure is called by several nonquick procedures. next_indentation internal procedure shares stack frame of internal procedure print_symbol. get_indentation 74 internal procedure is called by several nonquick procedures. finish_output internal procedure shares stack frame of internal procedure print_symbol. finish_bits internal procedure shares stack frame of internal procedure print_symbol. write_bitbufs internal procedure shares stack frame of internal procedure print_symbol. bitno internal procedure shares stack frame of internal procedure print_symbol. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME begin block on line 499 000100 inxs begin block on line 499 000100 level_1_c_struct_inx0 begin block on line 499 000101 level_1_c_struct_inx1 begin block on line 499 000102 level_1_c_struct_inx2 begin block on line 499 000103 total_number_of_elements begin block on line 499 decode 000100 result decode display_arithmetic 000100 source display_arithmetic 000110 target display_arithmetic 000120 precision display_arithmetic 000121 long_message display_arithmetic 000152 short_message display_arithmetic 000154 fb71 display_arithmetic 000156 hexfp_space display_arithmetic 000160 code display_arithmetic display_data_ 000100 global display_data_ 000422 dont_print_me_this_time display_data_ 000424 global_output_info display_data_ 000550 error_code display_data_ 000551 done_with_pascal display_data_ 000552 level_1_c_struct_ndims display_data_ 000554 level_1_c_struct_dims_ptr display_data_ 000556 print_the_data display_data_ 000557 double_override display_data_ 000560 system_area_ptr display_data_ 000562 probe_info_ptr display_data_ 000564 n_dims display_data_ 000576 temp_stuff_ptr common_c_setup 000600 nameptr begin block on line 427 000602 steps begin block on line 427 000604 found_ptr begin block on line 427 000606 t_ptr begin block on line 427 000616 idx set_globals_for_azm 000636 idx set_globals_for_probe get_indentation 000100 amount get_indentation get_symbol_name 000100 name_string get_symbol_name 000201 father_idx get_symbol_name 000202 start_level get_symbol_name 000203 sym_dim get_symbol_name 000204 running_dims get_symbol_name 000205 my_level get_symbol_name 000206 total_dims get_symbol_name 000207 father_dims get_symbol_name 000210 element_symbol_ptr get_symbol_name 000222 dim_idx add_dims indentation 000100 a_temp_value indentation print_symbol 000106 t_ptr ref_node_not_struct_or_union 000110 value_symbol_ptr print_symbol 000112 previous_value_symbol_ptr print_symbol 000114 this_value_symbol_ptr print_symbol 000116 value_ptr print_symbol 000120 previous_value_ptr print_symbol 000122 this_value_ptr print_symbol 000124 value_info print_symbol 000136 previous_value_info print_symbol 000150 this_value_info print_symbol 000161 value_data_info print_symbol 000162 previous_value_data_info print_symbol 000163 this_value_data_info print_symbol 000164 previous_value_indices print_symbol 000204 this_value_indices print_symbol 000224 value_name print_symbol 000325 previous_value_name print_symbol 000425 this_value_name print_symbol 000525 starting_name print_symbol 000626 previous_real_value_ptr print_symbol 000630 real_value_ptr print_symbol 000632 ndims print_symbol 000633 my_dims print_symbol 000634 first_dim print_symbol 000635 my_bounds print_symbol 000675 ele_num print_symbol 000676 levels_of_pointer_indir print_symbol 000677 my_father_is_a_typeref print_symbol 000700 override print_symbol 000702 my_real_name_ptr print_symbol 000704 value_str print_symbol 001102 old_value_symbol_ptr print_symbol 001120 idx setup_subscripts 001122 symbol_ptr setup_subscripts 001124 my_idx setup_subscripts 001125 symbol_level setup_subscripts 001126 first_level setup_subscripts 001132 value_array_info begin block on line 950 001352 ep display_probe_constant 001362 done print_cross_section 001363 first_time_sw print_cross_section 001364 same_count print_cross_section 001365 dont_print print_cross_section 001366 value_size print_cross_section 001376 offset_bits get_value_info 001377 offset_words get_value_info 001400 i get_value_info 001402 temp_ptr get_value_info 001414 idx ignore_this_element 001446 symbol_ptr do_symbol_and_sons 001450 my_output_info do_symbol_and_sons 001602 name_ptr dummy_node 001620 sym_addr display_c_enum 001622 t_ptr display_c_enum 001624 name_ptr display_c_enum 001626 not_found display_c_enum 001636 picture_ptr display_picture 001640 picture_len display_picture 001650 amount_trimmed display_char_string 001651 str_len display_char_string 001652 trimmed_len display_char_string 001654 str_ptr display_char_string 001656 trim_str display_char_string 001667 truncated_sw display_char_string 001670 quote_char display_char_string 001700 str_len display_bit_string 001702 str_ptr display_bit_string 001704 bit_radix display_bit_string 001705 truncated_sw display_bit_string 001714 bitbufp add_bit 001716 this_bit add_bit 001717 max_len add_bit 001720 new_len add_bit 001730 a_temp_pointer get_bitbuf 001740 bufp find_or_create_bitbuf 001750 max_len get_string_info 001751 chars_per_word get_string_info 001752 end_not_found begin block on line 2014 001753 max_len begin block on line 2014 001772 offset_ptr display_offset 001774 offset_overlay display_offset 002020 label display_label_or_entry 002046 message display_undisplayable 002066 a_temp_value next_indentation 002112 bitbufp write_bitbufs 002114 lastp write_bitbufs 002124 itsp bitno 002126 bito bitno 002130 bitp bitno write_value_str 000100 delimiter write_value_str 000111 value_len write_value_str 000112 max_len write_value_str 000113 buf_len write_value_str 000114 ind_len write_value_str 000115 include_value write_value_str THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 r_l_a r_g_a r_e_as 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 longbs_to_fx2 tra_ext_1 alloc_auto_adj mdfx1 signal_op enable_op shorten_stack ext_entry ext_entry_desc int_entry set_chars_eis set_bits_eis index_chars_eis op_alloc_ op_freen_ clock_mac THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. assign_$computational_ convert_status_code_ date_time_$format display_file_value_ format_pointer_$its format_pointer_$packed get_line_length_$switch get_size_in_bits_ get_system_free_area_ ioa_$ioa_switch ioa_$ioa_switch_nnl ioa_$rsnnl probe_error_$record probe_increment_indices_ probe_modes_mgr_$excludep probe_print_pascal_$value requote_string_ runtime_symbol_info_$array runtime_symbol_info_$array_dims runtime_symbol_info_$brother runtime_symbol_info_$father runtime_symbol_info_$level runtime_symbol_info_$name runtime_symbol_info_$son runtime_symbol_info_$type stu_$block_dcld_in stu_$decode_runtime_value_extended stu_$find_runtime_symbol stu_$get_runtime_address stu_$offset_to_pointer valid_decimal_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. data_type_info_$info iox_$user_output probe_et_$dim_limit probe_et_$no_address probe_et_$recorded_message sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 214 000751 297 001004 97 001014 100 001023 460 001024 466 001061 467 001065 468 001066 472 001067 475 001104 476 001110 478 001111 479 001115 481 001135 485 001140 488 001141 491 001150 493 001164 494 001167 496 001177 498 001200 499 001202 501 001205 527 001212 508 001214 509 001225 510 001226 511 001237 515 001250 517 001252 523 001264 524 001273 526 001322 527 001333 529 001361 530 001363 536 001374 538 001376 542 001420 543 001424 544 001426 545 001430 549 001441 550 001442 555 001446 556 001450 557 001451 558 001453 559 001454 561 001455 565 001501 566 001502 569 001503 571 001505 386 001506 392 001510 394 001511 395 001521 396 001523 397 001524 398 001525 399 001526 401 001527 402 001530 404 001532 407 001546 408 001552 409 001555 412 001572 415 001577 416 001600 420 001612 434 001640 437 001647 441 001657 445 001717 448 001727 451 001733 458 001735 573 001736 580 001737 581 001743 584 001753 585 001756 586 001757 587 001760 589 001761 590 001764 591 001773 593 001776 594 002000 595 002002 597 002003 598 002014 600 002020 601 002022 602 002023 603 002024 605 002025 607 002026 608 002030 610 002031 611 002037 612 002072 613 002075 615 002077 617 002103 618 002104 621 002127 622 002131 624 002132 628 002133 635 002135 638 002150 639 002151 643 002152 653 002153 655 002157 657 002161 658 002163 659 002170 661 002173 664 002204 666 002205 667 002210 671 002214 672 002217 673 002221 674 002222 675 002225 677 002230 680 002236 683 002251 687 002263 692 002274 699 002326 700 002327 703 002336 706 002344 709 002355 712 002362 714 002363 715 002371 718 002400 721 002405 724 002414 726 002415 728 002416 731 002424 735 002445 740 002502 741 002510 742 002512 745 002520 746 002522 748 002524 749 002531 750 002534 751 002535 753 002536 754 002537 756 002540 760 002541 764 002543 767 002555 768 002561 771 002572 773 002606 774 002613 775 002614 777 002626 779 002640 783 002646 841 002654 842 002655 843 002656 844 002660 854 002664 856 002673 857 002674 860 002675 864 002713 867 002750 870 002753 872 002754 873 002755 874 002756 875 002760 876 002762 877 002763 880 003010 881 003014 882 003016 884 003020 887 003025 890 003032 894 003053 895 003054 897 003064 898 003066 901 003067 902 003070 904 003071 908 003104 911 003105 923 003106 925 003117 926 003126 927 003127 930 003130 932 003133 933 003136 936 003141 939 003147 942 003151 948 003155 956 003157 958 003161 960 003177 963 003203 965 003215 967 003234 969 003256 970 003260 974 003262 975 003264 976 003273 978 003314 983 003357 984 003360 986 003362 988 003371 989 003402 991 003420 993 003422 994 003431 995 003435 996 003445 997 003450 1001 003451 1011 003457 1015 003470 1020 003523 1021 003531 1024 003601 1025 003604 1028 003607 1030 003614 1034 003620 1045 003621 1046 003626 1048 003631 1049 003634 1050 003637 1052 003644 1053 003651 1055 003653 1056 003660 1058 003670 1061 003672 1062 003674 1064 003675 1066 003676 1067 003677 1071 003700 1099 003701 1101 003703 1103 003704 1105 003711 1108 003712 1109 003714 1110 003715 1112 003716 1114 003721 1115 003723 1116 003724 1117 003727 1118 003731 1121 003732 1125 003743 1128 003751 1130 003752 1133 003755 1134 003760 1135 003761 1137 003762 1140 003763 1141 003766 1142 003770 1143 003772 1144 003774 1145 003777 1146 004001 1148 004004 1150 004011 1153 004061 1155 004062 1158 004066 1160 004067 1162 004070 1164 004073 1168 004074 1183 004075 1185 004077 1187 004115 1188 004120 1189 004121 1192 004122 1194 004127 1200 004161 1201 004165 1204 004172 1206 004174 1208 004211 1209 004215 1210 004220 1211 004221 1217 004234 1218 004240 1227 004273 1229 004276 1230 004302 1233 004307 1240 004317 1241 004320 1242 004324 1243 004330 1244 004333 1245 004334 1246 004340 1255 004374 1257 004377 1258 004403 1261 004410 1270 004420 1273 004435 1274 004440 1276 004442 1279 004473 1281 004477 1283 004500 1284 004512 1286 004532 1289 004543 1293 004544 1310 004546 1312 004547 1313 004552 1315 004562 1320 004616 1321 004620 1322 004631 1323 004654 1325 004657 1327 004661 1333 004717 1334 004722 1336 004724 1340 004730 1342 004750 1344 004771 1346 005012 1348 005032 1350 005056 1352 005076 1354 005120 1358 005123 1369 005124 1370 005127 1372 005157 1373 005163 1377 005164 1379 005174 1381 005227 1384 005231 1388 005234 1392 005235 1393 005237 1394 005242 1395 005244 1396 005246 1397 005250 1398 005254 1399 005256 1404 005257 1408 005260 1409 005262 1410 005265 1411 005267 1412 005271 1413 005275 1415 005276 1428 005314 1448 005322 1450 005351 1454 005416 1460 005423 1465 005467 1473 005470 1474 005473 1477 005511 1481 005530 1485 005560 1487 005571 1488 005577 1430 005600 1436 005602 1438 005610 1440 005622 1492 005627 1501 005630 1502 005635 1503 005645 1507 005700 1508 005702 1511 005705 1513 005715 1515 005722 1517 005727 1519 005736 1521 005742 1523 005746 1525 005752 1528 005760 1530 005764 1535 005774 1537 006000 1539 006004 1542 006010 1545 006017 1547 006020 1550 006021 1565 006027 1567 006047 1571 006100 1574 006143 1575 006150 1578 006151 1579 006154 1580 006157 1581 006163 1582 006170 1583 006172 1584 006176 1586 006200 1589 006205 1590 006210 1591 006212 1593 006220 1594 006222 1595 006224 1597 006226 1598 006245 1602 006252 1603 006255 1604 006260 1605 006262 1606 006264 1608 006266 1609 006305 1610 006324 1612 006343 1613 006362 1614 006364 1617 006371 1618 006404 1619 006431 1621 006432 1623 006455 1626 006475 1627 006500 1628 006502 1629 006504 1630 006506 1632 006510 1634 006530 1637 006543 1638 006562 1641 006655 1643 006656 1646 006663 1650 006664 1658 006665 1659 006667 1660 006671 1661 006700 1662 006710 1665 006741 1667 006747 1668 006755 1671 007013 1672 007015 1674 007016 1676 007026 1680 007030 1682 007031 1684 007041 1686 007043 1687 007044 1688 007046 1690 007070 1691 007072 1692 007074 1693 007100 1695 007104 1697 007105 1706 007106 1708 007112 1709 007145 1710 007152 1714 007153 1726 007154 1732 007210 1734 007211 1737 007212 1739 007216 1740 007221 1743 007246 1746 007266 1749 007306 1751 007307 1753 007323 1754 007324 1756 007325 1758 007333 1760 007341 1761 007343 1762 007345 1763 007346 1765 007350 1766 007352 1771 007416 1772 007420 1774 007427 1775 007430 1776 007437 1777 007473 1778 007502 1779 007511 1780 007522 1781 007531 1782 007532 1784 007533 1786 007537 1791 007603 1797 007671 1799 007736 1803 007740 1823 007741 1825 007745 1826 007765 1827 010000 1828 010004 1831 010005 1832 010013 1833 010015 1834 010017 1835 010020 1840 010022 1842 010034 1843 010053 1852 010054 1854 010061 1856 010070 1858 010104 1860 010106 1861 010114 1864 010173 1865 010200 1867 010201 1868 010205 1871 010260 1872 010261 1874 010262 1888 010300 1890 010306 1892 010312 1893 010314 1894 010331 1895 010335 1896 010337 1898 010347 1903 010353 1906 010370 1907 010403 1909 010404 1921 010406 1927 010432 1931 010451 1934 010455 1948 010457 1949 010466 1950 010474 1951 010475 1952 010477 1954 010505 1955 010510 1956 010511 1958 010512 1959 010515 1971 010521 1983 010523 1985 010534 1987 010536 1988 010541 1990 010542 1997 010572 1998 010574 1999 010610 2000 010613 2004 010651 2006 010652 2008 010667 2010 010721 2011 010724 2012 010725 2015 010753 2020 010755 2022 010764 2023 010772 2024 011004 2025 011015 2026 011016 2028 011024 2031 011031 2036 011066 2042 011141 2048 011176 2049 011203 2050 011207 2052 011210 2056 011211 2064 011212 2069 011243 2072 011270 2073 011274 2077 011275 2088 011276 2091 011322 2096 011354 2101 011365 2102 011367 2106 011425 2107 011431 2111 011432 2115 011433 2118 011512 2119 011516 2125 011517 2129 011520 2130 011545 2131 011551 2135 011552 2145 011553 2146 011562 2149 011636 2150 011642 2155 011643 2162 011644 2163 011661 2167 011662 2185 011663 2187 011673 2190 011745 2194 011746 2201 011747 2203 011760 2205 011766 2207 011774 2210 012002 2212 012010 2214 012050 2216 012106 2218 012112 2222 012113 2230 012121 2234 012131 2255 012137 2256 012150 2258 012151 2259 012170 2260 012171 2263 012201 2264 012215 2265 012220 2266 012243 2267 012251 2269 012252 2270 012256 2272 012261 2278 012270 2280 012305 2286 012343 2288 012372 2289 012373 2291 012404 2294 012436 2295 012450 2296 012461 2302 012470 2304 012500 2309 012521 2310 012522 2311 012523 2312 012532 2315 012533 2317 012552 2318 012553 2319 012561 2321 012566 2322 012615 2325 012631 2327 012643 2328 012645 2331 012657 2334 012661 2340 012674 2344 012704 2347 012712 2349 012713 2352 012732 2353 012741 2354 012746 2355 012775 2356 013004 2358 013006 2359 013011 2360 013040 2364 013050 2378 013052 2379 013056 2382 013057 2383 013065 2384 013077 2385 013120 2387 013172 2389 013205 2391 013210 2392 013217 2394 013220 2395 013227 2396 013250 2398 013322 2400 013340 2402 013343 2404 013352 2410 013353 2422 013361 2424 013363 2425 013367 2426 013412 2429 013413 2432 013414 2436 013422 2438 013423 2439 013427 2442 013430 2445 013431 2448 013445 2450 013451 2451 013455 2454 013462 2456 013471 2457 013476 2463 013570 2466 013571 2467 013577 2469 013601 2476 013604 2483 013675 2484 013724 2487 013726 2492 013733 2495 013752 2496 013764 2497 013776 2498 014010 2503 014011 2508 014042 2511 014062 2513 014070 2514 014102 2515 014114 2516 014126 2521 014127 2527 014210 2531 014211 2535 014217 2537 014243 2541 014247 2545 014251 2547 014275 2551 014301 2562 014307 2563 014331 2566 014334 2567 014340 2568 014345 2569 014351 2573 014353 2583 014355 2584 014361 2587 014362 2592 014414 2595 014421 2597 014446 2599 014450 2607 014451 2611 014470 2614 014507 2618 014510 2631 014512 2632 014514 2633 014524 2635 014532 2638 014607 2639 014611 2641 014614 2643 014622 2644 014625 2645 014626 2655 014627 2669 014633 2670 014637 2673 014661 2677 014664 2678 014671 2679 014702 2680 014704 2681 014710 2682 014717 2683 014721 ----------------------------------------------------------- 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