COMPILATION LISTING OF SEGMENT probe_block_name_ Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 10/27/88 1240.5 mst Thu Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 /****^ HISTORY COMMENTS: 14* 1) change(88-09-07,WAAnderson), approve(88-09-30,MCR7952), 15* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 16* Added format control comment to make the source more readable. 17* 2) change(88-10-19,WAAnderson), approve(88-10-19,MCR7952), 18* audit(88-10-25,RWaters), install(88-10-27,MR12.2-1194): 19* Modified to support C. We don't use 'ep', just 'bp'. The code 20* written for the other languages is poorly written and doesn't lend 21* itself well to the needs of C so a new block of code was written 22* exclusively for C. 23* END HISTORY COMMENTS */ 24 25 /* format: style1,insnl,ifthendo,indthenelse,^indnoniterdo,^inditerdo,indcom,^indthenbegin,^indprocbody,ind2,ll78,initcol0,dclind4,idind24,struclvlind1,comcol41 */ 26 27 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 28 29 probe_block_name_: 30 proc (P_probe_info_ptr, P_source_info_ptr, P_longp) 31 returns (char (256) varying); 32 33 /* Given a block as defined by the source_info block pointed to by */ 34 /* P_source_info_ptr, return its name in one of the following */ 35 /* formats: */ 36 /* */ 37 /* segname$entryname for an external entry. */ 38 /* $entryname in segname for an internal proc. */ 39 /* Block at line NN in segname$entryname for a begin block where */ 40 /* line number is known. */ 41 /* Block at segname|NNNNNN in entryname for a begin block of */ 42 /* unknown line number. */ 43 /* */ 44 /* We use the following components of source_info: */ 45 /* */ 46 /* block pointer (if available) */ 47 /* entry pointer (except for quick begin blocks) */ 48 /* seg_info (to get the segname) */ 49 /* */ 50 /* The entryname portion of seg_info is not used, because there is */ 51 /* only one seg_info for a given external procedure, and we might */ 52 /* be interested in one of its entry points other than the main */ 53 /* one. */ 54 /* */ 55 /* James R. Davis 12 July 79 */ 56 57 /* 10/21/82, S.Herbst, */ 58 /* Changed to print entry point name of ext proc if different from */ 59 /* segname. */ 60 /* 06/??/83, JMAthane, */ 61 /* Changed to handle PASCAL with blocks. */ 62 /* 08/26/83, S.Herbst, */ 63 /* Implemented P_longp to return full pathnames. */ 64 /* 02/14/84, S.Herbst, */ 65 /* Fixed to work on hardcore segments. */ 66 /* 05/29/84, S.Herbst, */ 67 /* Fixed bug sometimes causing foo$bar$foo$baz, also garbage names.*/ 68 /* 05/29/84, S. Herbst, */ 69 /* Fixed to detect ext entry points in lang's other than PL/1 */ 70 /* (runtime_block.type="01"b3). */ 71 72 dcl P_probe_info_ptr ptr parameter; 73 /* Input: only used because subrs we call use it */ 74 dcl P_source_info_ptr ptr parameter; 75 /* to callers source info */ 76 dcl P_longp bit (1) aligned parameter; 77 /* Input: return full pathnames */ 78 79 dcl ret_string char (256) varying; 80 /* what we return */ 81 82 dcl source_info_ptr ptr; 83 84 dcl 1 callers_source aligned like source_info 85 based (source_info_ptr); 86 87 dcl bp ptr; /* copy of block_ptr */ 88 dcl ep ptr; /* cop of entry ptr */ 89 dcl sip ptr; /* ptr to seg_info */ 90 dcl p ptr; /* temp ptr */ 91 dcl (file, line, stmt) fixed bin;/* from statement_map entry */ 92 dcl whole_name char (256); 93 dcl segment_pathname char (168); 94 dcl ext_entry_name char (72); 95 dcl proc_name char (32); 96 97 dcl format_pointer_$its entry (ptr, bit (1) aligned, ptr) 98 returns (char (256) varying); 99 dcl ioa_$rsnnl entry options (variable); 100 dcl get_entry_name_ entry (ptr, char (*), fixed bin (18), 101 char (8) aligned, fixed bin (35)); 102 dcl pathname_ entry (char (*), char (*)) returns (char (168)); 103 dcl code fixed bin (35); 104 105 dcl (addrel, after, before, fixed, index, ltrim, null, rel, rtrim, 106 substr) builtin; 107 108 probe_info_ptr = P_probe_info_ptr; 109 source_info_ptr = P_source_info_ptr; 110 bp = callers_source.block_ptr; 111 ep = callers_source.entry_ptr; 112 113 sip = callers_source.seg_info_ptr; 114 115 ext_entry_name = ""; 116 ret_string = ""; 117 segment_pathname = ""; 118 if (probe_info.language_type = C_lang_type) then do; 119 if P_longp 120 then 121 segment_pathname = 122 pathname_ (sip -> seg_info.directory_name, 123 sip -> seg_info.entry_name); 124 else segment_pathname = sip -> seg_info.entry_name; 125 if bp ^= null () then do; 126 if bp -> runtime_block.name then do; 127 p = addrel (bp, bp -> runtime_block.name); 128 ret_string = p -> acc.string; 129 ret_string = 130 before (ret_string, "$") || " in " 131 || rtrim (segment_pathname); 132 return (ret_string); 133 end; /* named proc */ 134 else do; /* is a begin block */ 135 ret_string = sip -> seg_info.entry_name; 136 if bp -> runtime_block.first ^= "0"b 137 then do; /* have statement map */ 138 p = addrel (bp, bp -> runtime_block.first); 139 /* pt to statement_map entry */ 140 141 file = fixed (p -> statement_map.file, 8); 142 line = fixed (p -> statement_map.line, 14); 143 stmt = fixed (p -> statement_map.statement, 5); 144 145 call ioa_$rsnnl ( 146 "Block at line ^[^d-^;^s^]^d^[,^d^;^s^] of ^a", 147 ret_string, (0), 148 file > 0, file, line, stmt > 1, stmt, 149 rtrim (segment_pathname)); 150 return (ret_string); 151 end; /* begin block with line */ 152 end; /* begin-block */ 153 end; /* using bp */ 154 end; 155 156 if P_longp then do; 157 whole_name, segment_pathname = 158 pathname_ (sip -> seg_info.directory_name, 159 sip -> seg_info.entry_name); 160 proc_name = sip -> seg_info.segname; 161 if proc_name ^= sip -> seg_info.entry_name 162 then /* bound component ... unless language is C */ 163 whole_name = 164 rtrim (sip -> seg_info.segname) || " in " 165 || segment_pathname; 166 end; 167 else do; 168 whole_name, proc_name = sip -> seg_info.segname; 169 if whole_name = "" /* is this possible */ 170 then whole_name = sip -> seg_info.entry_name; 171 end; 172 if whole_name = "" /* what still?? */ 173 then whole_name = "<>"; 174 175 if bp ^= null () 176 then do; 177 /* first look for containing block if PASCAL with block */ 178 if bp -> symbol_block.type = PASCAL_WITH_BLOCK 179 then 180 bp = addrel (bp, bp -> symbol_block.owner); 181 if bp -> runtime_block.name /* a proc, may be internal or external */ 182 then do; 183 p = addrel (bp, bp -> runtime_block.name); 184 ret_string = p -> acc.string; 185 ret_string = before (ret_string, "$"); 186 /* just the segment name */ 187 if P_longp 188 then 189 if ret_string = proc_name 190 then ret_string = whole_name; 191 /* external procedure ... all external in C */ 192 else ret_string = 193 ret_string || " in " || rtrim (whole_name); 194 /* internal procedure */ 195 if (bp -> runtime_block.father = "777421"b3 196 | bp -> runtime_block.type = "01"b3) 197 then 198 /* external entry point */ 199 if ep ^= null then do; 200 call get_entry_name_ (ep, ext_entry_name, 0, "", code); 201 if index (ext_entry_name, "$") ^= 0 202 then /* just the entry point name */ 203 ext_entry_name = after (ext_entry_name, "$"); 204 if code = 0 & ext_entry_name ^= ret_string 205 then 206 if P_longp 207 then 208 if sip -> seg_info.segname 209 ^= sip -> seg_info.entry_name 210 then /* bound comp */ 211 ret_string = 212 rtrim (sip -> seg_info.segname) 213 || "$" || 214 rtrim (ext_entry_name) 215 || " in " || segment_pathname; 216 else ret_string = 217 rtrim (segment_pathname) 218 || "$" 219 || rtrim (ext_entry_name); 220 else ret_string = 221 ret_string || "$" 222 || rtrim (ext_entry_name); 223 end; 224 end; /* named proc */ 225 else do; /* is a begin block */ 226 if bp -> runtime_block.first ^= "0"b 227 then do; /* have statement map */ 228 p = addrel (bp, bp -> runtime_block.first); 229 /* pt to statement_map entry */ 230 231 file = fixed (p -> statement_map.file, 8); 232 line = fixed (p -> statement_map.line, 14); 233 stmt = fixed (p -> statement_map.statement, 5); 234 235 call ioa_$rsnnl ("Block at line ^[^d-^;^s^]^d^[,^d^;^s^] of ^a", 236 ret_string, (0), 237 file > 0, file, line, stmt > 1, stmt, 238 whole_name); 239 end; /* begin block with line */ 240 else do; 241 call ioa_$rsnnl ("Block at ^a|^o", ret_string, (0), 242 whole_name, 243 fixed (rel (ep), 18)); 244 end; /* begin block with offset */ 245 end; /* begin-block */ 246 end; /* using bp */ 247 else if ep ^= null () 248 then do; 249 if is_begin_block (ep) 250 then do; 251 call ioa_$rsnnl ("Block at ^a|^o", ret_string, (0), 252 whole_name, 253 fixed (rel (ep), 18)); 254 end; /* begin-block */ 255 else do; 256 dcl entry_point_name char (32); 257 call get_entry_name_ (ep, entry_point_name, (0), (""), code); 258 if code = 0 259 then 260 if P_longp 261 then ret_string = 262 rtrim (whole_name) || "$" 263 || rtrim (entry_point_name); 264 else ret_string = rtrim (entry_point_name); 265 else do; 266 ret_string = format_pointer_$its (ep, "1"b, null); 267 ret_string = 268 ltrim (substr (ret_string, index (ret_string, " "))); 269 end; 270 end; /* proc using ep */ 271 end; /* trying to use ep */ 272 else ret_string = rtrim (whole_name); /* have no info, so I doubt this will help */ 273 274 return (ret_string); 275 276 277 278 279 is_begin_block: 280 proc (tp) returns (bit (1) aligned); 281 282 283 dcl tp ptr parameter; 284 dcl cp ptr; 285 dcl iword bit (36) aligned based (cp); 286 dcl i fixed bin; 287 dcl (addrel, hbound) builtin; 288 289 cp = addrel (tp, 1); /* point to first instruction */ 290 do i = 1 to hbound (begin_block_entries, 1); 291 if iword = begin_block_entries (i) /* matches */ 292 then return ("1"b); 293 end; 294 return ("0"b); 295 1 1 /* BEGIN INCLUDE FILE ... begin_block_entries */ 1 2 1 3 dcl begin_block_entries (2) bit (36) aligned static internal options (constant) init 1 4 ("000614272100"b3, /* tsp2 pr0|614 enter_begin_block */ 1 5 "001376272100"b3 /* tsp2 pr0|1376 ss_enter_begin_block */); 1 6 1 7 /* END INCLUDE FILE ... begin_block_entries */ 296 297 298 end is_begin_block; 299 2 1 /* BEGIN INCLUDE FILE ... probe_source_info.incl.pl1 2 2* 2 3* James R. Davis 2 July 79 */ 2 4 2 5 dcl 1 source_info based aligned, 2 6 2 stmnt_map_entry_index fixed bin, /* index in stmnt map for this stmnt */ 2 7 2 instruction_ptr ptr, /* to last instruction executed */ 2 8 2 block_ptr ptr, /* to runtime_block node */ 2 9 2 stack_ptr ptr, /* to a stack frame */ 2 10 2 entry_ptr ptr, /* to entry seq. for this proc */ 2 11 2 seg_info_ptr ptr; /* to seg_info */ 2 12 2 13 dcl 1 current_source aligned like source_info based (probe_info.ptr_to_current_source); 2 14 dcl 1 initial_source aligned like source_info based (probe_info.ptr_to_initial_source); 2 15 2 16 /* END INCLUDE FILE ... probe_source_info.incl.pl1 */ 300 301 3 1 /* BEGIN INCLUDE FILE ... probe_seg_info.incl.pl1 3 2* 3 3* 25 June 79 JRDavis 3 4* 3 5* Modified 7 April 1983, TO - Add fields for character offset/line 3 6* correction per file. 3 7**/ 3 8 3 9 dcl 1 seg_info based aligned, /* place to remember information about object seg */ 3 10 2 language_type fixed bin, /* language of source program */ 3 11 2 bits aligned, 3 12 3 ignore_case bit (1) unal, 3 13 3 bound_segment bit (1) unaligned, 3 14 3 component bit (1) unaligned, 3 15 3 pad bit (33) unal, 3 16 2 names, /* where to find it */ 3 17 3 directory_name character (168) unal, /* what directory */ 3 18 3 entry_name character (32) unal, /* what segment */ 3 19 3 segname character (32) unal, /* procedure segname definition */ 3 20 2 identifier fixed bin (71), /* time of object creation */ 3 21 2 pointers, /* location of various parts of segment */ 3 22 3 symbol_header_ptr ptr unal, /* to symbol section */ 3 23 3 original_source_ptr ptr unal, /* to segment source map */ 3 24 3 statement_map_ptr ptr unal, /* to segment statement map */ 3 25 3 break_info ptr unal, /* for unbound segments, and start of chain for 3 26* bound ones, -> break_map !obsolete, I think! */ 3 27 3 chain ptr unal, /* to entry for next component if bound */ 3 28 3 linkage_ptr ptr unal, /* to linkage section */ 3 29 2 bounds aligned, /* structure of bounds information */ 3 30 3 text_bounds, 3 31 4 start fixed bin (35), 3 32 4 end fixed bin (35), 3 33 3 symbol_bounds, 3 34 4 start fixed bin (35), 3 35 4 end fixed bin (35), 3 36 2 map_size fixed bin, /* size of statement map */ 3 37 2 error_code fixed bin (35), /* errors encoutered while getting info, are recorded here */ 3 38 2 bound_create_time fixed bin (71), /* time seg containing was bound or compiled. */ 3 39 2 bound_sym_header ptr unal, /* to sym. section header for bound seg */ 3 40 2 pad (1) fixed bin (35), 3 41 3 42 2 nfiles fixed bin, 3 43 2 per_file (seg_info_nfiles refer (seg_info.nfiles)), 3 44 3 file_pointers ptr unal, 3 45 3 break_line (0:3) fixed bin (18) unsigned unaligned; 3 46 3 47 dcl seg_info_nfiles fixed bin; /* for allocation purposes */ 3 48 3 49 3 50 /* END INCLUDE FILE ... probe_seg_info.incl.pl1 */ 302 303 4 1 dcl 1 statement_map aligned based, 4 2 2 location bit(18) unaligned, 4 3 2 source_id unaligned, 4 4 3 file bit(8), 4 5 3 line bit(14), 4 6 3 statement bit(5), 4 7 2 source_info unaligned, 4 8 3 start bit(18), 4 9 3 length bit(9); 304 305 5 1 /* BEGIN INCLUDE FILE --- acc.incl.pl1 5 2* 5 3*James R. Davis 21 Nov 78 5 4**/ 5 5 5 6 dcl 1 acc based aligned, 5 7 2 num_chars fixed bin (9) unsigned unaligned, 5 8 2 string char (0 refer (acc.num_chars)) unaligned; 5 9 5 10 /* END INCLUDE FILE --- acc.incl.pl1 */ 306 307 6 1 /* BEGIN INCLUDE FILE ... runtime_symbol_block.incl.pl1 */ 6 2 6 3 /* copied from runtime_symbol.incl.pl1 and updated January 1983 by Melanie Weaver */ 6 4 6 5 dcl 1 symbol_block aligned based, 6 6 2 flag unal bit (1), /* always "1"b for Version II */ 6 7 2 quick unal bit (1), /* "1"b if quick block */ 6 8 2 fortran unal bit (1), /* "1"b if fortran program */ 6 9 2 standard unal bit (1), /* "1"b if program has std obj segment */ 6 10 2 owner_flag unal bit (1), /* "1"b if block has valid owner field */ 6 11 2 skip unal bit (1), 6 12 2 type unal fixed bin (6) unsigned, /* = 0 for a block node */ 6 13 2 number unal fixed bin (6) unsigned, /* begin block number */ 6 14 2 start unal fixed bin (18) unsigned, /* rel ptr to start of symbols */ 6 15 2 name unal fixed bin (18) unsigned, /* rel ptr to name of proc */ 6 16 2 brother unal fixed bin (18) unsigned, /* rel ptr to brother block */ 6 17 2 father unal fixed bin (18) unsigned, /* rel ptr to father block */ 6 18 2 son unal fixed bin (18) unsigned, /* rel ptr to son block */ 6 19 2 map unal, 6 20 3 first fixed bin (18) unsigned,/* rel ptr to first word of map */ 6 21 3 last fixed bin (18) unsigned,/* rel ptr to last word of map */ 6 22 2 entry_info unal fixed bin (18) unsigned, /* info about entry of quick block */ 6 23 2 header unal fixed bin (18) unsigned, /* rel ptr to symbol header */ 6 24 2 chain (4) unal fixed bin (18) unsigned, /* chain(i) is rel ptr to first symbol 6 25* on start list with length >= 2**i */ 6 26 2 token (0:5) unal fixed bin (18) unsigned, /* token(i) is rel ptr to first token 6 27* on list with length >= 2 ** i */ 6 28 2 owner unal fixed bin (18) unsigned; /* rel ptr to owner block */ 6 29 6 30 dcl 1 with_symbol_block aligned based, /* version for PASCAL with blocks (type = 5) */ 6 31 2 common_block_info aligned like symbol_block, 6 32 2 with_string unal fixed bin (18) unsigned, 6 33 /* rel ptr to string used in with statement */ 6 34 2 real_level_1 unal fixed bin (18) unsigned; 6 35 /* rel ptr to original level 1 record node */ 6 36 6 37 dcl 1 symbol_token aligned based, 6 38 2 next unal fixed bin (18) unsigned, /* rel ptr to next token */ 6 39 2 dcl unal fixed bin (18) unsigned, /* rel ptr to first dcl of this token */ 6 40 2 name, /* ACC */ 6 41 3 size unal unsigned fixed bin (9), /* number of chars in token */ 6 42 3 string unal char (name_size refer (symbol_token.size)); 6 43 6 44 dcl name_size fixed bin (9) unsigned; /* number of chars in token */ 6 45 6 46 /* END INCLUDE FILE ... runtime_symbol_block.incl.pl1 */ 308 309 7 1 7 2 /* BEGIN INCLUDE FILE runtime_block_type.incl.pl1 */ 7 3 7 4 /* Created 1983 by JMAthane */ 7 5 /* modified October 1983 by M. Weaver */ 7 6 /* This include file contains the defined values for symbol_block.type. 7 7* As of 10/83, these values are used only by Pascal */ 7 8 7 9 dcl (EXTERNAL_ENTRY init (1), 7 10 NON_QUICK_INTERNAL_PROCEDURE init (2), 7 11 QUICK_INTERNAL_PROCEDURE init (3), 7 12 BEGIN_BLOCK init (4), 7 13 PASCAL_WITH_BLOCK init (5)) fixed bin int static options (constant); 7 14 7 15 /* END INCLUDE FILE runtime_block_type.incl.pl1 */ 7 16 310 311 8 1 /* BEGIN INCLUDE FILE ... runtime_symbol.incl.pl1 ... Modified 07/79 */ 8 2 8 3 dcl 1 runtime_symbol aligned based, 8 4 2 flag unal bit(1), /* always "1"b for Version II */ 8 5 2 use_digit unal bit(1), /* if "1"b and units are half words units are really digits */ 8 6 2 array_units unal bit(2), 8 7 2 units unal bit(2), /* addressing units */ 8 8 2 type unal bit(6), /* data type */ 8 9 2 level unal bit(6), /* structure level */ 8 10 2 ndims unal bit(6), /* number of dimensions */ 8 11 2 bits unal, 8 12 3 aligned bit(1), 8 13 3 packed bit(1), 8 14 3 simple bit(1), 8 15 2 skip unal bit(1), 8 16 2 scale unal bit(8), /* arithmetic scale factor */ 8 17 2 name unal bit(18), /* rel ptr to acc name */ 8 18 2 brother unal bit(18), /* rel ptr to brother entry */ 8 19 2 father unal bit(18), /* rel ptr to father entry */ 8 20 2 son unal bit(18), /* rel ptr to son entry */ 8 21 2 address unal, 8 22 3 location bit(18), /* location in storage class */ 8 23 3 class bit(4), /* storage class */ 8 24 3 next bit(14), /* rel ptr to next of same class */ 8 25 2 size fixed bin(35), /* encoded string|arith size */ 8 26 2 offset fixed bin(35), /* encoded offset from address */ 8 27 2 virtual_org fixed bin(35), 8 28 2 bounds(1), 8 29 3 lower fixed bin(35), /* encoded lower bound */ 8 30 3 upper fixed bin(35), /* encoded upper bound */ 8 31 3 multiplier fixed bin(35); /* encoded multiplier */ 8 32 8 33 dcl 1 runtime_bound based, 8 34 2 lower fixed bin(35), 8 35 2 upper fixed bin(35), 8 36 2 multiplier fixed bin(35); 8 37 8 38 dcl 1 runtime_block aligned based, 8 39 2 flag unal bit(1), /* always "1"b for Version II */ 8 40 2 quick unal bit(1), /* "1"b if quick block */ 8 41 2 fortran unal bit(1), /* "1"b if fortran program */ 8 42 2 standard unal bit(1), /* "1"b if program has std obj segment */ 8 43 2 owner_flag unal bit(1), /* "1"b if block has valid owner field */ 8 44 2 skip unal bit(1), 8 45 2 type unal bit(6), /* = 0 for a block node */ 8 46 2 number unal bit(6), /* begin block number */ 8 47 2 start unal bit(18), /* rel ptr to start of symbols */ 8 48 2 name unal bit(18), /* rel ptr to name of proc */ 8 49 2 brother unal bit(18), /* rel ptr to brother block */ 8 50 2 father unal bit(18), /* rel ptr to father block */ 8 51 2 son unal bit(18), /* rel ptr to son block */ 8 52 2 map unal, 8 53 3 first bit(18), /* rel ptr to first word of map */ 8 54 3 last bit(18), /* rel ptr to last word of map */ 8 55 2 entry_info unal bit(18), /* info about entry of quick block */ 8 56 2 header unal bit(18), /* rel ptr to symbol header */ 8 57 2 chain(4) unal bit(18), /* chain(i) is rel ptr to first symbol 8 58* on start list with length >= 2**i */ 8 59 2 token(0:5) unal bit(18), /* token(i) is rel ptr to first token 8 60* on list with length >= 2 ** i */ 8 61 2 owner unal bit(18); /* rel ptr to owner block */ 8 62 8 63 dcl 1 runtime_token aligned based, 8 64 2 next unal bit(18), /* rel ptr to next token */ 8 65 2 dcl unal bit(18), /* rel ptr to first dcl of this token */ 8 66 2 name, /* ACC */ 8 67 3 size unal unsigned fixed bin (9), /* number of chars in token */ 8 68 3 string unal char(n refer(runtime_token.size)); 8 69 8 70 dcl 1 encoded_value aligned based, 8 71 2 flag bit (2) unal, 8 72 2 code bit (4) unal, 8 73 2 n1 bit (6) unal, 8 74 2 n2 bit (6) unal, 8 75 2 n3 bit (18) unal; 8 76 8 77 /* END INCLUDE FILE ... runtime_symbol.incl.pl1 */ 312 313 9 1 /* BEGIN INCLUDE FILE ... probe_lang_types.incl.pl1 9 2* 9 3* JRD 26 June 79 9 4* MBW 31 July 1981 to add algol68 */ 9 5 9 6 9 7 /****^ HISTORY COMMENTS: 9 8* 1) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 9 9* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 9 10* Added C Language type. 9 11* END HISTORY COMMENTS */ 9 12 9 13 9 14 /* Modified June 83 JMAthane to add PASCAL language type */ 9 15 /* Modified April 88 Hinatsu to add C language type */ 9 16 9 17 dcl (UNKNOWN_lang_type init (1), 9 18 OTHER_lang_type init (2), 9 19 PL1_lang_type init (3), 9 20 FORTRAN_lang_type init (4), 9 21 COBOL_lang_type init (5), 9 22 ALM_lang_type init (6), 9 23 ALGOL68_lang_type init (7), 9 24 PASCAL_lang_type init (8), 9 25 C_lang_type init (9)) fixed bin internal static options (constant); 9 26 9 27 dcl official_language_names (9) char (32) internal static options (constant) init 9 28 ("Unknown", "other", "PL/I", "FORTRAN", "COBOL", "ALM", "Algol 68", "Pascal", "C"); 9 29 9 30 dcl palatable_language_names (9) char (32) internal static options (constant) init 9 31 ("Unknown", "Other", "pl1", "fortran", "cobol", "alm", "algol68", "pascal", "c"); 9 32 9 33 /* END INCLUDE FILE ... probe_lang_types.incl.pl1 */ 314 10 1 /* BEGIN INCLUDE FILE probe_info.incl.pl1 */ 10 2 10 3 10 4 10 5 /****^ HISTORY COMMENTS: 10 6* 1) change(88-10-24,WAAnderson), approve(88-10-24,MCR7952), 10 7* audit(88-10-24,RWaters), install(88-10-27,MR12.2-1194): 10 8* Added field 'retry_using_main' to add new C feature. 10 9* END HISTORY COMMENTS */ 10 10 10 11 10 12 /* Created: 04/22/79 W. Olin Sibert, from subsystem_info 10 13* Modified: 22 Sept 79 JRd to remove: default (ptr & (auto|based)) init (null ()); 10 14* Added flags.setting_break 08/22/83 Steve Herbst 10 15* Added flags.executing_quit_request 01/15/85 Steve Herbst 10 16**/ 10 17 10 18 dcl 1 probe_info aligned based (probe_info_ptr), /* standard data for a probe invocation */ 10 19 2 probe_info_version fixed bin, /* version of this structure */ 10 20 10 21 2 static_info_ptr pointer unaligned, /* pointer to static information structure */ 10 22 2 modes_ptr pointer unaligned, /* pointer to probe_modes structure */ 10 23 10 24 2 ptr_to_current_source ptr, /* current_source is based on this */ 10 25 2 ptr_to_initial_source ptr, /* initial_source is based on this */ 10 26 2 machine_cond_ptr pointer, /* pointer to machine conditions, if we faulted to get here */ 10 27 10 28 2 token_info aligned, /* information about token chain currently being processed */ 10 29 3 first_token pointer unaligned, /* first token in chain */ 10 30 3 ct pointer unaligned, /* pointer to current token; updated in MANY places */ 10 31 3 end_token bit (18) aligned, /* token type at which to stop scanning token chain */ 10 32 3 buffer_ptr pointer unaligned, /* pointer to input buffer */ 10 33 3 buffer_lth fixed bin (21), /* and length */ 10 34 10 35 2 random_info aligned, 10 36 3 current_stack_frame pointer unaligned, /* stack frame pointer for frame in which probe was invoked */ 10 37 3 input_type fixed bin, /* current input type */ 10 38 3 language_type fixed bin, /* current language being processed */ 10 39 3 return_method fixed bin, /* how we should return after exiting probe */ 10 40 3 entry_method fixed bin, /* how we got here in the first place */ 10 41 3 pad1 (19) bit (36) aligned, 10 42 10 43 2 break_info, /* break info -- only interesting if we got here via a break */ 10 44 3 break_slot_ptr pointer, /* pointer to break slot -- non-null IFF at a break */ 10 45 3 last_break_slot_ptr pointer unaligned, /* pointer to previous break slot, not presently used */ 10 46 3 break_reset bit (1) aligned, /* this break has been reset by somebody further on */ 10 47 3 real_break_return_loc pointer, /* where to REALLY return to, modulo previous bit */ 10 48 10 49 2 probe_area_info, /* information about various probe areas */ 10 50 3 break_segment_ptr pointer unaligned, /* pointer to Personid.probe */ 10 51 3 break_area_ptr pointer unaligned, /* pointer to area in break segment */ 10 52 3 scratch_area_ptr pointer unaligned, /* pointer to probe scratch seg in process dir */ 10 53 3 probe_area_ptr pointer unaligned, /* This area lasts as long as an invocation of probe. */ 10 54 3 work_area_ptr pointer unaligned, /* This area lasts as long as the current request line */ 10 55 3 expression_area_ptr pointer unaligned, /* This area lasts as long as the current command */ 10 56 10 57 2 flags aligned, /* this, in particular, should be saved and restored correctly */ 10 58 (3 execute, /* "1"b => execute requests, "0"b => just check syntax */ 10 59 3 in_listener, /* ON => in probe listener loop */ 10 60 3 executing_request, /* ON => executing a request */ 10 61 3 in_interpret_line, /* executing in probe_listen_$interpret_line */ 10 62 3 setting_break, /* executing "after" or "before": check syntax of "if" */ 10 63 3 executing_quit_request, /* to prevent error looping during "quit" request */ 10 64 3 pad (30)) bit (1) unaligned, 10 65 10 66 2 io_switches, /* switches probe will do normal I/O on */ 10 67 3 input_switch pointer, 10 68 3 output_switch pointer, 10 69 10 70 2 error_info, /* information about the last error saved for later printing */ 10 71 3 error_code fixed bin (35), 10 72 3 error_message char (300) varying, 10 73 10 74 2 listener_info, /* internal use by probe listener */ 10 75 3 request_name character (32) varying, /* primary name of the request being processed */ 10 76 3 abort_probe_label label variable, 10 77 3 abort_line_label label variable, 10 78 3 depth fixed binary, /* count of active invocations of probe */ 10 79 3 previous pointer unaligned, /* -> previous invocation's info */ 10 80 3 next pointer unaligned, 10 81 10 82 2 end_of_probe_info pointer aligned, 10 83 2 retry_using_main fixed bin aligned; 10 84 10 85 10 86 dcl probe_info_ptr pointer; 10 87 10 88 dcl probe_info_version fixed bin static options (constant) initial (1); 10 89 10 90 dcl probe_info_version_1 fixed bin static options (constant) initial (1); 10 91 10 92 dcl scratch_area area based (probe_info.scratch_area_ptr); 10 93 dcl probe_area area based (probe_info.probe_area_ptr); 10 94 dcl work_area area based (probe_info.work_area_ptr); 10 95 dcl expression_area area based (probe_info.expression_area_ptr); 10 96 10 97 /* END INCLUDE FILE probe_info.incl.pl1 */ 315 316 end probe_block_name_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/27/88 1223.0 probe_block_name_.pl1 >spec>install>MR12.2-1194>probe_block_name_.pl1 296 1 06/28/79 1204.8 begin_block_entries.incl.pl1 >ldd>include>begin_block_entries.incl.pl1 300 2 11/26/79 1320.6 probe_source_info.incl.pl1 >ldd>include>probe_source_info.incl.pl1 302 3 11/02/83 1845.0 probe_seg_info.incl.pl1 >ldd>include>probe_seg_info.incl.pl1 304 4 05/06/74 1751.6 statement_map.incl.pl1 >ldd>include>statement_map.incl.pl1 306 5 01/15/79 2202.9 acc.incl.pl1 >ldd>include>acc.incl.pl1 308 6 11/02/83 1845.0 runtime_symbol_block.incl.pl1 >ldd>include>runtime_symbol_block.incl.pl1 310 7 11/02/83 1845.0 runtime_block_type.incl.pl1 >ldd>include>runtime_block_type.incl.pl1 312 8 11/26/79 1320.6 runtime_symbol.incl.pl1 >ldd>include>runtime_symbol.incl.pl1 314 9 10/26/88 1255.5 probe_lang_types.incl.pl1 >ldd>include>probe_lang_types.incl.pl1 315 10 10/27/88 1223.7 probe_info.incl.pl1 >spec>install>MR12.2-1194>probe_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. C_lang_type constant fixed bin(17,0) initial dcl 9-17 ref 118 PASCAL_WITH_BLOCK constant fixed bin(17,0) initial dcl 7-9 ref 178 P_longp parameter bit(1) dcl 76 ref 29 119 156 187 204 258 P_probe_info_ptr parameter pointer dcl 72 ref 29 108 P_source_info_ptr parameter pointer dcl 74 ref 29 109 acc based structure level 1 dcl 5-6 addrel builtin function dcl 287 in procedure "is_begin_block" ref 289 addrel builtin function dcl 105 in procedure "probe_block_name_" ref 127 138 178 183 228 after builtin function dcl 105 ref 201 before builtin function dcl 105 ref 129 185 begin_block_entries 000000 constant bit(36) initial array dcl 1-3 ref 290 291 block_ptr 4 based pointer level 2 dcl 84 ref 110 bp 000204 automatic pointer dcl 87 set ref 110* 125 126 127 127 136 138 138 175 178 178* 178 178 181 183 183 195 195 226 228 228 callers_source based structure level 1 dcl 84 code 000423 automatic fixed bin(35,0) dcl 103 set ref 200* 204 257* 258 cp 000444 automatic pointer dcl 284 set ref 289* 291 directory_name 2 based char(168) level 3 packed packed unaligned dcl 3-9 set ref 119* 157* entry_name 54 based char(32) level 3 packed packed unaligned dcl 3-9 set ref 119* 124 135 157* 161 169 204 entry_point_name 000424 automatic char(32) packed unaligned dcl 256 set ref 257* 258 264 entry_ptr 10 based pointer level 2 dcl 84 ref 111 ep 000206 automatic pointer dcl 88 set ref 111* 195 200* 241 241 247 249* 251 251 257* 266* ext_entry_name 000371 automatic char(72) packed unaligned dcl 94 set ref 115* 200* 201 201* 201 204 204 216 220 father 2 based bit(18) level 2 packed packed unaligned dcl 8-38 ref 195 file 000214 automatic fixed bin(17,0) dcl 91 in procedure "probe_block_name_" set ref 141* 145 145* 231* 235 235* file 0(18) based bit(8) level 3 in structure "statement_map" packed packed unaligned dcl 4-1 in procedure "probe_block_name_" ref 141 231 first 3 based bit(18) level 3 packed packed unaligned dcl 8-38 ref 136 138 226 228 fixed builtin function dcl 105 ref 141 142 143 231 232 233 241 241 251 251 format_pointer_$its 000010 constant entry external dcl 97 ref 266 get_entry_name_ 000014 constant entry external dcl 100 ref 200 257 hbound builtin function dcl 287 ref 290 i 000446 automatic fixed bin(17,0) dcl 286 set ref 290* 291* index builtin function dcl 105 ref 201 267 ioa_$rsnnl 000012 constant entry external dcl 99 ref 145 235 241 251 iword based bit(36) dcl 285 ref 291 language_type 21 based fixed bin(17,0) level 3 dcl 10-18 ref 118 line 000215 automatic fixed bin(17,0) dcl 91 in procedure "probe_block_name_" set ref 142* 145* 232* 235* line 0(26) based bit(14) level 3 in structure "statement_map" packed packed unaligned dcl 4-1 in procedure "probe_block_name_" ref 142 232 ltrim builtin function dcl 105 ref 267 map 3 based structure level 2 packed packed unaligned dcl 8-38 name 1 based bit(18) level 2 packed packed unaligned dcl 8-38 ref 126 127 181 183 names 2 based structure level 2 dcl 3-9 null builtin function dcl 105 ref 125 175 195 247 266 266 num_chars based fixed bin(9,0) level 2 packed packed unsigned unaligned dcl 5-6 ref 128 184 owner 12 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 6-5 ref 178 p 000212 automatic pointer dcl 90 set ref 127* 128 138* 141 142 143 183* 184 228* 231 232 233 pathname_ 000016 constant entry external dcl 102 ref 119 157 probe_info based structure level 1 dcl 10-18 probe_info_ptr 000434 automatic pointer dcl 10-86 set ref 108* 118 proc_name 000413 automatic char(32) packed unaligned dcl 95 set ref 160* 161 168* 187 random_info 17 based structure level 2 dcl 10-18 rel builtin function dcl 105 ref 241 241 251 251 ret_string 000100 automatic varying char(256) dcl 79 set ref 116* 128* 129* 129 132 135* 145* 150 184* 185* 185 187 187* 192* 192 204 204* 216* 220* 220 235* 241* 251* 258* 264* 266* 267* 267 267 272* 274 rtrim builtin function dcl 105 ref 129 145 145 161 192 204 204 216 216 220 258 258 264 272 runtime_block based structure level 1 dcl 8-38 seg_info based structure level 1 dcl 3-9 seg_info_ptr 12 based pointer level 2 dcl 84 ref 113 segment_pathname 000317 automatic char(168) packed unaligned dcl 93 set ref 117* 119* 124* 129 145 145 157* 161 204 216 segname 64 based char(32) level 3 packed packed unaligned dcl 3-9 ref 160 161 168 204 204 sip 000210 automatic pointer dcl 89 set ref 113* 119 119 124 135 157 157 160 161 161 168 169 204 204 204 source_id 0(18) based structure level 2 packed packed unaligned dcl 4-1 source_info based structure level 1 dcl 2-5 source_info_ptr 000202 automatic pointer dcl 82 set ref 109* 110 111 113 statement 1(04) based bit(5) level 3 packed packed unaligned dcl 4-1 ref 143 233 statement_map based structure level 1 dcl 4-1 stmt 000216 automatic fixed bin(17,0) dcl 91 set ref 143* 145 145* 233* 235 235* string 0(09) based char level 2 packed packed unaligned dcl 5-6 ref 128 184 substr builtin function dcl 105 ref 267 symbol_block based structure level 1 dcl 6-5 tp parameter pointer dcl 283 ref 279 289 type 0(06) based bit(6) level 2 in structure "runtime_block" packed packed unaligned dcl 8-38 in procedure "probe_block_name_" ref 195 type 0(06) based fixed bin(6,0) level 2 in structure "symbol_block" packed packed unsigned unaligned dcl 6-5 in procedure "probe_block_name_" ref 178 whole_name 000217 automatic char(256) packed unaligned dcl 92 set ref 157* 161* 168* 169 169* 172 172* 187 192 235* 241* 251* 258 272 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ALGOL68_lang_type internal static fixed bin(17,0) initial dcl 9-17 ALM_lang_type internal static fixed bin(17,0) initial dcl 9-17 BEGIN_BLOCK internal static fixed bin(17,0) initial dcl 7-9 COBOL_lang_type internal static fixed bin(17,0) initial dcl 9-17 EXTERNAL_ENTRY internal static fixed bin(17,0) initial dcl 7-9 FORTRAN_lang_type internal static fixed bin(17,0) initial dcl 9-17 NON_QUICK_INTERNAL_PROCEDURE internal static fixed bin(17,0) initial dcl 7-9 OTHER_lang_type internal static fixed bin(17,0) initial dcl 9-17 PASCAL_lang_type internal static fixed bin(17,0) initial dcl 9-17 PL1_lang_type internal static fixed bin(17,0) initial dcl 9-17 QUICK_INTERNAL_PROCEDURE internal static fixed bin(17,0) initial dcl 7-9 UNKNOWN_lang_type internal static fixed bin(17,0) initial dcl 9-17 current_source based structure level 1 dcl 2-13 encoded_value based structure level 1 dcl 8-70 expression_area based area(1024) dcl 10-95 initial_source based structure level 1 dcl 2-14 name_size automatic fixed bin(9,0) unsigned dcl 6-44 official_language_names internal static char(32) initial array packed unaligned dcl 9-27 palatable_language_names internal static char(32) initial array packed unaligned dcl 9-30 probe_area based area(1024) dcl 10-93 probe_info_version internal static fixed bin(17,0) initial dcl 10-88 probe_info_version_1 internal static fixed bin(17,0) initial dcl 10-90 runtime_bound based structure level 1 unaligned dcl 8-33 runtime_symbol based structure level 1 dcl 8-3 runtime_token based structure level 1 dcl 8-63 scratch_area based area(1024) dcl 10-92 seg_info_nfiles automatic fixed bin(17,0) dcl 3-47 symbol_token based structure level 1 dcl 6-37 with_symbol_block based structure level 1 dcl 6-30 work_area based area(1024) dcl 10-94 NAMES DECLARED BY EXPLICIT CONTEXT. is_begin_block 001772 constant entry internal dcl 279 ref 249 probe_block_name_ 000055 constant entry external dcl 29 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2114 2134 2031 2124 Length 2524 2031 20 354 62 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME probe_block_name_ 396 external procedure is an external procedure. is_begin_block internal procedure shares stack frame of external procedure probe_block_name_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME probe_block_name_ 000100 ret_string probe_block_name_ 000202 source_info_ptr probe_block_name_ 000204 bp probe_block_name_ 000206 ep probe_block_name_ 000210 sip probe_block_name_ 000212 p probe_block_name_ 000214 file probe_block_name_ 000215 line probe_block_name_ 000216 stmt probe_block_name_ 000217 whole_name probe_block_name_ 000317 segment_pathname probe_block_name_ 000371 ext_entry_name probe_block_name_ 000413 proc_name probe_block_name_ 000423 code probe_block_name_ 000424 entry_point_name probe_block_name_ 000434 probe_info_ptr probe_block_name_ 000444 cp is_begin_block 000446 i is_begin_block THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out return_mac shorten_stack ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. format_pointer_$its get_entry_name_ ioa_$rsnnl pathname_ NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 29 000050 108 000062 109 000066 110 000071 111 000073 113 000075 115 000077 116 000102 117 000103 118 000106 119 000112 124 000135 125 000140 126 000144 127 000151 128 000154 129 000165 132 000240 135 000251 136 000257 138 000263 141 000266 142 000272 143 000277 145 000303 150 000404 156 000415 157 000421 160 000450 161 000454 166 000517 168 000521 169 000533 172 000542 175 000551 178 000555 181 000567 183 000574 184 000577 185 000610 187 000622 192 000641 195 000707 200 000725 201 000761 204 001010 216 001127 220 001207 223 001256 224 001257 226 001260 228 001264 231 001267 232 001273 233 001300 235 001304 239 001365 241 001366 246 001431 247 001432 249 001436 251 001443 254 001506 257 001507 258 001543 264 001630 266 001652 267 001673 271 001741 272 001742 274 001762 279 001772 289 001774 290 002000 291 002005 293 002014 294 002016 ----------------------------------------------------------- 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