COMPILATION LISTING OF SEGMENT alm_symtab_ Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 10/17/88 0942.6 mst Mon Options: optimize map 1 /****^ ******************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* ******************************************** */ 6 7 8 /****^ HISTORY COMMENTS: 9* 1) change(88-08-02,JRGray), approve(88-08-05,MCR7952), 10* audit(88-09-30,WAAnderson), install(88-10-17,MR12.2-1169): 11* These routines remember and emit structures necessary for symbol table 12* support. 13* END HISTORY COMMENTS */ 14 15 /* These procedures are used to build up information in the symbol 16* section of object segments. */ 17 alm_symtab_: proc; 18 dcl program_name char(11) static options(constant) init("alm_symtab_"); 19 dcl (name, string, type) char(*) parameter; 20 dcl sc_dtcm fixed bin(71) parameter; 21 dcl sc_uid bit(36) aligned parameter; 22 dcl (st_length, st_line, st_loc, st_num, st_offset) fixed bin(35) parameter; 23 dcl (admod, b29, basno, iaddr, offset, pc, value, word_count) fixed bin(26) parameter; 24 25 dcl (addr, before, bit, divide, fixed, hbound, index, length, max, mod, null, rtrim, size, substr, verify) builtin; 26 27 dcl alm_source_map_$count_map_words entry(fixed bin(26)); 28 dcl alm_source_map_$put_out_map entry(fixed bin(26)); 29 dcl getbit_ entry(fixed bin(26), fixed bin(26), fixed bin(26), fixed bin(26)); 30 dcl get_temp_segments_ entry(char(*), (*) ptr, fixed bin(35)); 31 dcl ioa_ entry options(variable); 32 dcl putout_$putblk entry(fixed bin(26), ptr, fixed bin(26), fixed bin(26), ptr); 33 dcl putout_$putwrd entry(fixed bin(26), fixed bin(26), fixed bin(26), fixed bin(26)); 34 dcl release_temp_segments_ entry(char(*), (*) ptr, fixed bin(35)); 35 36 dcl (source_data_ptr, symbol_data_ptr) ptr static; 37 dcl temp_ptrs(3) ptr init((3) null()) static; 38 39 dcl (context, current_block, current_source, current_statement, first_token, forward) fixed bin static; 40 dcl (max_allocated, max_block, max_source) fixed bin static; 41 dcl sc_string_len fixed bin(21) static; 42 dcl source_stack(1:255) fixed bin static; 43 dcl stack_level fixed bin static; 44 dcl (start_pl1_sb, start_sc, start_sc_strings, start_statement, start_symbol) fixed bin static; 45 46 dcl ec fixed bin(35); 47 dcl i fixed bin(21); 48 dcl s fixed bin; 49 50 dcl eb_data_$lavptr external ptr; 51 dcl 1 glpl_words(0:261119) based(eb_data_$lavptr), 52 2 (left, right) fixed bin(18) unsigned unaligned; 53 54 dcl word(261120) fixed bin(26) based; 55 56 dcl symbol_data(261120) fixed bin(35) based(symbol_data_ptr); 57 dcl 1 source_data based(source_data_ptr), 58 2 sc_map(0:255), 59 3 pathname unaligned, 60 4 (offset, size) fixed bin(18) unsigned unaligned, 61 3 uid bit(36) aligned, 62 3 dtm fixed bin(71), 63 2 sc_strings char(256 * 256), 64 2 st_map(121000), 65 3 location fixed bin(18) unsigned unaligned, 66 3 source_id unaligned, 67 4 file fixed bin(8) unsigned unaligned, 68 4 line fixed bin(14) unsigned unaligned, 69 4 statement fixed bin(5) unsigned unaligned, 70 3 source_info unaligned, 71 4 start fixed bin(18) unsigned unaligned, 72 4 length fixed bin(9) unsigned unaligned; 73 74 dcl (CHAR init(21), DOUBLE init(4), ENUMTYPE init(55), ENUMVALUE init(56), 75 FLOAT init(3), FUNCTION init(26), INT init(1), LONG init(2), PTR init(13), 76 STRUCTURE init(17), TYPEREF init(54), UINT init(33), ULONG init(34), UNION init(57)) 77 fixed bin int static options(constant); 78 79 initialize: entry; /* initializes static variables and creates tempsegs */ 80 /* first temp-segment is for source and statement info. 81* second tempseg is for runtime_symbol info: symbols, tokens, blocks. 82* third segment is for relocation info associated with symbol info. */ 83 call get_temp_segments_(program_name, temp_ptrs, ec); 84 source_data_ptr = temp_ptrs(1); 85 symbol_data_ptr = temp_ptrs(2); 86 context = 0; 87 current_block = 0; 88 current_source = 0; 89 current_statement = 0; 90 first_token = 0; 91 forward = 0; /* no forward references */ 92 max_allocated = 0; 93 max_block = 0; 94 max_source = -1; /* source zero is the first source */ 95 sc_string_len = 0; 96 stack_level = 0; 97 return; 98 99 block: entry(string); /* creates runtime_block & stores it in tree */ 100 if context ^= 0 then call error("New block encountered while in symbol context."); 101 context = 0; 102 call open_block(string, current_block); 103 return; 104 105 end_block: entry; /* closes out current runtime_block */ 106 if context ^= 0 then call error("end_block encountered while in symbol context."); 107 if current_block = 0 then call error("Mismatched end_block."); 108 else call close_block(current_block); 109 return; 110 111 enum: entry(string); /* Starts definition of enumeration type */ 112 call open_context(string, ENUMTYPE, context); 113 return; 114 115 end_enum: entry; /* closes out enumeration definitions */ 116 if context = 0 then call error("end_enum encountered while not in symbol context."); 117 else call close_context(context); 118 return; 119 120 source: entry(string, sc_uid, sc_dtcm); /* start source program: path, uid & dtcm */ 121 122 max_source = max_source + 1; 123 current_source = max_source; 124 stack_level = stack_level + 1; 125 source_stack(stack_level) = current_source; 126 127 sc_map(current_source).offset = divide(sc_string_len, 4, 17, 0); 128 i = length(rtrim(string)); 129 sc_map(current_source).size = i; 130 sc_map(current_source).uid = sc_uid; 131 sc_map(current_source).dtm = sc_dtcm; 132 133 i = i + mod(4000 - i, 4); /* pad length to fill last word */ 134 substr(sc_strings, sc_string_len+1, i) = string; /* store path in list containing all paths */ 135 sc_string_len = sc_string_len + i; 136 return; 137 138 end_source: entry; /* end of source program */ 139 if stack_level = 0 then call error("'end_source' encountered with no source active."); 140 else do; 141 stack_level = stack_level - 1; 142 current_source = source_stack(stack_level); 143 end; 144 return; 145 146 /* source line info associated with alm location */ 147 statement: entry(st_loc, st_offset, st_length, st_line, st_num); 148 current_statement = current_statement + 1; 149 st_map(current_statement).location = st_loc; 150 st_map(current_statement).source_info.start = st_offset; 151 st_map(current_statement).source_info.length = st_length; 152 st_map(current_statement).source_id.line = st_line; 153 st_map(current_statement).source_id.file = current_source; 154 st_map(current_statement).source_id.statement = st_num; 155 return; 156 157 structure: entry(string); /* starts definition of structure */ 158 call open_context(string, STRUCTURE, context); 159 return; 160 161 end_structure: entry; /* closes of structure definition */ 162 if context = 0 then call error("end_structure encountered while not in symbol context."); 163 else call close_context(context); 164 return; 165 166 /* defines information about a runtime symbol */ 167 symbol: entry(name, type, basno, value, admod, b29, iaddr, offset); 168 call define_symbol(name, type, basno, value, admod, b29, iaddr, offset, s); 169 return; 170 171 union: entry(string); /* Starts definition of union type */ 172 call open_context(string, UNION, context); 173 return; 174 175 end_union: entry; /* closes definition of union */ 176 if context = 0 then call error("end_union encountered while not in symbol context."); 177 else call close_context(context); 178 return; 179 180 count_words: entry(word_count); /* returns length of symbol_table info */ 181 if max_source < 0 then do; /* only info is map of alm sources */ 182 call alm_source_map_$count_map_words(word_count); 183 return; 184 end; 185 186 start_sc = new_sthedr_$hdrlen; 187 start_sc_strings = start_sc + 2 + (max_source+1) * 4; 188 start_pl1_sb = start_sc_strings + divide(sc_string_len + 3, 4, 17, 0); 189 if max_allocated = 0 & current_statement = 0 then do; 190 start_symbol = 0; 191 start_statement = 0; 192 word_count = start_pl1_sb - new_sthedr_$hdrlen; 193 end; 194 else do; 195 if context ^= 0 then call error("Missing end_(enum structure union) statement."); 196 if current_block ^= 0 then call error("Missing end_block."); 197 new_sthedr_$source_and_area.area_offset = bit(fixed(start_pl1_sb, 18), 18); 198 start_symbol = start_pl1_sb + size(pl1_symbol_block) + divide(length(rtrim(sthedr_$seg_name))+3, 4, 17, 0); 199 start_statement = start_symbol + max_allocated; 200 word_count = start_statement + (current_statement+1)*2 - new_sthedr_$hdrlen; 201 end; 202 return; 203 204 emit: entry(pc); /* emits symbol_table info & releases storage */ 205 if max_source < 0 then call alm_source_map_$put_out_map(pc); 206 else call emit_symtab; 207 208 cleanup: entry; /* release storage */ 209 if temp_ptrs(1) ^= null() then call release_temp_segments_(program_name, temp_ptrs, ec); 210 return; 211 /* ===================== Internal Procedures =================== */ 212 213 /* This procedure prints out an error message and sets the S error Flag */ 214 error: proc(string); 215 dcl string char(*); 216 217 prnts = 1; /* set flag for S (symbol) error */ 218 call ioa_("Symbol Table Error: ^a", string); 219 end error; 220 221 /* This procedure allocates a block in the symbol_data tempseg */ 222 allocate_storage: proc(size, offset); 223 dcl (size, offset) fixed bin parameter; 224 225 if max_allocated + size > hbound(symbol_data, 1) then do; 226 call error("Symbol Table Overflow."); 227 max_allocated = 0; 228 end; 229 offset = max_allocated + 1; 230 max_allocated = max_allocated + size; 231 end allocate_storage; 232 233 /* This procedure returns the offset of a specified runtime token. It will 234* create the token if one doesn't already exist. */ 235 get_token: proc(name, offset); 236 dcl name char(*) parameter; 237 dcl offset fixed bin(17) parameter; 238 dcl (t, last_t) fixed bin; 239 dcl t_ptr ptr; 240 dcl l fixed bin; 241 242 offset = 0; 243 l = length(name); 244 if l = 0 then return; 245 246 /* to optimize set token list and search via it */ 247 last_t = 0; 248 t = first_token; 249 do while(t > 0 ); 250 t_ptr = addr(symbol_data(t)); 251 if t_ptr -> runtime_token.size > l then goto create_token; 252 else if t_ptr -> runtime_token.size = l then 253 if t_ptr -> runtime_token.string > name then goto create_token; 254 else if t_ptr -> runtime_token.string = name then do; /* found it */ 255 offset = t; 256 return; 257 end; 258 last_t = t; 259 if t_ptr -> runtime_token.next = 0 then t = 0; 260 else t = t_ptr -> runtime_token.next + t; 261 end; 262 create_token: 263 call allocate_storage(divide(l+4, 4, 17, 0) + 1, t); /* new token */ 264 t_ptr = addr(symbol_data(t)); 265 t_ptr -> runtime_token.size = l; 266 t_ptr -> runtime_token.string = name; 267 if last_t = 0 then do; 268 if first_token ^= 0 then t_ptr -> runtime_token.next = first_token - t; 269 first_token = t; 270 end; 271 else do; 272 if addr(symbol_data(last_t)) -> runtime_token.next ^= 0 then 273 t_ptr -> runtime_token.next = addr(symbol_data(last_t)) -> runtime_token.next + last_t - t; 274 addr(symbol_data(last_t)) -> runtime_token.next = t - last_t; 275 end; 276 offset = t; 277 end get_token; 278 279 /* This procedure creates a runtime_block. It will create a runtime_token 280* if necessary and insert the block into the runtime_block tree. 281* Note: runtime_blocks are linked into a circular list whose parent 282* points to the last runtime_block. This form is converted into a standard 283* linked list by the close_block routine */ 284 open_block: proc(name, block); 285 dcl name char(*); 286 dcl (block, b, bot, t) fixed bin; 287 dcl b_ptr ptr; 288 289 if max_allocated>1 & current_block=0 then call error("Multiple blocks declared at the global level."); 290 call allocate_storage(size(runtime_block) - 1, b); /* -1 because no owner field */ 291 b_ptr = addr(symbol_data(b)); 292 if name = "" then do; 293 max_block = max_block + 1; 294 b_ptr -> runtime_block.number = max_block; 295 if block = 0 then b_ptr -> runtime_block.type = 4; 296 else do; /* quick block */ 297 b_ptr -> runtime_block.type = 3; 298 call allocate_storage(1, 0); /* room for owner */ 299 b_ptr -> runtime_block.owner_flag = "1"b; 300 b_ptr -> runtime_block.quick = "1"b; 301 if addr(symbol_data(block)) -> runtime_block.owner_flag then 302 b_ptr -> runtime_block.owner = addr(symbol_data(block)) -> runtime_block.owner + block - b; 303 else b_ptr -> runtime_block.owner = block - b; 304 end; 305 end; 306 else do; 307 call get_token(name, t); 308 b_ptr -> runtime_block.name = t-b+1; /* points to runtime_token.name */ 309 b_ptr -> runtime_block.type = 1; 310 end; 311 b_ptr -> runtime_block.flag = "1"b; 312 b_ptr -> runtime_block.standard = "1"b; 313 b_ptr -> runtime_block.first = current_statement; /* adjust later for start of statement map */ 314 if current_block = 0 then b_ptr -> runtime_block.father = 0; 315 else do; 316 b_ptr -> runtime_block.father = current_block - b; 317 bot = addr(symbol_data(current_block)) -> runtime_block.son; 318 if bot ^= 0 then do; 319 bot = bot + current_block; 320 b_ptr -> runtime_block.brother = addr(symbol_data(bot)) -> runtime_block.brother + bot - b; 321 addr(symbol_data(bot)) -> runtime_block.brother = b - bot; 322 end; 323 addr(symbol_data(current_block)) -> runtime_block.son = b - current_block; 324 end; 325 block = b; 326 end open_block; 327 328 /* This routine finishes a runtime block by converting its children from a 329* circular list into a regular list and then pops out to the parent block */ 330 close_block: proc(block); 331 dcl (block, bot) fixed bin; 332 dcl b_ptr ptr; 333 334 if block = 0 then return; 335 b_ptr = addr(symbol_data(block)); 336 b_ptr -> runtime_block.last = current_statement; 337 bot = b_ptr -> runtime_block.son; 338 if bot ^= 0 then do; /* convert list from circular to bounded */ 339 bot = bot + block; 340 b_ptr -> runtime_block.son = addr(symbol_data(bot)) -> runtime_block.brother + bot - block; 341 addr(symbol_data(bot)) -> runtime_block.brother = 0; 342 end; 343 344 if b_ptr -> runtime_block.father = 0 then block = 0; 345 else block = b_ptr -> runtime_block.father + block; 346 end close_block; 347 348 /* This procedure opens a context. It creates a symbol node for the 349* context, links it into the current context and updates the context. */ 350 open_context: proc(name, type, context); 351 dcl name char(*); 352 dcl (type, context, s) fixed bin; 353 354 call create_symbol(name, s); 355 if s = 0 then return; /* abort */ 356 addr(symbol_data(s)) -> runtime_symbol.type = type; 357 if addr(symbol_data(s)) -> runtime_symbol.level = 0 then 358 addr(symbol_data(s)) -> runtime_symbol.level = 1; 359 if context = 0 then call thread_symbol_into_block(s, current_block); 360 else call add_symbol_in_context(s, context); 361 context = s; 362 end open_context; 363 364 /* This procedure ends a context. It converts a end pointed circular 365* linked list into a start pointed bounded linked list */ 366 close_context: proc(context); 367 dcl (bot, context, top) fixed bin; 368 369 bot = addr(symbol_data(context)) -> runtime_symbol.son; 370 if bot ^= 0 then do; /* list is not empty */ 371 bot = bot + context; 372 top = addr(symbol_data(bot)) -> runtime_symbol.brother + bot; 373 addr(symbol_data(bot)) -> runtime_symbol.brother = 0; 374 addr(symbol_data(context)) -> runtime_symbol.son = top - context; 375 end; 376 context = addr(symbol_data(context)) -> runtime_symbol.father + context; /* leave context */ 377 if context = current_block then context = 0; 378 end close_context; 379 380 /* This procedure creates a runtime_symbol, creating/accessing a runtime_token as necessary */ 381 create_symbol: proc(name, s); 382 dcl name char(*) parameter; 383 dcl s fixed bin parameter; 384 dcl (dcladdr, t) fixed bin; 385 dcl s_ptr ptr; 386 387 if name = "" then do; 388 call allocate_storage(5, s); 389 s_ptr = addr(symbol_data(s)); 390 end; 391 else do; 392 call get_token(name, t); 393 call allocate_storage(5, s); 394 s_ptr = addr(symbol_data(s)); 395 s_ptr -> runtime_symbol.name = t - s + 1; 396 dcladdr = addr(symbol_data(t)) -> runtime_token.dcl; 397 if dcladdr ^= 0 then s_ptr -> runtime_symbol.next = dcladdr + t - s; 398 addr(symbol_data(t)) -> runtime_token.dcl = s - t; 399 end; 400 s_ptr -> runtime_symbol.flag = "1"b; 401 s_ptr -> runtime_symbol.aligned = "1"b; 402 s_ptr -> runtime_symbol.simple = "1"b; 403 end create_symbol; 404 405 /* This procedure searchs for the runtime_symbol node associated with a name */ 406 find_symbol: proc(name, context, in_symbol_context) returns(fixed bin); 407 dcl name char(*) parameter; 408 dcl context fixed bin; 409 dcl in_symbol_context bit(1); 410 dcl (b, c, first, o, s, t) fixed bin; 411 412 o = context; 413 if in_symbol_context then do; /* check in symbol contexts (containing structs, unions, enums) */ 414 c = 0; 415 do while(o ^= 0); /* end of list when zero offset */ 416 c = c + o; 417 s = c; 418 o = addr(symbol_data(c)) -> runtime_symbol.son; 419 first = s + o; /* remember for test for end of circular list */ 420 do while(o ^= 0 ); /* find name in symbol table */ 421 s = s + o; 422 t = addr(symbol_data(s)) -> runtime_symbol.name; 423 o = addr(symbol_data(s)) -> runtime_symbol.brother; 424 if s+o = first then o = 0; /* end of circular list */ 425 if t ^= 0 then 426 if addr(symbol_data(s+t-1)) -> runtime_token.string = name then return(s); 427 end; 428 o = addr(symbol_data(c)) -> runtime_symbol.father; 429 if c+o = current_block then o = 0; /* not found */ 430 if addr(symbol_data(c)) -> runtime_symbol.level > 1 then o = 0; 431 end; 432 o = c + addr(symbol_data(c)) -> runtime_symbol.father; /* containing block */ 433 end; 434 435 b = 0; /* OK now look in the runtime_blocks */ 436 do while(o ^= 0); 437 b = b + o; 438 s = b; 439 o = addr(symbol_data(b)) -> runtime_block.start; 440 do while(o ^= 0 ); /* find name in symbol table */ 441 s = s + o; 442 t = addr(symbol_data(s)) -> runtime_symbol.name; 443 o = addr(symbol_data(s)) -> runtime_symbol.brother; 444 if t ^= 0 then 445 if addr(symbol_data(s+t-1)) -> runtime_token.string = name then return(s); 446 end; 447 o = addr(symbol_data(b)) -> runtime_block.father; 448 end; 449 return(0); /* no runtime_symbol with specified name */ 450 end find_symbol; 451 452 /* This procedure returns the storage requirement associated with one element of a runtime_symbol */ 453 symbol_element_size: proc(s) returns(fixed bin); 454 dcl (first, i, m, o, s, sz, t) fixed bin; 455 456 if s = 0 then return(0); 457 t = addr(symbol_data(s)) -> runtime_symbol.type; 458 sz = addr(symbol_data(s)) -> runtime_symbol.size; 459 if t = INT | t = LONG then return(sz + 1); 460 if t = FLOAT| t = DOUBLE then return(sz + 9); 461 if t = PTR then return(72); 462 if t = UINT | t = ULONG then return(sz); 463 if t = CHAR then return(sz * 9); 464 if t = ENUMTYPE | t = ENUMVALUE then return(sz + 1); 465 if t = STRUCTURE then do; /* size of structure = last element: offset + size */ 466 o = addr(symbol_data(s)) -> runtime_symbol.son; 467 i = s; 468 if o = 0 then return(0); /* empty structure */ 469 if ^addr(symbol_data(s+o)) -> runtime_symbol.simple & 470 addr(symbol_data(s+o)) -> runtime_symbol.offset ^= 0 471 then i = s+o; /* attempt to take size of open structure */ 472 else do while(o ^= 0); 473 i = i + o; 474 o = addr(symbol_data(i)) -> runtime_symbol.brother; 475 end; 476 477 m = addr(symbol_data(i)) -> runtime_symbol.offset; 478 if addr(symbol_data(i)) -> runtime_symbol.type ^= UNION & /* here? must be typedefs */ 479 addr(symbol_data(i)) -> runtime_symbol.type ^= STRUCTURE then m = m + symbol_size(i); 480 return(72 * divide(m+71, 72, 17, 0)); 481 end; 482 if t = UNION then do; 483 m = 0; 484 i = s; 485 o = addr(symbol_data(i)) -> runtime_symbol.son; 486 /* it is an error to try to figure out size of something that 487* is not fully defined, but just in case prevent infinite loops */ 488 first = i + o; /* used for circular list end test */ 489 do while(o ^= 0); 490 i = i + o; 491 o = addr(symbol_data(i)) -> runtime_symbol.brother; 492 if i + o = first then o = 0; /* prevent infinite loops when scanning circular lists */ 493 if addr(symbol_data(i)) -> runtime_symbol.type ^= UNION & 494 addr(symbol_data(i)) -> runtime_symbol.type ^= STRUCTURE 495 then m = max(m, symbol_size(i)); /* unions & structure here are really typedefs */ 496 end; 497 return(72 * divide(m+71, 72, 17, 0)); 498 end; 499 if t = TYPEREF then 500 if addr(symbol_data(s)) -> runtime_symbol.son = 0 then return(0); 501 else return(symbol_size(s + addr(symbol_data(s)) -> runtime_symbol.son)); 502 return(0); 503 end symbol_element_size; 504 505 /* This procedure returns the storage requirement associated with a runtime_symbol */ 506 symbol_size: proc(s) returns(fixed bin); 507 dcl (i, s, sz) fixed bin; 508 dcl s_ptr ptr; 509 510 sz = symbol_element_size(s); 511 if sz = 0 then return(0); 512 s_ptr = addr(symbol_data(s)); 513 do i = 1 to s_ptr -> runtime_symbol.ndims; 514 sz = sz * (s_ptr -> runtime_symbol.bounds(i).upper - s_ptr -> runtime_symbol.bounds(i).lower + 1); 515 end; 516 return(sz); 517 end symbol_size; 518 519 /* This procedure fill out the multiplier field of array runtime_symbols */ 520 compute_array_data: proc(s); 521 dcl (i, s, sz) fixed bin; 522 dcl s_ptr ptr; 523 524 s_ptr = addr(symbol_data(s)); 525 if s_ptr -> runtime_symbol.ndims <= 0 then return; 526 sz = symbol_element_size(s); 527 if sz = 0 then return; 528 s_ptr -> runtime_symbol.array_units = 1; /* bit units */ 529 do i = s_ptr -> runtime_symbol.ndims to 1 by -1; 530 s_ptr -> runtime_symbol.bounds(i).multiplier = sz; 531 sz = sz * (s_ptr -> runtime_symbol.bounds(i).upper - s_ptr -> runtime_symbol.bounds(i).lower + 1); 532 end; 533 end compute_array_data; 534 535 /* This procedure links a runtime_symbol as the last son of the runtime_symbol 'context' */ 536 add_symbol_in_context: proc(s, c); 537 dcl (bot, c, offset, s, t) fixed bin; 538 dcl (b_ptr, c_ptr, s_ptr) ptr; 539 540 if c = 0 then return; /* no papa? no can do... */ 541 s_ptr = addr(symbol_data(s)); 542 c_ptr = addr(symbol_data(c)); 543 s_ptr -> runtime_symbol.level = c_ptr -> runtime_symbol.level + 1; 544 s_ptr -> runtime_symbol.father = c-s; 545 bot = c_ptr -> runtime_symbol.son; 546 if bot ^= 0 then do; 547 bot = bot + c; 548 b_ptr = addr(symbol_data(bot)); 549 s_ptr -> runtime_symbol.brother = b_ptr -> runtime_symbol.brother + bot - s; 550 b_ptr -> runtime_symbol.brother = s - bot; 551 552 if c_ptr -> runtime_symbol.type = STRUCTURE then do; /* fill in offset */ 553 if s_ptr -> runtime_symbol.simple then do; 554 call allocate_storage(2, 0); 555 s_ptr -> runtime_symbol.simple = "0"b; 556 end; 557 558 if b_ptr -> runtime_symbol.simple then offset = 0; 559 else offset = b_ptr -> runtime_symbol.offset; 560 if b_ptr -> runtime_symbol.type ^= STRUCTURE & /* in this context must be typedef */ 561 b_ptr -> runtime_symbol.type ^= UNION then offset = offset + symbol_size(bot); 562 if s_ptr -> runtime_symbol.aligned then do; /* align the data */ 563 t = s_ptr -> runtime_symbol.type; 564 if t = LONG | t = DOUBLE | t = PTR | t = STRUCTURE then offset = 72 * divide(offset + 71, 72, 17, 0); 565 else if t = CHAR then offset = 9 * divide(offset + 8, 9, 17, 0); 566 else offset = 36 * divide(offset + 35, 36, 17, 0); 567 end; 568 569 s_ptr -> runtime_symbol.offset = offset; 570 s_ptr -> runtime_symbol.units = 1; 571 end; 572 end; 573 c_ptr -> runtime_symbol.son = s - c; 574 end add_symbol_in_context; 575 576 /* This procedure takes a runtime_symbol node and inserts it into the 577* linked list of runtime_symbols in a specified block */ 578 thread_symbol_into_block: proc(s, b); 579 dcl (b, ct, ctl, i, j, last_s, slot, s, t, tl) fixed bin; 580 dcl (b_ptr, s_ptr, t_ptr) ptr; 581 582 if b = 0 then do; 583 call error("Attempt to link symbol when not in a runtime_block."); 584 return; 585 end; 586 587 s_ptr = addr(symbol_data(s)); 588 b_ptr = addr(symbol_data(b)); 589 s_ptr -> runtime_symbol.father = b-s; 590 591 last_s = 0; /* symbol that should precede new symbol */ 592 t = s_ptr -> runtime_symbol.name; 593 if t ^= 0 then do; /* find list location by finding last_s */ 594 t = t + s - 1; 595 t_ptr = addr(symbol_data(t)); 596 tl = t_ptr -> runtime_token.size; 597 j = b_ptr -> runtime_block.start; 598 if j ^= 0 then if ^ordered_symbols(s, b+j) then last_s = b+j; 599 600 i = 2; /* check symbol chain first, setting chain if necessary */ 601 do slot = 1 to 4 while(tl >= i); 602 i = i + i; /* min length of current slot */ 603 j = b_ptr -> runtime_block.chain(slot); 604 if j = 0 then b_ptr -> runtime_block.chain(slot) = s-b; 605 else do; /* compare with symbol */ 606 ct = addr(symbol_data(j+b)) -> runtime_symbol.name+j+b - 1; 607 ctl = addr(symbol_data(ct)) -> runtime_token.size; 608 if ctl > tl then b_ptr -> runtime_block.chain(slot) = s-b; 609 else if ctl < tl then last_s = j+b; 610 else if addr(symbol_data(ct)) -> runtime_token.string > 611 t_ptr -> runtime_token.string then b_ptr -> runtime_block.chain(slot) = s-b; 612 else last_s = j+b; 613 end; 614 end; 615 616 j = last_s; /* search through rest of list finding preceding symbol */ 617 last_s = 0; 618 do while(j ^= 0); 619 if ordered_symbols(last_s + j, s) then do; 620 last_s = last_s + j; 621 j = addr(symbol_data(last_s)) -> runtime_symbol.brother; 622 end; 623 else j = 0; 624 end; 625 end; 626 627 if last_s = 0 then do; /* put at beginning of list */ 628 if b_ptr -> runtime_block.start ^= 0 then 629 s_ptr -> runtime_symbol.brother = b + b_ptr -> runtime_block.start - s; 630 b_ptr -> runtime_block.start = s-b; 631 end; 632 else do; /* insert in list */ 633 if addr(symbol_data(last_s)) -> runtime_symbol.brother ^= 0 then 634 s_ptr -> runtime_symbol.brother = last_s + addr(symbol_data(last_s)) -> runtime_symbol.brother - s; 635 addr(symbol_data(last_s)) -> runtime_symbol.brother = s - last_s; 636 end; 637 end thread_symbol_into_block; 638 639 ordered_symbols: proc(s1, s2) returns(bit(1)); /* returns true if s1 should be ordered before s2 */ 640 dcl (s1, s2, t1, t2, t1l, t2l) fixed bin; 641 642 t1 = addr(symbol_data(s1)) -> runtime_symbol.name; 643 if t1 = 0 then return("1"b); 644 t2 = addr(symbol_data(s2)) -> runtime_symbol.name; 645 if t2 = 0 then return("0"b); 646 t1 = s1 + t1 - 1; 647 t2 = s2 + t2 - 1; 648 t1l = addr(symbol_data(t1)) -> runtime_token.size; 649 t2l = addr(symbol_data(t2)) -> runtime_token.size; 650 if t1l < t2l then return("1"b); 651 if t1l > t2l then return("0"b); 652 return( addr(symbol_data(t1)) -> runtime_token.string <= addr(symbol_data(t2)) -> runtime_token.string); 653 end ordered_symbols; 654 655 define_symbol: proc(name, type, basno, value, admod, b29, iaddr, offset, top); 656 dcl (name, type) char(*) parameter; 657 dcl (admod, b29, basno, iaddr, offset, value) fixed bin(26) parameter; 658 dcl reloc fixed bin(26); 659 dcl (i, key, s, top) fixed bin; 660 dcl s_ptr ptr; 661 dcl remainder char(80); 662 dcl token char(80) varying; 663 664 dcl valid_chars(0:15) char(80) varying int static options(constant) 665 init(("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"), 666 "", ")", "0123456789", (2)("0123456789]"), (10)("0123456789")); 667 dcl 01 type_name_info int static options(constant), 668 02 blank char(1) init(" "), 669 02 names(10) char(16) init(".int .short", ".uint .ushort", 670 ".long", ".ulong", ".char", ".uchar", ".float", ".double", 671 ".label", ".enum"); 672 dcl type_names char(10*16+1) based(addr(type_name_info)); 673 dcl 01 type_info(10) internal static options(constant), 674 02 type fixed bin init(1, 33, 2, 34, 21, 21, 3, 4, 24, 56), 675 02 default_size fixed bin init(35, 36, 71, 72, 1, 1, 27, 63, 0, 35); 676 677 call create_symbol(name, s); 678 if s = 0 then return; /* couldn't allocate: abort */ 679 top = s; /* return top of type chain */ 680 s_ptr = addr(symbol_data(s)); 681 682 /* set location information remembering relocation info */ 683 reloc = 0; /* absolute relocation */ 684 if iaddr = 0 then s_ptr -> runtime_symbol.location = value; 685 else do; /* address is relative to location counter */ 686 s_ptr -> runtime_symbol.location = value + glpl_words(iaddr+3).left; 687 call getbit_(iaddr, basno, 0 /* b29 = 0 always use 18 bit relocation */, reloc); 688 temp_ptrs(3) -> glpl_words(s+2).left = reloc; /* relocation info */ 689 end; 690 691 /* relocation info maps directly to some classes of storage */ 692 if reloc = itext then s_ptr -> runtime_symbol.class = 12; 693 else if reloc = ilink then s_ptr -> runtime_symbol.class = 5; 694 else if reloc = isymbl then s_ptr -> runtime_symbol.class = 11; 695 else do; /* figure it out the hard way */ 696 if admod = 16 then /* indirect flag */ 697 if basno = 7 then do; /* parameter */ 698 s_ptr -> runtime_symbol.class = 9; 699 s_ptr -> runtime_symbol.location = s_ptr -> runtime_symbol.location / 2; 700 end; 701 else s_ptr -> runtime_symbol.class = 8; /* indirect parameter?? */ 702 else if basno = 6 then s_ptr -> runtime_symbol.class = 1; 703 end; 704 705 if offset ^= 0 then do; /* explicitly fill in offset field */ 706 call allocate_storage(2, 0); 707 s_ptr -> runtime_symbol.simple = "0"b; 708 s_ptr -> runtime_symbol.aligned = "0"b; 709 s_ptr -> runtime_symbol.packed = "1"b; 710 if mod(offset, 9) = 0 then do; 711 s_ptr -> runtime_symbol.offset = divide(offset, 9, 26, 0); 712 s_ptr -> runtime_symbol.units = 2; /* byte */ 713 end; 714 else do; 715 s_ptr -> runtime_symbol.offset = offset; 716 s_ptr -> runtime_symbol.units = 1; /* bit */ 717 end; 718 end; 719 720 721 remainder = type; 722 do while(remainder ^= ""); /* fill in type related info */ 723 key = index("*(:[,0123456789", substr(remainder, 1, 1)); 724 i = verify(substr(remainder, 2), valid_chars(key)); 725 if i < 1 then i = length(remainder) - 1; 726 token = substr(remainder, 1, i); 727 remainder = substr(remainder, i + 1); 728 729 if key = 0 then do; /* Type Name */ 730 i = divide(15 + index(type_names, " " || token || " "), 16, 17, 0); 731 if i > 0 then do; /* C type */ 732 s_ptr -> runtime_symbol.type = type_info(i).type; 733 s_ptr -> runtime_symbol.size = type_info(i).default_size; 734 if type_info(i).type = CHAR then do; 735 s_ptr -> runtime_symbol.aligned = "0"b; 736 s_ptr -> runtime_symbol.packed = "1"b; 737 s_ptr -> runtime_symbol.decimal = (token = ".char"); 738 end; 739 end; 740 741 else do; /* type reference */ 742 s_ptr -> runtime_symbol.type = TYPEREF; 743 if context ^= 0 then i = find_symbol((token), context, "1"b); 744 else i = find_symbol((token), current_block, "0"b); 745 if i = 0 then do; /* forward reference */ 746 s_ptr -> runtime_symbol.size = forward; 747 forward = s; /* chain through size field */ 748 call get_token((token), i); 749 s_ptr -> runtime_symbol.son = i; /* remember name */ 750 end; 751 else do; 752 if addr(symbol_data(i)) -> runtime_symbol.type = ENUMTYPE & i = context 753 then s_ptr -> runtime_symbol.type = ENUMVALUE; 754 else s_ptr -> runtime_symbol.son = i-s; 755 end; 756 end; 757 end; 758 else if key <= 2 then do; /* pointer or function & type... */ 759 if key = 1 then s_ptr -> runtime_symbol.type = PTR; /* ptr */ 760 else s_ptr -> runtime_symbol.type = FUNCTION; /* function */ 761 if s = top then 762 if context = 0 then call thread_symbol_into_block(s, current_block); 763 else call add_symbol_in_context(s, context); 764 call compute_array_data(s); 765 call create_symbol("", i); 766 addr(symbol_data(i)) -> runtime_symbol.level = s_ptr -> runtime_symbol.level; 767 s_ptr -> runtime_symbol.son = i - s; 768 s = i; 769 s_ptr = addr(symbol_data(s)); 770 if context ^= 0 then s_ptr -> runtime_symbol.father = context - s; 771 else s_ptr -> runtime_symbol.father = current_block - s; 772 end; 773 else if key = 3 then do; /* size information */ 774 s_ptr -> runtime_symbol.aligned = "0"b; 775 s_ptr -> runtime_symbol.packed = "1"b; 776 s_ptr -> runtime_symbol.size = fixed(substr(token, 2)); 777 end; 778 else if key <= 5 then do; /* bounds info */ 779 if s_ptr -> runtime_symbol.simple then do; 780 s_ptr -> runtime_symbol.simple = "0"b; 781 call allocate_storage(2, 0); 782 end; 783 call allocate_storage(3, 0); 784 s_ptr -> runtime_symbol.ndims = s_ptr -> runtime_symbol.ndims + 1; 785 s_ptr -> runtime_symbol.bounds(s_ptr -> runtime_symbol.ndims).upper = 786 fixed(before(substr(token, 2), "]")) - 1; 787 end; 788 else s_ptr -> runtime_symbol.type = fixed(token); /* explicit type */ 789 end; 790 if s = top then 791 if context = 0 then call thread_symbol_into_block(s, current_block); 792 else call add_symbol_in_context(s, context); 793 call compute_array_data(s); 794 end define_symbol; 795 796 /* This procedure emits all the structures that have been previously 797* defined into the symbol table of the object. */ 798 emit_symtab: proc; /* IN-OUT (pc) */ 799 dcl (i, j) fixed bin(26); 800 dcl seg_name_size fixed bin(26); 801 dcl temp_string char(8); 802 dcl twop18 fixed bin(26) int static options(constant) init(262144); 803 dcl token(0:5) fixed bin; /* used to fill out token list in runtime_blocks */ 804 805 do i = 0 to max_source; /* fix up offsets of source strings */ 806 sc_map(i).pathname.offset = sc_map(i).pathname.offset + start_sc_strings; 807 end; 808 809 call putout_$putwrd(pc, 1, i66, 0); /* source_map.version */ 810 call putout_$putwrd(pc, (max_source+1), i66, 0); /* source_map.number */ 811 call putout_$putblk(pc, addr(sc_map), i66, (max_source+1)*4, null()); 812 813 call putout_$putblk(pc, addr(sc_strings), i66, divide(sc_string_len, 4, 26, 0), null()); 814 815 if current_statement = 0 & max_allocated = 0 then return; 816 817 /* pl1_symbol_block */ 818 j = length(rtrim(sthedr_$seg_name)); 819 seg_name_size = divide(j + 3, 4, 26, 0); 820 call putout_$putwrd(pc, 1, i66, 0); /* version */ 821 temp_string = "pl1info "; 822 call putout_$putblk(pc, addr(temp_string), i66, 2, null()); 823 call putout_$putwrd(pc, fixed("100000000000"b3,35), i66, 0); /* flags: map */ 824 call putout_$putwrd(pc, 0, i66, 0); /* greatest severity */ 825 call putout_$putwrd(pc, start_symbol * twop18, i66, 0); /* root, profile */ 826 i = start_statement * twop18 + start_statement + (current_statement+1)*2; 827 call putout_$putwrd(pc, i, i66, 0); /* map: first, last */ 828 call putout_$putwrd(pc, (pc + 1) * twop18 + j, i66, 0); /* segname: offset, length */ 829 call putout_$putblk(pc, addr(sthedr_$seg_name), i66, seg_name_size, null()); 830 831 /* output symbol information */ 832 if max_allocated > 0 then do; 833 call resolve_forward_references; 834 call make_token_list; 835 call adjust_block_offsets(1); 836 call putout_$putblk(pc, symbol_data_ptr, i66, (max_allocated), temp_ptrs(3)); 837 end; 838 839 /* can't allocate statement map as a block because of relocation */ 840 do i = 1 to current_statement; /* statement map */ 841 call putout_$putwrd(pc, addr(st_map(i)) -> word(1), i66, iltext); 842 call putout_$putwrd(pc, addr(st_map(i)) -> word(2), i66, 0); 843 end; 844 /* last statement map entry is special */ 845 call putout_$putwrd(pc, (itxpc-1)*twop18 + 262143, i66, iltext); 846 call putout_$putwrd(pc, 261632*twop18, i66, 0); 847 return; /* end emit_symtab */ 848 849 /* This procedure scans through the linked list of runtime tokens 850* creating the hashed list that is used by runtime_blocks */ 851 make_token_list: proc; 852 dcl (l, o, slot, t) fixed bin; 853 dcl t_ptr ptr; 854 855 token(*) = 0; 856 slot = 0; 857 l = 1; 858 t = 0; 859 o = first_token; 860 do while(o ^= 0); 861 t = t + o; 862 t_ptr = addr(symbol_data(t)); 863 o = t_ptr -> runtime_token.next; 864 do while(t_ptr -> runtime_token.size >= l); 865 token(slot) = t; 866 slot = slot + 1; 867 l = l + l; 868 if slot > hbound(token, 1) then return; 869 end; 870 end; 871 end make_token_list; 872 873 /* This procedure recursively adjusts offset values for the runtime_block 874* tree. It adjusts the values for the token hash list and statement map values */ 875 adjust_block_offsets: proc(b); 876 dcl b fixed bin parameter; 877 dcl b_ptr ptr; 878 dcl i fixed bin; 879 880 b_ptr = addr(symbol_data(b)); 881 b_ptr -> runtime_block.header = 1-b-start_symbol; 882 if b_ptr -> runtime_block.father = 0 then b_ptr -> runtime_block.father = 1 - b - start_symbol; 883 do i = 0 to 5 while(token(i) ^= 0); 884 b_ptr -> runtime_block.token(i) = token(i) - b; 885 end; 886 b_ptr -> runtime_block.map.first = b_ptr -> runtime_block.map.first*2 + start_statement-b-start_symbol+1; 887 b_ptr -> runtime_block.map.last = b_ptr -> runtime_block.map.last*2 + start_statement-b-start_symbol+1; 888 if b_ptr -> runtime_block.brother ^= 0 then 889 call adjust_block_offsets(b_ptr -> runtime_block.brother + b); 890 if b_ptr -> runtime_block.son ^= 0 then 891 call adjust_block_offsets(b_ptr -> runtime_block.son + b); 892 end adjust_block_offsets; 893 894 resolve_forward_references: proc; 895 dcl (s, i) fixed bin; 896 dcl s_ptr ptr; 897 898 s = forward; 899 do while(s ^= 0); 900 s_ptr = addr(symbol_data(s)); 901 i = find_symbol(addr(symbol_data(s_ptr -> runtime_symbol.son)) -> runtime_token.string, 902 s_ptr->runtime_symbol.father+s, (s_ptr->runtime_symbol.level > 0)); 903 if i = 0 then call ioa_("Type has been referenced but not defined: ^a", 904 addr(symbol_data(s_ptr -> runtime_symbol.son)) -> runtime_token.string); 905 else s_ptr -> runtime_symbol.son = i - s; 906 s = s_ptr -> runtime_symbol.size; /* link through size field */ 907 s_ptr -> runtime_symbol.size = 35; /* reasonable but useless value */ 908 end; 909 end resolve_forward_references; 910 911 end emit_symtab; 912 913 /* runtime symbol structures */ 914 915 dcl 1 runtime_symbol aligned based, 916 2 flag unal bit(1), /* always "1"b for Version II */ 917 2 use_digit unal bit(1), /* if "1"b and units are half words units are really digits */ 918 2 array_units unal fixed bin(2) unsigned, 919 2 units unal fixed bin(2) unsigned, /* addressing units */ 920 2 type unal fixed bin(6) unsigned, /* data type */ 921 2 level unal fixed bin(6) unsigned, /* structure level */ 922 2 ndims unal fixed bin(6) unsigned, /* number of dimensions */ 923 2 bits unal, 924 3 aligned bit(1), 925 3 packed bit(1), 926 3 simple bit(1), 927 3 decimal bit(1), 928 2 scale unal fixed bin(7), /* arithmetic scale factor */ 929 2 name unal fixed bin(17), /* rel ptr to acc name */ 930 2 brother unal fixed bin(17), /* rel ptr to brother entry */ 931 2 father unal fixed bin(17), /* rel ptr to father entry */ 932 2 son unal fixed bin(17), /* rel ptr to son entry */ 933 2 address unal, 934 3 location fixed bin(17), /* location in storage class */ 935 3 class unsigned fixed bin(4), /* storage class */ 936 3 next fixed bin(13), /* rel ptr to next of same class */ 937 2 size fixed bin(35), /* encoded string|arith size */ 938 2 offset fixed bin(35), /* encoded offset from address */ 939 2 virtual_org fixed bin(35), 940 2 bounds(1), 941 3 lower fixed bin(35), /* encoded lower bound */ 942 3 upper fixed bin(35), /* encoded upper bound */ 943 3 multiplier fixed bin(35); /* encoded multiplier */ 944 945 dcl 1 runtime_bound based, 946 2 lower fixed bin(35), 947 2 upper fixed bin(35), 948 2 multiplier fixed bin(35); 949 950 dcl 1 runtime_block aligned based, 951 2 flag unal bit(1), /* always "1"b for Version II */ 952 2 quick unal bit(1), /* "1"b if quick block */ 953 2 fortran unal bit(1), /* "1"b if fortran program */ 954 2 standard unal bit(1), /* "1"b if program has std obj segment */ 955 2 owner_flag unal bit(1), /* "1"b if block has valid owner field */ 956 2 skip unal bit(1), 957 2 type unal fixed bin(6) unsigned, /* = 0 for a block node */ 958 2 number unal fixed bin(6) unsigned, /* begin block number */ 959 2 start unal fixed bin(17), /* rel ptr to start of symbols */ 960 2 name unal fixed bin(17), /* rel ptr to name of proc */ 961 2 brother unal fixed bin(17), /* rel ptr to brother block */ 962 2 father unal fixed bin(17), /* rel ptr to father block */ 963 2 son unal fixed bin(17), /* rel ptr to son block */ 964 2 map unal, 965 3 first fixed bin(17), /* rel ptr to first word of map */ 966 3 last fixed bin(17), /* rel ptr to last word of map */ 967 2 entry_info unal fixed bin(17), /* info about entry of quick block */ 968 2 header unal fixed bin(17), /* rel ptr to symbol header */ 969 2 chain(4) unal fixed bin(17), /* chain(i) is rel ptr to first symbol 970* on start list with length >= 2**i */ 971 2 token(0:5) unal fixed bin(17), /* token(i) is rel ptr to first token 972* on list with length >= 2 ** i */ 973 2 owner unal fixed bin(17); /* rel ptr to owner block */ 974 975 dcl 1 runtime_token aligned based, 976 2 next unal fixed bin(17), /* rel ptr to next token */ 977 2 dcl unal fixed bin(17), /* rel ptr to first dcl of this token */ 978 2 name, /* ACC */ 979 3 size unal unsigned fixed bin (9), /* number of chars in token */ 980 3 string unal char(n refer(runtime_token.size)); 981 /* end of rutime symbol structures */ 982 1 1 1 2 1 3 1 4 /* include file for CONCOM */ 1 5 1 6 declare 1 eb_data_$concom ext aligned, 1 7 2 (ap, ab, bp, bb, lp, lb, sp, sb, 1 8 clunk, clint, clext, clbas, clstk, clndx, clmlc, fdef, 1 9 fmul, fphs, fset, frel, fabs, fbol, fcom, find, 1 10 flocrf, fequrf, fbolrf, fsetrf, fbasrf, fsegrf, fstkrf, fndxrf, 1 11 fmlcrf, onesev, twosev, thrsev, forsev, fivsev, sixsev, allsev, 1 12 symbas(8),mir, mri, mdu, mdl, mx0, mx1, mpc, 1 13 mpci, mfi, mits, mitb, ixtern, intern, iassgn, iserch, 1 14 ixvrvl, ixvrvp, invrvl, invrvp, ibvrvl, ibvrvp, iaccvl, iacivl, 1 15 mcmpq, mcmpx0, mldaq, mldq, mldx0, mnopdu, mstcd, mtra, 1 16 mtnc, mtnz, meabsp, meapap, meapbp, meaplp, meapsp, mstpap, 1 17 mstpbp, mstplp, mstpsp, i1542, i642, i3333, i66, ibb, 1 18 ibsp, nullf, smxer(2), sentry(2),sretrn(2), dzero(2) ) fixed bin (26) aligned ; 1 19 1 20 /* end of the include file for CONCOM */ 983 2 1 2 2 /* Last modified by EBush on 2/5/81 to add prnta */ 2 3 2 4 2 5 declare 1 eb_data_$erflgs ext aligned, 2 6 2 flgvec (36) fixed bin (17) aligned ; 2 7 2 8 2 9 declare 1 eb_data_$erflgs_overlay ext aligned, /* overlays the FLGVEC */ 2 10 2 (prnte, prntf, prntm, prntn, prnto, prntp, 2 11 prntr, prnts, prntt, prntu, prntx, prntb, 2 12 prntc, prntd, prnta, prnt5, prnt6, prnt7, 2 13 tstsw(18) ) fixed bin (17) aligned ; 2 14 2 15 984 3 1 /* Begin include file objnfo.incl.pl1. 3 2* Parameters saved for object map. 3 3* Last modified on 05/12/72 at 01:10:27 by R F Mabee. */ 3 4 3 5 3 6 /****^ HISTORY COMMENTS: 3 7* 1) change(86-10-01,JRGray), approve(86-10-01,MCR7507), 3 8* audit(86-10-27,RWaters), install(86-11-12,MR12.0-1202): 3 9* Modified to add definition count used to join blocks to the definition 3 10* section. 3 11* END HISTORY COMMENTS */ 3 12 3 13 declare 1 eb_data_$objnfo external static aligned, 3 14 2 (itxpc, ilkpc, istpc, idfpc, itxcnt, ilkcnt, istcnt, idfcnt) fixed bin (26) aligned, 3 15 2 (new_text_offset, new_definition_offset, new_link_offset, new_static_offset, new_symbol_offset) fixed bin (26) aligned, 3 16 2 (new_text_length, new_definition_length, new_link_length, new_static_length, new_symbol_length) fixed bin (26) aligned; 3 17 3 18 /* End of include file objnfo.incl.pl1. */ 985 4 1 dcl 1 pl1_symbol_block aligned based, 4 2 2 version fixed bin, 4 3 2 identifier char(8), /* must be "pl1info" */ 4 4 2 flags, 4 5 3 profile bit(1) unal, 4 6 3 table bit(1) unal, 4 7 3 map bit(1) unal, 4 8 3 flow bit(1) unal, 4 9 3 io bit(1) unal, 4 10 3 table_removed bit(1) unal, 4 11 3 long_profile bit(1) unal, 4 12 3 pad bit(29) unal, 4 13 2 greatest_severity fixed bin, 4 14 2 root unal bit(18), 4 15 2 profile unal bit(18), 4 16 2 map unal, 4 17 3 first bit(18), 4 18 3 last bit(18), 4 19 2 segname unaligned, 4 20 3 offset bit(18), 4 21 3 size bit(18); 986 5 1 5 2 5 3 5 4 /* include file for RELBIT */ 5 5 5 6 declare 1 eb_data_$relbit ext aligned, 5 7 2 ( iabsol, itext, imtext, ilink, imlink, ilkptr, idefpt, isymbl, 5 8 imsymb, ilblok, imblok, iselfr, iresv1, iresv2, iresv3, iresv4, 5 9 iescap, iltext, illink, ilsymb, ildefs, ibits(3) ) fixed bin (26) aligned ; 5 10 5 11 /* end of the include file RELBIT */ 5 12 5 13 5 14 987 6 1 /* Include file sthedr.incl.pl1. 6 2* This file declares old and new versions of symbol table headers. 6 3* Last modified on 06/20/72 at 18:51:18 by R F Mabee. */ 6 4 6 5 6 6 6 7 /****^ HISTORY COMMENTS: 6 8* 1) change(88-08-02,JRGray), approve(88-08-05,MCR7952), 6 9* audit(88-09-30,WAAnderson), install(88-10-17,MR12.2-1169): 6 10* Modified to make area_offset externally available. This is part of 6 11* Symbol Table Support. 6 12* END HISTORY COMMENTS */ 6 13 6 14 6 15 /* Declarations for old object segment format symbol table header. */ 6 16 6 17 declare sthedr_$sthedr_ ext aligned; 6 18 6 19 declare (sthedr_$alm_creation_date, sthedr_$time_of_translation) ext fixed bin (71) aligned; 6 20 6 21 declare sthedr_$seg_name ext char (32) aligned; 6 22 6 23 declare 1 sthedr_$text_and_link_lengths ext aligned, 6 24 2 text_length bit (18) unaligned, 6 25 2 link_length bit (18) unaligned; 6 26 6 27 declare sthedr_$hdrlen ext fixed bin (26) aligned; 6 28 6 29 /* Declarations for new object segment format symbol table header. */ 6 30 6 31 declare new_sthedr_$new_sthedr_ ext aligned; 6 32 6 33 declare (new_sthedr_$alm_creation_date, new_sthedr_$time_of_translation) ext fixed bin (71) aligned; 6 34 6 35 declare new_sthedr_$alm_version_name ext char (32) aligned; 6 36 6 37 declare new_sthedr_$user_id ext char (32) aligned; 6 38 6 39 declare new_sthedr_$comment ext char (64) aligned; 6 40 6 41 declare 1 new_sthedr_$text_and_link_boundaries ext aligned, 6 42 2 text_boundary bit (18) unaligned, 6 43 2 link_boundary bit (18) unaligned; 6 44 6 45 declare 1 new_sthedr_$source_and_area ext aligned, 6 46 2 source_map_offset bit (18) unaligned, 6 47 2 area_offset bit (18) unaligned; 6 48 6 49 declare 1 new_sthedr_$block_size ext aligned, 6 50 2 padding bit (18) unaligned, 6 51 2 block_size bit (18) unaligned; 6 52 6 53 declare 1 new_sthedr_$rel_bits_ptrs ext aligned, 6 54 2 padding bit (18) unaligned, 6 55 2 rel_text bit (18) unaligned, 6 56 2 rel_def bit (18) unaligned, 6 57 2 rel_link bit (18) unaligned, 6 58 2 rel_symbol bit (18) unaligned, 6 59 2 other_bits bit (18) unaligned; 6 60 6 61 declare 1 new_sthedr_$truncate_info ext aligned, 6 62 2 padding bit (18) unaligned, 6 63 2 default_truncate bit (18) unaligned, 6 64 2 optional_truncate bit (18) unaligned, 6 65 2 other_bits bit (18) unaligned; 6 66 6 67 declare new_sthedr_$hdrlen ext fixed bin (26) aligned; 6 68 6 69 declare new_sthedr_$relocinfo ext aligned; 6 70 6 71 /* End of the include file sthedr.incl.pl1 */ 988 989 990 end alm_symtab_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/17/88 0929.6 alm_symtab_.pl1 >spec>install>1170>alm_symtab_.pl1 983 1 10/21/74 1243.0 concom.incl.pl1 >ldd>include>concom.incl.pl1 984 2 07/17/81 1911.5 erflgs.incl.pl1 >ldd>include>erflgs.incl.pl1 985 3 11/12/86 1103.0 objnfo.incl.pl1 >ldd>include>objnfo.incl.pl1 986 4 03/10/77 1345.4 pl1_symbol_block.incl.pl1 >ldd>include>pl1_symbol_block.incl.pl1 987 5 10/21/74 1242.9 relbit.incl.pl1 >ldd>include>relbit.incl.pl1 988 6 10/17/88 0926.0 sthedr.incl.pl1 >ldd>include>sthedr.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. CHAR constant fixed bin(17,0) initial dcl 74 ref 463 565 734 DOUBLE constant fixed bin(17,0) initial dcl 74 ref 460 564 ENUMTYPE 000616 constant fixed bin(17,0) initial dcl 74 set ref 112* 464 752 ENUMVALUE constant fixed bin(17,0) initial dcl 74 ref 464 752 FLOAT constant fixed bin(17,0) initial dcl 74 ref 460 FUNCTION constant fixed bin(17,0) initial dcl 74 ref 760 INT constant fixed bin(17,0) initial dcl 74 ref 459 LONG constant fixed bin(17,0) initial dcl 74 ref 459 564 PTR constant fixed bin(17,0) initial dcl 74 ref 461 564 759 STRUCTURE 000642 constant fixed bin(17,0) initial dcl 74 set ref 158* 465 478 493 552 560 564 TYPEREF constant fixed bin(17,0) initial dcl 74 ref 499 742 UINT constant fixed bin(17,0) initial dcl 74 ref 462 ULONG constant fixed bin(17,0) initial dcl 74 ref 462 UNION 000615 constant fixed bin(17,0) initial dcl 74 set ref 172* 478 482 493 560 addr builtin function dcl 25 ref 250 264 272 272 274 291 301 301 317 320 321 323 335 340 341 356 357 357 369 372 373 374 376 389 394 396 398 418 422 423 425 428 430 432 439 442 443 444 447 457 458 466 469 469 474 477 478 478 485 491 493 493 499 501 512 524 541 542 548 587 588 595 606 607 610 621 633 633 635 642 644 648 649 652 652 680 730 752 766 769 811 811 813 813 822 822 829 829 841 842 862 880 900 901 903 address 3 based structure level 2 packed packed unaligned dcl 915 admod parameter fixed bin(26,0) dcl 657 in procedure "define_symbol" ref 655 696 admod parameter fixed bin(26,0) dcl 23 in procedure "alm_symtab_" set ref 167 168* aligned 0(24) based bit(1) level 3 packed packed unaligned dcl 915 set ref 401* 562 708* 735* 774* alm_source_map_$count_map_words 000442 constant entry external dcl 27 ref 182 alm_source_map_$put_out_map 000444 constant entry external dcl 28 ref 205 area_offset 0(18) 000476 external static bit(18) level 2 packed packed unaligned dcl 6-45 set ref 197* array_units 0(02) based fixed bin(2,0) level 2 packed packed unsigned unaligned dcl 915 set ref 528* b parameter fixed bin(17,0) dcl 579 in procedure "thread_symbol_into_block" ref 578 582 588 589 598 598 604 606 606 608 609 610 612 628 630 b 000112 automatic fixed bin(17,0) dcl 286 in procedure "open_block" set ref 290* 291 301 303 308 316 320 321 323 325 b parameter fixed bin(17,0) dcl 876 in procedure "adjust_block_offsets" ref 875 880 881 882 884 886 887 888 890 b 000100 automatic fixed bin(17,0) dcl 410 in procedure "find_symbol" set ref 435* 437* 437 438 439 447 b29 parameter fixed bin(26,0) dcl 23 in procedure "alm_symtab_" set ref 167 168* b29 parameter fixed bin(26,0) dcl 657 in procedure "define_symbol" ref 655 b_ptr 000130 automatic pointer dcl 332 in procedure "close_block" set ref 335* 336 337 340 344 345 b_ptr 000100 automatic pointer dcl 877 in procedure "adjust_block_offsets" set ref 880* 881 882 882 884 886 886 887 887 888 888 890 890 b_ptr 000210 automatic pointer dcl 538 in procedure "add_symbol_in_context" set ref 548* 549 550 558 559 560 560 b_ptr 000234 automatic pointer dcl 580 in procedure "thread_symbol_into_block" set ref 588* 597 603 604 608 610 628 628 630 b_ptr 000116 automatic pointer dcl 287 in procedure "open_block" set ref 291* 294 295 297 299 300 301 303 308 309 311 312 313 314 316 320 basno parameter fixed bin(26,0) dcl 23 in procedure "alm_symtab_" set ref 167 168* basno parameter fixed bin(26,0) dcl 657 in procedure "define_symbol" set ref 655 687* 696 702 before builtin function dcl 25 ref 785 bit builtin function dcl 25 ref 197 bits 0(24) based structure level 2 packed packed unaligned dcl 915 block parameter fixed bin(17,0) dcl 286 in procedure "open_block" set ref 284 295 301 301 301 303 325* block parameter fixed bin(17,0) dcl 331 in procedure "close_block" set ref 330 334 335 339 340 344* 345* 345 bot 000150 automatic fixed bin(17,0) dcl 367 in procedure "close_context" set ref 369* 370 371* 371 372 372 373 bot 000113 automatic fixed bin(17,0) dcl 286 in procedure "open_block" set ref 317* 318 319* 319 320 320 321 321 bot 000126 automatic fixed bin(17,0) dcl 331 in procedure "close_block" set ref 337* 338 339* 339 340 340 341 bot 000204 automatic fixed bin(17,0) dcl 537 in procedure "add_symbol_in_context" set ref 545* 546 547* 547 548 549 550 560* bounds 7 based structure array level 2 dcl 915 brother 1(18) based fixed bin(17,0) level 2 in structure "runtime_block" packed packed unaligned dcl 950 in procedure "alm_symtab_" set ref 320* 320 321* 340 341* 888 888 brother 1(18) based fixed bin(17,0) level 2 in structure "runtime_symbol" packed packed unaligned dcl 915 in procedure "alm_symtab_" set ref 372 373* 423 443 474 491 549* 549 550* 621 628* 633 633* 633 635* c parameter fixed bin(17,0) dcl 537 in procedure "add_symbol_in_context" ref 536 540 542 544 547 573 c 000101 automatic fixed bin(17,0) dcl 410 in procedure "find_symbol" set ref 414* 416* 416 417 418 428 429 430 432 432 c_ptr 000212 automatic pointer dcl 538 set ref 542* 543 545 552 573 chain 5 based fixed bin(17,0) array level 2 packed packed unaligned dcl 950 set ref 603 604* 608* 610* class 3(18) based fixed bin(4,0) level 3 packed packed unsigned unaligned dcl 915 set ref 692* 693* 694* 698* 701* 702* context 000022 internal static fixed bin(17,0) dcl 39 in procedure "alm_symtab_" set ref 86* 100 101* 106 112* 116 117* 158* 162 163* 172* 176 177* 195 743 743* 752 761 763* 770 770 790 792* context parameter fixed bin(17,0) dcl 367 in procedure "close_context" set ref 366 369 371 374 374 376* 376 376 377 377* context parameter fixed bin(17,0) dcl 352 in procedure "open_context" set ref 350 359 360* 361* context parameter fixed bin(17,0) dcl 408 in procedure "find_symbol" ref 406 412 ct 000224 automatic fixed bin(17,0) dcl 579 set ref 606* 607 610 ctl 000225 automatic fixed bin(17,0) dcl 579 set ref 607* 608 609 current_block 000023 internal static fixed bin(17,0) dcl 39 set ref 87* 102* 107 108* 196 289 314 316 317 319 323 323 359* 377 429 744* 761* 771 790* current_source 000024 internal static fixed bin(17,0) dcl 39 set ref 88* 123* 125 127 129 130 131 142* 153 current_statement 000025 internal static fixed bin(17,0) dcl 39 set ref 89* 148* 148 149 150 151 152 153 154 189 200 313 336 815 826 840 dcl 0(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 975 set ref 396 398* dcladdr 000160 automatic fixed bin(17,0) dcl 384 set ref 396* 397 397 decimal 0(27) based bit(1) level 3 packed packed unaligned dcl 915 set ref 737* default_size 1 000051 constant fixed bin(17,0) initial array level 2 dcl 673 ref 733 divide builtin function dcl 25 ref 127 188 198 262 480 497 564 565 566 711 730 813 813 819 dtm 2 based fixed bin(71,0) array level 3 dcl 57 set ref 131* eb_data_$concom 000464 external static structure level 1 dcl 1-6 eb_data_$erflgs_overlay 000466 external static structure level 1 dcl 2-9 eb_data_$lavptr 000462 external static pointer dcl 50 ref 686 eb_data_$objnfo 000470 external static structure level 1 dcl 3-13 eb_data_$relbit 000472 external static structure level 1 dcl 5-6 ec 000100 automatic fixed bin(35,0) dcl 46 set ref 83* 209* father 2 based fixed bin(17,0) level 2 in structure "runtime_block" packed packed unaligned dcl 950 in procedure "alm_symtab_" set ref 314* 316* 344 345 447 882 882* father 2 based fixed bin(17,0) level 2 in structure "runtime_symbol" packed packed unaligned dcl 915 in procedure "alm_symtab_" set ref 376 428 432 544* 589* 770* 771* 901 file 42000(18) based fixed bin(8,0) array level 4 packed packed unsigned unaligned dcl 57 set ref 153* first 000100 automatic fixed bin(17,0) dcl 454 in procedure "symbol_element_size" set ref 488* 492 first 3 based fixed bin(17,0) level 3 in structure "runtime_block" packed packed unaligned dcl 950 in procedure "alm_symtab_" set ref 313* 886* 886 first 000102 automatic fixed bin(17,0) dcl 410 in procedure "find_symbol" set ref 419* 424 first_token 000026 internal static fixed bin(17,0) dcl 39 set ref 90* 248 268 268 269* 859 fixed builtin function dcl 25 ref 197 776 785 788 823 823 flag based bit(1) level 2 in structure "runtime_symbol" packed packed unaligned dcl 915 in procedure "alm_symtab_" set ref 400* flag based bit(1) level 2 in structure "runtime_block" packed packed unaligned dcl 950 in procedure "alm_symtab_" set ref 311* forward 000027 internal static fixed bin(17,0) dcl 39 set ref 91* 746 747* 898 get_temp_segments_ 000450 constant entry external dcl 30 ref 83 getbit_ 000446 constant entry external dcl 29 ref 687 glpl_words based structure array level 1 packed packed unaligned dcl 51 hbound builtin function dcl 25 ref 225 868 header 4(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 950 set ref 881* i 000101 automatic fixed bin(21,0) dcl 47 in procedure "alm_symtab_" set ref 128* 129 133* 133 133 134 135 i 000101 automatic fixed bin(17,0) dcl 454 in procedure "symbol_element_size" set ref 467* 469* 473* 473 474 477 478 478 478* 484* 485 488 490* 490 491 492 493 493 493* i 000102 automatic fixed bin(17,0) dcl 878 in procedure "adjust_block_offsets" set ref 883* 883* 884 884* i 000263 automatic fixed bin(17,0) dcl 659 in procedure "define_symbol" set ref 724* 725 725* 726 727 730* 731 732 733 734 743* 744* 745 748* 749 752 752 754 765* 766 767 768 i 000413 automatic fixed bin(17,0) dcl 895 in procedure "resolve_forward_references" set ref 901* 903 905 i 000226 automatic fixed bin(17,0) dcl 579 in procedure "thread_symbol_into_block" set ref 600* 601 602* 602 602 i 000350 automatic fixed bin(26,0) dcl 799 in procedure "emit_symtab" set ref 805* 806 806* 826* 827* 840* 841 842* i 000172 automatic fixed bin(17,0) dcl 521 in procedure "compute_array_data" set ref 529* 530 531 531* i 000100 automatic fixed bin(17,0) dcl 507 in procedure "symbol_size" set ref 513* 514 514* i66 135 000464 external static fixed bin(26,0) level 2 dcl 1-6 set ref 809* 810* 811* 813* 820* 822* 823* 824* 825* 827* 828* 829* 836* 841* 842* 845* 846* iaddr parameter fixed bin(26,0) dcl 23 in procedure "alm_symtab_" set ref 167 168* iaddr parameter fixed bin(26,0) dcl 657 in procedure "define_symbol" set ref 655 684 686 687* ilink 3 000472 external static fixed bin(26,0) level 2 dcl 5-6 ref 693 iltext 21 000472 external static fixed bin(26,0) level 2 dcl 5-6 set ref 841* 845* in_symbol_context parameter bit(1) packed unaligned dcl 409 ref 406 413 index builtin function dcl 25 ref 723 730 ioa_ 000452 constant entry external dcl 31 ref 218 903 isymbl 7 000472 external static fixed bin(26,0) level 2 dcl 5-6 ref 694 itext 1 000472 external static fixed bin(26,0) level 2 dcl 5-6 ref 692 itxpc 000470 external static fixed bin(26,0) level 2 dcl 3-13 ref 845 j 000351 automatic fixed bin(26,0) dcl 799 in procedure "emit_symtab" set ref 818* 819 828 j 000227 automatic fixed bin(17,0) dcl 579 in procedure "thread_symbol_into_block" set ref 597* 598 598 598 603* 604 606 606 609 612 616* 618 619 620 621* 623* key 000264 automatic fixed bin(17,0) dcl 659 set ref 723* 724 729 758 759 773 778 l 000104 automatic fixed bin(17,0) dcl 240 in procedure "get_token" set ref 243* 244 251 252 262 265 l 000374 automatic fixed bin(17,0) dcl 852 in procedure "make_token_list" set ref 857* 864 867* 867 867 last 3(18) based fixed bin(17,0) level 3 packed packed unaligned dcl 950 set ref 336* 887* 887 last_s 000230 automatic fixed bin(17,0) dcl 579 set ref 591* 598* 609* 612* 616 617* 619 620* 620 621 627 633 633 633 635 635 last_t 000101 automatic fixed bin(17,0) dcl 238 set ref 247* 258* 267 272 272 272 274 274 left based fixed bin(18,0) array level 2 packed packed unsigned unaligned dcl 51 set ref 686 688* length 42001(27) based fixed bin(9,0) array level 4 in structure "source_data" packed packed unsigned unaligned dcl 57 in procedure "alm_symtab_" set ref 151* length builtin function dcl 25 in procedure "alm_symtab_" ref 128 198 243 725 818 level 0(12) based fixed bin(6,0) level 2 packed packed unsigned unaligned dcl 915 set ref 357 357* 430 543* 543 766* 766 901 line 42000(26) based fixed bin(14,0) array level 4 packed packed unsigned unaligned dcl 57 set ref 152* location 42000 based fixed bin(18,0) array level 3 in structure "source_data" packed packed unsigned unaligned dcl 57 in procedure "alm_symtab_" set ref 149* location 3 based fixed bin(17,0) level 3 in structure "runtime_symbol" packed packed unaligned dcl 915 in procedure "alm_symtab_" set ref 684* 686* 699* 699 lower 7 based fixed bin(35,0) array level 3 dcl 915 ref 514 531 m 000102 automatic fixed bin(17,0) dcl 454 set ref 477* 478* 478 480 483* 493* 493 497 map 3 based structure level 2 packed packed unaligned dcl 950 max builtin function dcl 25 ref 493 max_allocated 000030 internal static fixed bin(17,0) dcl 40 set ref 92* 189 199 225 227* 229 230* 230 289 815 832 836 max_block 000031 internal static fixed bin(17,0) dcl 40 set ref 93* 293* 293 294 max_source 000032 internal static fixed bin(17,0) dcl 40 set ref 94* 122* 122 123 181 187 205 805 810 811 mod builtin function dcl 25 ref 133 710 multiplier 11 based fixed bin(35,0) array level 3 dcl 915 set ref 530* name parameter char packed unaligned dcl 351 in procedure "open_context" set ref 350 354* name parameter char packed unaligned dcl 236 in procedure "get_token" ref 235 243 252 254 266 name parameter char packed unaligned dcl 19 in procedure "alm_symtab_" set ref 167 168* name parameter char packed unaligned dcl 656 in procedure "define_symbol" set ref 655 677* name parameter char packed unaligned dcl 407 in procedure "find_symbol" ref 406 425 444 name 1 based fixed bin(17,0) level 2 in structure "runtime_symbol" packed packed unaligned dcl 915 in procedure "alm_symtab_" set ref 395* 422 442 592 606 642 644 name parameter char packed unaligned dcl 382 in procedure "create_symbol" set ref 381 387 392* name 1 based fixed bin(17,0) level 2 in structure "runtime_block" packed packed unaligned dcl 950 in procedure "alm_symtab_" set ref 308* name parameter char packed unaligned dcl 285 in procedure "open_block" set ref 284 292 307* name 1 based structure level 2 in structure "runtime_token" dcl 975 in procedure "alm_symtab_" ndims 0(18) based fixed bin(6,0) level 2 packed packed unsigned unaligned dcl 915 set ref 513 525 529 784* 784 785 new_sthedr_$hdrlen 000500 external static fixed bin(26,0) dcl 6-67 ref 186 192 200 new_sthedr_$source_and_area 000476 external static structure level 1 dcl 6-45 next based fixed bin(17,0) level 2 in structure "runtime_token" packed packed unaligned dcl 975 in procedure "alm_symtab_" set ref 259 260 268* 272 272* 272 274* 863 next 3(22) based fixed bin(13,0) level 3 in structure "runtime_symbol" packed packed unaligned dcl 915 in procedure "alm_symtab_" set ref 397* null builtin function dcl 25 ref 209 811 811 813 813 822 822 829 829 number 0(12) based fixed bin(6,0) level 2 packed packed unsigned unaligned dcl 950 set ref 294* o 000103 automatic fixed bin(17,0) dcl 410 in procedure "find_symbol" set ref 412* 415 416 418* 419 420 421 423* 424 424* 428* 429 429* 430* 432* 436 437 439* 440 441 443* 447* o 000103 automatic fixed bin(17,0) dcl 454 in procedure "symbol_element_size" set ref 466* 468 469 469 469 472 473 474* 485* 488 489 490 491* 492 492* o 000375 automatic fixed bin(17,0) dcl 852 in procedure "make_token_list" set ref 859* 860 861 863* offset parameter fixed bin(17,0) dcl 223 in procedure "allocate_storage" set ref 222 229* offset based fixed bin(18,0) array level 4 in structure "source_data" packed packed unsigned unaligned dcl 57 in procedure "alm_symtab_" set ref 127* 806* 806 offset 000205 automatic fixed bin(17,0) dcl 537 in procedure "add_symbol_in_context" set ref 558* 559* 560* 560 564* 564 565* 565 566* 566 569 offset 5 based fixed bin(35,0) level 2 in structure "runtime_symbol" dcl 915 in procedure "alm_symtab_" set ref 469 477 559 569* 711* 715* offset parameter fixed bin(26,0) dcl 657 in procedure "define_symbol" ref 655 705 710 711 715 offset parameter fixed bin(17,0) dcl 237 in procedure "get_token" set ref 235 242* 255* 276* offset parameter fixed bin(26,0) dcl 23 in procedure "alm_symtab_" set ref 167 168* owner 12 based fixed bin(17,0) level 2 packed packed unaligned dcl 950 set ref 301* 301 303* owner_flag 0(04) based bit(1) level 2 packed packed unaligned dcl 950 set ref 299* 301 packed 0(25) based bit(1) level 3 packed packed unaligned dcl 915 set ref 709* 736* 775* pathname based structure array level 3 packed packed unaligned dcl 57 pc parameter fixed bin(26,0) dcl 23 set ref 204 205* 809* 810* 811* 813* 820* 822* 823* 824* 825* 827* 828* 828 829* 836* 841* 842* 845* 846* pl1_symbol_block based structure level 1 dcl 4-1 ref 198 prnts 7 000466 external static fixed bin(17,0) level 2 dcl 2-9 set ref 217* program_name 000617 constant char(11) initial packed unaligned dcl 18 set ref 83* 209* putout_$putblk 000454 constant entry external dcl 32 ref 811 813 822 829 836 putout_$putwrd 000456 constant entry external dcl 33 ref 809 810 820 823 824 825 827 828 841 842 845 846 quick 0(01) based bit(1) level 2 packed packed unaligned dcl 950 set ref 300* release_temp_segments_ 000460 constant entry external dcl 34 ref 209 reloc 000262 automatic fixed bin(26,0) dcl 658 set ref 683* 687* 688 692 693 694 remainder 000270 automatic char(80) packed unaligned dcl 661 set ref 721* 722 723 724 725 726 727* 727 rtrim builtin function dcl 25 ref 128 198 818 runtime_block based structure level 1 dcl 950 set ref 290 runtime_symbol based structure level 1 dcl 915 runtime_token based structure level 1 dcl 975 s parameter fixed bin(17,0) dcl 579 in procedure "thread_symbol_into_block" set ref 578 587 589 594 598* 604 608 610 619* 628 630 633 635 s parameter fixed bin(17,0) dcl 454 in procedure "symbol_element_size" ref 453 456 457 458 466 467 469 469 469 484 499 501 501 s 000102 automatic fixed bin(17,0) dcl 48 in procedure "alm_symtab_" set ref 168* s 000140 automatic fixed bin(17,0) dcl 352 in procedure "open_context" set ref 354* 355 356 357 357 359* 360* 361 s parameter fixed bin(17,0) dcl 507 in procedure "symbol_size" set ref 506 510* 512 s 000104 automatic fixed bin(17,0) dcl 410 in procedure "find_symbol" set ref 417* 419 421* 421 422 423 424 425 425 438* 441* 441 442 443 444 444 s 000265 automatic fixed bin(17,0) dcl 659 in procedure "define_symbol" set ref 677* 678 679 680 688 747 754 761 761* 763* 764* 767 768* 769 770 771 790 790* 792* 793* s parameter fixed bin(17,0) dcl 537 in procedure "add_symbol_in_context" ref 536 541 544 549 550 573 s parameter fixed bin(17,0) dcl 383 in procedure "create_symbol" set ref 381 388* 389 393* 394 395 397 398 s parameter fixed bin(17,0) dcl 521 in procedure "compute_array_data" set ref 520 524 526* s 000412 automatic fixed bin(17,0) dcl 895 in procedure "resolve_forward_references" set ref 898* 899 900 901 905 906* s1 parameter fixed bin(17,0) dcl 640 ref 639 642 646 s2 parameter fixed bin(17,0) dcl 640 ref 639 644 647 s_ptr 000414 automatic pointer dcl 896 in procedure "resolve_forward_references" set ref 900* 901 901 901 903 905 906 907 s_ptr 000266 automatic pointer dcl 660 in procedure "define_symbol" set ref 680* 684 686 692 693 694 698 699 699 701 702 707 708 709 711 712 715 716 732 733 735 736 737 742 746 749 752 754 759 760 766 767 769* 770 771 774 775 776 779 780 784 784 785 785 788 s_ptr 000236 automatic pointer dcl 580 in procedure "thread_symbol_into_block" set ref 587* 589 592 628 633 s_ptr 000214 automatic pointer dcl 538 in procedure "add_symbol_in_context" set ref 541* 543 544 549 553 555 562 563 569 570 s_ptr 000174 automatic pointer dcl 522 in procedure "compute_array_data" set ref 524* 525 528 529 530 531 531 s_ptr 000162 automatic pointer dcl 385 in procedure "create_symbol" set ref 389* 394* 395 397 400 401 402 s_ptr 000102 automatic pointer dcl 508 in procedure "symbol_size" set ref 512* 513 514 514 sc_dtcm parameter fixed bin(71,0) dcl 20 ref 120 131 sc_map based structure array level 2 unaligned dcl 57 set ref 811 811 sc_string_len 000033 internal static fixed bin(21,0) dcl 41 set ref 95* 127 134 135* 135 188 813 813 sc_strings 2000 based char(65536) level 2 packed packed unaligned dcl 57 set ref 134* 813 813 sc_uid parameter bit(36) dcl 21 ref 120 130 seg_name_size 000352 automatic fixed bin(26,0) dcl 800 set ref 819* 829* simple 0(26) based bit(1) level 3 packed packed unaligned dcl 915 set ref 402* 469 553 555* 558 707* 779 780* size 4 based fixed bin(35,0) level 2 in structure "runtime_symbol" dcl 915 in procedure "alm_symtab_" set ref 458 733* 746* 776* 906 907* size parameter fixed bin(17,0) dcl 223 in procedure "allocate_storage" ref 222 225 230 size 0(18) based fixed bin(18,0) array level 4 in structure "source_data" packed packed unsigned unaligned dcl 57 in procedure "alm_symtab_" set ref 129* size builtin function dcl 25 in procedure "alm_symtab_" ref 198 290 size 1 based fixed bin(9,0) level 3 in structure "runtime_token" packed packed unsigned unaligned dcl 975 in procedure "alm_symtab_" set ref 251 252 252 254 265* 266 425 444 596 607 610 610 648 649 652 652 864 901 901 903 903 slot 000376 automatic fixed bin(17,0) dcl 852 in procedure "make_token_list" set ref 856* 865 866* 866 868 slot 000231 automatic fixed bin(17,0) dcl 579 in procedure "thread_symbol_into_block" set ref 601* 603 604 608 610* son 2(18) based fixed bin(17,0) level 2 in structure "runtime_symbol" packed packed unaligned dcl 915 in procedure "alm_symtab_" set ref 369 374* 418 466 485 499 501 545 573* 749* 754* 767* 901 903 905* son 2(18) based fixed bin(17,0) level 2 in structure "runtime_block" packed packed unaligned dcl 950 in procedure "alm_symtab_" set ref 317 323* 337 340* 890 890 source_data based structure level 1 unaligned dcl 57 source_data_ptr 000010 internal static pointer dcl 36 set ref 84* 127 129 130 131 134 149 150 151 152 153 154 806 806 811 811 813 813 841 842 source_id 42000(18) based structure array level 3 packed packed unaligned dcl 57 source_info 42001(09) based structure array level 3 packed packed unaligned dcl 57 source_stack 000034 internal static fixed bin(17,0) array dcl 42 set ref 125* 142 st_length parameter fixed bin(35,0) dcl 22 ref 147 151 st_line parameter fixed bin(35,0) dcl 22 ref 147 152 st_loc parameter fixed bin(35,0) dcl 22 ref 147 149 st_map 42000 based structure array level 2 packed packed unaligned dcl 57 set ref 841 842 st_num parameter fixed bin(35,0) dcl 22 ref 147 154 st_offset parameter fixed bin(35,0) dcl 22 ref 147 150 stack_level 000433 internal static fixed bin(17,0) dcl 43 set ref 96* 124* 124 125 139 141* 141 142 standard 0(03) based bit(1) level 2 packed packed unaligned dcl 950 set ref 312* start 42001(09) based fixed bin(18,0) array level 4 in structure "source_data" packed packed unsigned unaligned dcl 57 in procedure "alm_symtab_" set ref 150* start 0(18) based fixed bin(17,0) level 2 in structure "runtime_block" packed packed unaligned dcl 950 in procedure "alm_symtab_" set ref 439 597 628 628 630* start_pl1_sb 000434 internal static fixed bin(17,0) dcl 44 set ref 188* 192 197 198 start_sc 000435 internal static fixed bin(17,0) dcl 44 set ref 186* 187 start_sc_strings 000436 internal static fixed bin(17,0) dcl 44 set ref 187* 188 806 start_statement 000437 internal static fixed bin(17,0) dcl 44 set ref 191* 199* 200 826 826 886 887 start_symbol 000440 internal static fixed bin(17,0) dcl 44 set ref 190* 198* 199 825 881 882 886 887 statement 42001(04) based fixed bin(5,0) array level 4 packed packed unsigned unaligned dcl 57 set ref 154* sthedr_$seg_name 000474 external static char(32) dcl 6-21 set ref 198 818 829 829 string parameter char packed unaligned dcl 19 in procedure "alm_symtab_" set ref 99 102* 111 112* 120 128 134 157 158* 171 172* string 1(09) based char level 3 in structure "runtime_token" packed packed unaligned dcl 975 in procedure "alm_symtab_" set ref 252 254 266* 425 444 610 610 652 652 901* 903* string parameter char packed unaligned dcl 215 in procedure "error" set ref 214 218* substr builtin function dcl 25 set ref 134* 723 724 726 727 776 785 symbol_data based fixed bin(35,0) array dcl 56 set ref 225 250 264 272 272 274 291 301 301 317 320 321 323 335 340 341 356 357 357 369 372 373 374 376 389 394 396 398 418 422 423 425 428 430 432 439 442 443 444 447 457 458 466 469 469 474 477 478 478 485 491 493 493 499 501 512 524 541 542 548 587 588 595 606 607 610 621 633 633 635 642 644 648 649 652 652 680 752 766 769 862 880 900 901 903 symbol_data_ptr 000012 internal static pointer dcl 36 set ref 85* 225 250 264 272 272 274 291 301 301 317 320 321 323 335 340 341 356 357 357 369 372 373 374 376 389 394 396 398 418 422 423 425 428 430 432 439 442 443 444 447 457 458 466 469 469 474 477 478 478 485 491 493 493 499 501 512 524 541 542 548 587 588 595 606 607 610 621 633 633 635 642 644 648 649 652 652 680 752 766 769 836* 862 880 900 901 903 sz 000101 automatic fixed bin(17,0) dcl 507 in procedure "symbol_size" set ref 510* 511 514* 514 516 sz 000104 automatic fixed bin(17,0) dcl 454 in procedure "symbol_element_size" set ref 458* 459 460 462 463 464 sz 000173 automatic fixed bin(17,0) dcl 521 in procedure "compute_array_data" set ref 526* 527 530 531* 531 t 000100 automatic fixed bin(17,0) dcl 238 in procedure "get_token" set ref 248* 249 250 255 258 259* 260* 260 262* 264 268 269 272 274 276 t 000377 automatic fixed bin(17,0) dcl 852 in procedure "make_token_list" set ref 858* 861* 861 862 865 t 000105 automatic fixed bin(17,0) dcl 454 in procedure "symbol_element_size" set ref 457* 459 459 460 460 461 462 462 463 464 464 465 482 499 t 000206 automatic fixed bin(17,0) dcl 537 in procedure "add_symbol_in_context" set ref 563* 564 564 564 564 565 t 000114 automatic fixed bin(17,0) dcl 286 in procedure "open_block" set ref 307* 308 t 000161 automatic fixed bin(17,0) dcl 384 in procedure "create_symbol" set ref 392* 395 396 397 398 398 t 000232 automatic fixed bin(17,0) dcl 579 in procedure "thread_symbol_into_block" set ref 592* 593 594* 594 595 t 000105 automatic fixed bin(17,0) dcl 410 in procedure "find_symbol" set ref 422* 425 425 442* 444 444 t1 000250 automatic fixed bin(17,0) dcl 640 set ref 642* 643 646* 646 648 652 t1l 000252 automatic fixed bin(17,0) dcl 640 set ref 648* 650 651 t2 000251 automatic fixed bin(17,0) dcl 640 set ref 644* 645 647* 647 649 652 t2l 000253 automatic fixed bin(17,0) dcl 640 set ref 649* 650 651 t_ptr 000240 automatic pointer dcl 580 in procedure "thread_symbol_into_block" set ref 595* 596 610 t_ptr 000400 automatic pointer dcl 853 in procedure "make_token_list" set ref 862* 863 864 t_ptr 000102 automatic pointer dcl 239 in procedure "get_token" set ref 250* 251 252 252 254 259 260 264* 265 266 268 272 temp_ptrs 000014 internal static pointer initial array dcl 37 set ref 83* 84 85 209 209* 688 836* temp_string 000354 automatic char(8) packed unaligned dcl 801 set ref 821* 822 822 tl 000233 automatic fixed bin(17,0) dcl 579 set ref 596* 601 608 609 token 000356 automatic fixed bin(17,0) array dcl 803 in procedure "emit_symtab" set ref 855* 865* 868 883 884 token 7 based fixed bin(17,0) array level 2 in structure "runtime_block" packed packed unaligned dcl 950 in procedure "alm_symtab_" set ref 884* token 000314 automatic varying char(80) dcl 662 in procedure "define_symbol" set ref 726* 730 737 743 744 748 776 785 788 top 000151 automatic fixed bin(17,0) dcl 367 in procedure "close_context" set ref 372* 374 top parameter fixed bin(17,0) dcl 659 in procedure "define_symbol" set ref 655 679* 761 790 twop18 constant fixed bin(26,0) initial dcl 802 ref 825 826 828 845 846 type parameter char packed unaligned dcl 656 in procedure "define_symbol" ref 655 721 type 000051 constant fixed bin(17,0) initial array level 2 in structure "type_info" dcl 673 in procedure "define_symbol" ref 732 734 type 0(06) based fixed bin(6,0) level 2 in structure "runtime_symbol" packed packed unsigned unaligned dcl 915 in procedure "alm_symtab_" set ref 356* 457 478 478 493 493 552 560 560 563 732* 742* 752 752* 759* 760* 788* type parameter char packed unaligned dcl 19 in procedure "alm_symtab_" set ref 167 168* type 0(06) based fixed bin(6,0) level 2 in structure "runtime_block" packed packed unsigned unaligned dcl 950 in procedure "alm_symtab_" set ref 295* 297* 309* type parameter fixed bin(17,0) dcl 352 in procedure "open_context" ref 350 356 type_info 000051 constant structure array level 1 unaligned dcl 673 type_name_info 000000 constant structure level 1 packed packed unaligned dcl 667 set ref 730 type_names based char(161) packed unaligned dcl 672 ref 730 uid 1 based bit(36) array level 3 dcl 57 set ref 130* units 0(04) based fixed bin(2,0) level 2 packed packed unsigned unaligned dcl 915 set ref 570* 712* 716* upper 10 based fixed bin(35,0) array level 3 dcl 915 set ref 514 531 785* valid_chars 000075 constant varying char(80) initial array dcl 664 ref 724 value parameter fixed bin(26,0) dcl 23 in procedure "alm_symtab_" set ref 167 168* value parameter fixed bin(26,0) dcl 657 in procedure "define_symbol" ref 655 684 686 verify builtin function dcl 25 ref 724 word based fixed bin(26,0) array dcl 54 set ref 841* 842* word_count parameter fixed bin(26,0) dcl 23 set ref 180 182* 192* 200* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. eb_data_$erflgs external static structure level 1 dcl 2-5 new_sthedr_$alm_creation_date external static fixed bin(71,0) dcl 6-33 new_sthedr_$alm_version_name external static char(32) dcl 6-35 new_sthedr_$block_size external static structure level 1 dcl 6-49 new_sthedr_$comment external static char(64) dcl 6-39 new_sthedr_$new_sthedr_ external static fixed bin(17,0) dcl 6-31 new_sthedr_$rel_bits_ptrs external static structure level 1 dcl 6-53 new_sthedr_$relocinfo external static fixed bin(17,0) dcl 6-69 new_sthedr_$text_and_link_boundaries external static structure level 1 dcl 6-41 new_sthedr_$time_of_translation external static fixed bin(71,0) dcl 6-33 new_sthedr_$truncate_info external static structure level 1 dcl 6-61 new_sthedr_$user_id external static char(32) dcl 6-37 runtime_bound based structure level 1 unaligned dcl 945 sthedr_$alm_creation_date external static fixed bin(71,0) dcl 6-19 sthedr_$hdrlen external static fixed bin(26,0) dcl 6-27 sthedr_$sthedr_ external static fixed bin(17,0) dcl 6-17 sthedr_$text_and_link_lengths external static structure level 1 dcl 6-23 sthedr_$time_of_translation external static fixed bin(71,0) dcl 6-19 NAMES DECLARED BY EXPLICIT CONTEXT. add_symbol_in_context 004405 constant entry internal dcl 536 ref 360 763 792 adjust_block_offsets 007337 constant entry internal dcl 875 ref 835 888 890 allocate_storage 002417 constant entry internal dcl 222 ref 262 290 298 388 393 554 706 781 783 alm_symtab_ 001120 constant entry external dcl 17 block 001201 constant entry external dcl 99 cleanup 002323 constant entry external dcl 208 close_block 003104 constant entry internal dcl 330 ref 108 close_context 003251 constant entry internal dcl 366 ref 117 163 177 compute_array_data 004317 constant entry internal dcl 520 ref 764 793 count_words 002124 constant entry external dcl 180 create_symbol 003313 constant entry internal dcl 381 ref 354 677 765 create_token 002545 constant label dcl 262 ref 251 252 define_symbol 005262 constant entry internal dcl 655 ref 168 emit 002300 constant entry external dcl 204 emit_symtab 006422 constant entry internal dcl 798 ref 206 end_block 001254 constant entry external dcl 105 end_enum 001366 constant entry external dcl 115 end_source 001522 constant entry external dcl 138 end_structure 001675 constant entry external dcl 161 end_union 002066 constant entry external dcl 175 enum 001327 constant entry external dcl 111 error 002357 constant entry internal dcl 214 ref 100 106 107 116 139 162 176 195 196 226 289 583 find_symbol 003446 constant entry internal dcl 406 ref 743 744 901 get_token 002457 constant entry internal dcl 235 ref 307 392 748 initialize 001127 constant entry external dcl 79 make_token_list 007257 constant entry internal dcl 851 ref 834 open_block ----------------------------------------------------------- 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