COMPILATION LISTING OF SEGMENT probe_source_segment_ Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 10/27/88 1235.3 mst Thu Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 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 /****^ HISTORY COMMENTS: 13* 1) change(87-06-18,RWaters), approve(87-06-18,MCR7687), audit(87-06-24,Huen), 14* install(87-07-15,MR12.1-1040): 15* Probe error #108: allow the object command to work w/o source code. 16* 2) change(88-09-07,WAAnderson), approve(88-09-30,MCR7952), 17* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 18* Added format control comment to make the source more readable. 19* END HISTORY COMMENTS */ 20 21 /* format: style1,insnl,ifthendo,indthenelse,^indnoniterdo,^inditerdo,indcom,^indthenbegin,^indprocbody,ind2,ll78,initcol0,dclind4,idind24,struclvlind1,comcol41 */ 22 23 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 24 25 probe_source_segment_: 26 proc (); 27 28 call probe_error_$malfunction (); /* dummy entry */ 29 30 /* This module is used to examine the source of a program. It can list source 31* statements, search for a string in the source, and check if a given 32* statement is within the statement map. 33* 34* Initial Version: 13 August 1974 by Jeffrey M. Broughton 35* Modified: 20 Sept 78 by James R Davis to not print anything if ps "string" fails, 36* and to ident lines properly on output 37* Converted to probe 4.0 05/19/79 WOS 38* Fixed to implement ps "", May 79 JRD 39*/* Added $position_source_lines for relative positioning by number of lines 10/08/81 S. Herbst */ 40 /* Changed $find_source to handle regular expressions 10/09/81 S. Herbst */ 41 /* Changed to handle long PL/1 and FORTRAN statements (>256 chars) 10/23/81 S. Herbst */ 42 /* Added $get_file_ptr for use by probe_find_location_ */ 43 /* Fixed not to print to end of seg for some cases of symbol table mismatch 06/01/82 S. Herbst */ 44 /* Fixed bug in regular expression searching for complicated programs 07/14/82 S. Herbst */ 45 /* Fixed $list_statement to not stray beyond text into int proc statements 09/13/82 S. Herbst */ 46 /* Fixed "b /REGEXP/" loop bug 10/18/82 S. Herbst */ 47 /* Modified: 7 April 1983, TO - Add 'line_start' routine to correct for 48* line start modulus 256K in source. Add line counting to 49* 'file_pointer' to setup line breaks. */ 50 /* Modified: 13 April 1983, TO - Modify archive checking to presume archive 51* component implied. Fix bug in 'get_stmt_length' in which the first 52* statment can start at character 1, and have a length of 0. If so, 53* the max function prevents a character check at character position 0. */ 54 /* Modified: 11 May 1983, RG - To use find_source_file_$look_in_wdir which 55* supports archive components implied/explicit. */ 56 /* Fixed regexp search with internal procedures 08/05/83 S. Herbst */ 57 /* Modified: 31 Aug 1983, Lee A. Newcomb: to use probe search lists. */ 58 /* Fixed to detect when saved source pointer points to wrong thing 09/01/83 S. Herbst */ 59 /* Fixed "ps /foo /" to not ignore the trailing white space 02/09/84 S. Herbst */ 60 /* Fixed "ps +N" for case where last int proc is not end of program 02/10/84 S. Herbst */ 61 /* Fixed get_stmt_length for zero-length statements listed in map 02/13/84 S. Herbst */ 62 /* Fixed line_start int proc to test if seg_info.per_file(file).break_line(i) = 0 02/24/84 S. Herbst */ 63 /* Fixed not to check seg_info.(directory_name entry_name) since these usually 64* refer to the object not the source 11/07/84 Steve Herbst */ 65 /* Fixed file_pointer proc to always search for source seg, not trust stored ptr 11/28/84 Steve Herbst */ 66 /* Fixed to return null on error if entered through $get_file_ptr 01/03/85 Steve Herbst */ 67 /* Fixed bug that caused a fault when stmt map shows 0 as a stmt's start position 01/16/85 Steve Herbst */ 68 /* Fixed loop caused by 2 stmt map entries for an on statement 01/16/85 Steve Herbst */ 69 /* Fixed undefined source bug when last match for regexp is last statement 01/23/85 Steve Herbst */ 70 /* Changed the procedure file_pointer to return an error code so the object command will work without a source file. 05/21/87 RWaters */ 71 72 73 dcl ( 74 P_probe_info_ptr pointer, 75 P_number_to_list fixed bin,/* number of statements to list */ 76 P_search_string character (*), 77 /* string to be searched for */ 78 P_origin_source_info_ptr 79 ptr, 80 P_relocate fixed bin,/* move source pointer this number of stmts */ 81 P_code fixed bin (35) 82 ) parameter; 83 84 dcl 1 origin_source_info aligned based (origin_source_info_ptr) 85 like source_info; 86 dcl origin_source_info_ptr ptr; 87 88 dcl position_lines bit (1) aligned; 89 /* position N lines instead of N statements */ 90 dcl returns_ptr_sw bit (1) aligned; 91 dcl line_number fixed bin; 92 dcl statement_number fixed bin; 93 dcl smp pointer; /* to first statement map entry of interest */ 94 dcl file_number fixed bin;/* number of file that we are currently using */ 95 dcl filep pointer; /* to current file */ 96 dcl info pointer; /* seg_info pointer for origin_source_info */ 97 dcl based_string character (1) aligned based; 98 /* dummy string to overlay segment, and output buffer */ 99 100 dcl number fixed bin initial (1); 101 /* number of statements that we have listed */ 102 dcl start fixed bin (35); 103 /* character offset of start of statement's text */ 104 dcl len fixed bin (35); 105 /* length of the statement in characters */ 106 dcl offset fixed bin;/* collumn in which statement starts */ 107 dcl p ptr; 108 dcl last_file_number fixed bin;/* last source file scaned */ 109 dcl (stmt_len, stmt_start) fixed bin (21); 110 dcl code fixed bin (35); 111 dcl (i, j, last_source_index) 112 fixed bin; 113 114 dcl 1 map_array (map_size) aligned based (smp) 115 like statement_map; 116 /* overlay for entire statement map */ 117 dcl map_size fixed bin (21); 118 dcl find_source_file_$search_path 119 entry (char (*), char (*), char (*), char (*), 120 ptr, fixed bin (24), fixed bin (35)); 121 dcl ioa_$ioa_switch_nnl entry options (variable); 122 dcl iox_$put_chars entry (pointer, pointer, fixed binary (21), 123 fixed binary (35)); 124 125 dcl probe_find_location_ entry (ptr, ptr, fixed bin, fixed bin, 126 fixed bin, bit (36) aligned, ptr, fixed bin); 127 128 dcl ( 129 probe_et_$bad_line, 130 probe_et_$no_saved_string, 131 probe_et_$string_search_failed, 132 probe_et_$no_statement_map, 133 probe_et_$recorded_message 134 ) fixed bin (35) external static; 135 136 dcl probe_error_ entry options (variable); 137 dcl probe_error_$malfunction 138 entry options (variable); 139 dcl probe_error_$record entry options (variable); 140 141 dcl newline char (1) aligned internal static 142 options (constant) initial (" 143 "); 144 dcl TAB_BS char (2) internal static options (constant) 145 init (" "); 146 147 dcl (addrel, addr, binary, divide, fixed, index, length, max, min) 148 builtin; 149 dcl (mod, null, pointer, reverse, rtrim, string, substr, unspec) 150 builtin; 151 152 list_statement: 153 entry (P_probe_info_ptr, P_origin_source_info_ptr, P_number_to_list, P_code) 154 ; 155 156 returns_ptr_sw = "0"b; 157 158 call common_setup; 159 160 if statement_number < 1 | statement_number > map_size 161 then call probe_error_ (probe_info_ptr, probe_et_$bad_line, "", ""); 162 /* segment does not have a table of source lines */ 163 164 smp = addr (smp -> map_array (statement_number)); 165 /* make smp point only to the part of the source map we */ 166 /* are interested in. This is sorta kludgy. */ 167 168 last_file_number = -1; /* no such file number; for comparison */ 169 170 do while (number <= P_number_to_list);/* loop until we have processed all statements */ 171 file_number = fixed (map_array (number).file) + 1; 172 if file_number = last_file_number 173 then goto MAIN_RETURN; /* gone beyond text into int proc statements */ 174 last_file_number = file_number; 175 filep = file_pointer (P_code); /* get a pointer to the file */ 176 if P_code ^= 0 177 then goto MAIN_RETURN; 178 start = line_start (number - 1 + statement_number) + 1; 179 /* where in segment does statement begin */ 180 181 /* get character offset of statement from beginning of line */ 182 183 i = start 184 - 185 index (reverse (substr (filep -> based_string, 1, start - 1)), 186 newline); 187 if i = start 188 then i = 0; /* find location of first preceding newline */ 189 190 offset = 0; /* at start of line, no padding needed */ 191 do i = i + 1 to start - 1; /* compute indentation of the line */ 192 j = index (TAB_BS, substr (filep -> based_string, i, 1)); 193 /* check if tab, backspace or something else */ 194 if j = 0 195 then offset = offset + 1; /* and have a width of one */ 196 else if j = 1 197 then /* a tab */ 198 offset = offset + 10 - mod (offset, 10); 199 /* compute how far to tabulate */ 200 else if j = 2 201 then offset = offset - 1; /* backspace */ 202 end; 203 204 /* get all lines that we can print in this part -- all that belong to the same file, 205* and which have monotonically increasing line and statement numbers */ 206 207 do number = number + 1 by 1 208 to P_number_to_list /* look for a statement not in current group */ 209 while (file_number = fixed (map_array (number).file) + 1 210 & string (map_array (number).source_id) 211 >= string (map_array (number - 1).source_id)); 212 end; 213 len = line_start (statement_number - 1 + number - 1) - start + 214 get_stmt_length (fixed (map_array (number - 1).length, 17, 0), 215 (number)) + 1; 216 217 if len = 0 218 then call probe_error_ (probe_info_ptr, probe_et_$bad_line, "", ""); 219 /* may happen for dcl statement */ 220 else do; /* write out the lines */ 221 call ioa_$ioa_switch_nnl (probe_info.output_switch, "^v( ^)", offset); 222 p = addr (substr (filep -> based_string, start, 1)); 223 call iox_$put_chars (probe_info.output_switch, p, (len), code); 224 if code ^= 0 225 then call probe_error_ (probe_info_ptr, code, "Writing output"); 226 call iox_$put_chars (probe_info.output_switch, addr (newline), 1, 227 code); 228 end; 229 230 if string (map_array (number).source_id) = (27)"1"b 231 then goto MAIN_RETURN; 232 /* we have reached the end of the program */ 233 234 end; /* and loop back for next file, if there is one */ 235 236 goto MAIN_RETURN; 237 238 position_source: 239 entry (P_probe_info_ptr, P_origin_source_info_ptr, P_relocate, P_code); 240 241 position_lines = "0"b; 242 go to POSITION; 243 244 245 position_source_lines: 246 entry (P_probe_info_ptr, P_origin_source_info_ptr, P_relocate, P_code); 247 248 position_lines = "1"b; 249 250 POSITION: 251 returns_ptr_sw = "0"b; 252 253 call common_setup; 254 255 if statement_number < 0 | statement_number > map_size 256 then do; 257 P_code = probe_et_$bad_line; 258 goto SOME_ERROR; 259 end; 260 261 if position_lines then do; 262 POSITION_LINES: 263 line_number = fixed (map_array (statement_number).line); 264 /* ps +N lines, ps -N lines */ 265 line_number = line_number + P_relocate; 266 if line_number < 1 then do; 267 call probe_error_$record (probe_info_ptr, 0, 268 "Attempt to position before first line."); 269 go to RECORDED_MESSAGE; 270 end; 271 272 call probe_find_location_ (probe_info_ptr, 273 origin_source_info.seg_info_ptr, 274 0, line_number, 1, "1110"b, (null), statement_number); 275 if statement_number = -1 then do; 276 call probe_error_$record (probe_info_ptr, 0, 277 "No source line number ^d", line_number); 278 go to RECORDED_MESSAGE; 279 end; 280 end; 281 282 else do; /* ps +N, ps -N */ 283 if statement_number + P_relocate < 0 284 | statement_number + P_relocate > map_size then do; 285 position_lines = "1"b; 286 go to POSITION_LINES; /* next best thing */ 287 end; 288 statement_number = statement_number + P_relocate; 289 end; 290 291 goto CALCULATE_BLOCK_ETC; 292 293 find_source: 294 entry (P_probe_info_ptr, P_origin_source_info_ptr, P_search_string, P_code); 295 296 /* this entry implements the search for a quoted string - it remembers the string used for 297* use if a "" is upplied */ 298 299 dcl search_string char (256) varying; 300 /* string to search for */ 301 dcl regexp_string char (256) varying; 302 /* search_string /.../ without the slashes */ 303 dcl previous_search_string char (256) varying internal static init (""); 304 /* last string searched for */ 305 306 dcl (found_start, search_end, search_start) 307 fixed bin (21); 308 dcl search_file_ entry (ptr, fixed bin (21), fixed bin (21), ptr, 309 fixed bin (21), fixed bin (21), fixed bin (21), 310 fixed bin (21), fixed bin (35)); 311 312 returns_ptr_sw = "0"b; 313 314 call common_setup; 315 316 if P_search_string = "" then do; /* wants same string as last time */ 317 if previous_search_string = "" then do; 318 /* but there was no last time */ 319 P_code = probe_et_$no_saved_string; 320 /* failure */ 321 goto SOME_ERROR; 322 end; 323 search_string = previous_search_string; 324 end; 325 326 else do; 327 search_string = P_search_string; 328 previous_search_string = P_search_string; 329 /* and save it for posterity */ 330 end; 331 332 if substr (search_string, 1, 1) = "/" 333 & substr (search_string, length (rtrim (search_string)), 1) = "/" 334 then do; 335 /* regular expression */ 336 regexp_string = 337 substr (search_string, 2, length (rtrim (search_string)) - 2); 338 339 search_end = line_start ((map_size)) + 340 fixed (map_array (map_size).length, 17, 0) - 1; 341 342 if statement_number < 1 | statement_number > map_size then do; 343 search_start = line_start (1); 344 statement_number = 0; 345 end; 346 else if statement_number = map_size 347 then search_start = search_end; 348 else do; 349 if unspec (map_array (statement_number).source_info) = 350 unspec (map_array (statement_number + 1).source_info) 351 then 352 statement_number = statement_number + 1; 353 /* there are 2 stmt map entries for an on statement */ 354 search_start = line_start (statement_number + 1); 355 end; 356 357 file_number = 358 fixed (map_array (min (map_size, statement_number + 1)).file, 17, 359 0) + 1; 360 filep = file_pointer (code); 361 if code ^= 0 362 then 363 call probe_error_ (probe_info_ptr, code); 364 365 search_end = 0; 366 do i = 1 to map_size; 367 j = line_start (i); 368 if j > search_end then do; 369 search_end = j; 370 last_source_index = i; 371 end; 372 end; 373 search_end = 374 search_end + fixed (map_array (last_source_index).length, 17, 0) 375 - 1; 376 377 if statement_number < 1 | statement_number > map_size then do; 378 search_start = max (1, fixed (map_array (1).start, 17, 0)); 379 statement_number = 0; 380 end; 381 else if statement_number = map_size 382 then search_start = search_end; 383 else search_start = 384 max (1, fixed (map_array (statement_number + 1).start, 17, 0)) 385 ; 386 387 SEARCH: 388 call search_file_ (addrel (addr (regexp_string), 1), 1, 389 length (regexp_string), 390 filep, search_start, search_end, found_start, 0, code); 391 if code ^= 0 then do; /* search previous portion too, like ps "STRING" */ 392 393 call search_file_ (addrel (addr (regexp_string), 1), 1, 394 length (regexp_string), 395 filep, 1, search_start - 1, found_start, 0, code); 396 if code ^= 0 then do; 397 P_code = probe_et_$string_search_failed; 398 goto MAIN_RETURN; 399 end; 400 end; 401 402 do i = 1 to map_size; /* find the statement corresponding to this text position */ 403 stmt_start = line_start (i); 404 stmt_len = fixed (map_array (i).length, 21, 0); 405 if found_start >= stmt_start & found_start < stmt_start + stmt_len 406 then 407 go to FOUND_STRING; 408 end; 409 410 search_start = found_start + 1; /* must be in a comment; keep searching */ 411 go to SEARCH; 412 end; 413 414 415 if statement_number < 1 | statement_number > map_size 416 then statement_number = 0; /* start at beginnning, if undefined loc now */ 417 418 /* Scan through all executable statements looking for "string" */ 419 420 last_file_number = -1; /* shouldn't be any file with this number */ 421 do i = statement_number + 1 to info -> seg_info.map_size, 422 1 to statement_number; 423 file_number = fixed (map_array (i).file, 17, 0) + 1; 424 /* get file number */ 425 if file_number ^= last_file_number /* if not in last file, get new filep */ 426 then filep = file_pointer (code); 427 428 start = line_start (i) + 1; /* where in source is the line */ 429 len = get_stmt_length (fixed (map_array (i).length, 17, 0), i + 1); 430 431 if index (substr (filep -> based_string, start, len), search_string) ^= 0 432 then goto FOUND_STRING; 433 434 last_file_number = file_number; /* not in current line try again */ 435 end; /* of loop through statements */ 436 437 P_code = probe_et_$string_search_failed; 438 /* sorry */ 439 goto MAIN_RETURN; 440 441 FOUND_STRING: 442 statement_number = i; 443 444 goto CALCULATE_BLOCK_ETC; 445 446 447 448 CALCULATE_BLOCK_ETC: 449 450 dcl loc bit (18); 451 dcl hp ptr; 452 dcl stu_$find_containing_block 453 entry (ptr, fixed bin (18) unsigned) 454 returns (ptr); 455 dcl probe_stack_trace_$find_block_frame 456 entry (ptr, ptr); 457 458 loc = map_array (statement_number).location; 459 hp = info -> seg_info.symbol_header_ptr; 460 461 origin_source_info.block_ptr = 462 stu_$find_containing_block (hp, binary (loc, 18, 0)); 463 464 if origin_source_info.block_ptr ^= null () 465 then call probe_stack_trace_$find_block_frame (probe_info_ptr, 466 origin_source_info_ptr); 467 468 /* must set these after searching stack */ 469 470 origin_source_info.instruction_ptr = pointer (hp, loc); 471 origin_source_info.stmnt_map_entry_index = statement_number; 472 473 goto MAIN_RETURN; /* end for position and search */ 474 475 get_file_ptr: 476 entry (P_probe_info_ptr, P_origin_source_info_ptr, P_file_number) 477 returns (ptr); 478 479 dcl P_file_number fixed bin; 480 481 returns_ptr_sw = "1"b; 482 483 call common_setup; 484 485 if P_file_number = 0 486 then file_number = 1; 487 else file_number = P_file_number; 488 return (file_pointer (0)); 489 490 common_setup: 491 proc; 492 493 /* all three entries call this internal proc to do common setup and checking */ 494 495 496 probe_info_ptr = P_probe_info_ptr; 497 origin_source_info_ptr = P_origin_source_info_ptr; 498 P_code = 0; 499 500 info = origin_source_info.seg_info_ptr; 501 if info = null () 502 then do; 503 P_code = probe_et_$bad_line; 504 goto SOME_ERROR; 505 end; 506 507 smp = info -> seg_info.statement_map_ptr; 508 if smp = null () 509 then do; 510 P_code = probe_et_$no_statement_map; 511 goto SOME_ERROR; 512 end; 513 514 map_size = info -> seg_info.map_size; 515 516 statement_number = origin_source_info.stmnt_map_entry_index; 517 end common_setup; 518 RECORDED_MESSAGE: 519 P_code = probe_et_$recorded_message; 520 goto MAIN_RETURN; 521 522 SOME_ERROR: 523 if returns_ptr_sw 524 then 525 return (null); 526 527 MAIN_RETURN: 528 return; 529 530 get_stmt_length: 531 proc (P_len, P_next_number) returns (fixed bin (35)); 532 533 /* Looks for the statement delimiter; since the statement map's length number 534* is mod (256), end of stmt is either N, 256+N, 512+N, etc. */ 535 536 dcl (P_len, P_next_number, len, limit) 537 fixed bin (35); 538 dcl lang fixed bin; 539 dcl char char (1); 540 dcl max builtin; 541 542 543 if P_len = 0 544 then 545 return (0); 546 547 lang = info -> seg_info.language_type; 548 if lang ^= PL1_lang_type & lang ^= PASCAL_lang_type 549 & lang ^= FORTRAN_lang_type 550 then 551 return (P_len); /* nothing we can do */ 552 553 len = P_len; 554 limit = line_start ((P_next_number)) - start; 555 /* up to start of next statement in map */ 556 557 do while (len < limit); 558 559 char = substr (filep -> based_string, max (start + len - 1, 1), 1); 560 if lang = FORTRAN_lang_type then do; 561 if char = ";" | char = newline 562 then 563 return (len); 564 end; 565 else if char = ";" 566 then 567 return (len); 568 569 len = len + 256; 570 end; 571 572 return (P_len); 573 574 end get_stmt_length; 575 576 file_pointer: 577 procedure (e_code) returns (pointer); 578 579 /* global imports: 580* info ptr to seg_info 581* file_number the number of the file of interest 582**/ 583 584 dcl e_code fixed bin (35); 585 dcl bitcount fixed bin (24); 586 dcl char_count fixed bin (21); 587 dcl (i, j, k, start, limit) fixed bin (21); 588 dcl line fixed bin; 589 dcl string char (char_count) unaligned based (try); 590 dcl NL char (1) static options (constant) initial (" 591 "); 592 dcl try pointer; 593 dcl osrc pointer; /* to original source map */ 594 dcl relpath char (relpath_l) based (relpath_p); 595 /* the rel path we must expand */ 596 dcl relpath_l fixed bin; 597 dcl relpath_p ptr; 598 dcl relpath_ename char (32);/* the entryname part of relpath as */ 599 /* returned by find_source_file_$search_path */ 600 601 e_code = 0; 602 osrc = info -> seg_info.original_source_ptr; 603 604 /* get pointer to the segment */ 605 try = info -> seg_info.file_pointers (file_number); 606 607 if try = null () then do; 608 relpath_p = 609 addrel (info -> seg_info.symbol_header_ptr, 610 osrc -> source_map.offset (file_number)); 611 relpath_l = (fixed (osrc -> source_map (file_number).size)); 612 /* and get length of files path */ 613 call find_source_file_$search_path ((relpath), "", "probe", 614 relpath_ename, try, bitcount, e_code); 615 616 /* If we are attempting to execute the object request, then just return 617*an error code all the way back to probe_requests_$object and let it handle it. 618*Otherwise call probe_error_ 619**/ 620 if e_code ^= 0 621 then 622 if probe_info.request_name = "object" 623 then 624 return (null ()); 625 end; 626 627 if try = null () then do; 628 call probe_error_ (probe_info_ptr, e_code, 629 "Cannot find source file ^a using probe search list.", 630 relpath_ename); 631 return (null ()); 632 end; 633 634 if try ^= info -> seg_info.file_pointers (file_number) then do; 635 636 /* if the file is beyond the 256K character limit then we need to fill in 637* the line break points. Do this by counting lines in all 256K character 638* sections which are filled, and fill in the line_break point table. The last 639* table entry is always the maximum possible 18-bit line number to stop the 640* scan. */ 641 642 char_count = divide (bitcount, 9, 21, 0); 643 644 line = 1; 645 j = 0; 646 do i = 1 to divide (char_count, 2 ** 18, 18, 0); 647 start = (i - 1) * 2 ** 18 + 1; 648 limit = 2 ** 18; 649 k = index (substr (string, start, limit), NL); 650 do line = line repeat line + 1 while (k ^= 0); 651 limit = limit - k; 652 k = index (substr (string, start, limit), NL); 653 start = start + k; 654 end /* do line (count lines)*/; 655 656 info -> seg_info.per_file (file_number).break_line (j) = line; 657 j = j + 1; 658 end /* do i (scan char blocks) */; 659 info -> seg_info.per_file (file_number).break_line (j) = 2 ** 18 - 1; 660 661 /* Having just gotton ptr to source file, we might want to check it to see if 662* it has changed since the object seg was compiled, and WARN if so. */ 663 664 info -> seg_info.file_pointers (file_number) = try; 665 end; 666 return (info -> seg_info.file_pointers (file_number)); 667 668 end file_pointer; 669 670 line_start: 671 procedure (line_number) returns (fixed bin (21)); 672 673 /* Procedure to scan the segment information line_break and convert the 674* line character offset in the map, with the line character modulus info 675* in the seg_info structure to a true character address. */ 676 677 dcl address fixed bin (21); 678 /* character address */ 679 dcl file fixed bin;/* current file */ 680 dcl i fixed bin; 681 dcl source_line fixed bin;/* line in source */ 682 dcl break_line fixed bin; 683 dcl line_number fixed bin; 684 dcl smp ptr; 685 686 687 smp = info -> seg_info.statement_map_ptr; 688 file = fixed (smp -> map_array (line_number).file, 17, 0) + 1; 689 source_line = fixed (smp -> map_array (line_number).line, 14, 0); 690 address = fixed (smp -> map_array (line_number).start, 18, 0); 691 692 do i = 0 to 3; 693 break_line = info -> seg_info.per_file (file).break_line (i); 694 if break_line <= 0 695 then 696 return (address); /* no info stored for this entry */ 697 else if source_line > break_line 698 then address = address + 2 ** 18; 699 else 700 return (address); 701 end; 702 return (address); 703 704 end line_start; 705 1 1 /* BEGIN INCLUDE FILE ... access_mode_values.incl.pl1 1 2* 1 3* Values for the "access mode" argument so often used in hardcore 1 4* James R. Davis 26 Jan 81 MCR 4844 1 5* Added constants for SM access 4/28/82 Jay Pattin 1 6* Added text strings 03/19/85 Chris Jones 1 7**/ 1 8 1 9 1 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 1 11 dcl ( 1 12 N_ACCESS init ("000"b), 1 13 R_ACCESS init ("100"b), 1 14 E_ACCESS init ("010"b), 1 15 W_ACCESS init ("001"b), 1 16 RE_ACCESS init ("110"b), 1 17 REW_ACCESS init ("111"b), 1 18 RW_ACCESS init ("101"b), 1 19 S_ACCESS init ("100"b), 1 20 M_ACCESS init ("010"b), 1 21 A_ACCESS init ("001"b), 1 22 SA_ACCESS init ("101"b), 1 23 SM_ACCESS init ("110"b), 1 24 SMA_ACCESS init ("111"b) 1 25 ) bit (3) internal static options (constant); 1 26 1 27 /* The following arrays are meant to be accessed by doing either 1) bin (bit_value) or 1 28* 2) divide (bin_value, 2) to come up with an index into the array. */ 1 29 1 30 dcl SEG_ACCESS_MODE_NAMES (0:7) init ("null", "W", "E", "EW", "R", "RW", "RE", "REW") char (4) internal 1 31 static options (constant); 1 32 1 33 dcl DIR_ACCESS_MODE_NAMES (0:7) init ("null", "A", "M", "MA", "S", "SA", "SM", "SMA") char (4) internal 1 34 static options (constant); 1 35 1 36 dcl ( 1 37 N_ACCESS_BIN init (00000b), 1 38 R_ACCESS_BIN init (01000b), 1 39 E_ACCESS_BIN init (00100b), 1 40 W_ACCESS_BIN init (00010b), 1 41 RW_ACCESS_BIN init (01010b), 1 42 RE_ACCESS_BIN init (01100b), 1 43 REW_ACCESS_BIN init (01110b), 1 44 S_ACCESS_BIN init (01000b), 1 45 M_ACCESS_BIN init (00010b), 1 46 A_ACCESS_BIN init (00001b), 1 47 SA_ACCESS_BIN init (01001b), 1 48 SM_ACCESS_BIN init (01010b), 1 49 SMA_ACCESS_BIN init (01011b) 1 50 ) fixed bin (5) internal static options (constant); 1 51 1 52 /* END INCLUDE FILE ... access_mode_values.incl.pl1 */ 706 707 2 1 /* BEGIN INCLUDE FILE probe_info.incl.pl1 */ 2 2 2 3 2 4 2 5 /****^ HISTORY COMMENTS: 2 6* 1) change(88-10-24,WAAnderson), approve(88-10-24,MCR7952), 2 7* audit(88-10-24,RWaters), install(88-10-27,MR12.2-1194): 2 8* Added field 'retry_using_main' to add new C feature. 2 9* END HISTORY COMMENTS */ 2 10 2 11 2 12 /* Created: 04/22/79 W. Olin Sibert, from subsystem_info 2 13* Modified: 22 Sept 79 JRd to remove: default (ptr & (auto|based)) init (null ()); 2 14* Added flags.setting_break 08/22/83 Steve Herbst 2 15* Added flags.executing_quit_request 01/15/85 Steve Herbst 2 16**/ 2 17 2 18 dcl 1 probe_info aligned based (probe_info_ptr), /* standard data for a probe invocation */ 2 19 2 probe_info_version fixed bin, /* version of this structure */ 2 20 2 21 2 static_info_ptr pointer unaligned, /* pointer to static information structure */ 2 22 2 modes_ptr pointer unaligned, /* pointer to probe_modes structure */ 2 23 2 24 2 ptr_to_current_source ptr, /* current_source is based on this */ 2 25 2 ptr_to_initial_source ptr, /* initial_source is based on this */ 2 26 2 machine_cond_ptr pointer, /* pointer to machine conditions, if we faulted to get here */ 2 27 2 28 2 token_info aligned, /* information about token chain currently being processed */ 2 29 3 first_token pointer unaligned, /* first token in chain */ 2 30 3 ct pointer unaligned, /* pointer to current token; updated in MANY places */ 2 31 3 end_token bit (18) aligned, /* token type at which to stop scanning token chain */ 2 32 3 buffer_ptr pointer unaligned, /* pointer to input buffer */ 2 33 3 buffer_lth fixed bin (21), /* and length */ 2 34 2 35 2 random_info aligned, 2 36 3 current_stack_frame pointer unaligned, /* stack frame pointer for frame in which probe was invoked */ 2 37 3 input_type fixed bin, /* current input type */ 2 38 3 language_type fixed bin, /* current language being processed */ 2 39 3 return_method fixed bin, /* how we should return after exiting probe */ 2 40 3 entry_method fixed bin, /* how we got here in the first place */ 2 41 3 pad1 (19) bit (36) aligned, 2 42 2 43 2 break_info, /* break info -- only interesting if we got here via a break */ 2 44 3 break_slot_ptr pointer, /* pointer to break slot -- non-null IFF at a break */ 2 45 3 last_break_slot_ptr pointer unaligned, /* pointer to previous break slot, not presently used */ 2 46 3 break_reset bit (1) aligned, /* this break has been reset by somebody further on */ 2 47 3 real_break_return_loc pointer, /* where to REALLY return to, modulo previous bit */ 2 48 2 49 2 probe_area_info, /* information about various probe areas */ 2 50 3 break_segment_ptr pointer unaligned, /* pointer to Personid.probe */ 2 51 3 break_area_ptr pointer unaligned, /* pointer to area in break segment */ 2 52 3 scratch_area_ptr pointer unaligned, /* pointer to probe scratch seg in process dir */ 2 53 3 probe_area_ptr pointer unaligned, /* This area lasts as long as an invocation of probe. */ 2 54 3 work_area_ptr pointer unaligned, /* This area lasts as long as the current request line */ 2 55 3 expression_area_ptr pointer unaligned, /* This area lasts as long as the current command */ 2 56 2 57 2 flags aligned, /* this, in particular, should be saved and restored correctly */ 2 58 (3 execute, /* "1"b => execute requests, "0"b => just check syntax */ 2 59 3 in_listener, /* ON => in probe listener loop */ 2 60 3 executing_request, /* ON => executing a request */ 2 61 3 in_interpret_line, /* executing in probe_listen_$interpret_line */ 2 62 3 setting_break, /* executing "after" or "before": check syntax of "if" */ 2 63 3 executing_quit_request, /* to prevent error looping during "quit" request */ 2 64 3 pad (30)) bit (1) unaligned, 2 65 2 66 2 io_switches, /* switches probe will do normal I/O on */ 2 67 3 input_switch pointer, 2 68 3 output_switch pointer, 2 69 2 70 2 error_info, /* information about the last error saved for later printing */ 2 71 3 error_code fixed bin (35), 2 72 3 error_message char (300) varying, 2 73 2 74 2 listener_info, /* internal use by probe listener */ 2 75 3 request_name character (32) varying, /* primary name of the request being processed */ 2 76 3 abort_probe_label label variable, 2 77 3 abort_line_label label variable, 2 78 3 depth fixed binary, /* count of active invocations of probe */ 2 79 3 previous pointer unaligned, /* -> previous invocation's info */ 2 80 3 next pointer unaligned, 2 81 2 82 2 end_of_probe_info pointer aligned, 2 83 2 retry_using_main fixed bin aligned; 2 84 2 85 2 86 dcl probe_info_ptr pointer; 2 87 2 88 dcl probe_info_version fixed bin static options (constant) initial (1); 2 89 2 90 dcl probe_info_version_1 fixed bin static options (constant) initial (1); 2 91 2 92 dcl scratch_area area based (probe_info.scratch_area_ptr); 2 93 dcl probe_area area based (probe_info.probe_area_ptr); 2 94 dcl work_area area based (probe_info.work_area_ptr); 2 95 dcl expression_area area based (probe_info.expression_area_ptr); 2 96 2 97 /* END INCLUDE FILE probe_info.incl.pl1 */ 708 709 3 1 /* BEGIN INCLUDE FILE ... probe_lang_types.incl.pl1 3 2* 3 3* JRD 26 June 79 3 4* MBW 31 July 1981 to add algol68 */ 3 5 3 6 3 7 /****^ HISTORY COMMENTS: 3 8* 1) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 3 9* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 3 10* Added C Language type. 3 11* END HISTORY COMMENTS */ 3 12 3 13 3 14 /* Modified June 83 JMAthane to add PASCAL language type */ 3 15 /* Modified April 88 Hinatsu to add C language type */ 3 16 3 17 dcl (UNKNOWN_lang_type init (1), 3 18 OTHER_lang_type init (2), 3 19 PL1_lang_type init (3), 3 20 FORTRAN_lang_type init (4), 3 21 COBOL_lang_type init (5), 3 22 ALM_lang_type init (6), 3 23 ALGOL68_lang_type init (7), 3 24 PASCAL_lang_type init (8), 3 25 C_lang_type init (9)) fixed bin internal static options (constant); 3 26 3 27 dcl official_language_names (9) char (32) internal static options (constant) init 3 28 ("Unknown", "other", "PL/I", "FORTRAN", "COBOL", "ALM", "Algol 68", "Pascal", "C"); 3 29 3 30 dcl palatable_language_names (9) char (32) internal static options (constant) init 3 31 ("Unknown", "Other", "pl1", "fortran", "cobol", "alm", "algol68", "pascal", "c"); 3 32 3 33 /* END INCLUDE FILE ... probe_lang_types.incl.pl1 */ 710 711 4 1 /* BEGIN INCLUDE FILE ... probe_seg_info.incl.pl1 4 2* 4 3* 25 June 79 JRDavis 4 4* 4 5* Modified 7 April 1983, TO - Add fields for character offset/line 4 6* correction per file. 4 7**/ 4 8 4 9 dcl 1 seg_info based aligned, /* place to remember information about object seg */ 4 10 2 language_type fixed bin, /* language of source program */ 4 11 2 bits aligned, 4 12 3 ignore_case bit (1) unal, 4 13 3 bound_segment bit (1) unaligned, 4 14 3 component bit (1) unaligned, 4 15 3 pad bit (33) unal, 4 16 2 names, /* where to find it */ 4 17 3 directory_name character (168) unal, /* what directory */ 4 18 3 entry_name character (32) unal, /* what segment */ 4 19 3 segname character (32) unal, /* procedure segname definition */ 4 20 2 identifier fixed bin (71), /* time of object creation */ 4 21 2 pointers, /* location of various parts of segment */ 4 22 3 symbol_header_ptr ptr unal, /* to symbol section */ 4 23 3 original_source_ptr ptr unal, /* to segment source map */ 4 24 3 statement_map_ptr ptr unal, /* to segment statement map */ 4 25 3 break_info ptr unal, /* for unbound segments, and start of chain for 4 26* bound ones, -> break_map !obsolete, I think! */ 4 27 3 chain ptr unal, /* to entry for next component if bound */ 4 28 3 linkage_ptr ptr unal, /* to linkage section */ 4 29 2 bounds aligned, /* structure of bounds information */ 4 30 3 text_bounds, 4 31 4 start fixed bin (35), 4 32 4 end fixed bin (35), 4 33 3 symbol_bounds, 4 34 4 start fixed bin (35), 4 35 4 end fixed bin (35), 4 36 2 map_size fixed bin, /* size of statement map */ 4 37 2 error_code fixed bin (35), /* errors encoutered while getting info, are recorded here */ 4 38 2 bound_create_time fixed bin (71), /* time seg containing was bound or compiled. */ 4 39 2 bound_sym_header ptr unal, /* to sym. section header for bound seg */ 4 40 2 pad (1) fixed bin (35), 4 41 4 42 2 nfiles fixed bin, 4 43 2 per_file (seg_info_nfiles refer (seg_info.nfiles)), 4 44 3 file_pointers ptr unal, 4 45 3 break_line (0:3) fixed bin (18) unsigned unaligned; 4 46 4 47 dcl seg_info_nfiles fixed bin; /* for allocation purposes */ 4 48 4 49 4 50 /* END INCLUDE FILE ... probe_seg_info.incl.pl1 */ 712 713 5 1 /* BEGIN INCLUDE FILE ... probe_source_info.incl.pl1 5 2* 5 3* James R. Davis 2 July 79 */ 5 4 5 5 dcl 1 source_info based aligned, 5 6 2 stmnt_map_entry_index fixed bin, /* index in stmnt map for this stmnt */ 5 7 2 instruction_ptr ptr, /* to last instruction executed */ 5 8 2 block_ptr ptr, /* to runtime_block node */ 5 9 2 stack_ptr ptr, /* to a stack frame */ 5 10 2 entry_ptr ptr, /* to entry seq. for this proc */ 5 11 2 seg_info_ptr ptr; /* to seg_info */ 5 12 5 13 dcl 1 current_source aligned like source_info based (probe_info.ptr_to_current_source); 5 14 dcl 1 initial_source aligned like source_info based (probe_info.ptr_to_initial_source); 5 15 5 16 /* END INCLUDE FILE ... probe_source_info.incl.pl1 */ 714 715 6 1 /* BEGIN INCLUDE FILE ... source_map.incl.pl1 */ 6 2 6 3 dcl 1 source_map aligned based, 6 4 2 version fixed bin, 6 5 2 number fixed bin, 6 6 2 map(n refer(source_map.number)) aligned, 6 7 3 pathname unaligned, 6 8 4 offset bit(18), 6 9 4 size bit(18), 6 10 3 uid bit(36), 6 11 3 dtm fixed bin(71); 6 12 6 13 /* END INCLUDE FILE ... source_map.incl.pl1 */ 716 717 7 1 dcl 1 statement_map aligned based, 7 2 2 location bit(18) unaligned, 7 3 2 source_id unaligned, 7 4 3 file bit(8), 7 5 3 line bit(14), 7 6 3 statement bit(5), 7 7 2 source_info unaligned, 7 8 3 start bit(18), 7 9 3 length bit(9); 718 719 720 721 end probe_source_segment_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/27/88 1225.2 probe_source_segment_.pl1 >spec>install>MR12.2-1194>probe_source_segment_.pl1 706 1 04/11/85 1452.6 access_mode_values.incl.pl1 >ldd>include>access_mode_values.incl.pl1 708 2 10/27/88 1223.7 probe_info.incl.pl1 >spec>install>MR12.2-1194>probe_info.incl.pl1 710 3 10/26/88 1255.5 probe_lang_types.incl.pl1 >ldd>include>probe_lang_types.incl.pl1 712 4 11/02/83 1845.0 probe_seg_info.incl.pl1 >ldd>include>probe_seg_info.incl.pl1 714 5 11/26/79 1320.6 probe_source_info.incl.pl1 >ldd>include>probe_source_info.incl.pl1 716 6 11/26/79 1320.6 source_map.incl.pl1 >ldd>include>source_map.incl.pl1 718 7 05/06/74 1751.6 statement_map.incl.pl1 >ldd>include>statement_map.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. FORTRAN_lang_type constant fixed bin(17,0) initial dcl 3-17 ref 548 560 NL constant char(1) initial packed unaligned dcl 590 ref 649 652 PASCAL_lang_type constant fixed bin(17,0) initial dcl 3-17 ref 548 PL1_lang_type constant fixed bin(17,0) initial dcl 3-17 ref 548 P_code parameter fixed bin(35,0) dcl 73 set ref 152 175* 176 238 245 257* 293 319* 397* 437* 498* 503* 510* 518* P_file_number parameter fixed bin(17,0) dcl 479 ref 475 485 487 P_len parameter fixed bin(35,0) dcl 536 ref 530 543 548 553 572 P_next_number parameter fixed bin(35,0) dcl 536 ref 530 554 P_number_to_list parameter fixed bin(17,0) dcl 73 ref 152 170 207 P_origin_source_info_ptr parameter pointer dcl 73 ref 152 238 245 293 475 497 P_probe_info_ptr parameter pointer dcl 73 ref 152 238 245 293 475 496 P_relocate parameter fixed bin(17,0) dcl 73 ref 238 245 265 283 283 288 P_search_string parameter char packed unaligned dcl 73 ref 293 316 327 328 TAB_BS 003166 constant char(2) initial packed unaligned dcl 144 ref 192 addr builtin function dcl 147 ref 164 222 226 226 387 387 393 393 addrel builtin function dcl 147 ref 387 387 393 393 608 address 000450 automatic fixed bin(21,0) dcl 677 set ref 690* 694 697* 697 699 702 based_string based char(1) dcl 97 set ref 183 192 222 431 559 binary builtin function dcl 147 ref 461 461 bitcount 000410 automatic fixed bin(24,0) dcl 585 set ref 613* 642 block_ptr 4 based pointer level 2 dcl 84 set ref 461* 464 break_line 120 based fixed bin(18,0) array level 3 in structure "seg_info" packed packed unsigned unaligned dcl 4-9 in procedure "probe_source_segment_" set ref 656* 659* 693 break_line 000454 automatic fixed bin(17,0) dcl 682 in procedure "line_start" set ref 693* 694 697 char 000401 automatic char(1) packed unaligned dcl 539 set ref 559* 561 561 565 char_count 000411 automatic fixed bin(21,0) dcl 586 set ref 642* 646 649 652 code 000127 automatic fixed bin(35,0) dcl 110 set ref 223* 224 224* 226* 360* 361 361* 387* 391 393* 396 425* divide builtin function dcl 147 ref 642 646 e_code parameter fixed bin(35,0) dcl 584 set ref 576 601* 613* 620 628* file 000451 automatic fixed bin(17,0) dcl 679 in procedure "line_start" set ref 688* 693 file 0(18) based bit(8) array level 3 in structure "map_array" packed packed unaligned dcl 114 in procedure "probe_source_segment_" set ref 171 207 357 423 688 file_number 000110 automatic fixed bin(17,0) dcl 94 set ref 171* 172 174 207 357* 423* 425 434 485* 487* 605 608 611 634 656 659 664 666 file_pointers 117 based pointer array level 3 packed packed unaligned dcl 4-9 set ref 605 634 664* 666 filep 000112 automatic pointer dcl 95 set ref 175* 183 192 222 360* 387* 393* 425* 431 559 find_source_file_$search_path 000114 constant entry external dcl 118 ref 613 fixed builtin function dcl 147 ref 171 207 213 213 262 339 357 373 378 383 404 423 429 429 611 688 689 690 found_start 000336 automatic fixed bin(21,0) dcl 306 set ref 387* 393* 405 405 410 hp 000342 automatic pointer dcl 451 set ref 459* 461* 470 i 000130 automatic fixed bin(17,0) dcl 111 in procedure "probe_source_segment_" set ref 183* 187 187* 191* 191* 192* 366* 367* 370* 402* 403* 404* 421* 423 428* 429 429 429* 441 i 000412 automatic fixed bin(21,0) dcl 587 in procedure "file_pointer" set ref 646* 647* i 000452 automatic fixed bin(17,0) dcl 680 in procedure "line_start" set ref 692* 693* index builtin function dcl 147 ref 183 192 431 649 652 info 000114 automatic pointer dcl 96 set ref 421 459 500* 501 507 514 547 602 605 608 634 656 659 664 666 687 693 instruction_ptr 2 based pointer level 2 dcl 84 set ref 470* io_switches 66 based structure level 2 dcl 2-18 ioa_$ioa_switch_nnl 000116 constant entry external dcl 121 ref 221 iox_$put_chars 000120 constant entry external dcl 122 ref 223 226 j 000131 automatic fixed bin(17,0) dcl 111 in procedure "probe_source_segment_" set ref 192* 194 196 200 367* 368 369 j 000413 automatic fixed bin(21,0) dcl 587 in procedure "file_pointer" set ref 645* 656 657* 657 659 k 000414 automatic fixed bin(21,0) dcl 587 set ref 649* 650 651 652* 653 lang 000400 automatic fixed bin(17,0) dcl 538 set ref 547* 548 548 548 560 language_type based fixed bin(17,0) level 2 dcl 4-9 ref 547 last_file_number 000124 automatic fixed bin(17,0) dcl 108 set ref 168* 172 174* 420* 425 434* last_source_index 000132 automatic fixed bin(17,0) dcl 111 set ref 370* 373 len 000376 automatic fixed bin(35,0) dcl 536 in procedure "get_stmt_length" set ref 553* 557 559 561 565 569* 569 len 000120 automatic fixed bin(35,0) dcl 104 in procedure "probe_source_segment_" set ref 213* 217 223 429* 431 length 1(27) based bit(9) array level 3 in structure "map_array" packed packed unaligned dcl 114 in procedure "probe_source_segment_" set ref 213 213 339 373 404 429 429 length builtin function dcl 147 in procedure "probe_source_segment_" ref 332 336 387 387 393 393 limit 000416 automatic fixed bin(21,0) dcl 587 in procedure "file_pointer" set ref 648* 649 651* 651 652 limit 000377 automatic fixed bin(35,0) dcl 536 in procedure "get_stmt_length" set ref 554* 557 line 000417 automatic fixed bin(17,0) dcl 588 in procedure "file_pointer" set ref 644* 650* 650 654* 656 line 0(26) based bit(14) array level 3 in structure "map_array" packed packed unaligned dcl 114 in procedure "probe_source_segment_" set ref 262 689 line_number parameter fixed bin(17,0) dcl 683 in procedure "line_start" ref 670 688 689 690 line_number 000104 automatic fixed bin(17,0) dcl 91 in procedure "probe_source_segment_" set ref 262* 265* 265 266 272* 276* listener_info 210 based structure level 2 dcl 2-18 loc 000341 automatic bit(18) packed unaligned dcl 448 set ref 458* 461 461 470 location based bit(18) array level 2 packed packed unaligned dcl 114 set ref 458 map 2 based structure array level 2 dcl 6-3 map_array based structure array level 1 dcl 114 set ref 164 map_size 000133 automatic fixed bin(21,0) dcl 117 in procedure "probe_source_segment_" set ref 160 255 283 339 339 342 346 357 366 377 381 402 415 514* map_size 110 based fixed bin(17,0) level 2 in structure "seg_info" dcl 4-9 in procedure "probe_source_segment_" ref 421 514 max builtin function dcl 540 in procedure "get_stmt_length" ref 559 max builtin function dcl 147 in procedure "probe_source_segment_" ref 378 383 min builtin function dcl 147 ref 357 mod builtin function dcl 149 ref 196 newline 000000 constant char(1) initial dcl 141 set ref 183 226 226 561 null builtin function dcl 149 ref 272 464 501 508 522 607 620 627 631 number 000116 automatic fixed bin(17,0) initial dcl 100 set ref 100* 170 171 178 207* 207 207 207 207* 213 213 213 213 230 offset 000121 automatic fixed bin(17,0) dcl 106 in procedure "probe_source_segment_" set ref 190* 194* 194 196* 196 196 200* 200 221* offset 2 based bit(18) array level 4 in structure "source_map" packed packed unaligned dcl 6-3 in procedure "probe_source_segment_" ref 608 origin_source_info based structure level 1 dcl 84 origin_source_info_ptr 000100 automatic pointer dcl 86 set ref 272 461 464 464* 470 471 497* 500 516 original_source_ptr 77 based pointer level 3 packed packed unaligned dcl 4-9 ref 602 osrc 000422 automatic pointer dcl 593 set ref 602* 608 611 output_switch 70 based pointer level 3 dcl 2-18 set ref 221* 223* 226* p 000122 automatic pointer dcl 107 set ref 222* 223* pathname 2 based structure array level 3 packed packed unaligned dcl 6-3 per_file 117 based structure array level 2 dcl 4-9 pointer builtin function dcl 149 ref 470 pointers 76 based structure level 2 dcl 4-9 position_lines 000102 automatic bit(1) dcl 88 set ref 241* 248* 261 285* previous_search_string 000010 internal static varying char(256) initial dcl 303 set ref 317 323 328* probe_error_ 000136 constant entry external dcl 136 ref 160 217 224 361 628 probe_error_$malfunction 000140 constant entry external dcl 137 ref 28 probe_error_$record 000142 constant entry external dcl 139 ref 267 276 probe_et_$bad_line 000124 external static fixed bin(35,0) dcl 128 set ref 160* 217* 257 503 probe_et_$no_saved_string 000126 external static fixed bin(35,0) dcl 128 ref 319 probe_et_$no_statement_map 000132 external static fixed bin(35,0) dcl 128 ref 510 probe_et_$recorded_message 000134 external static fixed bin(35,0) dcl 128 ref 518 probe_et_$string_search_failed 000130 external static fixed bin(35,0) dcl 128 ref 397 437 probe_find_location_ 000122 constant entry external dcl 125 ref 272 probe_info based structure level 1 dcl 2-18 probe_info_ptr 000344 automatic pointer dcl 2-86 set ref 160* 217* 221 223 224* 226 267* 272* 276* 361* 464* 496* 620 628* probe_stack_trace_$find_block_frame 000150 constant entry external dcl 455 ref 464 regexp_string 000235 automatic varying char(256) dcl 301 set ref 336* 387 387 387 387 393 393 393 393 relpath based char packed unaligned dcl 594 ref 613 relpath_ename 000430 automatic char(32) packed unaligned dcl 598 set ref 613* 628* relpath_l 000424 automatic fixed bin(17,0) dcl 596 set ref 611* 613 relpath_p 000426 automatic pointer dcl 597 set ref 608* 613 request_name 210 based varying char(32) level 3 dcl 2-18 ref 620 returns_ptr_sw 000103 automatic bit(1) dcl 90 set ref 156* 250* 312* 481* 522 reverse builtin function dcl 149 ref 183 rtrim builtin function dcl 149 ref 332 336 search_end 000337 automatic fixed bin(21,0) dcl 306 set ref 339* 346 365* 368 369* 373* 373 381 387* search_file_ 000144 constant entry external dcl 308 ref 387 393 search_start 000340 automatic fixed bin(21,0) dcl 306 set ref 343* 346* 354* 378* 381* 383* 387* 393 410* search_string 000134 automatic varying char(256) dcl 299 set ref 323* 327* 332 332 332 336 336 431 seg_info based structure level 1 dcl 4-9 seg_info_ptr 12 based pointer level 2 dcl 84 set ref 272* 500 size 2(18) based bit(18) array level 4 packed packed unaligned dcl 6-3 ref 611 smp 000106 automatic pointer dcl 93 in procedure "probe_source_segment_" set ref 164* 164 171 207 207 207 213 213 230 262 339 349 349 357 373 378 383 404 423 429 429 458 507* 508 smp 000456 automatic pointer dcl 684 in procedure "line_start" set ref 687* 688 689 690 source_id 0(18) based structure array level 2 packed packed unaligned dcl 114 set ref 207 207 230 source_info based structure level 1 dcl 5-5 in procedure "probe_source_segment_" source_info 1(09) based structure array level 2 in structure "map_array" packed packed unaligned dcl 114 in procedure "probe_source_segment_" set ref 349 349 source_line 000453 automatic fixed bin(17,0) dcl 681 set ref 689* 697 source_map based structure level 1 dcl 6-3 start 000415 automatic fixed bin(21,0) dcl 587 in procedure "file_pointer" set ref 647* 649 652 653* 653 start 1(09) based bit(18) array level 3 in structure "map_array" packed packed unaligned dcl 114 in procedure "probe_source_segment_" set ref 378 383 690 start 000117 automatic fixed bin(35,0) dcl 102 in procedure "probe_source_segment_" set ref 178* 183 183 187 191 213 222 428* 431 554 559 statement_map based structure level 1 dcl 7-1 statement_map_ptr 100 based pointer level 3 packed packed unaligned dcl 4-9 ref 507 687 statement_number 000105 automatic fixed bin(17,0) dcl 92 set ref 160 160 164 178 213 255 255 262 272* 275 283 283 288* 288 342 342 344* 346 349 349 349* 349 354 357 377 377 379* 381 383 415 415 415* 421 421 441* 458 471 516* stmnt_map_entry_index based fixed bin(17,0) level 2 dcl 84 set ref 471* 516 stmt_len 000125 automatic fixed bin(21,0) dcl 109 set ref 404* 405 stmt_start 000126 automatic fixed bin(21,0) dcl 109 set ref 403* 405 405 string based char packed unaligned dcl 589 in procedure "file_pointer" ref 649 652 string builtin function dcl 149 in procedure "probe_source_segment_" ref 207 207 230 stu_$find_containing_block 000146 constant entry external dcl 452 ref 461 substr builtin function dcl 149 ref 183 192 222 332 332 336 431 559 649 652 symbol_header_ptr 76 based pointer level 3 packed packed unaligned dcl 4-9 ref 459 608 try 000420 automatic pointer dcl 592 set ref 605* 607 613* 627 634 649 652 664 unspec builtin function dcl 149 ref 349 349 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ALGOL68_lang_type internal static fixed bin(17,0) initial dcl 3-17 ALM_lang_type internal static fixed bin(17,0) initial dcl 3-17 A_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 A_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 COBOL_lang_type internal static fixed bin(17,0) initial dcl 3-17 C_lang_type internal static fixed bin(17,0) initial dcl 3-17 DIR_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 1-33 E_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 E_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 M_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 M_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 N_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 N_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 OTHER_lang_type internal static fixed bin(17,0) initial dcl 3-17 REW_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 REW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RE_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 RE_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RW_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 RW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 R_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 R_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SA_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SEG_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 1-30 SMA_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SMA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SM_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SM_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 S_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 S_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 UNKNOWN_lang_type internal static fixed bin(17,0) initial dcl 3-17 W_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 W_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 current_source based structure level 1 dcl 5-13 expression_area based area(1024) dcl 2-95 initial_source based structure level 1 dcl 5-14 official_language_names internal static char(32) initial array packed unaligned dcl 3-27 palatable_language_names internal static char(32) initial array packed unaligned dcl 3-30 probe_area based area(1024) dcl 2-93 probe_info_version internal static fixed bin(17,0) initial dcl 2-88 probe_info_version_1 internal static fixed bin(17,0) initial dcl 2-90 scratch_area based area(1024) dcl 2-92 seg_info_nfiles automatic fixed bin(17,0) dcl 4-47 work_area based area(1024) dcl 2-94 NAMES DECLARED BY EXPLICIT CONTEXT. CALCULATE_BLOCK_ETC 001704 constant label dcl 448 ref 291 444 FOUND_STRING 001701 constant label dcl 441 ref 405 431 MAIN_RETURN 002045 constant label dcl 527 ref 172 176 230 236 398 439 473 520 POSITION 000660 constant label dcl 250 ref 242 POSITION_LINES 000675 constant label dcl 262 ref 286 RECORDED_MESSAGE 002024 constant label dcl 518 ref 269 278 SEARCH 001403 constant label dcl 387 ref 411 SOME_ERROR 002031 constant label dcl 522 ref 258 321 504 511 common_setup 002054 constant entry internal dcl 490 ref 158 253 314 483 file_pointer 002235 constant entry internal dcl 576 ref 175 360 425 488 find_source 001060 constant entry external dcl 293 get_file_ptr 001766 constant entry external dcl 475 get_stmt_length 002116 constant entry internal dcl 530 ref 213 429 line_start 002722 constant entry internal dcl 670 ref 178 213 339 343 354 367 403 428 554 list_statement 000130 constant entry external dcl 152 position_source 000632 constant entry external dcl 238 position_source_lines 000646 constant entry external dcl 245 probe_source_segment_ 000105 constant entry external dcl 25 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3500 3652 3176 3510 Length 4240 3176 152 351 301 102 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME probe_source_segment_ 512 external procedure is an external procedure. common_setup internal procedure shares stack frame of external procedure probe_source_segment_. get_stmt_length internal procedure shares stack frame of external procedure probe_source_segment_. file_pointer internal procedure shares stack frame of external procedure probe_source_segment_. line_start internal procedure shares stack frame of external procedure probe_source_segment_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 previous_search_string probe_source_segment_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME probe_source_segment_ 000100 origin_source_info_ptr probe_source_segment_ 000102 position_lines probe_source_segment_ 000103 returns_ptr_sw probe_source_segment_ 000104 line_number probe_source_segment_ 000105 statement_number probe_source_segment_ 000106 smp probe_source_segment_ 000110 file_number probe_source_segment_ 000112 filep probe_source_segment_ 000114 info probe_source_segment_ 000116 number probe_source_segment_ 000117 start probe_source_segment_ 000120 len probe_source_segment_ 000121 offset probe_source_segment_ 000122 p probe_source_segment_ 000124 last_file_number probe_source_segment_ 000125 stmt_len probe_source_segment_ 000126 stmt_start probe_source_segment_ 000127 code probe_source_segment_ 000130 i probe_source_segment_ 000131 j probe_source_segment_ 000132 last_source_index probe_source_segment_ 000133 map_size probe_source_segment_ 000134 search_string probe_source_segment_ 000235 regexp_string probe_source_segment_ 000336 found_start probe_source_segment_ 000337 search_end probe_source_segment_ 000340 search_start probe_source_segment_ 000341 loc probe_source_segment_ 000342 hp probe_source_segment_ 000344 probe_info_ptr probe_source_segment_ 000376 len get_stmt_length 000377 limit get_stmt_length 000400 lang get_stmt_length 000401 char get_stmt_length 000410 bitcount file_pointer 000411 char_count file_pointer 000412 i file_pointer 000413 j file_pointer 000414 k file_pointer 000415 start file_pointer 000416 limit file_pointer 000417 line file_pointer 000420 try file_pointer 000422 osrc file_pointer 000424 relpath_l file_pointer 000426 relpath_p file_pointer 000430 relpath_ename file_pointer 000450 address line_start 000451 file line_start 000452 i line_start 000453 source_line line_start 000454 break_line line_start 000456 smp line_start THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp unpk_to_pk call_ext_out_desc call_ext_out return_mac mpfx2 mdfx1 signal_op shorten_stack ext_entry ext_entry_desc set_chars_eis index_chars_eis real_to_real_truncatdivide_fx2 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. decimal_exp_ find_source_file_$search_path ioa_$ioa_switch_nnl iox_$put_chars probe_error_ probe_error_$malfunction probe_error_$record probe_find_location_ probe_stack_trace_$find_block_frame search_file_ stu_$find_containing_block THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. probe_et_$bad_line probe_et_$no_saved_string probe_et_$no_statement_map probe_et_$recorded_message probe_et_$string_search_failed LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 100 000100 25 000104 28 000115 152 000122 156 000140 158 000141 160 000142 164 000173 168 000200 170 000202 171 000206 172 000215 174 000217 175 000220 176 000230 178 000233 183 000244 187 000266 190 000271 191 000272 192 000306 194 000321 196 000324 200 000337 202 000343 207 000345 212 000410 213 000412 217 000444 221 000472 222 000516 223 000524 224 000544 226 000573 230 000615 234 000626 236 000627 238 000630 241 000642 242 000643 245 000644 248 000656 250 000660 253 000661 255 000662 257 000666 258 000672 261 000673 262 000675 265 000705 266 000710 267 000713 269 000740 272 000741 275 000776 276 001001 278 001035 280 001036 283 001037 285 001045 286 001047 288 001050 291 001052 293 001053 312 001076 314 001077 316 001100 317 001107 319 001115 321 001117 323 001120 324 001125 327 001126 328 001136 332 001147 336 001173 339 001203 342 001217 343 001224 344 001230 345 001231 346 001232 349 001236 354 001253 357 001260 360 001274 361 001276 365 001315 366 001316 367 001325 368 001331 369 001333 370 001334 372 001336 373 001340 377 001350 378 001355 379 001364 380 001365 381 001366 383 001372 387 001403 391 001444 393 001446 396 001514 397 001516 398 001522 402 001523 403 001533 404 001535 405 001543 408 001552 410 001554 411 001557 415 001560 420 001566 421 001570 423 001603 425 001613 428 001617 429 001624 431 001637 434 001652 435 001654 437 001674 439 001700 441 001701 444 001703 458 001704 459 001712 461 001715 464 001733 470 001751 471 001756 473 001760 475 001761 481 001775 483 001777 485 002000 487 002006 488 002007 518 002024 520 002030 522 002031 527 002045 490 002054 496 002055 497 002061 498 002064 500 002065 501 002067 503 002073 504 002076 507 002077 508 002101 510 002105 511 002110 514 002111 516 002113 517 002115 530 002116 543 002120 547 002124 548 002126 553 002137 554 002141 557 002153 559 002157 560 002200 561 002203 564 002214 565 002215 569 002224 570 002230 572 002231 576 002235 601 002237 602 002240 605 002243 607 002250 608 002255 611 002267 613 002272 620 002345 627 002362 628 002366 631 002417 634 002423 642 002431 644 002434 645 002436 646 002437 647 002475 648 002527 649 002553 650 002567 651 002574 652 002576 653 002612 654 002613 656 002615 657 002634 658 002635 659 002637 664 002706 666 002713 670 002722 687 002724 688 002727 689 002737 690 002744 692 002750 693 002755 694 002772 697 002777 699 003031 701 003035 702 003037 ----------------------------------------------------------- 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