COMPILATION LISTING OF SEGMENT probe_assign_value_ Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 11/11/88 1546.9 mst Fri Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 /* format: style1,insnl,ifthendo,indthenelse,^indnoniterdo,^inditerdo,indcom,^indthenbegin,^indprocbody,ind2,ll78,initcol0,dclind4,idind24,struclvlind1,comcol41 */ 13 14 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 15 16 /****^ HISTORY COMMENTS: 17* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 18* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1212): 19* Extended pointer values assignment capabilities when language is PASCAL. 20* Any pointer value is now allowed (variable or constant). Removed 21* references to pascal_symbol_node declaration. They have been replaced by 22* calls to runtime_symbol_info_. 23* 2) change(88-06-01,WAAnderson), approve(88-09-30,MCR7952), 24* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 25* Added a test that checks for character string constants in C. If we 26* happen to encounter one, we confirm that the 'constant_token_ptr' is 27* null and allow the assignment because the 'string' is actually an 28* array of characters (as changed by probe_eval_). 29* 3) change(88-09-07,WAAnderson), approve(88-09-30,MCR7952), 30* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 31* Added format control comment to make the source more readable. 32* END HISTORY COMMENTS */ 33 34 probe_assign_value_: 35 proc (P_probe_info_ptr, P_target, P_source, P_code); 36 37 /* assign the value designated by P_source to the storage designated by 38* P_target. Both are input only */ 39 40 /* Written 11 Nov 78 By James R. Davis 41* Modified 11 May 79 JRD to check for constant assignment. 42* Modified June 79 WOS to convert to probe 4.0 43* Modified 13 Nov 79 JRD to convert to assign_$computational and data_type_info */ 44 /* Fixed to catch size condition 08/20/81 S. Herbst */ 45 /* Modified June 83 JMAthane to add PASCAL values */ 46 /* Fixed "let pascal_string = constant_string" to pad target with blanks 07/27/83 S. Herbst */ 47 /* Changed for new probe_increment_indices_ calling sequence 08/02/83 Olin Sibert */ 48 /* Fixed to work on arrays, cross-sections and structures 08/23/83 S. Herbst */ 49 /* Added version string to runtime_type_info structure 10/06/83 S. Herbst */ 50 /* Changed to call get_size_in_bits_$structure with ref_ptr, handle var extents 06/05/84 S. Herbst */ 51 /* Fixed to compute addresses correctly for based cross-sections 06/06/84 S. Herbst */ 52 /* Extended pointer values assignment possibilities in Pascal. 53* Removed references to pascal_symbol_node declaration. 54* JMAthane June 85 */ 55 56 dcl ( 57 P_probe_info_ptr pointer, 58 P_code fixed bin (35) 59 ) parameter; 60 61 dcl 1 P_target aligned like reference_node parameter; 62 dcl 1 P_source aligned like reference_node parameter; 63 64 dcl BASED_CLASS bit (4) unaligned int static 65 options (constant) init ("0011"b); 66 67 dcl ( 68 1 source, 69 1 target 70 ) aligned like computational_data; 71 72 dcl (target_indices, source_indices) 73 (16) fixed bin; 74 dcl (target_invert, source_invert) 75 bit (1) aligned; 76 dcl (target_p, source_p) ptr; 77 dcl done bit (1) aligned init ("0"b); 78 dcl code fixed bin (35); 79 80 dcl 1 subscripts aligned based like reference_subscripts; 81 82 /* FORTRAN allows up to 7 dims, PL/I allows more than 16 I think, but 16 is our maximum */ 83 84 dcl ( 85 probe_et_$bad_assign, 86 probe_et_$bad_section, 87 probe_et_$constant_target, 88 probe_et_$no_address, 89 probe_et_$recorded_message, 90 probe_et_$c_string_assign, 91 probe_et_$size 92 ) fixed bin (35) external static; 93 94 dcl probe_error_$record entry options (variable); 95 dcl get_size_in_bits_ entry (fixed bin, fixed bin (35), bit (1)) 96 returns (fixed bin); 97 dcl get_size_in_bits_$structure 98 entry (ptr) returns (fixed bin); 99 dcl probe_increment_indices_ 100 entry (bit (1) aligned, (*) fixed bin, 101 (2, *) fixed bin (24), 102 fixed bin, bit (1) aligned, bit (1) aligned); 103 dcl probe_pascal_$real_type entry (fixed bin (35), ptr, fixed bin (35), ptr) 104 ; 105 dcl assign_$computational_ entry (ptr, ptr, fixed bin (35)); 106 /* converts computational types */ 107 dcl area_assign_ entry (pointer, pointer); 108 /* assigns one area to another */ 109 dcl stu_$get_runtime_address 110 entry (ptr, ptr, ptr, ptr, ptr, ptr, ptr) 111 returns (ptr); 112 dcl stu_$offset_to_pointer entry (ptr, ptr, ptr, ptr, ptr, ptr) 113 returns (ptr); 114 dcl stu_$pointer_to_offset entry (ptr, ptr, ptr, ptr, ptr, ptr) 115 returns (offset); 116 /* used to convert on based of default area */ 117 118 dcl (addr, baseno, binary, copy, divide, null, nullo, pointer, string, 119 substr, unspec) builtin; 120 121 dcl conversion condition; 122 /* \014 */ 123 probe_info_ptr = P_probe_info_ptr; 124 125 if P_target.flags.constant & ^P_target.flags.pseudo_var then do; 126 /* "let 7 = 14", eh? */ 127 if (probe_info.language_type = C_lang_type & 128 P_target.type = char_dtype & P_target.precision > 1) 129 then do; 130 if (P_source.type ^= char_dtype & ^P_source.flags.constant) 131 then 132 code = probe_et_$c_string_assign; 133 else if ^P_target.flags.c_ptr_to_char 134 & P_target.constant_token_ptr = null () then do; 135 begin; 136 dcl based_str char (256) based; 137 dcl the_null_byte char (1) 138 based (addr (zero_value)); 139 dcl zero_value fixed bin (9) unsigned init (0); 140 substr (P_target.address_ptr -> based_str, 1, 141 P_source.precision) = 142 substr (P_source.address_ptr -> based_str, 1, 143 P_source.precision); 144 substr (P_target.address_ptr -> based_str, 145 P_source.precision + 1, 1) = 146 the_null_byte; 147 return; 148 end; 149 end; 150 else do; 151 call probe_error_$record (probe_info_ptr, 0, 152 "Cannot assign a string to a char pointer."); 153 goto RECORDED_MESSAGE; 154 end; 155 end; 156 else code = probe_et_$constant_target; 157 goto SOME_ERROR; 158 end; 159 160 if ^P_target.cross_section then do; 161 if P_source.cross_section then do;/* cant assign xsection to scalar */ 162 code = probe_et_$bad_section; 163 goto SOME_ERROR; 164 end; 165 166 if P_target.address_ptr = null () then do; 167 /* no place to assign to */ 168 call probe_error_$record (probe_info_ptr, probe_et_$no_address, 169 P_target.name); 170 goto RECORDED_MESSAGE; 171 end; 172 173 call assign_reference (); 174 end; 175 else do; /* assigning to a xsection */ 176 177 target_indices = P_target.subscript_ptr -> subscripts.value (1, *); 178 /* set to low bound */ 179 target_p = P_target.address_ptr; 180 if P_target.symbol_ptr ^= null 181 then 182 if P_target.symbol_ptr -> runtime_symbol.class = BASED_CLASS 183 then 184 target_p = null; /* let stu_ compute the based address */ 185 target_invert = 186 P_target.source_info_ptr -> source_info.seg_info_ptr 187 -> seg_info.language_type 188 = FORTRAN_lang_type; 189 190 source_indices = P_source.subscript_ptr -> subscripts.value (1, *); 191 /* set to low bound */ 192 source_p = P_source.address_ptr; 193 if P_source.symbol_ptr ^= null 194 then 195 if P_source.symbol_ptr -> runtime_symbol.class = BASED_CLASS 196 then 197 source_p = null; /* let stu_ compute the based address */ 198 source_invert = 199 P_source.source_info_ptr -> source_info.seg_info_ptr 200 -> seg_info.language_type 201 = FORTRAN_lang_type; 202 203 do while (^done); 204 205 P_target.address_ptr = 206 stu_$get_runtime_address (P_target.source_info_ptr 207 -> source_info.block_ptr, 208 P_target.symbol_ptr, 209 P_target.source_info_ptr -> source_info.stack_ptr, 210 (P_target.source_info_ptr -> source_info.seg_info_ptr 211 -> seg_info.linkage_ptr), 212 P_target.source_info_ptr -> source_info.block_ptr, 213 target_p, 214 addr (target_indices)); 215 if P_target.address_ptr = null () then do; 216 call probe_error_$record (probe_info_ptr, probe_et_$no_address, 217 P_target.name); 218 goto RECORDED_MESSAGE; 219 end; 220 221 /* do the same with source if not a constant */ 222 if P_source.symbol_ptr ^= null 223 then P_source.address_ptr = stu_$get_runtime_address 224 (P_source.source_info_ptr -> source_info.block_ptr, 225 P_source.symbol_ptr, 226 P_source.source_info_ptr -> source_info.stack_ptr, 227 (P_source.source_info_ptr -> source_info.seg_info_ptr 228 -> seg_info.linkage_ptr), 229 P_source.source_info_ptr -> source_info.block_ptr, 230 source_p, 231 addr (source_indices)); 232 call assign_reference (); 233 call probe_increment_indices_ (target_invert, target_indices, 234 P_target.subscript_ptr -> subscripts.value, 235 P_target.subscript_ptr -> subscripts.number, 236 done, ("0"b)); 237 238 if P_source.cross_section 239 then 240 call probe_increment_indices_ (source_invert, source_indices, 241 P_source.subscript_ptr -> subscripts.value, 242 P_source.subscript_ptr -> subscripts.number, 243 done, ("0"b)); 244 245 end; /* of cross-section assign loop */ 246 end; /* of cross-section code */ 247 248 P_code = 0; /* all done, successfully */ 249 return; 250 251 252 RECORDED_MESSAGE: 253 code = probe_et_$recorded_message; 254 goto SOME_ERROR; 255 256 257 SOME_ERROR: 258 P_code = code; 259 return; 260 261 262 bad_assignment: 263 call probe_error_$record (probe_info_ptr, probe_et_$bad_assign, 264 P_source.name, P_target.name); 265 goto RECORDED_MESSAGE; 266 267 /* \014 */ 268 269 assign_reference: 270 procedure (); 271 272 dcl 1 temp aligned like reference_node; 273 274 275 dcl based_ptr pointer aligned based; 276 /* overlays for various data types */ 277 dcl based_packed_ptr pointer unaligned based; 278 dcl based_offset offset based; 279 dcl based_label label based; 280 dcl based_entry entry based; 281 dcl based_file file based; 282 283 dcl 1 label_var aligned, /* internal representation of label */ 284 2 place pointer, /* location of label */ 285 2 frame pointer; /* stack frame containing invocation */ 286 287 dcl 1 entry_var aligned like label_var; 288 289 dcl gen pointer; /* temporary for generation of offset */ 290 dcl p pointer; /* temporary */ 291 292 dcl (source_len, source_size, target_len, target_size) 293 fixed bin; 294 dcl target_object bit (target_size) 295 based (P_target.address_ptr) unal; 296 dcl source_object bit (source_size) 297 based (P_source.address_ptr) unal; 298 dcl target_string char (target_len) based (P_target.address_ptr); 299 dcl source_string char (source_len) based (P_source.address_ptr); 300 dcl (target_real_type, source_real_type) 301 fixed bin (35); 302 dcl (target_real_type_ptr, source_real_type_ptr) 303 ptr; 304 dcl 1 target_type_type_info like runtime_type_info; 305 dcl 1 source_type_type_info like runtime_type_info; 306 /* \014 */ 307 308 temp.argument_list, target_real_type_ptr, source_real_type_ptr = null; 309 on conversion go to bad_assignment; /* catch error */ 310 on size 311 begin; 312 code = probe_et_$size; 313 go to SOME_ERROR; 314 end; 315 316 if probe_info.language_type = PASCAL_lang_type then do; 317 if P_target.source_info_ptr ^= null 318 then 319 if baseno (P_target.address_ptr) 320 = baseno (P_target.source_info_ptr -> source_info.entry_ptr) 321 then do; 322 code = probe_et_$constant_target; 323 go to SOME_ERROR; 324 end; 325 call probe_pascal_$real_type (P_target.type, P_target.type_ptr, 326 target_real_type, target_real_type_ptr); 327 call probe_pascal_$real_type (P_source.type, P_source.type_ptr, 328 source_real_type, source_real_type_ptr); 329 end; 330 else do; 331 target_real_type = P_target.type; 332 target_real_type_ptr = P_target.type_ptr; 333 source_real_type = P_source.type; 334 source_real_type_ptr = P_source.type_ptr; 335 end; 336 337 338 if source_real_type_ptr ^= null then do; 339 source_type_type_info.version = RUNTIME_TYPE_INFO_VERSION_1; 340 call runtime_symbol_info_$type (source_real_type_ptr, 341 addr (source_type_type_info), code); 342 if code ^= 0 343 then go to bad_assignment; 344 end; 345 if target_real_type_ptr ^= null then do; 346 target_type_type_info.version = RUNTIME_TYPE_INFO_VERSION_1; 347 call runtime_symbol_info_$type (target_real_type_ptr, 348 addr (target_type_type_info), code); 349 if code ^= 0 350 then go to bad_assignment; 351 end; 352 353 if target_real_type = structure_dtype then do; 354 if source_real_type ^= structure_dtype then do; 355 call probe_error_$record (probe_info_ptr, 0, 356 "Can't assign a scalar to a structure."); 357 go to RECORDED_MESSAGE; 358 end; 359 360 if ^same_format (P_target.symbol_ptr, P_source.symbol_ptr) then do; 361 if target_real_type = structure_dtype 362 then call probe_error_$record (probe_info_ptr, 0, 363 "Structures have different format. Use the unspec builtin if necessary." 364 ); 365 else call probe_error_$record (probe_info_ptr, 366 "Arrays have different dimension."); 367 go to RECORDED_MESSAGE; 368 end; 369 370 call make_unspec (P_target); 371 call make_unspec (P_source); 372 373 call setup_str (P_target, target, (bit_dtype)); 374 call setup_str (P_source, source, (bit_dtype)); 375 376 call assign_$computational_ (addr (target), addr (source), code); 377 if code ^= 0 378 then go to SOME_ERROR; 379 end; 380 381 else if data_type_info_$info (target_real_type).computational then do; 382 if ^data_type_info_$info (source_real_type).computational 383 then goto bad_assignment; 384 385 call setup_str (P_target, target, target_real_type); 386 call setup_str (P_source, source, source_real_type); 387 388 call assign_$computational_ (addr (target), addr (source), code); 389 if code ^= 0 390 then goto SOME_ERROR; 391 end; /* computational */ 392 393 else if target_real_type = pointer_dtype then do; 394 if (source_real_type = pascal_user_defined_type_instance_dtype 395 & source_type_type_info.type = pascal_typed_pointer_type_dtype) 396 | source_real_type = pointer_dtype 397 /* another pointer */ 398 then if P_source.packed /* is it a packed pointer */ 399 then p = P_source.address_ptr -> based_packed_ptr; 400 else p = P_source.address_ptr -> based_ptr; 401 else if source_real_type = offset_dtype /* offset */ 402 then do; 403 gen = P_source.source_info_ptr; 404 /* to avoid typing */ 405 p = stu_$offset_to_pointer (gen -> source_info.block_ptr, 406 P_source.symbol_ptr, P_source.address_ptr, 407 gen -> source_info.stack_ptr, 408 (gen -> source_info.seg_info_ptr -> seg_info.linkage_ptr), 409 gen -> source_info.block_ptr); 410 /* convert offset using default area */ 411 if p = null & P_source.address_ptr -> based_offset ^= nullo 412 then go to bad_assignment; /* could not get default area */ 413 end; 414 else go to bad_assignment; /* won't allow ptr = 1 */ 415 416 if P_target.packed 417 then P_target.address_ptr -> based_packed_ptr = p; 418 /* assign value to symbol */ 419 else P_target.address_ptr -> based_ptr = p; 420 421 end; /* pointer */ 422 423 else if target_real_type = offset_dtype then do; 424 425 if source_real_type = pointer_dtype /* pointer */ 426 then do; 427 gen = P_target.source_info_ptr; 428 if P_source.packed /* unpack it if necessary */ 429 then p = P_source.address_ptr -> based_packed_ptr; 430 else p = P_source.address_ptr -> based_ptr; 431 P_target.address_ptr -> based_offset = 432 /* convert ptr relative to area */ 433 stu_$pointer_to_offset (gen -> source_info.block_ptr, 434 P_target.symbol_ptr, addr (p), 435 gen -> source_info.stack_ptr, 436 (gen -> source_info.seg_info_ptr -> seg_info.linkage_ptr), 437 gen -> source_info.block_ptr); 438 if P_target.address_ptr -> based_offset = nullo & p ^= null 439 then go to bad_assignment; /* could not get default area */ 440 end; 441 else if source_real_type = offset_dtype 442 /* another offset */ 443 then P_target.address_ptr -> based_offset = 444 P_source.address_ptr -> based_offset; 445 else go to bad_assignment; 446 447 end; /* offset */ 448 449 else if target_real_type = label_dtype then do; 450 451 if source_real_type = label_dtype /* variable */ 452 then P_target.address_ptr -> based_label = 453 P_source.address_ptr -> based_label; 454 else if source_real_type 455 = 456 label_constant_runtime_dtype 457 /* constant, must get frame label is in */ 458 then do; 459 label_var.place = P_source.address_ptr; 460 label_var.frame = P_source.source_info_ptr -> source_info.stack_ptr; 461 unspec (P_target.address_ptr -> based_label) = unspec (label_var); 462 end; 463 else go to bad_assignment; 464 465 end; /* label var */ 466 467 else if target_real_type = entry_dtype then do; 468 469 if source_real_type = entry_dtype /* entry variable */ 470 then P_target.address_ptr -> based_entry = 471 P_source.address_ptr -> based_entry; 472 else if source_real_type >= int_entry_runtime_dtype /* entry constant */ 473 then do; 474 entry_var.place = P_source.address_ptr; 475 if source_real_type = int_entry_runtime_dtype 476 then entry_var.frame = 477 P_source.source_info_ptr -> source_info.stack_ptr; 478 /* internal proc, get display */ 479 else entry_var.frame = null (); 480 /* level 0, display is null */ 481 P_target.address_ptr -> based_entry = 482 addr (entry_var) -> based_entry; 483 end; 484 else go to bad_assignment; 485 486 end; /* entry var */ 487 488 else if target_real_type = area_dtype then do; 489 490 if source_real_type ^= area_dtype 491 then go to bad_assignment; /* can only assign an area to another area */ 492 493 call area_assign_ (P_target.address_ptr, P_source.address_ptr); 494 end; /* area */ 495 496 else if target_real_type = file_dtype then do; 497 if source_real_type ^= file_dtype 498 then go to bad_assignment; /* only a file can be source */ 499 500 P_target.address_ptr -> based_file = P_source.address_ptr -> based_file; 501 502 end; /* file */ 503 504 else if data_type_info_$info (target_real_type).type then do; 505 call probe_error_$record (probe_info_ptr, 0, 506 "Can't assign to a PASCAL type"); 507 go to RECORDED_MESSAGE; 508 end; /* type */ 509 510 else if target_real_type = pascal_char_dtype then do; 511 if source_real_type = pascal_char_dtype 512 then 513 call assign_pascal_enumerated; 514 else if source_real_type = char_dtype 515 & P_source.precision = 1 then do; 516 /* unique char constant */ 517 P_source.type = pascal_char_dtype; 518 P_source.precision = 9; 519 call assign_pascal_enumerated; 520 end; 521 else go to bad_assignment; 522 end; /* PASCAL char */ 523 524 else if target_real_type = pascal_boolean_dtype then do; 525 if source_real_type = pascal_boolean_dtype 526 then 527 call assign_pascal_enumerated; 528 else go to bad_assignment; 529 end; /* PASCAL boolean */ 530 531 else if target_real_type = pascal_enumerated_type_element_dtype then do; 532 call probe_error_$record (probe_info_ptr, 0, 533 "Can't assign to an enumerated type element constant."); 534 go to RECORDED_MESSAGE; 535 end; /* PASCAL enumerated type element */ 536 537 else if target_real_type = pascal_enumerated_type_instance_dtype then do; 538 if source_real_type = pascal_enumerated_type_element_dtype then do; 539 if target_real_type_ptr 540 = runtime_symbol_info_$father_type (P_source.symbol_ptr) 541 then 542 call assign_pascal_enumerated; 543 else go to bad_assignment; 544 end; 545 else if source_real_type = pascal_enumerated_type_instance_dtype 546 then do; 547 if target_real_type_ptr = source_real_type_ptr 548 then 549 call assign_pascal_enumerated; 550 else go to bad_assignment; 551 end; 552 else go to bad_assignment; 553 end; /* PASCAL enumerated type instance */ 554 555 else if target_real_type = pascal_text_file_dtype then do; 556 call probe_error_$record (probe_info_ptr, 0, 557 "Can't assign to a PASCAL file (temporary restriction)."); 558 go to RECORDED_MESSAGE; 559 end; 560 561 else if target_real_type = pascal_user_defined_type_instance_dtype then do; 562 if source_real_type = pascal_user_defined_type_instance_dtype then do; 563 if source_real_type_ptr = target_real_type_ptr then do; 564 if target_type_type_info.has_dimensions /* array */ 565 | target_type_type_info.type 566 = pascal_record_type_dtype /* record */ 567 | target_type_type_info.type = pascal_set_dtype /* set */ 568 then do; 569 source_size = 570 get_size_in_bits_ ((P_source.type), P_source.precision, 571 P_source.packed); 572 target_size = 573 get_size_in_bits_ ((P_target.type), P_target.precision, 574 P_target.packed); 575 if source_size > target_size 576 then 577 target_object = 578 substr (source_object, 1, target_size); 579 else 580 target_object = source_object; 581 end; 582 else if target_type_type_info.type = 583 pascal_record_file_type_dtype then do; 584 call probe_error_$record (probe_info_ptr, 0, 585 "Can't assign to a PASCAL file (temporary restriction)." 586 ); 587 go to RECORDED_MESSAGE; 588 end; 589 else if target_type_type_info.type = 590 pascal_typed_pointer_type_dtype then do; 591 if P_target.precision = 36 592 then 593 if P_source.precision = 72 594 then 595 P_target.address_ptr -> based_packed_ptr = 596 P_source.address_ptr -> based_ptr; 597 else 598 P_target.address_ptr -> based_packed_ptr = 599 P_source.address_ptr -> based_packed_ptr; 600 else 601 if P_source.precision = 72 602 then 603 P_target.address_ptr -> based_ptr = 604 P_source.address_ptr -> based_ptr; 605 else 606 P_target.address_ptr -> based_ptr = 607 P_source.address_ptr -> based_packed_ptr; 608 end; 609 else go to bad_assignment; 610 end; 611 else 612 if target_type_type_info.type = pascal_set_dtype 613 & P_source.name = "<>" then do; 614 source_size = 615 get_size_in_bits_ ((P_source.type), P_source.precision, 616 P_source.packed); 617 target_size = 618 get_size_in_bits_ ((P_target.type), P_target.precision, 619 P_target.packed); 620 if source_size > target_size 621 then 622 target_object = substr (source_object, 1, target_size); 623 else 624 target_object = source_object; 625 end; 626 else go to bad_assignment; 627 end; 628 else if source_real_type = pointer_dtype then do; 629 if target_type_type_info.type = pascal_typed_pointer_type_dtype 630 then do; 631 if P_target.precision = 36 632 then 633 if ^P_source.packed 634 then 635 P_target.address_ptr -> based_packed_ptr = 636 P_source.address_ptr -> based_ptr; 637 else 638 P_target.address_ptr -> based_packed_ptr = 639 P_source.address_ptr -> based_packed_ptr; 640 else 641 if ^P_source.packed 642 then 643 P_target.address_ptr -> based_ptr = 644 P_source.address_ptr -> based_ptr; 645 else 646 P_target.address_ptr -> based_ptr = 647 P_source.address_ptr -> based_packed_ptr; 648 end; 649 else go to bad_assignment; 650 end; 651 else if source_real_type = char_dtype then do; 652 if P_source.precision > 1 653 & target_type_type_info.packed 654 & target_type_type_info.has_dimensions then do; 655 656 target_type_type_info.version = RUNTIME_TYPE_INFO_VERSION_1; 657 658 call runtime_symbol_info_$type (target_real_type_ptr, 659 addr (target_type_type_info), code); 660 if code ^= 0 661 then go to bad_assignment; 662 663 n_dims = runtime_symbol_info_$array_dims (target_real_type_ptr); 664 if (target_type_type_info.base_type = pascal_char_dtype) 665 & (n_dims = 1) 666 then 667 do; 668 target_size = 669 get_size_in_bits_ ((P_target.type), P_target.precision, 670 P_target.packed); 671 source_size = 672 get_size_in_bits_ ((P_source.type), P_source.precision, 673 P_source.packed); 674 if source_size > target_size 675 then 676 target_object = 677 substr (source_object, 1, target_size); 678 else do; 679 target_len = divide (target_size, 9, 17, 0); 680 source_len = divide (source_size, 9, 17, 0); 681 target_string = 682 source_string 683 || copy (" ", target_len - source_len); 684 end; 685 end; 686 else go to bad_assignment; 687 end; 688 else go to bad_assignment; 689 end; 690 else go to bad_assignment; 691 end; /* PASCAL user defined type instance dtype */ 692 693 else do; 694 call probe_error_$record (probe_info_ptr, 0, 695 "Can't assign to an object of type like ^a", P_target.name); 696 go to RECORDED_MESSAGE; 697 end; 698 return; 699 700 /* Procedures internal to assign_reference: */ 701 702 assign_pascal_enumerated: 703 proc; 704 705 call set_up (P_target, target); 706 call set_up (P_source, source); 707 708 call assign_$computational_ (addr (target), addr (source), code); 709 if code ^= 0 710 then go to SOME_ERROR; 711 712 set_up: 713 proc (ref, comp); 714 715 dcl 1 ref parameter aligned like reference_node; 716 dcl 1 comp parameter aligned like computational_data; 717 718 comp.address = ref.address_ptr; 719 comp.prec_or_length = ref.precision; 720 if ref.precision >= 36 721 then 722 comp.data_type = real_fix_bin_2_uns_dtype; 723 else 724 comp.data_type = real_fix_bin_1_uns_dtype; 725 string (comp.flags) = "0"b; 726 comp.flags.packed = "1"b; 727 comp.scale = 0; 728 end set_up; 729 end assign_pascal_enumerated; 730 731 make_unspec: 732 proc (P_ref); 733 734 dcl 1 P_ref aligned like reference_node; 735 736 P_ref.pseudo_var = "1"b; 737 P_ref.type = bit_dtype; 738 P_ref.type_ptr = null; 739 P_ref.descriptor = P_ref.type * 2; 740 P_ref.packed = "1"b; 741 P_ref.precision = get_size_in_bits_$structure (addr (P_ref)); 742 if P_ref.precision = -1 then do; 743 call probe_error_$record (probe_info_ptr, 0, 744 "Can't determine size of ^a", P_ref.name); 745 go to RECORDED_MESSAGE; 746 end; 747 end make_unspec; 748 749 same_format: 750 proc (P_ptr1, P_ptr2) returns (bit (1)); 751 752 dcl (P_ptr1, P_ptr2) ptr; /* pointers to symbol nodes */ 753 dcl (p1, p2) ptr; 754 dcl (var1_type, var2_type) fixed bin; 755 756 var1_type = binary (P_ptr1 -> runtime_symbol.type); 757 var2_type = binary (P_ptr2 -> runtime_symbol.type); 758 if var1_type ^= var2_type 759 then 760 return ("0"b); 761 if P_ptr1 -> runtime_symbol.ndims ^= P_ptr2 -> runtime_symbol.ndims 762 then 763 return ("0"b); 764 765 if var1_type = structure_dtype then do; 766 p1 = runtime_symbol_info_$son (P_ptr1); 767 do p2 = runtime_symbol_info_$son (P_ptr2) 768 repeat (runtime_symbol_info_$brother (p2)) 769 while (p2 ^= null); 770 771 if ^same_format (p1, p2) 772 then 773 return ("0"b); 774 p1 = runtime_symbol_info_$brother (p1); 775 end; 776 if p1 ^= null 777 then return ("0"b); 778 else return ("1"b); 779 end; 780 781 else do; 782 if P_ptr1 -> runtime_symbol.aligned ^= P_ptr2 -> runtime_symbol.aligned 783 then return ("0"b); 784 if P_ptr1 -> runtime_symbol.packed ^= P_ptr2 -> runtime_symbol.packed 785 then return ("0"b); 786 if P_ptr1 -> runtime_symbol.simple ^= P_ptr2 -> runtime_symbol.simple 787 then return ("0"b); 788 if P_ptr1 -> runtime_symbol.scale ^= P_ptr2 -> runtime_symbol.scale 789 then return ("0"b); 790 if P_ptr1 -> runtime_symbol.size ^= P_ptr2 -> runtime_symbol.size 791 then return ("0"b); 792 793 return ("1"b); 794 end; 795 796 end same_format; 797 798 setup_str: 799 proc (ref, comp, t_code); 800 801 dcl 1 ref parameter aligned like reference_node; 802 dcl t_code fixed bin (35); 803 dcl 1 comp parameter aligned like computational_data; 804 805 dcl 1 an_encoded_value like encoded_precision; 806 807 comp.address = ref.address_ptr; 808 comp.data_type = t_code; 809 string (comp.flags) = "0"b; 810 comp.flags.packed = ref.flags.packed; 811 if data_type_info_$info (ref.type).arithmetic 812 then do; 813 unspec (an_encoded_value) = unspec (ref.precision); 814 815 comp.prec_or_length = an_encoded_value.prec; 816 comp.scale = an_encoded_value.scale; 817 end; 818 else do; 819 comp.prec_or_length = ref.precision; 820 comp.scale = 0; 821 end; 822 if ref.type = picture_runtime_dtype 823 then comp.picture_image_ptr = pointer (ref.symbol_ptr, ref.precision); 824 else comp.picture_image_ptr = null (); 825 end setup_str; 826 827 end assign_reference; 828 /* \014 */ 1 1 /* BEGIN INCLUDE FILE probe_info.incl.pl1 */ 1 2 1 3 1 4 1 5 /****^ HISTORY COMMENTS: 1 6* 1) change(88-10-24,WAAnderson), approve(88-10-24,MCR7952), 1 7* audit(88-10-24,RWaters), install(88-10-27,MR12.2-1194): 1 8* Added field 'retry_using_main' to add new C feature. 1 9* END HISTORY COMMENTS */ 1 10 1 11 1 12 /* Created: 04/22/79 W. Olin Sibert, from subsystem_info 1 13* Modified: 22 Sept 79 JRd to remove: default (ptr & (auto|based)) init (null ()); 1 14* Added flags.setting_break 08/22/83 Steve Herbst 1 15* Added flags.executing_quit_request 01/15/85 Steve Herbst 1 16**/ 1 17 1 18 dcl 1 probe_info aligned based (probe_info_ptr), /* standard data for a probe invocation */ 1 19 2 probe_info_version fixed bin, /* version of this structure */ 1 20 1 21 2 static_info_ptr pointer unaligned, /* pointer to static information structure */ 1 22 2 modes_ptr pointer unaligned, /* pointer to probe_modes structure */ 1 23 1 24 2 ptr_to_current_source ptr, /* current_source is based on this */ 1 25 2 ptr_to_initial_source ptr, /* initial_source is based on this */ 1 26 2 machine_cond_ptr pointer, /* pointer to machine conditions, if we faulted to get here */ 1 27 1 28 2 token_info aligned, /* information about token chain currently being processed */ 1 29 3 first_token pointer unaligned, /* first token in chain */ 1 30 3 ct pointer unaligned, /* pointer to current token; updated in MANY places */ 1 31 3 end_token bit (18) aligned, /* token type at which to stop scanning token chain */ 1 32 3 buffer_ptr pointer unaligned, /* pointer to input buffer */ 1 33 3 buffer_lth fixed bin (21), /* and length */ 1 34 1 35 2 random_info aligned, 1 36 3 current_stack_frame pointer unaligned, /* stack frame pointer for frame in which probe was invoked */ 1 37 3 input_type fixed bin, /* current input type */ 1 38 3 language_type fixed bin, /* current language being processed */ 1 39 3 return_method fixed bin, /* how we should return after exiting probe */ 1 40 3 entry_method fixed bin, /* how we got here in the first place */ 1 41 3 pad1 (19) bit (36) aligned, 1 42 1 43 2 break_info, /* break info -- only interesting if we got here via a break */ 1 44 3 break_slot_ptr pointer, /* pointer to break slot -- non-null IFF at a break */ 1 45 3 last_break_slot_ptr pointer unaligned, /* pointer to previous break slot, not presently used */ 1 46 3 break_reset bit (1) aligned, /* this break has been reset by somebody further on */ 1 47 3 real_break_return_loc pointer, /* where to REALLY return to, modulo previous bit */ 1 48 1 49 2 probe_area_info, /* information about various probe areas */ 1 50 3 break_segment_ptr pointer unaligned, /* pointer to Personid.probe */ 1 51 3 break_area_ptr pointer unaligned, /* pointer to area in break segment */ 1 52 3 scratch_area_ptr pointer unaligned, /* pointer to probe scratch seg in process dir */ 1 53 3 probe_area_ptr pointer unaligned, /* This area lasts as long as an invocation of probe. */ 1 54 3 work_area_ptr pointer unaligned, /* This area lasts as long as the current request line */ 1 55 3 expression_area_ptr pointer unaligned, /* This area lasts as long as the current command */ 1 56 1 57 2 flags aligned, /* this, in particular, should be saved and restored correctly */ 1 58 (3 execute, /* "1"b => execute requests, "0"b => just check syntax */ 1 59 3 in_listener, /* ON => in probe listener loop */ 1 60 3 executing_request, /* ON => executing a request */ 1 61 3 in_interpret_line, /* executing in probe_listen_$interpret_line */ 1 62 3 setting_break, /* executing "after" or "before": check syntax of "if" */ 1 63 3 executing_quit_request, /* to prevent error looping during "quit" request */ 1 64 3 pad (30)) bit (1) unaligned, 1 65 1 66 2 io_switches, /* switches probe will do normal I/O on */ 1 67 3 input_switch pointer, 1 68 3 output_switch pointer, 1 69 1 70 2 error_info, /* information about the last error saved for later printing */ 1 71 3 error_code fixed bin (35), 1 72 3 error_message char (300) varying, 1 73 1 74 2 listener_info, /* internal use by probe listener */ 1 75 3 request_name character (32) varying, /* primary name of the request being processed */ 1 76 3 abort_probe_label label variable, 1 77 3 abort_line_label label variable, 1 78 3 depth fixed binary, /* count of active invocations of probe */ 1 79 3 previous pointer unaligned, /* -> previous invocation's info */ 1 80 3 next pointer unaligned, 1 81 1 82 2 end_of_probe_info pointer aligned, 1 83 2 retry_using_main fixed bin aligned; 1 84 1 85 1 86 dcl probe_info_ptr pointer; 1 87 1 88 dcl probe_info_version fixed bin static options (constant) initial (1); 1 89 1 90 dcl probe_info_version_1 fixed bin static options (constant) initial (1); 1 91 1 92 dcl scratch_area area based (probe_info.scratch_area_ptr); 1 93 dcl probe_area area based (probe_info.probe_area_ptr); 1 94 dcl work_area area based (probe_info.work_area_ptr); 1 95 dcl expression_area area based (probe_info.expression_area_ptr); 1 96 1 97 /* END INCLUDE FILE probe_info.incl.pl1 */ 829 2 1 /* BEGIN INCLUDE FILE probe_tokens.incl.pl1 */ 2 2 /* Split up into probe_tokens and probe_references, 04/22/79 WOS */ 2 3 2 4 dcl 1 token_header aligned based, /* header information common to all tokens */ 2 5 2 next pointer unaligned, /* pointer to next token in chain */ 2 6 2 prev pointer unaligned, /* same for previous token */ 2 7 2 type bit (18) aligned, 2 8 2 buffer_ptr pointer unaligned, /* pointer to beginning of input buffer */ 2 9 2 location fixed bin (17) unal, /* offset in input buffer */ 2 10 2 length fixed bin (17) unal, 2 11 2 flags aligned, 2 12 (3 leading_whitespace, /* there is whitespace before thios token */ 2 13 3 trailing_whitespace) bit (1) unaligned, /* and same for after */ 2 14 3 pad1 bit (34) unaligned; 2 15 2 16 dcl 1 token aligned based, /* produced by scan_probe_input_ */ 2 17 2 header aligned like token_header; /* that's all there is */ 2 18 2 19 dcl 1 identifier aligned based, /* keyword or identifier token */ 2 20 2 header aligned like token_header, 2 21 2 length fixed bin, /* length of name */ 2 22 2 name pointer unaligned; /* to string in buffer containing name */ 2 23 2 24 dcl 1 operator aligned based, /* for punctuation */ 2 25 2 header aligned like token_header; /* nothing but a header here */ 2 26 2 27 dcl 1 constant aligned based, /* for strings pointers numbers etc */ 2 28 2 header aligned like token_header, 2 29 2 encoded_precision aligned, /* encoded precision kludge for assign_ */ 2 30 3 scale fixed bin (17) unaligned, /* arithmetic scale */ 2 31 3 precision fixed bin (17) unaligned, /* arithmetic precision or other size */ 2 32 2 scale_and_precision fixed bin (35), /* An identical copy of the two values above */ 2 33 2 data_type fixed bin, /* standard data type code + packed bit */ 2 34 2 data_ptr pointer unaligned; 2 35 2 36 2 37 dcl (OPERATOR_TYPE init ("100"b), /* types for above */ 2 38 NAME_TYPE init ("010"b), 2 39 CONSTANT_TYPE init ("001"b)) bit (18) internal static options (constant); 2 40 2 41 2 42 dcl current_identifier_name /* Overlays for looking at the current tokens */ 2 43 char (probe_info.ct -> identifier.length) based (probe_info.ct -> identifier.name); 2 44 dcl 1 current_constant aligned like constant based (probe_info.ct); 2 45 dcl 1 current_token aligned like token based (probe_info.ct); 2 46 2 47 /* END INCLUDE FILE probe_tokens.incl.pl1 */ 830 3 1 /* BEGIN INCLUDE FILE probe_references.incl.pl1 */ 3 2 3 3 /****^ HISTORY COMMENTS: 3 4* 1) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 3 5* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 3 6* Added new field (c_symbol) for C-Probe support. 3 7* 2) change(88-10-28,WAAnderson), approve(88-10-28,MCR7952), 3 8* audit(88-10-31,RWaters), install(88-11-11,MR12.2-1210): 3 9* Added new field (c_sub_c_ptr) for C-Probe_support. 3 10* END HISTORY COMMENTS */ 3 11 3 12 /* Split out of probe_tokens, 04/22/79 WOS */ 3 13 /* modified for probe variables Feb 19 80 JRD */ 3 14 /* Modified June 83 JMAthane to add "type_ptr" and "builtin" fields */ 3 15 3 16 dcl 1 reference_node aligned based, /* information about a reference */ 3 17 2 symbol_ptr pointer aligned, /* to symbol table entry for reference */ 3 18 2 type_ptr pointer aligned, /* to symbol table entry for type (null if none) */ 3 19 2 address_ptr pointer aligned, /* to location of variable */ 3 20 2 base_addr pointer aligned, /* pointer on which whole symbol is based */ 3 21 2 source_info_ptr pointer aligned, /* to symbol structure for reference */ 3 22 3 23 2 name char (256) unaligned varying, /* symbol name */ 3 24 3 25 2 type fixed bin (35), /* data type */ 3 26 2 descriptor fixed bin (35), /* type || packed */ 3 27 2 precision fixed bin (35), /* scale and precision */ 3 28 2 flags, 3 29 3 packed bit (1) unal, /* data is in packed format */ 3 30 3 constant bit (1) unal, /* data is really a constant */ 3 31 3 cross_section bit (1) unal, /* reference is an array cross-section */ 3 32 3 function bit (1) unal, /* reference is function value */ 3 33 3 octal bit (1) unal, /* indicates that this is the octal bif */ 3 34 3 star_extent bit (1) unal, /* reference is a star subscript for father */ 3 35 3 have_generation bit (1) unal, /* this reference has an explicitly specified generation */ 3 36 3 pseudo_var bit (1) unal, /* it is ok to assign to it */ 3 37 3 probe_variable bit (1) unal, 3 38 3 path bit (1) unal, /* it's a pathname/virtual entry */ 3 39 3 builtin bit (1) unal, /* probe builtinvalue */ 3 40 3 c_ptr_to_char bit (1) unal, 3 41 3 c_sub_c_ptr bit (1) unal, 3 42 3 pad2 bit (23) unal, 3 43 3 44 2 optional_info, /* information which may or may not be present */ 3 45 3 argument_list pointer unaligned, /* pointer to reference_arg_list */ 3 46 3 subscript_ptr pointer unaligned, /* pointer to reference_subscripts */ 3 47 3 n_arguments fixed bin, /* number of arguments in argument list */ 3 48 3 n_subscripts fixed bin, /* number of subscripts present */ 3 49 3 50 2 constant_token_ptr pointer unaligned, /* pointer to constant token if this is a constant */ 3 51 2 subscript_refs_ptr pointer unaligned, /* pointer to array of subscript reference node pointers */ 3 52 2 invocation_level fixed bin, /* invocation level number ("[-17]") for this reference */ 3 53 2 probe_var_info_ptr ptr unal, /* only if flags.probe_variable */ 3 54 2 c_symbol_ptr ptr unal, 3 55 2 pad1 (9) pointer unaligned, 3 56 2 end_of_reference_node pointer aligned; 3 57 3 58 3 59 dcl 1 reference_arg_list aligned based, /* argument list; based on reference.argument_list */ 3 60 2 number fixed bin, /* number of arguments actually present */ 3 61 2 node (16) pointer aligned; /* reference node pointers for each argument */ 3 62 3 63 3 64 dcl 1 reference_subscripts aligned based, /* subscript array; based on reference.subscript_ptr */ 3 65 2 number fixed bin, /* number actually present */ 3 66 2 value (2, 16) fixed bin (24); /* values for lower and upper bound for each */ 3 67 3 68 3 69 dcl 1 subscript_reference_ptrs aligned based, /* array of pointers to subscript reference nodes */ 3 70 2 ptr (2, 16) pointer aligned; 3 71 3 72 /* END INCLUDE FILE probe_references.incl.pl1 */ 831 4 1 /* BEGIN INCLUDE FILE ... probe_source_info.incl.pl1 4 2* 4 3* James R. Davis 2 July 79 */ 4 4 4 5 dcl 1 source_info based aligned, 4 6 2 stmnt_map_entry_index fixed bin, /* index in stmnt map for this stmnt */ 4 7 2 instruction_ptr ptr, /* to last instruction executed */ 4 8 2 block_ptr ptr, /* to runtime_block node */ 4 9 2 stack_ptr ptr, /* to a stack frame */ 4 10 2 entry_ptr ptr, /* to entry seq. for this proc */ 4 11 2 seg_info_ptr ptr; /* to seg_info */ 4 12 4 13 dcl 1 current_source aligned like source_info based (probe_info.ptr_to_current_source); 4 14 dcl 1 initial_source aligned like source_info based (probe_info.ptr_to_initial_source); 4 15 4 16 /* END INCLUDE FILE ... probe_source_info.incl.pl1 */ 832 5 1 /* BEGIN INCLUDE FILE ... probe_seg_info.incl.pl1 5 2* 5 3* 25 June 79 JRDavis 5 4* 5 5* Modified 7 April 1983, TO - Add fields for character offset/line 5 6* correction per file. 5 7**/ 5 8 5 9 dcl 1 seg_info based aligned, /* place to remember information about object seg */ 5 10 2 language_type fixed bin, /* language of source program */ 5 11 2 bits aligned, 5 12 3 ignore_case bit (1) unal, 5 13 3 bound_segment bit (1) unaligned, 5 14 3 component bit (1) unaligned, 5 15 3 pad bit (33) unal, 5 16 2 names, /* where to find it */ 5 17 3 directory_name character (168) unal, /* what directory */ 5 18 3 entry_name character (32) unal, /* what segment */ 5 19 3 segname character (32) unal, /* procedure segname definition */ 5 20 2 identifier fixed bin (71), /* time of object creation */ 5 21 2 pointers, /* location of various parts of segment */ 5 22 3 symbol_header_ptr ptr unal, /* to symbol section */ 5 23 3 original_source_ptr ptr unal, /* to segment source map */ 5 24 3 statement_map_ptr ptr unal, /* to segment statement map */ 5 25 3 break_info ptr unal, /* for unbound segments, and start of chain for 5 26* bound ones, -> break_map !obsolete, I think! */ 5 27 3 chain ptr unal, /* to entry for next component if bound */ 5 28 3 linkage_ptr ptr unal, /* to linkage section */ 5 29 2 bounds aligned, /* structure of bounds information */ 5 30 3 text_bounds, 5 31 4 start fixed bin (35), 5 32 4 end fixed bin (35), 5 33 3 symbol_bounds, 5 34 4 start fixed bin (35), 5 35 4 end fixed bin (35), 5 36 2 map_size fixed bin, /* size of statement map */ 5 37 2 error_code fixed bin (35), /* errors encoutered while getting info, are recorded here */ 5 38 2 bound_create_time fixed bin (71), /* time seg containing was bound or compiled. */ 5 39 2 bound_sym_header ptr unal, /* to sym. section header for bound seg */ 5 40 2 pad (1) fixed bin (35), 5 41 5 42 2 nfiles fixed bin, 5 43 2 per_file (seg_info_nfiles refer (seg_info.nfiles)), 5 44 3 file_pointers ptr unal, 5 45 3 break_line (0:3) fixed bin (18) unsigned unaligned; 5 46 5 47 dcl seg_info_nfiles fixed bin; /* for allocation purposes */ 5 48 5 49 5 50 /* END INCLUDE FILE ... probe_seg_info.incl.pl1 */ 833 6 1 /* BEGIN INCLUDE FILE ... probe_lang_types.incl.pl1 6 2* 6 3* JRD 26 June 79 6 4* MBW 31 July 1981 to add algol68 */ 6 5 6 6 6 7 /****^ HISTORY COMMENTS: 6 8* 1) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 6 9* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 6 10* Added C Language type. 6 11* END HISTORY COMMENTS */ 6 12 6 13 6 14 /* Modified June 83 JMAthane to add PASCAL language type */ 6 15 /* Modified April 88 Hinatsu to add C language type */ 6 16 6 17 dcl (UNKNOWN_lang_type init (1), 6 18 OTHER_lang_type init (2), 6 19 PL1_lang_type init (3), 6 20 FORTRAN_lang_type init (4), 6 21 COBOL_lang_type init (5), 6 22 ALM_lang_type init (6), 6 23 ALGOL68_lang_type init (7), 6 24 PASCAL_lang_type init (8), 6 25 C_lang_type init (9)) fixed bin internal static options (constant); 6 26 6 27 dcl official_language_names (9) char (32) internal static options (constant) init 6 28 ("Unknown", "other", "PL/I", "FORTRAN", "COBOL", "ALM", "Algol 68", "Pascal", "C"); 6 29 6 30 dcl palatable_language_names (9) char (32) internal static options (constant) init 6 31 ("Unknown", "Other", "pl1", "fortran", "cobol", "alm", "algol68", "pascal", "c"); 6 32 6 33 /* END INCLUDE FILE ... probe_lang_types.incl.pl1 */ 834 835 7 1 /* BEGIN INCLUDE FILE ... encoded_precision.incl.pl1 7 2* 7 3* This is the format used by assign_ to encode the precision and scale of 7 4* arithmetic data into one word. This structure should be assigned (use unspec) 7 5* to a fixed bin (35). 7 6**/ 7 7 7 8 dcl 1 encoded_precision based aligned, 7 9 2 scale fixed bin (17) unal, 7 10 2 prec fixed bin (18) unsigned unal; 7 11 7 12 /* END INCLUDE FILE ... encoded_precision.incl.pl1 */ 836 8 1 /* BEGIN INCLUDE FILE ... data_type_info_.incl.pl1 8 2* 8 3* attributes of each Multics data type. You may not rely on the dimension never exceeding 64 8 4* James R. Davis 6 Apr 79 8 5* Modified JMAthane June 83 to add "type" bit field 8 6* Upped bound from 64 to 80 10/18/83 S. Herbst 8 7* Added "hex" and "generic" bits 01/23/84 S. Herbst 8 8* Upped bound from 80 to 86 01/81/84 R. Gray 8 9* Upper bound from 86 to 87 JMAthane (for Pascal strings type dtype) 8 10**/ 8 11 8 12 8 13 /****^ HISTORY COMMENTS: 8 14* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 8 15* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1208): 8 16* The data_type_info array now has 87 entries instead of 86 due to 8 17* introduction of pascal_string_type_dtype. 8 18* END HISTORY COMMENTS */ 8 19 8 20 dcl data_type_info_$version_number fixed bin external static; 8 21 dcl data_type_info_this_version fixed bin internal static options (constant) init (1); 8 22 8 23 dcl 1 data_type_info_$info (87) aligned external static, 8 24 2 computational bit (1) unal, 8 25 2 arithmetic bit (1) unal, 8 26 2 arithmetic_attributes unal, /* only valid if arithmetic */ 8 27 3 fixed bit (1) unal, /* PL/I type */ 8 28 3 complex bit (1) unal, /* PL/I mode */ 8 29 3 decimal bit (1) unal, /* PL/I base */ 8 30 3 signed bit (1) unal, 8 31 3 trailing_sign bit (1) unal, /* only valid if signed */ 8 32 3 decimal_attributes unal, /* only valid if decimal */ 8 33 4 packed_dec bit (1) unal, /* 4 bits per digit or 9 */ 8 34 4 digit_aligned bit (1) unal, /* valid for packed_dec only */ 8 35 4 overpunched bit (1) unal, 8 36 2 char_string bit (1) unal, /* valid for non-arithmetic */ 8 37 2 bit_string bit (1) unal, /* valid for non-arithmetic */ 8 38 2 varying bit (1) unal, /* for bit or char only */ 8 39 2 type bit (1) unal, /* this symbol is a type */ 8 40 2 hex bit (1) unal, /* a hexadecimal type (eg., hex floating point) */ 8 41 2 generic bit (1) unal, /* eg., real_flt_dec_generic_dtype */ 8 42 2 pad bit (20) unal; 8 43 8 44 dcl data_type_info_$ninebit_sign_chars char (2) external static; 8 45 dcl data_type_info_$ninebit_digit_chars char (10) external static; 8 46 dcl data_type_info_$ninebit_overpunched_sign_chars char (22) external static; 8 47 8 48 dcl data_type_info_$max_decimal_precision fixed bin external static; 8 49 dcl data_type_info_$max_float_binary_precision fixed bin external static; 8 50 dcl data_type_info_$max_fixed_binary_precision fixed bin external static; 8 51 8 52 8 53 /* END INCLUDE FILE ... data_type_info_.incl.pl1 */ 837 9 1 /* BEGIN INCLUDE FILE ... computational_data.incl.pl1 9 2* 9 3* 12 July 79 JRDavis */ 9 4 9 5 /* this is the format of the structure given to assign_$computational_ 9 6* that describes the data to be assigned */ 9 7 9 8 dcl 1 computational_data aligned based, 9 9 2 address ptr aligned, /* to data */ 9 10 2 data_type fixed bin (17), /* standard descriptor type */ 9 11 2 flags aligned, 9 12 3 packed bit (1) unal, 9 13 3 pad bit (35) unal, 9 14 2 prec_or_length fixed bin (24), /* string length or arith prec */ 9 15 2 scale fixed bin (35), /* must be zero even if has no scale */ 9 16 2 picture_image_ptr ptr aligned; /* to picture image block */ 9 17 9 18 /* END INCLUDE FILE ... computational_data.incl.pl1 */ 838 10 1 /* BEGIN INCLUDE FILE ... runtime_symbol.incl.pl1 ... Modified 07/79 */ 10 2 10 3 dcl 1 runtime_symbol aligned based, 10 4 2 flag unal bit(1), /* always "1"b for Version II */ 10 5 2 use_digit unal bit(1), /* if "1"b and units are half words units are really digits */ 10 6 2 array_units unal bit(2), 10 7 2 units unal bit(2), /* addressing units */ 10 8 2 type unal bit(6), /* data type */ 10 9 2 level unal bit(6), /* structure level */ 10 10 2 ndims unal bit(6), /* number of dimensions */ 10 11 2 bits unal, 10 12 3 aligned bit(1), 10 13 3 packed bit(1), 10 14 3 simple bit(1), 10 15 2 skip unal bit(1), 10 16 2 scale unal bit(8), /* arithmetic scale factor */ 10 17 2 name unal bit(18), /* rel ptr to acc name */ 10 18 2 brother unal bit(18), /* rel ptr to brother entry */ 10 19 2 father unal bit(18), /* rel ptr to father entry */ 10 20 2 son unal bit(18), /* rel ptr to son entry */ 10 21 2 address unal, 10 22 3 location bit(18), /* location in storage class */ 10 23 3 class bit(4), /* storage class */ 10 24 3 next bit(14), /* rel ptr to next of same class */ 10 25 2 size fixed bin(35), /* encoded string|arith size */ 10 26 2 offset fixed bin(35), /* encoded offset from address */ 10 27 2 virtual_org fixed bin(35), 10 28 2 bounds(1), 10 29 3 lower fixed bin(35), /* encoded lower bound */ 10 30 3 upper fixed bin(35), /* encoded upper bound */ 10 31 3 multiplier fixed bin(35); /* encoded multiplier */ 10 32 10 33 dcl 1 runtime_bound based, 10 34 2 lower fixed bin(35), 10 35 2 upper fixed bin(35), 10 36 2 multiplier fixed bin(35); 10 37 10 38 dcl 1 runtime_block aligned based, 10 39 2 flag unal bit(1), /* always "1"b for Version II */ 10 40 2 quick unal bit(1), /* "1"b if quick block */ 10 41 2 fortran unal bit(1), /* "1"b if fortran program */ 10 42 2 standard unal bit(1), /* "1"b if program has std obj segment */ 10 43 2 owner_flag unal bit(1), /* "1"b if block has valid owner field */ 10 44 2 skip unal bit(1), 10 45 2 type unal bit(6), /* = 0 for a block node */ 10 46 2 number unal bit(6), /* begin block number */ 10 47 2 start unal bit(18), /* rel ptr to start of symbols */ 10 48 2 name unal bit(18), /* rel ptr to name of proc */ 10 49 2 brother unal bit(18), /* rel ptr to brother block */ 10 50 2 father unal bit(18), /* rel ptr to father block */ 10 51 2 son unal bit(18), /* rel ptr to son block */ 10 52 2 map unal, 10 53 3 first bit(18), /* rel ptr to first word of map */ 10 54 3 last bit(18), /* rel ptr to last word of map */ 10 55 2 entry_info unal bit(18), /* info about entry of quick block */ 10 56 2 header unal bit(18), /* rel ptr to symbol header */ 10 57 2 chain(4) unal bit(18), /* chain(i) is rel ptr to first symbol 10 58* on start list with length >= 2**i */ 10 59 2 token(0:5) unal bit(18), /* token(i) is rel ptr to first token 10 60* on list with length >= 2 ** i */ 10 61 2 owner unal bit(18); /* rel ptr to owner block */ 10 62 10 63 dcl 1 runtime_token aligned based, 10 64 2 next unal bit(18), /* rel ptr to next token */ 10 65 2 dcl unal bit(18), /* rel ptr to first dcl of this token */ 10 66 2 name, /* ACC */ 10 67 3 size unal unsigned fixed bin (9), /* number of chars in token */ 10 68 3 string unal char(n refer(runtime_token.size)); 10 69 10 70 dcl 1 encoded_value aligned based, 10 71 2 flag bit (2) unal, 10 72 2 code bit (4) unal, 10 73 2 n1 bit (6) unal, 10 74 2 n2 bit (6) unal, 10 75 2 n3 bit (18) unal; 10 76 10 77 /* END INCLUDE FILE ... runtime_symbol.incl.pl1 */ 839 11 1 /* BEGIN INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 11 2 11 3 11 4 /****^ HISTORY COMMENTS: 11 5* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 11 6* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1208): 11 7* Added pascal_string_type_dtype descriptor type. Its number is 87. 11 8* Objects of this type are PASCAL string types. 11 9* 2) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 11 10* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 11 11* Added the new C types. 11 12* END HISTORY COMMENTS */ 11 13 11 14 /* This include file defines mnemonic names for the Multics 11 15* standard descriptor types, using both pl1 and cobol terminology. 11 16* PG 780613 11 17* JRD 790530 11 18* JRD 791016 11 19* MBW 810731 11 20* TGO 830614 Add hex types. 11 21* Modified June 83 JMAthane to add PASCAL data types 11 22* TGO 840120 Add float dec extended and generic, float binary generic 11 23**/ 11 24 11 25 dcl (real_fix_bin_1_dtype init (1), 11 26 real_fix_bin_2_dtype init (2), 11 27 real_flt_bin_1_dtype init (3), 11 28 real_flt_bin_2_dtype init (4), 11 29 cplx_fix_bin_1_dtype init (5), 11 30 cplx_fix_bin_2_dtype init (6), 11 31 cplx_flt_bin_1_dtype init (7), 11 32 cplx_flt_bin_2_dtype init (8), 11 33 real_fix_dec_9bit_ls_dtype init (9), 11 34 real_flt_dec_9bit_dtype init (10), 11 35 cplx_fix_dec_9bit_ls_dtype init (11), 11 36 cplx_flt_dec_9bit_dtype init (12), 11 37 pointer_dtype init (13), 11 38 offset_dtype init (14), 11 39 label_dtype init (15), 11 40 entry_dtype init (16), 11 41 structure_dtype init (17), 11 42 area_dtype init (18), 11 43 bit_dtype init (19), 11 44 varying_bit_dtype init (20), 11 45 char_dtype init (21), 11 46 varying_char_dtype init (22), 11 47 file_dtype init (23), 11 48 real_fix_dec_9bit_ls_overp_dtype init (29), 11 49 real_fix_dec_9bit_ts_overp_dtype init (30), 11 50 real_fix_bin_1_uns_dtype init (33), 11 51 real_fix_bin_2_uns_dtype init (34), 11 52 real_fix_dec_9bit_uns_dtype init (35), 11 53 real_fix_dec_9bit_ts_dtype init (36), 11 54 real_fix_dec_4bit_uns_dtype init (38), /* digit-aligned */ 11 55 real_fix_dec_4bit_ts_dtype init (39), /* byte-aligned */ 11 56 real_fix_dec_4bit_bytealigned_uns_dtype init (40), /* COBOL */ 11 57 real_fix_dec_4bit_ls_dtype init (41), /* digit-aligned */ 11 58 real_flt_dec_4bit_dtype init (42), /* digit-aligned */ 11 59 real_fix_dec_4bit_bytealigned_ls_dtype init (43), 11 60 real_flt_dec_4bit_bytealigned_dtype init (44), 11 61 cplx_fix_dec_4bit_bytealigned_ls_dtype init (45), 11 62 cplx_flt_dec_4bit_bytealigned_dtype init (46), 11 63 real_flt_hex_1_dtype init (47), 11 64 real_flt_hex_2_dtype init (48), 11 65 cplx_flt_hex_1_dtype init (49), 11 66 cplx_flt_hex_2_dtype init (50), 11 67 c_typeref_dtype init (54), 11 68 c_enum_dtype init (55), 11 69 c_enum_const_dtype init (56), 11 70 c_union_dtype init (57), 11 71 algol68_straight_dtype init (59), 11 72 algol68_format_dtype init (60), 11 73 algol68_array_descriptor_dtype init (61), 11 74 algol68_union_dtype init (62), 11 75 11 76 cobol_comp_6_dtype init (1), 11 77 cobol_comp_7_dtype init (1), 11 78 cobol_display_ls_dtype init (9), 11 79 cobol_structure_dtype init (17), 11 80 cobol_char_string_dtype init (21), 11 81 cobol_display_ls_overp_dtype init (29), 11 82 cobol_display_ts_overp_dtype init (30), 11 83 cobol_display_uns_dtype init (35), 11 84 cobol_display_ts_dtype init (36), 11 85 cobol_comp_8_uns_dtype init (38), /* digit aligned */ 11 86 cobol_comp_5_ts_dtype init (39), /* byte aligned */ 11 87 cobol_comp_5_uns_dtype init (40), 11 88 cobol_comp_8_ls_dtype init (41), /* digit aligned */ 11 89 real_flt_dec_extended_dtype init (81), /* 9-bit exponent */ 11 90 cplx_flt_dec_extended_dtype init (82), /* 9-bit exponent */ 11 91 real_flt_dec_generic_dtype init (83), /* generic float decimal */ 11 92 cplx_flt_dec_generic_dtype init (84), 11 93 real_flt_bin_generic_dtype init (85), /* generic float binary */ 11 94 cplx_flt_bin_generic_dtype init (86)) fixed bin internal static options (constant); 11 95 11 96 dcl (ft_integer_dtype init (1), 11 97 ft_real_dtype init (3), 11 98 ft_double_dtype init (4), 11 99 ft_complex_dtype init (7), 11 100 ft_complex_double_dtype init (8), 11 101 ft_external_dtype init (16), 11 102 ft_logical_dtype init (19), 11 103 ft_char_dtype init (21), 11 104 ft_hex_real_dtype init (47), 11 105 ft_hex_double_dtype init (48), 11 106 ft_hex_complex_dtype init (49), 11 107 ft_hex_complex_double_dtype init (50) 11 108 ) fixed bin internal static options (constant); 11 109 11 110 dcl (algol68_short_int_dtype init (1), 11 111 algol68_int_dtype init (1), 11 112 algol68_long_int_dtype init (2), 11 113 algol68_real_dtype init (3), 11 114 algol68_long_real_dtype init (4), 11 115 algol68_compl_dtype init (7), 11 116 algol68_long_compl_dtype init (8), 11 117 algol68_bits_dtype init (19), 11 118 algol68_bool_dtype init (19), 11 119 algol68_char_dtype init (21), 11 120 algol68_byte_dtype init (21), 11 121 algol68_struct_struct_char_dtype init (22), 11 122 algol68_struct_struct_bool_dtype init (20) 11 123 ) fixed bin internal static options (constant); 11 124 11 125 dcl (label_constant_runtime_dtype init (24), 11 126 int_entry_runtime_dtype init (25), 11 127 ext_entry_runtime_dtype init (26), 11 128 ext_procedure_runtime_dtype init (27), 11 129 picture_runtime_dtype init (63) 11 130 ) fixed bin internal static options (constant); 11 131 11 132 dcl (pascal_integer_dtype init (1), 11 133 pascal_real_dtype init (4), 11 134 pascal_label_dtype init (24), 11 135 pascal_internal_procedure_dtype init (25), 11 136 pascal_exportable_procedure_dtype init (26), 11 137 pascal_imported_procedure_dtype init (27), 11 138 pascal_typed_pointer_type_dtype init (64), 11 139 pascal_char_dtype init (65), 11 140 pascal_boolean_dtype init (66), 11 141 pascal_record_file_type_dtype init (67), 11 142 pascal_record_type_dtype init (68), 11 143 pascal_set_dtype init (69), 11 144 pascal_enumerated_type_dtype init (70), 11 145 pascal_enumerated_type_element_dtype init (71), 11 146 pascal_enumerated_type_instance_dtype init (72), 11 147 pascal_user_defined_type_dtype init (73), 11 148 pascal_user_defined_type_instance_dtype init (74), 11 149 pascal_text_file_dtype init (75), 11 150 pascal_procedure_type_dtype init (76), 11 151 pascal_variable_formal_parameter_dtype init (77), 11 152 pascal_value_formal_parameter_dtype init (78), 11 153 pascal_entry_formal_parameter_dtype init (79), 11 154 pascal_parameter_procedure_dtype init (80), 11 155 pascal_string_type_dtype init (87)) fixed bin int static options (constant); 11 156 11 157 11 158 /* END INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 840 12 1 /* BEGIN INCLUDE FILE runtime_symbol_info_.incl.pl1 */ 12 2 12 3 12 4 /****^ HISTORY COMMENTS: 12 5* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 12 6* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1208): 12 7* Added runtime_symbol_info_$subrange entry which was missing. Added 12 8* has_dimensions and has subrange_limits fields in type_info record. 12 9* Structure version numbers have not been changed since this change does not 12 10* affect existing programs. 12 11* END HISTORY COMMENTS */ 12 12 12 13 /* Declarations for using the various entry points in runtime_symbol_info_ */ 12 14 /* NOTE: These entries do not support PL/1 version 1. */ 12 15 12 16 /* Made structures aligned, removed variable extent from runtime_array_info.bounds 08/25/83 S. Herbst */ 12 17 /* Added version strings to structures 10/05/83 S. Herbst */ 12 18 /* Added has_dimensions and has_subrange_limits bits in type_info 12 19*Added subrange entry. JMAthane 08/31/84 */ 12 20 12 21 12 22 dcl runtime_symbol_info_$type entry (ptr, ptr, fixed bin (35)); 12 23 12 24 dcl 1 runtime_type_info aligned based, 12 25 2 version char (8), /* = "RUNTYP_1" */ 12 26 2 flags, 12 27 3 aligned bit (1) unal, 12 28 3 packed bit (1) unal, 12 29 3 size_is_encoded bit (1) unal, 12 30 3 has_dimensions bit (1) unal, 12 31 3 has_subrange_limits bit (1) unal, 12 32 3 pad bit (23) unal, 12 33 2 scale fixed bin (7) unal, 12 34 2 (type, base_type) fixed bin (18) unsigned unal, 12 35 2 (type_addr, base_type_addr) ptr, 12 36 2 size fixed bin (35); 12 37 12 38 dcl runtime_symbol_info_$father entry (ptr) returns (ptr); 12 39 12 40 dcl runtime_symbol_info_$brother entry (ptr) returns (ptr); 12 41 12 42 dcl runtime_symbol_info_$father_type entry (ptr) returns (ptr); 12 43 12 44 dcl runtime_symbol_info_$son entry (ptr) returns (ptr); 12 45 12 46 dcl runtime_symbol_info_$successor entry (ptr) returns (ptr); 12 47 12 48 dcl runtime_symbol_info_$name entry (ptr) returns (ptr); 12 49 12 50 dcl runtime_symbol_info_$level entry (ptr) returns (fixed bin); 12 51 12 52 dcl runtime_symbol_info_$next entry (ptr) returns (ptr); 12 53 12 54 dcl runtime_symbol_info_$address entry (ptr, ptr, fixed bin (35)); 12 55 12 56 dcl 1 runtime_address_info aligned based, 12 57 2 version char (8), /* = "RUNADR_1" */ 12 58 2 location fixed bin (18) unsigned unal, 12 59 2 class fixed bin (6) unsigned unal, 12 60 2 use_digit fixed bin (1) unsigned unal, 12 61 2 units fixed bin (2) unsigned unal, 12 62 2 offset_is_encoded bit (1) unal, 12 63 2 pad bit (8) unal, 12 64 2 offset fixed bin (35); 12 65 12 66 dcl runtime_symbol_info_$array_dims entry (ptr) returns (fixed bin); 12 67 12 68 dcl runtime_symbol_info_$array entry (ptr, ptr, fixed bin (35)); 12 69 12 70 dcl 1 runtime_array_info aligned based, 12 71 2 version char (8), /* = "RUNARY_1" */ 12 72 2 access_info aligned, 12 73 3 ndims fixed bin (6) unsigned unaligned, /* number of dimensions */ 12 74 3 use_digit fixed bin (1) unsigned unaligned, /* if "1"b and units are half words, 12 75* units are really digits */ 12 76 3 array_units fixed bin (2) unsigned unaligned, 12 77 3 virtual_origin_is_encoded 12 78 bit (1) unaligned, 12 79 3 pad bit (26) unaligned, 12 80 2 virtual_origin fixed bin (35), 12 81 2 bounds (16) 12 82 aligned, 12 83 3 flags aligned, 12 84 4 lower_is_encoded 12 85 bit (1) unaligned, 12 86 4 upper_is_encoded 12 87 bit (1) unaligned, 12 88 4 multiplier_is_encoded 12 89 bit (1) unaligned, 12 90 4 pad bit (33) unaligned, 12 91 3 lower fixed bin (35), 12 92 3 upper fixed bin (35), 12 93 3 multiplier fixed bin (35), 12 94 3 subscript_type fixed bin (35), 12 95 3 subscript_type_addr ptr; 12 96 12 97 dcl n_dims fixed bin; 12 98 12 99 dcl runtime_symbol_info_$n_variants entry (ptr) returns (fixed bin (35)); 12 100 12 101 dcl runtime_symbol_info_$variant entry (ptr, ptr, fixed bin (35)); 12 102 12 103 dcl 1 runtime_variant_info aligned based, 12 104 2 version char (8), /* = "RUNVAR_1" */ 12 105 2 number_of_variants fixed bin, 12 106 2 first_value_in_set fixed bin (35), /* value corresponding to the first bit in set stings */ 12 107 2 case (n_variants), 12 108 3 set_addr ptr, /* bit string specifies cases; 12 109* set's base type is this node's type */ 12 110 3 brother_addr ptr; /* ptr to brother for this variant */ 12 111 12 112 dcl n_variants fixed bin (35); 12 113 12 114 dcl runtime_symbol_info_$subrange entry (ptr, ptr, fixed bin (35)); 12 115 12 116 dcl 1 runtime_subrange_info based, 12 117 2 version char (8), /* = "RUNSUB_1" */ 12 118 2 flags aligned, 12 119 3 has_subrange_limits bit (1) unal, 12 120 3 lower_bound_is_encoded bit (1) unal, 12 121 3 upper_bound_is_encoded bit (1) unal, 12 122 3 pad bit (33) unal, 12 123 2 subrange_lower_bound fixed bin (35), 12 124 2 subrange_upper_bound fixed bin (35); 12 125 12 126 12 127 dcl RUNTIME_TYPE_INFO_VERSION_1 char (8) int static options (constant) init ("RUNTYP_1"); 12 128 dcl RUNTIME_ADDRESS_INFO_VERSION_1 char (8) int static options (constant) init ("RUNADR_1"); 12 129 dcl RUNTIME_ARRAY_INFO_VERSION_1 char (8) int static options (constant) init ("RUNARY_1"); 12 130 dcl RUNTIME_VARIANT_INFO_VERSION_1 char (8) int static options (constant) init ("RUNVAR_1"); 12 131 dcl RUNTIME_SUBRANGE_INFO_VERSION_1 char (8) int static options (constant) init ("RUNSUB_1"); 12 132 12 133 12 134 /* END INCLUDE FILE runtime_symbol_info_.incl.pl1 */ 841 842 843 end probe_assign_value_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/88 1545.0 probe_assign_value_.pl1 >spec>install>MR12.2-1210>probe_assign_value_.pl1 829 1 10/27/88 1339.2 probe_info.incl.pl1 >ldd>include>probe_info.incl.pl1 830 2 11/26/79 1320.6 probe_tokens.incl.pl1 >ldd>include>probe_tokens.incl.pl1 831 3 11/11/88 1543.8 probe_references.incl.pl1 >spec>install>MR12.2-1210>probe_references.incl.pl1 832 4 11/26/79 1320.6 probe_source_info.incl.pl1 >ldd>include>probe_source_info.incl.pl1 833 5 11/02/83 1845.0 probe_seg_info.incl.pl1 >ldd>include>probe_seg_info.incl.pl1 834 6 10/26/88 1255.5 probe_lang_types.incl.pl1 >ldd>include>probe_lang_types.incl.pl1 836 7 07/11/79 1711.3 encoded_precision.incl.pl1 >ldd>include>encoded_precision.incl.pl1 837 8 11/12/86 1748.0 data_type_info_.incl.pl1 >ldd>include>data_type_info_.incl.pl1 838 9 11/01/79 1612.9 computational_data.incl.pl1 >ldd>include>computational_data.incl.pl1 839 10 11/26/79 1320.6 runtime_symbol.incl.pl1 >ldd>include>runtime_symbol.incl.pl1 840 11 10/26/88 1255.5 std_descriptor_types.incl.pl1 >ldd>include>std_descriptor_types.incl.pl1 841 12 11/12/86 1748.0 runtime_symbol_info_.incl.pl1 >ldd>include>runtime_symbol_info_.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. BASED_CLASS constant bit(4) initial packed unaligned dcl 64 ref 180 193 C_lang_type constant fixed bin(17,0) initial dcl 6-17 ref 127 FORTRAN_lang_type constant fixed bin(17,0) initial dcl 6-17 ref 185 198 PASCAL_lang_type constant fixed bin(17,0) initial dcl 6-17 ref 316 P_code parameter fixed bin(35,0) dcl 56 set ref 34 248* 257* P_probe_info_ptr parameter pointer dcl 56 ref 34 123 P_ptr1 parameter pointer dcl 752 set ref 749 756 761 766* 782 784 786 788 790 P_ptr2 parameter pointer dcl 752 set ref 749 757 761 767* 782 784 786 788 790 P_ref parameter structure level 1 dcl 734 set ref 731 741 741 P_source parameter structure level 1 dcl 62 set ref 34 371* 374* 386* 706* P_target parameter structure level 1 dcl 61 set ref 34 370* 373* 385* 705* RUNTIME_TYPE_INFO_VERSION_1 000000 constant char(8) initial packed unaligned dcl 12-127 ref 339 346 656 addr builtin function dcl 118 ref 144 205 205 222 222 340 340 347 347 376 376 376 376 388 388 388 388 431 431 481 658 658 708 708 708 708 741 741 address 3 based structure level 2 in structure "runtime_symbol" packed packed unaligned dcl 10-3 in procedure "probe_assign_value_" address parameter pointer level 2 in structure "comp" dcl 803 in procedure "setup_str" set ref 807* address parameter pointer level 2 in structure "comp" dcl 716 in procedure "set_up" set ref 718* address_ptr 4 parameter pointer level 2 in structure "P_target" dcl 61 in procedure "probe_assign_value_" set ref 140 144 166 179 205* 215 317 416 419 431 438 441 451 461 469 481 493* 500 575 579 591 597 600 605 620 623 631 637 640 645 674 681 address_ptr 4 parameter pointer level 2 in structure "ref" dcl 715 in procedure "set_up" ref 718 address_ptr 4 parameter pointer level 2 in structure "P_source" dcl 62 in procedure "probe_assign_value_" set ref 140 192 222* 394 400 405* 411 428 430 441 451 459 469 474 493* 500 575 579 591 597 600 605 620 623 631 637 640 645 674 681 address_ptr 4 parameter pointer level 2 in structure "ref" dcl 801 in procedure "setup_str" ref 807 aligned 0(24) based bit(1) level 3 packed packed unaligned dcl 10-3 ref 782 782 an_encoded_value 000362 automatic structure level 1 packed packed unaligned dcl 805 set ref 813* area_assign_ 000042 constant entry external dcl 107 ref 493 area_dtype constant fixed bin(17,0) initial dcl 11-25 ref 488 490 argument_list 117 000100 automatic pointer level 3 packed packed unaligned dcl 272 set ref 308* arithmetic 0(01) 000052 external static bit(1) array level 2 packed packed unaligned dcl 8-23 ref 811 assign_$computational_ 000040 constant entry external dcl 105 ref 376 388 708 base_type 3(18) 000272 automatic fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 304 set ref 664 based_entry based entry variable dcl 280 set ref 469* 469 481* 481 based_file based file variable dcl 281 set ref 500* 500 based_label based label variable dcl 279 set ref 451* 451 461* based_offset based offset dcl 278 set ref 411 431* 438 441* 441 based_packed_ptr based pointer packed unaligned dcl 277 set ref 394 416* 428 591* 597* 597 605 631* 637* 637 645 based_ptr based pointer dcl 275 set ref 400 419* 430 591 600* 600 605* 631 640* 640 645* based_str based char(256) packed unaligned dcl 136 set ref 140* 140 144* baseno builtin function dcl 118 ref 317 317 binary builtin function dcl 118 ref 756 757 bit_dtype constant fixed bin(17,0) initial dcl 11-25 ref 373 374 737 bits 0(24) based structure level 2 packed packed unaligned dcl 10-3 block_ptr 4 based pointer level 2 dcl 4-5 set ref 205* 205* 222* 222* 405* 405* 431* 431* c_ptr_to_char 116(11) parameter bit(1) level 3 packed packed unaligned dcl 61 set ref 133 char_dtype constant fixed bin(17,0) initial dcl 11-25 ref 127 130 514 651 class 3(18) based bit(4) level 3 packed packed unaligned dcl 10-3 ref 180 193 code 000167 automatic fixed bin(35,0) dcl 78 set ref 130* 156* 162* 252* 257 312* 322* 340* 342 347* 349 376* 377 388* 389 658* 660 708* 709 comp parameter structure level 1 dcl 803 in procedure "setup_str" set ref 798 comp parameter structure level 1 dcl 716 in procedure "set_up" set ref 712 computational 000052 external static bit(1) array level 2 packed packed unaligned dcl 8-23 ref 381 382 computational_data based structure level 1 dcl 9-8 constant 116(01) parameter bit(1) level 3 in structure "P_source" packed packed unaligned dcl 62 in procedure "probe_assign_value_" set ref 130 constant based structure level 1 dcl 2-27 in procedure "probe_assign_value_" constant 116(01) parameter bit(1) level 3 in structure "P_target" packed packed unaligned dcl 61 in procedure "probe_assign_value_" set ref 125 constant_token_ptr 123 parameter pointer level 2 packed packed unaligned dcl 61 set ref 133 conversion 000000 stack reference condition dcl 121 ref 309 copy builtin function dcl 118 ref 681 cross_section 116(02) parameter bit(1) level 3 in structure "P_target" packed packed unaligned dcl 61 in procedure "probe_assign_value_" set ref 160 cross_section 116(02) parameter bit(1) level 3 in structure "P_source" packed packed unaligned dcl 62 in procedure "probe_assign_value_" set ref 161 238 data_type 2 parameter fixed bin(17,0) level 2 in structure "comp" dcl 803 in procedure "setup_str" set ref 808* data_type 2 parameter fixed bin(17,0) level 2 in structure "comp" dcl 716 in procedure "set_up" set ref 720* 723* data_type_info_$info 000052 external static structure array level 1 dcl 8-23 descriptor 114 parameter fixed bin(35,0) level 2 dcl 734 set ref 739* divide builtin function dcl 118 ref 679 680 done 000166 automatic bit(1) initial dcl 77 set ref 77* 203 233* 238* encoded_precision based structure level 1 dcl 7-8 entry_dtype constant fixed bin(17,0) initial dcl 11-25 ref 467 469 entry_ptr 10 based pointer level 2 dcl 4-5 ref 317 entry_var 000250 automatic structure level 1 dcl 287 set ref 481 file_dtype constant fixed bin(17,0) initial dcl 11-25 ref 496 497 flags 116 parameter structure level 2 in structure "ref" dcl 801 in procedure "setup_str" flags 3 parameter structure level 2 in structure "comp" dcl 716 in procedure "set_up" set ref 725* flags 3 parameter structure level 2 in structure "comp" dcl 803 in procedure "setup_str" set ref 809* flags 116 parameter structure level 2 in structure "P_target" dcl 61 in procedure "probe_assign_value_" flags 116 parameter structure level 2 in structure "P_source" dcl 62 in procedure "probe_assign_value_" flags 2 000272 automatic structure level 2 in structure "target_type_type_info" packed packed unaligned dcl 304 in procedure "assign_reference" flags 116 parameter structure level 2 in structure "P_ref" dcl 734 in procedure "make_unspec" frame 2 000244 automatic pointer level 2 in structure "label_var" dcl 283 in procedure "assign_reference" set ref 460* frame 2 000250 automatic pointer level 2 in structure "entry_var" dcl 287 in procedure "assign_reference" set ref 475* 479* gen 000254 automatic pointer dcl 289 set ref 403* 405 405 405 405 427* 431 431 431 431 get_size_in_bits_ 000030 constant entry external dcl 95 ref 569 572 614 617 668 671 get_size_in_bits_$structure 000032 constant entry external dcl 97 ref 741 has_dimensions 2(03) 000272 automatic bit(1) level 3 packed packed unaligned dcl 304 set ref 564 652 int_entry_runtime_dtype constant fixed bin(17,0) initial dcl 11-125 ref 472 475 label_constant_runtime_dtype constant fixed bin(17,0) initial dcl 11-125 ref 454 label_dtype constant fixed bin(17,0) initial dcl 11-25 ref 449 451 label_var 000244 automatic structure level 1 dcl 283 set ref 461 language_type 21 based fixed bin(17,0) level 3 in structure "probe_info" dcl 1-18 in procedure "probe_assign_value_" ref 127 316 language_type based fixed bin(17,0) level 2 in structure "seg_info" dcl 5-9 in procedure "probe_assign_value_" ref 185 198 linkage_ptr 103 based pointer level 3 packed packed unaligned dcl 5-9 ref 205 222 405 431 n_dims 000172 automatic fixed bin(17,0) dcl 12-97 set ref 663* 664 name 12 parameter varying char(256) level 2 in structure "P_ref" dcl 734 in procedure "make_unspec" set ref 743* name 12 parameter varying char(256) level 2 in structure "P_target" dcl 61 in procedure "probe_assign_value_" set ref 168* 216* 262* 694* name 12 parameter varying char(256) level 2 in structure "P_source" dcl 62 in procedure "probe_assign_value_" set ref 262* 611 ndims 0(18) based bit(6) level 2 packed packed unaligned dcl 10-3 ref 761 761 null builtin function dcl 118 ref 133 166 180 180 193 193 215 222 308 317 338 345 411 438 479 738 767 776 824 nullo builtin function dcl 118 ref 411 438 number based fixed bin(17,0) level 2 dcl 80 set ref 233* 238* offset_dtype constant fixed bin(17,0) initial dcl 11-25 ref 401 423 441 optional_info 117 000100 automatic structure level 2 in structure "temp" dcl 272 in procedure "assign_reference" optional_info 117 parameter structure level 2 in structure "P_target" dcl 61 in procedure "probe_assign_value_" optional_info 117 parameter structure level 2 in structure "P_source" dcl 62 in procedure "probe_assign_value_" p 000256 automatic pointer dcl 290 set ref 394* 400* 405* 411 416 419 428* 430* 431 431 438 p1 000100 automatic pointer dcl 753 set ref 766* 771* 774* 774* 776 p2 000102 automatic pointer dcl 753 set ref 767* 767* 771* 775* packed 116 parameter bit(1) level 3 in structure "ref" packed packed unaligned dcl 801 in procedure "setup_str" ref 810 packed 116 parameter bit(1) level 3 in structure "P_target" packed packed unaligned dcl 61 in procedure "probe_assign_value_" set ref 416 572* 617* 668* packed 0(25) based bit(1) level 3 in structure "runtime_symbol" packed packed unaligned dcl 10-3 in procedure "probe_assign_value_" ref 784 784 packed 2(01) 000272 automatic bit(1) level 3 in structure "target_type_type_info" packed packed unaligned dcl 304 in procedure "assign_reference" set ref 652 packed 3 parameter bit(1) level 3 in structure "comp" packed packed unaligned dcl 803 in procedure "setup_str" set ref 810* packed 116 parameter bit(1) level 3 in structure "P_ref" packed packed unaligned dcl 734 in procedure "make_unspec" set ref 740* packed 3 parameter bit(1) level 3 in structure "comp" packed packed unaligned dcl 716 in procedure "set_up" set ref 726* packed 116 parameter bit(1) level 3 in structure "P_source" packed packed unaligned dcl 62 in procedure "probe_assign_value_" set ref 394 428 569* 614* 631 640 671* pascal_boolean_dtype constant fixed bin(17,0) initial dcl 11-132 ref 524 525 pascal_char_dtype constant fixed bin(17,0) initial dcl 11-132 ref 510 511 517 664 pascal_enumerated_type_element_dtype constant fixed bin(17,0) initial dcl 11-132 ref 531 538 pascal_enumerated_type_instance_dtype constant fixed bin(17,0) initial dcl 11-132 ref 537 545 pascal_record_file_type_dtype constant fixed bin(17,0) initial dcl 11-132 ref 582 pascal_record_type_dtype constant fixed bin(17,0) initial dcl 11-132 ref 564 pascal_set_dtype constant fixed bin(17,0) initial dcl 11-132 ref 564 611 pascal_text_file_dtype constant fixed bin(17,0) initial dcl 11-132 ref 555 pascal_typed_pointer_type_dtype constant fixed bin(17,0) initial dcl 11-132 ref 394 589 629 pascal_user_defined_type_instance_dtype constant fixed bin(17,0) initial dcl 11-132 ref 394 561 562 picture_image_ptr 6 parameter pointer level 2 dcl 803 set ref 822* 824* picture_runtime_dtype constant fixed bin(17,0) initial dcl 11-125 ref 822 place 000244 automatic pointer level 2 in structure "label_var" dcl 283 in procedure "assign_reference" set ref 459* place 000250 automatic pointer level 2 in structure "entry_var" dcl 287 in procedure "assign_reference" set ref 474* pointer builtin function dcl 118 ref 822 pointer_dtype constant fixed bin(17,0) initial dcl 11-25 ref 393 394 425 628 pointers 76 based structure level 2 dcl 5-9 prec 0(18) 000362 automatic fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 805 set ref 815 prec_or_length 4 parameter fixed bin(24,0) level 2 in structure "comp" dcl 803 in procedure "setup_str" set ref 815* 819* prec_or_length 4 parameter fixed bin(24,0) level 2 in structure "comp" dcl 716 in procedure "set_up" set ref 719* precision 115 parameter fixed bin(35,0) level 2 in structure "P_ref" dcl 734 in procedure "make_unspec" set ref 741* 742 precision 115 parameter fixed bin(35,0) level 2 in structure "ref" dcl 801 in procedure "setup_str" ref 813 819 822 precision 115 parameter fixed bin(35,0) level 2 in structure "P_target" dcl 61 in procedure "probe_assign_value_" set ref 127 572* 591 617* 631 668* precision 115 parameter fixed bin(35,0) level 2 in structure "ref" dcl 715 in procedure "set_up" ref 719 720 precision 115 parameter fixed bin(35,0) level 2 in structure "P_source" dcl 62 in procedure "probe_assign_value_" set ref 140 140 144 514 518* 569* 591 600 614* 652 671* probe_error_$record 000026 constant entry external dcl 94 ref 151 168 216 262 355 361 365 505 532 556 584 694 743 probe_et_$bad_assign 000010 external static fixed bin(35,0) dcl 84 set ref 262* probe_et_$bad_section 000012 external static fixed bin(35,0) dcl 84 ref 162 probe_et_$c_string_assign 000022 external static fixed bin(35,0) dcl 84 ref 130 probe_et_$constant_target 000014 external static fixed bin(35,0) dcl 84 ref 156 322 probe_et_$no_address 000016 external static fixed bin(35,0) dcl 84 set ref 168* 216* probe_et_$recorded_message 000020 external static fixed bin(35,0) dcl 84 ref 252 probe_et_$size 000024 external static fixed bin(35,0) dcl 84 ref 312 probe_increment_indices_ 000034 constant entry external dcl 99 ref 233 238 probe_info based structure level 1 dcl 1-18 probe_info_ptr 000170 automatic pointer dcl 1-86 set ref 123* 127 151* 168* 216* 262* 316 355* 361* 365* 505* 532* 556* 584* 694* 743* probe_pascal_$real_type 000036 constant entry external dcl 103 ref 325 327 pseudo_var 116(07) parameter bit(1) level 3 in structure "P_target" packed packed unaligned dcl 61 in procedure "probe_assign_value_" set ref 125 pseudo_var 116(07) parameter bit(1) level 3 in structure "P_ref" packed packed unaligned dcl 734 in procedure "make_unspec" set ref 736* random_info 17 based structure level 2 dcl 1-18 real_fix_bin_1_uns_dtype constant fixed bin(17,0) initial dcl 11-25 ref 723 real_fix_bin_2_uns_dtype constant fixed bin(17,0) initial dcl 11-25 ref 720 ref parameter structure level 1 dcl 801 in procedure "setup_str" ref 798 ref parameter structure level 1 dcl 715 in procedure "set_up" ref 712 reference_node based structure level 1 dcl 3-16 reference_subscripts based structure level 1 dcl 3-64 runtime_symbol based structure level 1 dcl 10-3 runtime_symbol_info_$array_dims 000064 constant entry external dcl 12-66 ref 663 runtime_symbol_info_$brother 000056 constant entry external dcl 12-40 ref 774 775 runtime_symbol_info_$father_type 000060 constant entry external dcl 12-42 ref 539 runtime_symbol_info_$son 000062 constant entry external dcl 12-44 ref 766 767 runtime_symbol_info_$type 000054 constant entry external dcl 12-22 ref 340 347 658 runtime_type_info based structure level 1 dcl 12-24 scale 5 parameter fixed bin(35,0) level 2 in structure "comp" dcl 803 in procedure "setup_str" set ref 816* 820* scale 000362 automatic fixed bin(17,0) level 2 in structure "an_encoded_value" packed packed unaligned dcl 805 in procedure "setup_str" set ref 816 scale 0(28) based bit(8) level 2 in structure "runtime_symbol" packed packed unaligned dcl 10-3 in procedure "probe_assign_value_" ref 788 788 scale 5 parameter fixed bin(35,0) level 2 in structure "comp" dcl 716 in procedure "set_up" set ref 727* seg_info based structure level 1 dcl 5-9 seg_info_ptr 12 based pointer level 2 dcl 4-5 ref 185 198 205 222 405 431 simple 0(26) based bit(1) level 3 packed packed unaligned dcl 10-3 ref 786 786 size 4 based fixed bin(35,0) level 2 in structure "runtime_symbol" dcl 10-3 in procedure "probe_assign_value_" ref 790 790 size 12 based fixed bin(35,0) level 2 in structure "runtime_type_info" dcl 12-24 in procedure "probe_assign_value_" ref 310 source 000100 automatic structure level 1 dcl 67 set ref 374* 376 376 386* 388 388 706* 708 708 source_indices 000140 automatic fixed bin(17,0) array dcl 72 set ref 190* 222 222 238* source_info based structure level 1 dcl 4-5 source_info_ptr 10 parameter pointer level 2 in structure "P_source" dcl 62 in procedure "probe_assign_value_" set ref 198 222 222 222 222 403 460 475 source_info_ptr 10 parameter pointer level 2 in structure "P_target" dcl 61 in procedure "probe_assign_value_" set ref 185 205 205 205 205 317 317 427 source_invert 000161 automatic bit(1) dcl 74 set ref 198* 238* source_len 000260 automatic fixed bin(17,0) dcl 292 set ref 680* 681 681 source_object based bit packed unaligned dcl 296 ref 575 579 620 623 674 source_p 000164 automatic pointer dcl 76 set ref 192* 193* 222* source_real_type 000265 automatic fixed bin(35,0) dcl 300 set ref 327* 333* 354 382 386* 394 394 401 425 441 451 454 469 472 475 490 497 511 514 525 538 545 562 628 651 source_real_type_ptr 000270 automatic pointer dcl 302 set ref 308* 327* 334* 338 340* 547 563 source_size 000261 automatic fixed bin(17,0) dcl 292 set ref 569* 575 575 579 614* 620 620 623 671* 674 674 680 source_string based char packed unaligned dcl 299 ref 681 source_type_type_info 000304 automatic structure level 1 unaligned dcl 305 set ref 340 340 stack_ptr 6 based pointer level 2 dcl 4-5 set ref 205* 222* 405* 431* 460 475 string builtin function dcl 118 set ref 725* 809* structure_dtype constant fixed bin(17,0) initial dcl 11-25 ref 353 354 361 765 stu_$get_runtime_address 000044 constant entry external dcl 109 ref 205 222 stu_$offset_to_pointer 000046 constant entry external dcl 112 ref 405 stu_$pointer_to_offset 000050 constant entry external dcl 114 ref 431 subscript_ptr 120 parameter pointer level 3 in structure "P_target" packed packed unaligned dcl 61 in procedure "probe_assign_value_" set ref 177 233 233 subscript_ptr 120 parameter pointer level 3 in structure "P_source" packed packed unaligned dcl 62 in procedure "probe_assign_value_" set ref 190 238 238 subscripts based structure level 1 dcl 80 substr builtin function dcl 118 set ref 140* 140 144* 575 620 674 symbol_ptr parameter pointer level 2 in structure "P_target" dcl 61 in procedure "probe_assign_value_" set ref 180 180 205* 360* 431* symbol_ptr parameter pointer level 2 in structure "P_source" dcl 62 in procedure "probe_assign_value_" set ref 193 193 222 222* 360* 405* 539* symbol_ptr parameter pointer level 2 in structure "ref" dcl 801 in procedure "setup_str" ref 822 t_code parameter fixed bin(35,0) dcl 802 ref 798 808 target 000110 automatic structure level 1 dcl 67 set ref 373* 376 376 385* 388 388 705* 708 708 target_indices 000120 automatic fixed bin(17,0) array dcl 72 set ref 177* 205 205 233* target_invert 000160 automatic bit(1) dcl 74 set ref 185* 233* target_len 000262 automatic fixed bin(17,0) dcl 292 set ref 679* 681 681 target_object based bit packed unaligned dcl 294 set ref 575* 579* 620* 623* 674* target_p 000162 automatic pointer dcl 76 set ref 179* 180* 205* target_real_type 000264 automatic fixed bin(35,0) dcl 300 set ref 325* 331* 353 361 381 385* 393 423 449 467 488 496 504 510 524 531 537 555 561 target_real_type_ptr 000266 automatic pointer dcl 302 set ref 308* 325* 332* 345 347* 539 547 563 658* 663* target_size 000263 automatic fixed bin(17,0) dcl 292 set ref 572* 575 575 575 579 617* 620 620 620 623 668* 674 674 674 679 target_string based char packed unaligned dcl 298 set ref 681* target_type_type_info 000272 automatic structure level 1 unaligned dcl 304 set ref 347 347 658 658 temp 000100 automatic structure level 1 dcl 272 the_null_byte based char(1) packed unaligned dcl 137 ref 144 token based structure level 1 dcl 2-16 token_header based structure level 1 dcl 2-4 type 113 parameter fixed bin(35,0) level 2 in structure "P_target" dcl 61 in procedure "probe_assign_value_" set ref 127 325* 331 572 617 668 type 113 parameter fixed bin(35,0) level 2 in structure "P_source" dcl 62 in procedure "probe_assign_value_" set ref 130 327* 333 517* 569 614 671 type 113 parameter fixed bin(35,0) level 2 in structure "P_ref" dcl 734 in procedure "make_unspec" set ref 737* 739 type 3 000272 automatic fixed bin(18,0) level 2 in structure "target_type_type_info" packed packed unsigned unaligned dcl 304 in procedure "assign_reference" set ref 564 564 582 589 611 629 type 113 parameter fixed bin(35,0) level 2 in structure "ref" dcl 801 in procedure "setup_str" ref 811 822 type 0(13) 000052 external static bit(1) array level 2 in structure "data_type_info_$info" packed packed unaligned dcl 8-23 in procedure "probe_assign_value_" ref 504 type 0(06) based bit(6) level 2 in structure "runtime_symbol" packed packed unaligned dcl 10-3 in procedure "probe_assign_value_" ref 756 757 type 3 000304 automatic fixed bin(18,0) level 2 in structure "source_type_type_info" packed packed unsigned unaligned dcl 305 in procedure "assign_reference" set ref 394 type_ptr 2 parameter pointer level 2 in structure "P_ref" dcl 734 in procedure "make_unspec" set ref 738* type_ptr 2 parameter pointer level 2 in structure "P_source" dcl 62 in procedure "probe_assign_value_" set ref 327* 334 type_ptr 2 parameter pointer level 2 in structure "P_target" dcl 61 in procedure "probe_assign_value_" set ref 325* 332 unspec builtin function dcl 118 set ref 461* 461 813* 813 value 1 based fixed bin(24,0) array level 2 dcl 80 set ref 177 190 233* 238* var1_type 000104 automatic fixed bin(17,0) dcl 754 set ref 756* 758 765 var2_type 000105 automatic fixed bin(17,0) dcl 754 set ref 757* 758 version 000272 automatic char(8) level 2 in structure "target_type_type_info" packed packed unaligned dcl 304 in procedure "assign_reference" set ref 346* 656* version 000304 automatic char(8) level 2 in structure "source_type_type_info" packed packed unaligned dcl 305 in procedure "assign_reference" set ref 339* zero_value 000174 automatic fixed bin(9,0) initial unsigned dcl 139 set ref 139* 144 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ALGOL68_lang_type internal static fixed bin(17,0) initial dcl 6-17 ALM_lang_type internal static fixed bin(17,0) initial dcl 6-17 COBOL_lang_type internal static fixed bin(17,0) initial dcl 6-17 CONSTANT_TYPE internal static bit(18) initial packed unaligned dcl 2-37 NAME_TYPE internal static bit(18) initial packed unaligned dcl 2-37 OPERATOR_TYPE internal static bit(18) initial packed unaligned dcl 2-37 OTHER_lang_type internal static fixed bin(17,0) initial dcl 6-17 PL1_lang_type internal static fixed bin(17,0) initial dcl 6-17 RUNTIME_ADDRESS_INFO_VERSION_1 internal static char(8) initial packed unaligned dcl 12-128 RUNTIME_ARRAY_INFO_VERSION_1 internal static char(8) initial packed unaligned dcl 12-129 RUNTIME_SUBRANGE_INFO_VERSION_1 internal static char(8) initial packed unaligned dcl 12-131 RUNTIME_VARIANT_INFO_VERSION_1 internal static char(8) initial packed unaligned dcl 12-130 UNKNOWN_lang_type internal static fixed bin(17,0) initial dcl 6-17 algol68_array_descriptor_dtype internal static fixed bin(17,0) initial dcl 11-25 algol68_bits_dtype internal static fixed bin(17,0) initial dcl 11-110 algol68_bool_dtype internal static fixed bin(17,0) initial dcl 11-110 algol68_byte_dtype internal static fixed bin(17,0) initial dcl 11-110 algol68_char_dtype internal static fixed bin(17,0) initial dcl 11-110 algol68_compl_dtype internal static fixed bin(17,0) initial dcl 11-110 algol68_format_dtype internal static fixed bin(17,0) initial dcl 11-25 algol68_int_dtype internal static fixed bin(17,0) initial dcl 11-110 algol68_long_compl_dtype internal static fixed bin(17,0) initial dcl 11-110 algol68_long_int_dtype internal static fixed bin(17,0) initial dcl 11-110 algol68_long_real_dtype internal static fixed bin(17,0) initial dcl 11-110 algol68_real_dtype internal static fixed bin(17,0) initial dcl 11-110 algol68_short_int_dtype internal static fixed bin(17,0) initial dcl 11-110 algol68_straight_dtype internal static fixed bin(17,0) initial dcl 11-25 algol68_struct_struct_bool_dtype internal static fixed bin(17,0) initial dcl 11-110 algol68_struct_struct_char_dtype internal static fixed bin(17,0) initial dcl 11-110 algol68_union_dtype internal static fixed bin(17,0) initial dcl 11-25 c_enum_const_dtype internal static fixed bin(17,0) initial dcl 11-25 c_enum_dtype internal static fixed bin(17,0) initial dcl 11-25 c_typeref_dtype internal static fixed bin(17,0) initial dcl 11-25 c_union_dtype internal static fixed bin(17,0) initial dcl 11-25 cobol_char_string_dtype internal static fixed bin(17,0) initial dcl 11-25 cobol_comp_5_ts_dtype internal static fixed bin(17,0) initial dcl 11-25 cobol_comp_5_uns_dtype internal static fixed bin(17,0) initial dcl 11-25 cobol_comp_6_dtype internal static fixed bin(17,0) initial dcl 11-25 cobol_comp_7_dtype internal static fixed bin(17,0) initial dcl 11-25 cobol_comp_8_ls_dtype internal static fixed bin(17,0) initial dcl 11-25 cobol_comp_8_uns_dtype internal static fixed bin(17,0) initial dcl 11-25 cobol_display_ls_dtype internal static fixed bin(17,0) initial dcl 11-25 cobol_display_ls_overp_dtype internal static fixed bin(17,0) initial dcl 11-25 cobol_display_ts_dtype internal static fixed bin(17,0) initial dcl 11-25 cobol_display_ts_overp_dtype internal static fixed bin(17,0) initial dcl 11-25 cobol_display_uns_dtype internal static fixed bin(17,0) initial dcl 11-25 cobol_structure_dtype internal static fixed bin(17,0) initial dcl 11-25 cplx_fix_bin_1_dtype internal static fixed bin(17,0) initial dcl 11-25 cplx_fix_bin_2_dtype internal static fixed bin(17,0) initial dcl 11-25 cplx_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 11-25 cplx_fix_dec_9bit_ls_dtype internal static fixed bin(17,0) initial dcl 11-25 cplx_flt_bin_1_dtype internal static fixed bin(17,0) initial dcl 11-25 cplx_flt_bin_2_dtype internal static fixed bin(17,0) initial dcl 11-25 cplx_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 11-25 cplx_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 11-25 cplx_flt_dec_9bit_dtype internal static fixed bin(17,0) initial dcl 11-25 cplx_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 11-25 cplx_flt_dec_generic_dtype internal static fixed bin(17,0) initial dcl 11-25 cplx_flt_hex_1_dtype internal static fixed bin(17,0) initial dcl 11-25 cplx_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 11-25 current_constant based structure level 1 dcl 2-44 current_identifier_name based char packed unaligned dcl 2-42 current_source based structure level 1 dcl 4-13 current_token based structure level 1 dcl 2-45 data_type_info_$max_decimal_precision external static fixed bin(17,0) dcl 8-48 data_type_info_$max_fixed_binary_precision external static fixed bin(17,0) dcl 8-50 data_type_info_$max_float_binary_precision external static fixed bin(17,0) dcl 8-49 data_type_info_$ninebit_digit_chars external static char(10) packed unaligned dcl 8-45 data_type_info_$ninebit_overpunched_sign_chars external static char(22) packed unaligned dcl 8-46 data_type_info_$ninebit_sign_chars external static char(2) packed unaligned dcl 8-44 data_type_info_$version_number external static fixed bin(17,0) dcl 8-20 data_type_info_this_version internal static fixed bin(17,0) initial dcl 8-21 encoded_value based structure level 1 dcl 10-70 expression_area based area(1024) dcl 1-95 ext_entry_runtime_dtype internal static fixed bin(17,0) initial dcl 11-125 ext_procedure_runtime_dtype internal static fixed bin(17,0) initial dcl 11-125 ft_char_dtype internal static fixed bin(17,0) initial dcl 11-96 ft_complex_double_dtype internal static fixed bin(17,0) initial dcl 11-96 ft_complex_dtype internal static fixed bin(17,0) initial dcl 11-96 ft_double_dtype internal static fixed bin(17,0) initial dcl 11-96 ft_external_dtype internal static fixed bin(17,0) initial dcl 11-96 ft_hex_complex_double_dtype internal static fixed bin(17,0) initial dcl 11-96 ft_hex_complex_dtype internal static fixed bin(17,0) initial dcl 11-96 ft_hex_double_dtype internal static fixed bin(17,0) initial dcl 11-96 ft_hex_real_dtype internal static fixed bin(17,0) initial dcl 11-96 ft_integer_dtype internal static fixed bin(17,0) initial dcl 11-96 ft_logical_dtype internal static fixed bin(17,0) initial dcl 11-96 ft_real_dtype internal static fixed bin(17,0) initial dcl 11-96 identifier based structure level 1 dcl 2-19 initial_source based structure level 1 dcl 4-14 n_variants automatic fixed bin(35,0) dcl 12-112 official_language_names internal static char(32) initial array packed unaligned dcl 6-27 operator based structure level 1 dcl 2-24 palatable_language_names internal static char(32) initial array packed unaligned dcl 6-30 pascal_entry_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 11-132 pascal_enumerated_type_dtype internal static fixed bin(17,0) initial dcl 11-132 pascal_exportable_procedure_dtype internal static fixed bin(17,0) initial dcl 11-132 pascal_imported_procedure_dtype internal static fixed bin(17,0) initial dcl 11-132 pascal_integer_dtype internal static fixed bin(17,0) initial dcl 11-132 pascal_internal_procedure_dtype internal static fixed bin(17,0) initial dcl 11-132 pascal_label_dtype internal static fixed bin(17,0) initial dcl 11-132 pascal_parameter_procedure_dtype internal static fixed bin(17,0) initial dcl 11-132 pascal_procedure_type_dtype internal static fixed bin(17,0) initial dcl 11-132 pascal_real_dtype internal static fixed bin(17,0) initial dcl 11-132 pascal_string_type_dtype internal static fixed bin(17,0) initial dcl 11-132 pascal_user_defined_type_dtype internal static fixed bin(17,0) initial dcl 11-132 pascal_value_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 11-132 pascal_variable_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 11-132 probe_area based area(1024) dcl 1-93 probe_info_version internal static fixed bin(17,0) initial dcl 1-88 probe_info_version_1 internal static fixed bin(17,0) initial dcl 1-90 real_fix_bin_1_dtype internal static fixed bin(17,0) initial dcl 11-25 real_fix_bin_2_dtype internal static fixed bin(17,0) initial dcl 11-25 real_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 11-25 real_fix_dec_4bit_bytealigned_uns_dtype internal static fixed bin(17,0) initial dcl 11-25 real_fix_dec_4bit_ls_dtype internal static fixed bin(17,0) initial dcl 11-25 real_fix_dec_4bit_ts_dtype internal static fixed bin(17,0) initial dcl 11-25 real_fix_dec_4bit_uns_dtype internal static fixed bin(17,0) initial dcl 11-25 real_fix_dec_9bit_ls_dtype internal static fixed bin(17,0) initial dcl 11-25 real_fix_dec_9bit_ls_overp_dtype internal static fixed bin(17,0) initial dcl 11-25 real_fix_dec_9bit_ts_dtype internal static fixed bin(17,0) initial dcl 11-25 real_fix_dec_9bit_ts_overp_dtype internal static fixed bin(17,0) initial dcl 11-25 real_fix_dec_9bit_uns_dtype internal static fixed bin(17,0) initial dcl 11-25 real_flt_bin_1_dtype internal static fixed bin(17,0) initial dcl 11-25 real_flt_bin_2_dtype internal static fixed bin(17,0) initial dcl 11-25 real_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 11-25 real_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 11-25 real_flt_dec_4bit_dtype internal static fixed bin(17,0) initial dcl 11-25 real_flt_dec_9bit_dtype internal static fixed bin(17,0) initial dcl 11-25 real_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 11-25 real_flt_dec_generic_dtype internal static fixed bin(17,0) initial dcl 11-25 real_flt_hex_1_dtype internal static fixed bin(17,0) initial dcl 11-25 real_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 11-25 reference_arg_list based structure level 1 dcl 3-59 runtime_address_info based structure level 1 dcl 12-56 runtime_array_info based structure level 1 dcl 12-70 runtime_block based structure level 1 dcl 10-38 runtime_bound based structure level 1 unaligned dcl 10-33 runtime_subrange_info based structure level 1 unaligned dcl 12-116 runtime_symbol_info_$address 000000 constant entry external dcl 12-54 runtime_symbol_info_$array 000000 constant entry external dcl 12-68 runtime_symbol_info_$father 000000 constant entry external dcl 12-38 runtime_symbol_info_$level 000000 constant entry external dcl 12-50 runtime_symbol_info_$n_variants 000000 constant entry external dcl 12-99 runtime_symbol_info_$name 000000 constant entry external dcl 12-48 runtime_symbol_info_$next 000000 constant entry external dcl 12-52 runtime_symbol_info_$subrange 000000 constant entry external dcl 12-114 runtime_symbol_info_$successor 000000 constant entry external dcl 12-46 runtime_symbol_info_$variant 000000 constant entry external dcl 12-101 runtime_token based structure level 1 dcl 10-63 runtime_variant_info based structure level 1 dcl 12-103 scratch_area based area(1024) dcl 1-92 seg_info_nfiles automatic fixed bin(17,0) dcl 5-47 subscript_reference_ptrs based structure level 1 dcl 3-69 varying_bit_dtype internal static fixed bin(17,0) initial dcl 11-25 varying_char_dtype internal static fixed bin(17,0) initial dcl 11-25 work_area based area(1024) dcl 1-94 NAMES DECLARED BY EXPLICIT CONTEXT. RECORDED_MESSAGE 001041 constant label dcl 252 set ref 153 170 218 265 357 367 507 534 558 587 696 745 SOME_ERROR 001045 constant label dcl 257 ref 157 163 254 313 323 377 389 709 assign_pascal_enumerated 003542 constant entry internal dcl 702 ref 511 519 525 539 547 assign_reference 001103 constant entry internal dcl 269 ref 173 232 bad_assignment 001051 constant label dcl 262 ref 309 342 349 382 401 411 438 441 454 472 490 497 514 525 539 545 547 589 611 629 651 652 660 664 make_unspec 003644 constant entry internal dcl 731 ref 370 371 probe_assign_value_ 000304 constant entry external dcl 34 same_format 003742 constant entry internal dcl 749 ref 360 771 set_up 003620 constant entry internal dcl 712 ref 705 706 setup_str 004232 constant entry internal dcl 798 ref 373 374 385 386 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4646 4734 4307 4656 Length 5446 4307 66 475 336 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME probe_assign_value_ 200 external procedure is an external procedure. begin block on line 135 begin block shares stack frame of external procedure probe_assign_value_. assign_reference 340 internal procedure enables or reverts conditions. on unit on line 309 64 on unit on unit on line 310 64 on unit assign_pascal_enumerated internal procedure shares stack frame of internal procedure assign_reference. set_up internal procedure shares stack frame of internal procedure assign_reference. make_unspec internal procedure shares stack frame of internal procedure assign_reference. same_format 88 internal procedure calls itself recursively. setup_str internal procedure shares stack frame of internal procedure assign_reference. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME assign_reference 000100 temp assign_reference 000244 label_var assign_reference 000250 entry_var assign_reference 000254 gen assign_reference 000256 p assign_reference 000260 source_len assign_reference 000261 source_size assign_reference 000262 target_len assign_reference 000263 target_size assign_reference 000264 target_real_type assign_reference 000265 source_real_type assign_reference 000266 target_real_type_ptr assign_reference 000270 source_real_type_ptr assign_reference 000272 target_type_type_info assign_reference 000304 source_type_type_info assign_reference 000362 an_encoded_value setup_str probe_assign_value_ 000100 source probe_assign_value_ 000110 target probe_assign_value_ 000120 target_indices probe_assign_value_ 000140 source_indices probe_assign_value_ 000160 target_invert probe_assign_value_ 000161 source_invert probe_assign_value_ 000162 target_p probe_assign_value_ 000164 source_p probe_assign_value_ 000166 done probe_assign_value_ 000167 code probe_assign_value_ 000170 probe_info_ptr probe_assign_value_ 000172 n_dims probe_assign_value_ 000174 zero_value begin block on line 135 same_format 000100 p1 same_format 000102 p2 same_format 000104 var1_type same_format 000105 var2_type same_format THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp call_ext_out_desc call_ext_out call_int_this call_int_other begin_return_mac return_mac tra_ext_1 enable_op shorten_stack ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. area_assign_ assign_$computational_ get_size_in_bits_ get_size_in_bits_$structure probe_error_$record probe_increment_indices_ probe_pascal_$real_type runtime_symbol_info_$array_dims runtime_symbol_info_$brother runtime_symbol_info_$father_type runtime_symbol_info_$son runtime_symbol_info_$type stu_$get_runtime_address stu_$offset_to_pointer stu_$pointer_to_offset THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. data_type_info_$info probe_et_$bad_assign probe_et_$bad_section probe_et_$c_string_assign probe_et_$constant_target probe_et_$no_address probe_et_$recorded_message probe_et_$size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 34 000277 77 000311 123 000312 125 000316 127 000325 130 000336 133 000350 139 000356 140 000357 144 000370 147 000373 149 000375 151 000376 153 000422 155 000423 156 000424 157 000426 160 000427 161 000432 162 000436 163 000440 166 000441 168 000445 170 000465 173 000466 174 000472 177 000473 179 000510 180 000512 185 000527 190 000534 192 000550 193 000552 198 000567 203 000574 205 000577 215 000635 216 000643 218 000664 222 000665 232 000726 233 000732 238 000772 245 001035 248 001036 249 001040 252 001041 254 001044 257 001045 259 001050 262 001051 265 001101 269 001102 308 001110 309 001114 310 001133 312 001147 313 001153 316 001156 317 001163 322 001201 323 001204 325 001207 327 001224 329 001244 331 001245 332 001251 333 001253 334 001256 338 001260 339 001264 340 001266 342 001304 345 001312 346 001316 347 001320 349 001336 353 001344 354 001347 355 001352 357 001400 360 001403 361 001422 365 001454 367 001475 370 001500 371 001510 373 001520 374 001536 376 001554 377 001576 379 001604 381 001605 382 001612 385 001621 386 001635 388 001651 389 001673 391 001701 393 001702 394 001704 400 001733 401 001737 403 001744 405 001751 411 002002 416 002017 419 002034 421 002036 423 002037 425 002041 427 002044 428 002051 430 002064 431 002067 438 002121 440 002136 441 002137 447 002152 449 002153 451 002155 454 002173 459 002200 460 002205 461 002210 465 002220 467 002221 469 002223 472 002241 474 002246 475 002253 479 002262 481 002264 486 002272 488 002273 490 002275 493 002303 494 002320 496 002321 497 002323 500 002331 502 002343 504 002344 505 002347 507 002374 510 002377 511 002401 514 002406 517 002424 518 002431 519 002433 522 002434 524 002435 525 002437 529 002446 531 002447 532 002451 534 002476 537 002501 538 002503 539 002506 544 002530 545 002531 547 002536 553 002546 555 002547 556 002551 558 002576 561 002601 562 002603 563 002606 564 002612 569 002624 572 002645 575 002667 579 002705 581 002717 582 002720 584 002722 587 002747 589 002752 591 002757 597 003002 600 003017 605 003030 610 003037 611 003040 614 003062 617 003104 620 003126 623 003144 627 003156 628 003157 629 003161 631 003170 637 003213 640 003230 645 003241 650 003250 651 003251 652 003256 656 003276 658 003300 660 003316 663 003324 664 003336 668 003354 671 003376 674 003420 679 003436 680 003441 681 003444 684 003501 691 003502 694 003503 696 003536 698 003541 702 003542 705 003543 706 003555 708 003567 709 003611 729 003617 712 003620 718 003622 719 003625 720 003630 723 003635 725 003637 726 003640 727 003642 728 003643 731 003644 736 003646 737 003651 738 003653 739 003655 740 003660 741 003662 742 003701 743 003703 745 003735 747 003740 749 003741 756 003747 757 003755 758 003762 761 003771 765 004007 766 004012 767 004022 771 004040 774 004064 775 004074 776 004105 778 004117 782 004125 784 004143 786 004161 788 004177 790 004213 793 004225 798 004232 807 004234 808 004237 809 004242 810 004243 811 004247 813 004255 815 004257 816 004262 817 004265 819 004266 820 004270 822 004271 824 004302 825 004304 ----------------------------------------------------------- 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