COMPILATION LISTING OF SEGMENT set_fortran_common Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 11/20/86 1158.3 mst Thu Options: optimize list 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 12 /****^ HISTORY COMMENTS: 13* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7420), 14* audit(86-08-21,Schroth), install(86-11-20,MR12.0-1222): 15* changed calling sequence for list_init_ 16* 2) change(86-08-06,Elhard), approve(86-08-06,MCR7457), 17* audit(86-08-22,DGHowe), install(86-11-20,MR12.0-1222): 18* Modified to look in all components of object MSFs for external links and 19* to ignore external variables with deferred initialization. 20* END HISTORY COMMENTS */ 21 22 23 /* format: style3,^indnoniterdo */ 24 set_fortran_common: 25 sfc: 26 proc; 27 28 /* This program finds the links to common blocks in the specified segments and obtains the 29* initialization info from them. If there are multiple initializations for the same 30* common block, they are combined, with the longest length being used. Then all the common 31* blocks are initialized with the specified init info (allocated first if necessary). 32**/ 33 /* coded October 18, 1977 by Melanie Weaver */ 34 /* modified December , 1977 by Melanie Weaver to increase dimensions and handle stat_ */ 35 /* Modified: November 12, 1982 - T Oke, to handle Very Large Array COMMON. */ 36 /* modified January 1983 by Melanie Weaver to handle variables occupying a whole segment */ 37 /* Modified November 1 1984 by M. Mabey to explicitly zero any variable that is */ 38 /* reinitialized with list templates. */ 39 40 /* AUTOMATIC */ 41 42 dcl (nargs, alng, i, j, nblocks) 43 fixed bin; 44 dcl (new_vsize, variable_size) 45 fixed bin (35); 46 dcl bitcnt fixed bin (24); 47 dcl type fixed bin (18); 48 dcl code fixed bin (35); 49 50 dcl (longsw, fatalsw, found_sw) 51 bit (1) aligned; 52 dcl block_end bit (18) aligned; 53 dcl dummy_init_info bit (72) aligned; 54 dcl k fixed bin; 55 dcl sys_areap ptr; 56 dcl sys_area area based (sys_areap); 57 dcl n_segs fixed bin; 58 dcl msf_sw bit (1); 59 60 dcl (aptr, seg_ptr, p, type_ptr, segnp, node_ptr, ext_ptr) 61 ptr; 62 dcl viptr (2) ptr; 63 64 65 dcl ext_name char (65); 66 dcl dir char (168); 67 dcl ent char (32); 68 dcl component_generator char (8); 69 70 dcl 1 seg_info (1000) aligned based (viptr (2)), 71 2 pathname char (168), 72 2 segp ptr, 73 2 bc fixed bin (24); 74 75 dcl 1 var_info (10000) aligned based (viptr (1)), 76 2 init_ptr ptr, 77 2 vsize fixed bin (35), 78 2 init_owner fixed bin, 79 2 name char (65) unaligned; 80 81 dcl 1 oi aligned like object_info; 82 83 /* CONSTANTS */ 84 85 dcl me char (18) init ("set_fortran_common") static options (constant); 86 dcl Fault_Tag_2 bit (6) aligned init ("100110"b) static options (constant); 87 88 /* EXTERNALS */ 89 90 dcl (addr, addrel, baseno, bin, bit, clock, divide, empty, 91 fixed, index, rel, max, null, ptr, substr, unspec) 92 builtin; 93 94 dcl cleanup condition; 95 96 dcl ( 97 error_table_$badopt, 98 error_table_$bad_link_target_init_info 99 ) ext fixed bin (35); 100 dcl sys_info$max_seg_size 101 ext fixed bin (35); 102 dcl pl1_operators_$VLA_words_per_seg_ 103 fixed bin (19) external; 104 105 dcl cu_$arg_count entry (fixed bin); 106 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 107 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 108 dcl (com_err_, ioa_) entry options (variable); 109 dcl get_system_free_area_ 110 entry () returns (ptr); 111 dcl object_lib_$initiate 112 entry (char (*), char (*), char (*), bit (1), ptr, fixed bin (24), bit (1), fixed bin (35)); 113 dcl object_lib_$get_component_info 114 entry (ptr, ptr, char (8), char (*), ptr, fixed bin (35)); 115 dcl pathname_ entry (char (*), char (*)) returns (char (168)); 116 dcl object_info_$brief entry (ptr, fixed bin (24), ptr, fixed bin (35)); 117 dcl set_ext_variable_ entry (char(*), ptr, ptr, bit(1) aligned, 118 ptr, fixed bin(35)); 119 dcl hcs_$terminate_noname 120 entry (ptr, fixed bin (35)); 121 dcl (get_temp_segments_, release_temp_segments_) 122 entry (char (*), (*) ptr, fixed bin (35)); 123 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); 124 dcl unique_chars_ entry (bit (36)) returns (char (15)); 125 dcl list_init_ entry (ptr, ptr, fixed bin (35), ptr , ptr, 126 fixed bin(35)); 127 dcl list_init_$variable_already_zero 128 entry (ptr, ptr, fixed bin (35), ptr, ptr, 129 fixed bin(35)); 130 131 dcl fortran_storage_manager_$alloc 132 entry (fixed bin, ptr, ptr); 133 dcl fortran_storage_manager_$free 134 entry (ptr); 135 136 137 /* BASED */ 138 139 dcl arg char (alng) based (aptr); 140 dcl new_init_info (new_vsize) fixed bin (35) based; 141 dcl based_area area (variable_size) based; 142 dcl variable (variable_size) bit (36) based; 143 144 145 146 dcl 1 acc_name aligned based, 147 2 nsize fixed bin (8) unal, 148 2 string char (0 refer (acc_name.nsize)) unaligned; 149 150 151 /* */ 152 nblocks = 0; 153 n_segs = 0; 154 longsw = "0"b; 155 fatalsw = "0"b; 156 sb = ptr (addr (sb), 0); 157 lotp = sb -> stack_header.lot_ptr; 158 159 call cu_$arg_count (nargs); 160 161 if nargs = 0 162 then do; 163 call com_err_ (0, me, "Usage is: set_fortran_common paths {-long}"); 164 return; 165 end; 166 167 sys_areap = get_system_free_area_ (); 168 169 viptr (1) = null; 170 comp_infop = null; 171 on cleanup 172 begin; 173 if viptr (1) ^= null then do; 174 do i = 1 to n_segs; 175 if seg_info (i).segp ^= null 176 then call hcs_$terminate_noname (seg_info (i).segp, code); 177 end; 178 call release_temp_segments_ (me, viptr, code); 179 end; 180 if comp_infop ^= null 181 then free component_info in (sys_area); 182 end; 183 184 call get_temp_segments_ (me, viptr, code); 185 186 do i = 1 to nargs; /* first loop to find control args */ 187 call cu_$arg_ptr (i, aptr, alng, code); 188 if (arg = "-long") | (arg = "-lg") 189 then do; 190 longsw = "1"b; 191 goto end_arg_loop; 192 end; 193 else if substr (arg, 1, 1) = "-" 194 then do; 195 call com_err_ (error_table_$badopt, me, arg); 196 fatalsw = "1"b; 197 end; 198 call expand_pathname_ (arg, dir, ent, code); 199 if code ^= 0 200 then do; 201 error1: 202 call com_err_ (code, me, arg); 203 fatalsw = "1"b; 204 goto end_arg_loop; 205 end; 206 207 call object_lib_$initiate (dir, ent, "", "1"b, seg_ptr, bitcnt, msf_sw, code); 208 if code ^= 0 209 then do; 210 error2: 211 call com_err_ (code, me, "^a>^a", dir, ent); 212 fatalsw = "1"b; 213 goto end_arg_loop; 214 end; 215 seg_info (n_segs+1).segp = null; /* initialize variable for cleanup handler. */ 216 n_segs = n_segs + 1; 217 218 do j = 1 to n_segs - 1; /* see if this arg is a duplicate */ 219 if seg_info (j).segp = seg_ptr 220 then do; /* already have this one */ 221 n_segs = n_segs - 1; 222 goto end_arg_loop; 223 end; 224 end; 225 seg_info (n_segs).segp = seg_ptr; 226 seg_info (n_segs).bc = bitcnt; 227 seg_info (n_segs).pathname = pathname_ (dir, ent); 228 229 if msf_sw 230 then do; 231 call object_lib_$get_component_info (seg_ptr, sys_areap, component_info_version_1, "none", comp_infop, code); 232 if code ^= 0 233 then goto error2; 234 235 do j = 1 to component_info.max; 236 seg_info (n_segs+1).segp = null; /* initialize variable for cleanup handler. */ 237 n_segs = n_segs + 1; 238 239 do k = 1 to n_segs - 1; /* see if this arg is a duplicate */ 240 if seg_info (k).segp = component_info.comp (j).segp 241 then do; /* already have this one */ 242 n_segs = n_segs - 1; 243 free component_info in (sys_area); 244 comp_infop = null; 245 goto end_arg_loop; 246 end; 247 end; 248 seg_info (n_segs).segp = component_info.comp (j).segp; 249 seg_info (n_segs).bc = component_info.comp (j).bc; 250 seg_info (n_segs).pathname = pathname_ (dir, ent); 251 end; 252 253 free component_info in (sys_area); 254 comp_infop = null; 255 end; 256 257 end_arg_loop: 258 end; 259 260 if fatalsw 261 then goto terminate; 262 263 do i = 1 to n_segs; /* get object info and check for non fortran */ 264 265 oi.version_number = object_info_version_2; 266 call object_info_$brief (seg_info (i).segp, seg_info (i).bc, addr (oi), code); 267 if code ^= 0 268 then goto error2; 269 270 /* 271* . call get_bound_seg_info_ (seg_ptr, bitcnt, addr (oi), bmp, binder_sblkp, code); 272* . if code ^= 0 then do; 273* . if code ^= error_table_$not_bound then goto error2; 274* . if (oi.compiler = "fortran") | (oi.compiler = "fortran2") then goto has_fortran; 275* . end; 276* . else do j = 1 to bmp -> bindmap.n_components; 277* . component_generator = addrel (oi.symbp, bmp -> bindmap.component (j).symb_start) 278* . -> std_symbol_header.generator; 279* . if (component_generator = "fortran") | (component_generator = "fortran2") 280* . then goto has_fortran; 281* . end; 282* . 283* . fatalsw = "1"b; 284* . if code = 0 then call com_err_ (0, me, "^a does not have a fortran component.", arg); 285* . else call com_err_ (0, me, "^a was not compiled by fortran.", arg); 286* . 287* . goto end_arg_loop; 288* . 289* .has_fortran: 290**/ 291 /* look through links for common */ 292 if oi.linkp -> virgin_linkage_header.defs_in_link = "010000"b 293 then block_end = rel (addrel (oi.linkp, oi.linkp -> virgin_linkage_header.def_offset)); 294 else block_end = rel (addrel (oi.linkp, oi.linkp -> virgin_linkage_header.linkage_section_lng)); 295 296 do p = addrel (oi.linkp, oi.linkp -> header.stats.begin_links) repeat (addrel (p, 2)) 297 while (rel (p) < block_end); 298 299 if p -> link.ft2 = Fault_Tag_2 300 then do; /* see if it is to common */ 301 type_ptr = addrel (oi.defp, (addrel (oi.defp, p -> link.exp_ptr) -> exp_word.type_ptr)); 302 type = bin (type_ptr -> type_pair.type, 18); 303 if type = 5 304 then do; 305 if bin (type_ptr -> type_pair.seg_ptr, 18) = 5 306 /* *system */ 307 then ext_name = addrel (oi.defp, type_ptr -> type_pair.ext_ptr) -> acc_name.string; 308 else goto next_link; 309 end; 310 else if type = 6 311 then do; 312 segnp = addrel (oi.defp, type_ptr -> type_pair.seg_ptr); 313 ext_ptr = addrel (oi.defp, type_ptr -> type_pair.ext_ptr); 314 if ext_ptr -> acc_name.nsize = 0 315 then do; 316 j = index (segnp -> acc_name.string, ".com"); 317 if (j = 0) | (j < (segnp -> acc_name.nsize - 3)) 318 then goto next_link; 319 ext_name = substr (segnp -> acc_name.string, 1, j - 1); 320 if ext_name = "b_" 321 then ext_name = "blnk*com"; 322 end; 323 else if segnp -> acc_name.string = "stat_" 324 then ext_name = ext_ptr -> acc_name.string; 325 else if segnp -> acc_name.string = "cobol_fsb_" 326 then ext_name = "cobol_fsb_" || ext_ptr -> acc_name.string; 327 else goto next_link; 328 end; 329 else goto next_link; 330 end; 331 else goto next_link; /* not a link */ 332 333 if type_ptr -> type_pair.trap_ptr = "0"b 334 then goto next_link; /* no init info */ 335 init_info_ptr = addrel (oi.defp, type_ptr -> type_pair.trap_ptr); 336 337 do j = 1 to nblocks; /* see if name is on list; if not, add it */ 338 if ext_name = var_info (j).name 339 then do; /* we do have name */ 340 if init_info_ptr -> init_info.type > NO_INIT 341 & init_info_ptr -> init_info.type ^= INIT_DEFERRED 342 then do; /* we have an init template */ 343 if var_info (j).init_ptr -> init_info.type = NO_INIT 344 then do; /* now we have init template to use */ 345 var_info (j).init_ptr = init_info_ptr; 346 var_info (j).init_owner = i; 347 end; 348 else if var_info (j).init_ptr -> init_info.size < init_info_ptr -> init_info.size 349 then do; /* have a larger template to use */ 350 call ioa_ ( 351 "^a: Initialization for common block ^a defined in subprogram ^a^/^-replacing initialization defined in subprogram ^a because it is longer.", 352 me, ext_name, seg_info (i).pathname, 353 seg_info (var_info (j).init_owner).pathname); 354 var_info (j).init_ptr = init_info_ptr; 355 var_info (j).init_owner = i; 356 end; 357 else do; /* new template is same or smaller size */ 358 if unspec (var_info (j).init_ptr -> init_info.init_template) 359 ^= unspec (init_info_ptr -> init_info.init_template) 360 then call ioa_ ( 361 "^a: Initialization for common block ^a defined in subprogram ^a is ignored; ^/^-using initialization defined in subprogram ^a.", 362 me, ext_name, seg_info (i).pathname, 363 seg_info (var_info (j).init_owner).pathname); 364 end; 365 end; 366 var_info (j).vsize = max (var_info (j).vsize, init_info_ptr -> init_info.size); 367 goto next_link; 368 end; 369 end; 370 nblocks = nblocks + 1; 371 372 var_info (nblocks).init_ptr = init_info_ptr; 373 var_info (nblocks).vsize = init_info_ptr -> init_info.size; 374 var_info (nblocks).init_owner = i; 375 var_info (nblocks).name = ext_name; 376 next_link: 377 end; 378 end; 379 380 if fatalsw 381 then goto terminate; /* we have gone as far as we can go */ 382 if nblocks = 0 383 then do; 384 call ioa_ ("^a: None of the specified programs have any common blocks.", me); 385 goto terminate; 386 end; 387 388 /* now allocate/initialize all common blocks */ 389 390 do i = 1 to nblocks; 391 new_vsize = 0; 392 if var_info (i).vsize > var_info (i).init_ptr -> init_info.size 393 then do; /* must make temp init info with correct size */ 394 if var_info (i).init_ptr -> init_info.type = TEMPLATE_INIT 395 then do; /* must copy template */ 396 new_vsize = var_info (i).vsize + 2; 397 allocate new_init_info in (sb -> stack_header.user_free_ptr -> based_area) set (init_info_ptr); 398 init_info_ptr -> init_info.size = var_info (i).vsize; 399 init_info_ptr -> init_info.type = TEMPLATE_INIT; 400 unspec (init_info_ptr -> init_info.init_template) = 401 unspec (var_info (i).init_ptr -> init_info.init_template); 402 end; 403 else if var_info (i).init_ptr -> init_info.type = LIST_TEMPLATE_INIT 404 then do; /* copy list template */ 405 new_vsize = var_info (i).init_ptr -> list_init_info.list_size + 3; 406 allocate new_init_info in (sb -> stack_header.user_free_ptr -> based_area) set (init_info_ptr); 407 unspec (init_info_ptr -> list_init_info) = unspec (var_info (i).init_ptr -> list_init_info); 408 init_info_ptr -> init_info.size = var_info (i).vsize; 409 end; 410 else do; 411 init_info_ptr = addr (dummy_init_info); 412 init_info_ptr -> init_info.size = var_info (i).vsize; 413 init_info_ptr -> init_info.type = var_info (i).init_ptr -> init_info.type; 414 end; 415 end; 416 else init_info_ptr = var_info (i).init_ptr; /* can use program's init info directly */ 417 418 call set_ext_variable_ (var_info (i).name, init_info_ptr, sb, 419 found_sw, node_ptr, code); 420 if code ^= 0 421 then if ^found_sw 422 then do; 423 init_error: 424 call com_err_ (code, me, "Initializing common block ^a", var_info (i).name); 425 if new_vsize > 0 426 then free init_info_ptr -> new_init_info; 427 goto terminate; 428 end; 429 430 if ^found_sw 431 then goto next_block; /* allocated as specified */ 432 433 if node_ptr -> variable_node.vbl_size < init_info_ptr -> init_info.size 434 then do; /* must reallocate and unsnap links */ 435 if longsw 436 then call ioa_ ( 437 "^a: Common block ^a is already in use with a smaller block length.^/^-The old version will be deleted.", 438 me, var_info (i).name); 439 call delete_it (node_ptr); 440 variable_size = init_info_ptr -> init_info.size; 441 442 if variable_size > sys_info$max_seg_size 443 then do; 444 if (init_info_ptr -> init_info.type ^= NO_INIT) 445 & (init_info_ptr -> init_info.type ^= LIST_TEMPLATE_INIT) 446 then do; /* multi-seg variable can't have template or area */ 447 code = error_table_$bad_link_target_init_info; 448 go to init_error; 449 end; 450 call fortran_storage_manager_$alloc ( 451 divide (variable_size + pl1_operators_$VLA_words_per_seg_ - 1, 452 pl1_operators_$VLA_words_per_seg_, 17), node_ptr, node_ptr -> variable_node.vbl_ptr); 453 end; 454 else if variable_size > (sys_info$max_seg_size - 50) 455 then do; 456 call hcs_$make_seg ("", unique_chars_ (""b) || "linker", "", 01110b, 457 node_ptr -> variable_node.vbl_ptr, code); 458 if code ^= 0 459 then go to init_error; 460 end; 461 else allocate variable in (sb -> stack_header.user_free_ptr -> based_area) 462 set (node_ptr -> variable_node.vbl_ptr); 463 464 node_ptr -> variable_node.vbl_size = variable_size; 465 node_ptr -> variable_node.time_allocated = clock (); 466 sb -> stack_header.sys_link_info_ptr -> variable_table_header.total_allocated_size = 467 sb -> stack_header.sys_link_info_ptr -> variable_table_header.total_allocated_size 468 + variable_size; 469 end; 470 471 /* reinitialize the variable; not worth checking to see if it's already OK */ 472 473 variable_size = node_ptr -> variable_node.vbl_size; 474 475 if init_info_ptr -> init_info.type = NO_INIT 476 then call list_init_ (node_ptr -> variable_node.vbl_ptr, 477 null (), variable_size, null(), null(), code); 478 479 else if init_info_ptr -> init_info.type = EMPTY_AREA_INIT 480 /* this would not be a fortran link */ 481 then node_ptr -> variable_node.vbl_ptr -> based_area = empty; 482 483 else if init_info_ptr -> init_info.type = LIST_TEMPLATE_INIT 484 /* list_template init */ 485 then do; 486 call list_init_ (node_ptr -> variable_node.vbl_ptr, 487 null (), variable_size, null(), null(), code); 488 call list_init_$variable_already_zero ( 489 node_ptr -> variable_node.vbl_ptr, 490 addr (init_info_ptr -> list_init_info.template), 491 variable_size, null(), null(), code); 492 end; 493 else unspec (node_ptr -> variable_node.vbl_ptr -> variable) = 494 unspec (init_info_ptr -> init_info.init_template); 495 496 497 /* now check for possible errors from list init and set_ext_var */ 498 499 if code ^= 0 then 500 do; 501 call com_err_ (code,me, " while referencing ^a", 502 node_ptr->variable_node.name); 503 goto terminate; 504 end; 505 506 node_ptr -> variable_node.init_type = init_info_ptr -> init_info.type; 507 508 next_block: 509 node_ptr -> variable_node.init_ptr = var_info (i).init_ptr; 510 /* fill in with permanent address */ 511 if new_vsize > 0 512 then free init_info_ptr -> new_init_info; 513 end; 514 515 /* now terminate noname everything that was known before the command was invoked */ 516 517 terminate: 518 do i = 1 to n_segs; 519 if seg_info (i).segp ^= null 520 then call hcs_$terminate_noname (seg_info (i).segp, code); 521 end; 522 523 524 if viptr (1) ^= null 525 then call release_temp_segments_ (me, viptr, code); 526 527 return; 528 529 /* */ 530 delete_it: 531 proc (np); 532 533 /* This procedure unsnaps the links to an external variable and then frees it */ 534 535 dcl (np, headptr, defstartptr, linkstartptr, itsptr, vlp, lptr, vptr) 536 ptr; 537 dcl based_ptr ptr based; 538 dcl based_double bit (72) aligned based; 539 dcl (segno, hcscnt, high_seg) 540 fixed bin; 541 dcl vsize fixed bin (35); 542 dcl old_variable (vsize) bit (36) based; 543 dcl hcs_$high_low_seg_count 544 entry (fixed bin, fixed bin); 545 dcl delete_$ptr entry (ptr, bit (6), char (*), fixed bin (35)); 546 547 vptr = np -> variable_node.vbl_ptr; /* get value links would have */ 548 549 call hcs_$high_low_seg_count (high_seg, hcscnt); 550 551 do segno = hcscnt + 1 to hcscnt + high_seg; 552 if rel (lotp -> lot.lp (segno)) ^= "0"b 553 then do; 554 headptr = lotp -> lot.lp (segno); 555 defstartptr = headptr -> header.def_ptr;/* pointer to beginning of def section */ 556 linkstartptr = addrel (headptr, headptr -> header.stats.begin_links); 557 558 /* check for defs in linkage section and compute end of links */ 559 560 if (baseno (linkstartptr) = baseno (defstartptr)) 561 & (fixed (rel (defstartptr), 18) > fixed (rel (linkstartptr), 18)) 562 then block_end = rel (defstartptr); /* end of links before end of block if defs follow links */ 563 564 else block_end = rel (addrel (headptr, headptr -> header.stats.block_length)); 565 /* end of links and of block are the same */ 566 567 do itsptr = linkstartptr repeat (addrel (itsptr, 2)) /* loop through all links */ 568 while (rel (itsptr) < block_end); 569 if itsptr -> its.its_mod = "100011"b 570 then do; /* snapped link */ 571 lptr = itsptr -> based_ptr; /* copy to pick up any indirection */ 572 if lptr = vptr 573 then do; /* have a link pointing to the variable; unsnap */ 574 vlp = headptr -> header.original_linkage_ptr; 575 itsptr -> based_double = 576 addrel (vlp, bit (bin (bin (rel (itsptr), 18) - bin (rel (headptr), 18), 18))) 577 -> based_double; 578 end; 579 end; 580 end; 581 end; 582 end; 583 584 /* now free the variable */ 585 586 vsize = np -> variable_node.vbl_size; 587 588 if vsize > sys_info$max_seg_size 589 then call fortran_storage_manager_$free (np); 590 591 else if rel (np -> variable_node.vbl_ptr) = "0"b /* separate seg was created outside area */ 592 then call delete_$ptr (np -> variable_node.vbl_ptr, "010100"b, me, code); 593 594 else free np -> variable_node.vbl_ptr -> old_variable; 595 596 np -> variable_node.vbl_ptr = null; 597 sb -> stack_header.sys_link_info_ptr -> variable_table_header.total_allocated_size = 598 sb -> stack_header.sys_link_info_ptr -> variable_table_header.total_allocated_size - vsize; 599 600 return; 601 602 end; /* of delete_it */ 603 604 605 606 /* Include Files */ 1 1 /* BEGIN INCLUDE FILE ... system_link_names.incl.pl1 */ 1 2 1 3 1 4 /****^ HISTORY COMMENTS: 1 5* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396), audit(86-11-12,Zwick), 1 6* install(86-11-20,MR12.0-1222): 1 7* added the declaration of the heap_header. 1 8* 2) change(86-10-20,DGHowe), approve(86-10-20,MCR7420), audit(86-11-12,Zwick), 1 9* install(86-11-20,MR12.0-1222): 1 10* add the seg ptr to the variable node structure. 1 11* END HISTORY COMMENTS */ 1 12 1 13 1 14 /* created by M. Weaver 7/28/76 */ 1 15 /* Modified: 82-11-19 by T. Oke to add LIST_TEMPLATE_INIT. */ 1 16 /* Modified 02/11/83 by M. Weaver to add have_vla_variables flag */ 1 17 1 18 1 19 dcl 1 variable_table_header aligned based, /* header for name table */ 1 20 2 hash_table (0:63) ptr unaligned, /* hash table for variable nodes */ 1 21 2 total_search_time fixed bin (71), /* total time to search for variables */ 1 22 2 total_allocation_time fixed bin (71), /* total time spent allocating and initializing nodes and variables */ 1 23 2 number_of_searches fixed bin, /* number of times names were looked up */ 1 24 2 number_of_variables fixed bin (35), /* number of variables allocated by the linker, incl deletions */ 1 25 2 flags unaligned, 1 26 3 have_vla_variables bit (1) unaligned, /* on if some variables are > sys_info$max_seg_size */ 1 27 3 pad bit (11) unaligned, 1 28 2 cur_num_of_variables fixed bin (24) unal, /* current number of variables allocated */ 1 29 2 number_of_steps fixed bin, /* total number of nodes looked at */ 1 30 2 total_allocated_size fixed bin (35); /* current amount of storage in user area */ 1 31 1 32 1 33 dcl 1 variable_node aligned based, /* individual variable information */ 1 34 2 forward_thread ptr unaligned, /* thread to next node off same hash bucket */ 1 35 2 vbl_size fixed bin (24) unsigned unaligned, /* length in words of variable */ 1 36 2 init_type fixed bin (11) unaligned, /* 0=not init; 3=init template; 4=area 5=list_template*/ 1 37 2 time_allocated fixed bin (71), /* time when variable was allocated */ 1 38 2 vbl_ptr ptr, /* pointer to variable's storage */ 1 39 2 init_ptr ptr, /* pointer to original init info in object seg */ 1 40 2 name_size fixed bin(21) aligned, /* length of name in characters */ 1 41 2 name char (nchars refer (variable_node.name_size)), /* name of variable */ 1 42 2 seg_ptr pointer; 1 43 1 44 /* variable_node.seg_ptr 1 45* Is a pointer to the segment containing the initialization information 1 46* for this variable. It is used as a segment base pointer for external 1 47* pointer initialization via list_init_. 1 48* 1 49* The init_ptr can not be used as a reference to the defining segment 1 50* due to the possibility of set_fortran_common being used to initialize 1 51* the external variables. sfc will generate an initialization information 1 52* structure if multiple intialization sizes are found in the specified 1 53* segments. sfc stores the address of this structure in the init_ptr field. 1 54* This is one reason why sfc does not perform external pointer 1 55* initialization. 1 56* 1 57* The seg_ptr is set to point at the segment used to define the 1 58* initialization information. term_ sets this field to null on termination 1 59* due to the possiblity of executing a different segment which defines 1 60* initialization information. In this way the seg_ptr field will either 1 61* be valid or null. 1 62**/ 1 63 1 64 dcl 1 heap_header based, 1 65 2 version char(8), /* specifies the verison of the header */ 1 66 2 heap_name_list_ptr pointer, /* points to the variable_table_header for this heap */ 1 67 2 previous_heap_ptr pointer, /* points to the previous heap or is null */ 1 68 2 area_ptr pointer, /* points to the heap area */ 1 69 2 execution_level fixed bin (17); /* specifies the execution level this header deals with */ 1 70 1 71 dcl heap_header_version_1 char(8) static options (constant) 1 72 init ("Heap_v01"); 1 73 1 74 1 75 /* END INCLUDE FILE ... system_link_names.incl.pl1 */ 607 608 2 1 /* Begin include file ... system_link_init_info.incl.pl1 ... 5/6/80 MRJ */ 2 2 2 3 2 4 2 5 /****^ HISTORY COMMENTS: 2 6* 1) change(86-05-02,Elhard), approve(86-05-02,MCR7391), 2 7* audit(86-07-18,DGHowe), install(86-11-20,MR12.0-1222): 2 8* Modified to declare DEFERRED_INIT type constant. 2 9* 2) change(86-06-24,DGHowe), approve(86-06-24,MCR7420), audit(86-11-12,Zwick), 2 10* install(86-11-20,MR12.0-1222): 2 11* added the external pointer initialization structure and the constants 2 12* required to use them. 2 13* END HISTORY COMMENTS */ 2 14 2 15 2 16 /* Modified: 82-11-17 by T. Oke to add list_init_info and LIST_TEMPLATE_INIT. */ 2 17 2 18 /* format: style3,idind25 */ 2 19 2 20 /* NOTE -------------------------------------------------- 2 21* the following structures defining initialization information can also 2 22* be found in fortran_storage.incl.pl1 definition_dcls.incl.pl1 2 23* and should be kept equivalent 2 24* ------------------------------------------------------- 2 25**/ 2 26 2 27 dcl init_info_ptr ptr; /* ptr to structure below */ 2 28 dcl init_size fixed bin (35); /* size (in words) of initialization template */ 2 29 2 30 dcl 1 init_info aligned based (init_info_ptr), 2 31 2 size fixed bin (35), /* size (in words) of data */ 2 32 2 type fixed bin, /* type of initialization: see below */ 2 33 2 init_template (init_size refer (init_info.size)) fixed bin (35); 2 34 2 35 dcl 1 init_info_single_word aligned based (init_info_ptr), 2 36 /* for convenience of people like ssi */ 2 37 2 size fixed bin (19), /* = 1 */ 2 38 2 type fixed bin, /* = TEMPLATE_INIT */ 2 39 2 init_template (1) fixed bin (35); /* = value */ 2 40 2 41 dcl 1 list_init_info aligned based, 2 42 2 size fixed bin (35), /* length of variable */ 2 43 2 type fixed bin, /* LIST_TEMPLATE_INIT */ 2 44 2 pad bit (18) unaligned, 2 45 2 list_size fixed bin (18) unsigned unaligned, 2 46 /* size in words of template */ 2 47 2 template (0 refer (list_init_info.list_size)) bit (36); 2 48 /* first create_entry position */ 2 49 2 50 /* A list template consists of a series of entries with the following 2 51* description, concatenated together. n_bits and datum are bit items, 2 52* to permit a wide range of inputs. 2 53* 2 54* 1. A 'repeat' of '0' signifies skipping of 'n_bits' bits. 2 55* 2. A 'n_bits' of '0' signifies the last item of the list. 2 56* 2 57* COMMON, VLA's, and LA's are presumed to start at the base pointer 2 58* of their particular storage section. */ 2 59 2 60 dcl 1 list_template_entry aligned based, 2 61 2 n_bits fixed bin (35) aligned, /* size of datum */ 2 62 2 mbz bit (3) unaligned, /* future expansion */ 2 63 2 init_type fixed bin (3) unsigned unaligned, /* 0 normal init, 1 ptr init, 2 packed ptr init */ 2 64 2 repeat fixed bin (30) unsigned unaligned, 2 65 /* number of times to repeat datum */ 2 66 2 datum bit (init_n_bits_in_datum refer (list_template_entry.n_bits)); 2 67 2 68 /* list_template_entry_ptr is defined such that it can be used as an 2 69* automatic definition overlay with a fixed size datum. it has a declared 2 70* size of 72 to allow for the its pointer sixe of 72 bits. 2 71**/ 2 72 2 73 dcl 1 list_template_entry_ptr aligned based, 2 74 2 n_bits fixed bin (35) aligned, 2 75 2 mbz bit(3) unaligned, 2 76 2 init_type fixed bin (3) unsigned unaligned, 2 77 2 repeat fixed bin (30) unsigned unaligned, 2 78 2 datum bit(72); 2 79 2 80 /* the pointer_init_template represents the initialization information 2 81* for ITS and packed pointers. Both pointer types require the entire 2 82* 72 bit structure. 2 83**/ 2 84 2 85 dcl 1 pointer_init_template based, 2 86 2 ptr_type fixed bin (18) unsigned unaligned, /* 0 text section, 1 linkage section, 2 static section */ 2 87 2 section_offset fixed bin (18) unsigned unaligned, /* offset to item in specified section */ 2 88 2 word_offset fixed bin (18) unsigned unaligned, /* word offset from section item to target */ 2 89 2 mbz bit (12) unaligned, 2 90 2 bit_offset fixed bin (6) unsigned unaligned; /* bit offset from section item|word offset to target */ 2 91 2 92 2 93 dcl init_n_bits_in_datum fixed bin (35); 2 94 2 95 dcl NO_INIT fixed bin static options (constant) init (0); 2 96 dcl TEMPLATE_INIT fixed bin static options (constant) init (3); 2 97 dcl EMPTY_AREA_INIT fixed bin static options (constant) init (4); 2 98 dcl LIST_TEMPLATE_INIT fixed bin static options (constant) init (5); 2 99 dcl INIT_DEFERRED fixed bin static options (constant) init (6); 2 100 dcl ITS_PTR_INIT fixed bin (3) unsigned static options (constant) init(1); 2 101 dcl PACKED_PTR_INIT fixed bin (3) unsigned static options (constant) init(2); 2 102 dcl PTR_INIT_TEXT fixed bin (17) static options (constant) init(0); 2 103 dcl PTR_INIT_LOT fixed bin (17) static options (constant) init(1); 2 104 dcl PTR_INIT_ISOT fixed bin (17) static options (constant) init(2); 2 105 2 106 2 107 /* End include file ... system_link_init_info.incl.pl1 */ 609 610 3 1 /* BEGIN INCLUDE FILE ... object_info.incl.pl1 3 2*coded February 8, 1972 by Michael J. Spier */ 3 3 /* modified May 26, 1972 by M. Weaver */ 3 4 /* modified 15 April, 1975 by M. Weaver */ 3 5 3 6 declare 1 object_info aligned based, /* structure containing object info based, returned by object_info_ */ 3 7 2 version_number fixed bin, /* version number of current structure format (=2) */ 3 8 2 textp pointer, /* pointer to beginning of text section */ 3 9 2 defp pointer, /* pointer to beginning of definition section */ 3 10 2 linkp pointer, /* pointer to beginning of linkage section */ 3 11 2 statp pointer, /* pointer to beginning of static section */ 3 12 2 symbp pointer, /* pointer to beginning of symbol section */ 3 13 2 bmapp pointer, /* pointer to beginning of break map (may be null) */ 3 14 2 tlng fixed bin, /* length in words of text section */ 3 15 2 dlng fixed bin, /* length in words of definition section */ 3 16 2 llng fixed bin, /* length in words of linkage section */ 3 17 2 ilng fixed bin, /* length in words of static section */ 3 18 2 slng fixed bin, /* length in words of symbol section */ 3 19 2 blng fixed bin, /* length in words of break map */ 3 20 2 format, /* word containing bit flags about object type */ 3 21 3 old_format bit(1) unaligned, /* on if segment isn't in new format, i.e. has old style object map */ 3 22 3 bound bit(1) unaligned, /* on if segment is bound */ 3 23 3 relocatable bit(1) unaligned, /* on if seg has relocation info in its first symbol block */ 3 24 3 procedure bit(1) unaligned, /* on if segment is an executable object program */ 3 25 3 standard bit(1) unaligned, /* on if seg is in standard format (more than just standard map) */ 3 26 3 gate bit(1) unaligned, /* on if segment is a gate */ 3 27 3 separate_static bit(1) unaligned, /* on if static not in linkage */ 3 28 3 links_in_text bit(1) unaligned, /* on if there are threaded links in text */ 3 29 3 perprocess_static bit (1) unaligned, /* on if static is not to be per run unit */ 3 30 3 pad bit(27) unaligned, 3 31 2 entry_bound fixed bin, /* entry bound if segment is a gate */ 3 32 2 textlinkp pointer, /* ptr to first link in text */ 3 33 3 34 /* LIMIT OF BRIEF STRUCTURE */ 3 35 3 36 2 compiler char(8) aligned, /* name of processor which generated segment */ 3 37 2 compile_time fixed bin(71), /* clock reading of date/time object was generated */ 3 38 2 userid char(32) aligned, /* standard Multics id of creator of object segment */ 3 39 2 cvers aligned, /* generator version name in printable char string form */ 3 40 3 offset bit(18) unaligned, /* offset of name in words relative to base of symbol section */ 3 41 3 length bit(18) unaligned, /* length of name in characters */ 3 42 2 comment aligned, /* printable comment concerning generator or generation of segment */ 3 43 3 offset bit(18) unaligned, /* offset of comment in words relative to base of symbol section */ 3 44 3 length bit(18) unaligned, /* length of comment in characters */ 3 45 2 source_map fixed bin, /* offset, relative to base of symbol section, of source map structure */ 3 46 3 47 /* LIMIT OF DISPLAY STRUCTURE */ 3 48 3 49 2 rel_text pointer, /* pointer to text section relocation info */ 3 50 2 rel_def pointer, /* pointer to definition section relocation info */ 3 51 2 rel_link pointer, /* pointer to linkage section relocation info */ 3 52 2 rel_static pointer, /* pointer to static section relocation info */ 3 53 2 rel_symbol pointer, /* pointer to symbol section relocation info */ 3 54 2 text_boundary fixed bin, /* specifies mod of text section base boundary */ 3 55 2 static_boundary fixed bin, /* specifies mod of internal static base boundary */ 3 56 /* currently not used by system */ 3 57 2 default_truncate fixed bin, /* offset rel to symbp for binder to automatically trunc. symb sect. */ 3 58 2 optional_truncate fixed bin; /* offset rel to symbp for binder to optionally trunc. symb sect. */ 3 59 3 60 declare object_info_version_2 fixed bin int static init(2); 3 61 3 62 /* END INCLUDE FILE ... object_info.incl.pl1 */ 611 612 4 1 /* BEGIN INCLUDE FILE linkdcl.incl.pl1 --- last modified 15 Nov 1971 by C Garman */ 4 2 4 3 /* Last Modified (Date and Reason): 4 4* 6/75 by M.Weaver to add virgin_linkage_header declaration 4 5* 6/75 by S.Webber to comment existing structures better 4 6* 9/77 by M. Weaver to add run_depth to link 4 7* 2/83 by M. Weaver to add linkage header flags and change run_depth precision 4 8**/ 4 9 4 10 /* format: style3 */ 4 11 dcl 1 link based aligned, /* link pair in linkage section */ 4 12 2 head_ptr bit (18) unal, /* rel pointer to beginning of linkage section */ 4 13 2 ringno bit (3) unal, 4 14 2 mbz bit (6) unal, 4 15 2 run_depth fixed bin (2) unal, /* run unit depth, filled when link is snapped */ 4 16 2 ft2 bit (6) unal, /* fault tag. 46(8) if not snapped, 43(8) if snapped */ 4 17 2 exp_ptr bit (18) unal, /* pointer (rel to defs) of expression word */ 4 18 2 mbz2 bit (12) unal, 4 19 2 modifier bit (6) unal; /* modifier to be left in snapped link */ 4 20 4 21 dcl 1 exp_word based aligned, /* expression word in link definition */ 4 22 2 type_ptr bit (18) unal, /* pointer (rel to defs) of type pair structure */ 4 23 2 exp bit (18) unal; /* constant expression to be added in when snapping link */ 4 24 4 25 dcl 1 type_pair based aligned, /* type pair in link definition */ 4 26 2 type bit (18) unal, /* type of link. may be 1,2,3,4,5, or 6 */ 4 27 2 trap_ptr bit (18) unal, /* pointer (rel to defs) to the trap word */ 4 28 2 seg_ptr bit (18) unal, /* pointer to ACC reference name for segment referenced */ 4 29 2 ext_ptr bit (18) unal; /* pointer (rel to defs) of ACC segdef name */ 4 30 4 31 dcl 1 header based aligned, /* linkage block header */ 4 32 2 def_ptr ptr, /* pointer to definition section */ 4 33 2 symbol_ptr ptr unal, /* pointer to symbol section in object segment */ 4 34 2 original_linkage_ptr 4 35 ptr unal, /* pointer to linkage section in object segment */ 4 36 2 unused bit (72), 4 37 2 stats, 4 38 3 begin_links bit (18) unal, /* offset (rel to this section) of first link */ 4 39 3 block_length bit (18) unal, /* number of words in this linkage section */ 4 40 3 segment_number 4 41 bit (18) unal, /* text segment number associated with this section */ 4 42 3 static_length bit (18) unal; /* number of words of static for this segment */ 4 43 4 44 dcl 1 linkage_header_flags 4 45 aligned based, /* overlay of def_ptr for flags */ 4 46 2 pad1 bit (28) unaligned, /* flags are in first word */ 4 47 2 static_vlas bit (1) unaligned, /* static section "owns" some LA/VLA segments */ 4 48 2 perprocess_static 4 49 bit (1) unaligned, /* 1 copy of static section is used by all tasks/run units */ 4 50 2 pad2 bit (6) unaligned; 4 51 4 52 dcl 1 virgin_linkage_header 4 53 aligned based, /* template for linkage header in object segment */ 4 54 2 pad bit (30) unaligned, /* is filled in by linker */ 4 55 2 defs_in_link bit (6) unaligned, /* =o20 if defs in linkage (nonstandard) */ 4 56 2 def_offset bit (18) unaligned, /* offset of definition section */ 4 57 2 first_ref_relp bit (18) unaligned, /* offset of trap-at-first-reference offset array */ 4 58 2 filled_in_later bit (144), 4 59 2 link_begin bit (18) unaligned, /* offset of first link */ 4 60 2 linkage_section_lng 4 61 bit (18) unaligned, /* length of linkage section */ 4 62 2 segno_pad bit (18) unaligned, /* will be segment number of copied linkage */ 4 63 2 static_length bit (18) unaligned; /* length of static section */ 4 64 4 65 4 66 dcl 1 trap_word based aligned, /* trap word in link definition */ 4 67 2 call_ptr bit (18) unal, /* pointer (rel to link) of link to trap procedure */ 4 68 2 arg_ptr bit (18) unal; /* pointer (rel to link) of link to arg info for trap proc */ 4 69 4 70 dcl 1 name based aligned, /* storage of ASCII names in definitions */ 4 71 2 nchars bit (9) unaligned, /* number of characters in name */ 4 72 2 char_string char (31) unaligned; /* 31-character name */ 4 73 4 74 /* END INCLUDE FILE linkdcl.incl.pl1 */ 613 614 5 1 /* BEGIN INCLUDE FILE ... stack_header.incl.pl1 .. 3/72 Bill Silver */ 5 2 /* modified 7/76 by M. Weaver for *system links and more system use of areas */ 5 3 /* modified 3/77 by M. Weaver to add rnt_ptr */ 5 4 /* Modified April 1983 by C. Hornig for tasking */ 5 5 5 6 /****^ HISTORY COMMENTS: 5 7* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396), 5 8* audit(86-08-05,Schroth), install(86-11-03,MR12.0-1206): 5 9* added the heap_header_ptr definition. 5 10* 2) change(86-08-12,Kissel), approve(86-08-12,MCR7473), 5 11* audit(86-10-10,Fawcett), install(86-11-03,MR12.0-1206): 5 12* Modified to support control point management. These changes were actually 5 13* made in February 1985 by G. Palter. 5 14* 3) change(86-10-22,Fawcett), approve(86-10-22,MCR7473), 5 15* audit(86-10-22,Farley), install(86-11-03,MR12.0-1206): 5 16* Remove the old_lot pointer and replace it with cpm_data_ptr. Use the 18 5 17* bit pad after cur_lot_size for the cpm_enabled. This was done to save some 5 18* space int the stack header and change the cpd_ptr unal to cpm_data_ptr 5 19* (ITS pair). 5 20* END HISTORY COMMENTS */ 5 21 5 22 /* format: style2 */ 5 23 5 24 dcl sb ptr; /* the main pointer to the stack header */ 5 25 5 26 dcl 1 stack_header based (sb) aligned, 5 27 2 pad1 (4) fixed bin, /* (0) also used as arg list by outward_call_handler */ 5 28 2 cpm_data_ptr ptr, /* (4) pointer to control point which owns this stack */ 5 29 2 combined_stat_ptr ptr, /* (6) pointer to area containing separate static */ 5 30 2 clr_ptr ptr, /* (8) pointer to area containing linkage sections */ 5 31 2 max_lot_size fixed bin (17) unal, /* (10) DU number of words allowed in lot */ 5 32 2 main_proc_invoked fixed bin (11) unal, /* (10) DL nonzero if main procedure invoked in run unit */ 5 33 2 have_static_vlas bit (1) unal, /* (10) DL "1"b if (very) large arrays are being used in static */ 5 34 2 pad4 bit (2) unal, 5 35 2 run_unit_depth fixed bin (2) unal, /* (10) DL number of active run units stacked */ 5 36 2 cur_lot_size fixed bin (17) unal, /* (11) DU number of words (entries) in lot */ 5 37 2 cpm_enabled bit (18) unal, /* (11) DL non-zero if control point management is enabled */ 5 38 2 system_free_ptr ptr, /* (12) pointer to system storage area */ 5 39 2 user_free_ptr ptr, /* (14) pointer to user storage area */ 5 40 2 null_ptr ptr, /* (16) */ 5 41 2 stack_begin_ptr ptr, /* (18) pointer to first stack frame on the stack */ 5 42 2 stack_end_ptr ptr, /* (20) pointer to next useable stack frame */ 5 43 2 lot_ptr ptr, /* (22) pointer to the lot for the current ring */ 5 44 2 signal_ptr ptr, /* (24) pointer to signal procedure for current ring */ 5 45 2 bar_mode_sp ptr, /* (26) value of sp before entering bar mode */ 5 46 2 pl1_operators_ptr ptr, /* (28) pointer to pl1_operators_$operator_table */ 5 47 2 call_op_ptr ptr, /* (30) pointer to standard call operator */ 5 48 2 push_op_ptr ptr, /* (32) pointer to standard push operator */ 5 49 2 return_op_ptr ptr, /* (34) pointer to standard return operator */ 5 50 2 return_no_pop_op_ptr 5 51 ptr, /* (36) pointer to standard return / no pop operator */ 5 52 2 entry_op_ptr ptr, /* (38) pointer to standard entry operator */ 5 53 2 trans_op_tv_ptr ptr, /* (40) pointer to translator operator ptrs */ 5 54 2 isot_ptr ptr, /* (42) pointer to ISOT */ 5 55 2 sct_ptr ptr, /* (44) pointer to System Condition Table */ 5 56 2 unwinder_ptr ptr, /* (46) pointer to unwinder for current ring */ 5 57 2 sys_link_info_ptr ptr, /* (48) pointer to *system link name table */ 5 58 2 rnt_ptr ptr, /* (50) pointer to Reference Name Table */ 5 59 2 ect_ptr ptr, /* (52) pointer to event channel table */ 5 60 2 assign_linkage_ptr ptr, /* (54) pointer to storage for (obsolete) hcs_$assign_linkage */ 5 61 2 heap_header_ptr ptr, /* (56) pointer to the heap header for this ring */ 5 62 2 trace, 5 63 3 frames, 5 64 4 count fixed bin, /* (58) number of trace frames */ 5 65 4 top_ptr ptr unal, /* (59) pointer to last trace frame */ 5 66 3 in_trace bit (36) aligned, /* (60) trace antirecursion flag */ 5 67 2 pad2 bit (36), /* (61) */ 5 68 2 pad5 pointer; /* (62) pointer to future stuff */ 5 69 5 70 /* The following offset refers to a table within the pl1 operator table. */ 5 71 5 72 dcl tv_offset fixed bin init (361) internal static; 5 73 /* (551) octal */ 5 74 5 75 5 76 /* The following constants are offsets within this transfer vector table. */ 5 77 5 78 dcl ( 5 79 call_offset fixed bin init (271), 5 80 push_offset fixed bin init (272), 5 81 return_offset fixed bin init (273), 5 82 return_no_pop_offset fixed bin init (274), 5 83 entry_offset fixed bin init (275) 5 84 ) internal static; 5 85 5 86 5 87 5 88 5 89 5 90 /* The following declaration is an overlay of the whole stack header. Procedures which 5 91* move the whole stack header should use this overlay. 5 92**/ 5 93 5 94 dcl stack_header_overlay (size (stack_header)) fixed bin based (sb); 5 95 5 96 5 97 5 98 /* END INCLUDE FILE ... stack_header.incl.pl1 */ 615 616 6 1 /* BEGIN INCLUDE FILE -- lot.incl.pl1 S.Webber 9/74, Modified by R. Bratt 04/76, modified by M. Weaver 7/76 */ 6 2 /* modified by M. Weaver 3/77 */ 6 3 6 4 dcl lotp ptr; 6 5 6 6 dcl 1 lot based (lotp) aligned, 6 7 2 lp (0:9999) ptr unaligned; /* array of packed pointers to linkage sections */ 6 8 6 9 dcl lot_fault bit (36) aligned static options (constant) init ("111000000000000000000000000000000000"b); 6 10 /* lot fault has fault code = 0 and offset = 0 */ 6 11 6 12 dcl isotp ptr; 6 13 dcl 1 isot based (isotp) aligned, 6 14 2 isp (0:9999) ptr unaligned; 6 15 6 16 dcl 1 isot1 (0 :9999) aligned based, 6 17 2 flags unaligned, 6 18 3 fault bit (2) unaligned, 6 19 3 system bit (1) unaligned, 6 20 3 mbz bit (6) unaligned, 6 21 2 fault_code fixed bin (8) unaligned, 6 22 2 static_offset bit (18) unaligned; 6 23 6 24 6 25 /* END INCLUDE FILE lot.incl.pl1 */ 617 618 7 1 /* BEGIN INCLUDE FILE its.incl.pl1 7 2* modified 27 July 79 by JRDavis to add its_unsigned 7 3* Internal format of ITS pointer, including ring-number field for follow-on processor */ 7 4 7 5 dcl 1 its based aligned, /* declaration for ITS type pointer */ 7 6 2 pad1 bit (3) unaligned, 7 7 2 segno bit (15) unaligned, /* segment number within the pointer */ 7 8 2 ringno bit (3) unaligned, /* ring number within the pointer */ 7 9 2 pad2 bit (9) unaligned, 7 10 2 its_mod bit (6) unaligned, /* should be 43(8) */ 7 11 7 12 2 offset bit (18) unaligned, /* word offset within the addressed segment */ 7 13 2 pad3 bit (3) unaligned, 7 14 2 bit_offset bit (6) unaligned, /* bit offset within the word */ 7 15 2 pad4 bit (3) unaligned, 7 16 2 mod bit (6) unaligned; /* further modification */ 7 17 7 18 dcl 1 itp based aligned, /* declaration for ITP type pointer */ 7 19 2 pr_no bit (3) unaligned, /* number of pointer register to use */ 7 20 2 pad1 bit (27) unaligned, 7 21 2 itp_mod bit (6) unaligned, /* should be 41(8) */ 7 22 7 23 2 offset bit (18) unaligned, /* word offset from pointer register word offset */ 7 24 2 pad2 bit (3) unaligned, 7 25 2 bit_offset bit (6) unaligned, /* bit offset relative to new word offset */ 7 26 2 pad3 bit (3) unaligned, 7 27 2 mod bit (6) unaligned; /* further modification */ 7 28 7 29 7 30 dcl 1 its_unsigned based aligned, /* just like its, but with unsigned binary */ 7 31 2 pad1 bit (3) unaligned, 7 32 2 segno fixed bin (15) unsigned unaligned, 7 33 2 ringno fixed bin (3) unsigned unaligned, 7 34 2 pad2 bit (9) unaligned, 7 35 2 its_mod bit (6) unaligned, 7 36 7 37 2 offset fixed bin (18) unsigned unaligned, 7 38 2 pad3 bit (3) unaligned, 7 39 2 bit_offset fixed bin (6) unsigned unaligned, 7 40 2 pad4 bit (3) unaligned, 7 41 2 mod bit (6) unaligned; 7 42 7 43 dcl 1 itp_unsigned based aligned, /* just like itp, but with unsigned binary where appropriate */ 7 44 2 pr_no fixed bin (3) unsigned unaligned, 7 45 2 pad1 bit (27) unaligned, 7 46 2 itp_mod bit (6) unaligned, 7 47 7 48 2 offset fixed bin (18) unsigned unaligned, 7 49 2 pad2 bit (3) unaligned, 7 50 2 bit_offset fixed bin (6) unsigned unaligned, 7 51 2 pad3 bit (3) unaligned, 7 52 2 mod bit (6) unaligned; 7 53 7 54 7 55 dcl ITS_MODIFIER bit (6) unaligned internal static options (constant) init ("43"b3); 7 56 dcl ITP_MODIFIER bit (6) unaligned internal static options (constant) init ("41"b3); 7 57 7 58 /* END INCLUDE FILE its.incl.pl1 */ 619 620 8 1 dcl 1 std_symbol_header based aligned, 8 2 2 dcl_version fixed bin, 8 3 2 identifier char(8), 8 4 2 gen_number fixed bin, 8 5 2 gen_created fixed bin(71), 8 6 2 object_created fixed bin(71), 8 7 2 generator char(8), 8 8 2 gen_version unaligned, 8 9 3 offset bit(18), 8 10 3 size bit(18), 8 11 2 userid unaligned, 8 12 3 offset bit(18), 8 13 3 size bit(18), 8 14 2 comment unaligned, 8 15 3 offset bit(18), 8 16 3 size bit(18), 8 17 2 text_boundary bit(18) unaligned, 8 18 2 stat_boundary bit(18) unaligned, 8 19 2 source_map bit(18) unaligned, 8 20 2 area_pointer bit(18) unaligned, 8 21 2 backpointer bit(18) unaligned, 8 22 2 block_size bit(18) unaligned, 8 23 2 next_block bit(18) unaligned, 8 24 2 rel_text bit(18) unaligned, 8 25 2 rel_def bit(18) unaligned, 8 26 2 rel_link bit(18) unaligned, 8 27 2 rel_symbol bit(18) unaligned, 8 28 2 mini_truncate bit(18) unaligned, 8 29 2 maxi_truncate bit(18) unaligned; 621 622 9 1 /* START OF: object_lib_defs.incl.pl1 * * * * * */ 9 2 9 3 9 4 /****^ HISTORY COMMENTS: 9 5* 1) change(86-05-02,Elhard), approve(86-05-02,MCR7391), 9 6* audit(86-10-03,DGHowe), install(86-11-20,MR12.0-1222): 9 7* Written to define structure returned by object_lib_$get_component_info. 9 8* END HISTORY COMMENTS */ 9 9 9 10 /********************************************************************/ 9 11 /* */ 9 12 /* Name: object_lib_defs */ 9 13 /* */ 9 14 /* Function: This include file defines constants & structures */ 9 15 /* used and returned by the object_lib_ subroutines. */ 9 16 /* */ 9 17 /********************************************************************/ 9 18 9 19 dcl 01 component_info aligned based (comp_infop), 9 20 02 version char (8), 9 21 02 flags aligned, 9 22 03 msf bit (1) unaligned, 9 23 03 mbz bit (35) unaligned, 9 24 02 max fixed bin, 9 25 02 comp (0:max_component refer (component_info.max)), 9 26 03 segp ptr, 9 27 03 bc fixed bin (24), 9 28 03 mbz bit (36), 9 29 03 info like object_info; 9 30 9 31 dcl comp_infop ptr; 9 32 dcl max_component fixed bin; 9 33 dcl component_info_version_1 9 34 char (8) static options (constant) 9 35 init ("cinfo1.0"); 9 36 9 37 /* END OF: object_lib_defs.incl.pl1 * * * * * */ 623 624 625 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/20/86 1142.5 set_fortran_common.pl1 >special_ldd>install>MR12.0-1222>set_fortran_common.pl1 607 1 11/20/86 1035.4 system_link_names.incl.pl1 >special_ldd>install>MR12.0-1222>system_link_names.incl.pl1 609 2 11/20/86 1035.4 system_link_init_info.incl.pl1 >special_ldd>install>MR12.0-1222>system_link_init_info.incl.pl1 611 3 08/05/77 1022.5 object_info.incl.pl1 >ldd>include>object_info.incl.pl1 613 4 07/27/83 0910.0 linkdcl.incl.pl1 >ldd>include>linkdcl.incl.pl1 615 5 11/07/86 1550.3 stack_header.incl.pl1 >ldd>include>stack_header.incl.pl1 617 6 08/05/77 1022.4 lot.incl.pl1 >ldd>include>lot.incl.pl1 619 7 11/26/79 1320.6 its.incl.pl1 >ldd>include>its.incl.pl1 621 8 05/06/74 1751.6 std_symbol_header.incl.pl1 >ldd>include>std_symbol_header.incl.pl1 623 9 11/20/86 1035.3 object_lib_defs.incl.pl1 >special_ldd>install>MR12.0-1222>object_lib_defs.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. EMPTY_AREA_INIT constant fixed bin(17,0) initial dcl 2-97 ref 479 Fault_Tag_2 constant bit(6) initial dcl 86 ref 299 INIT_DEFERRED constant fixed bin(17,0) initial dcl 2-99 ref 340 LIST_TEMPLATE_INIT constant fixed bin(17,0) initial dcl 2-98 ref 403 444 483 NO_INIT constant fixed bin(17,0) initial dcl 2-95 ref 340 343 444 475 TEMPLATE_INIT constant fixed bin(17,0) initial dcl 2-96 ref 394 399 acc_name based structure level 1 dcl 146 addr builtin function dcl 90 ref 156 266 266 411 488 488 addrel builtin function dcl 90 ref 292 294 296 301 301 305 312 313 335 376 556 564 575 580 alng 000101 automatic fixed bin(17,0) dcl 42 set ref 187* 188 188 193 195 195 198 198 201 201 aptr 000126 automatic pointer dcl 60 set ref 187* 188 188 193 195 198 201 arg based char unaligned dcl 139 set ref 188 188 193 195* 198* 201* based_area based area dcl 141 set ref 397 406 461 479* based_double based bit(72) dcl 538 set ref 575* 575 based_ptr based pointer dcl 537 ref 571 baseno builtin function dcl 90 ref 560 560 bc 6 based fixed bin(24,0) array level 3 in structure "component_info" dcl 9-19 in procedure "sfc" ref 249 bc 54 based fixed bin(24,0) array level 2 in structure "seg_info" dcl 70 in procedure "sfc" set ref 226* 249* 266* begin_links 6 based bit(18) level 3 packed unaligned dcl 4-31 ref 296 556 bin builtin function dcl 90 ref 302 305 575 575 575 bit builtin function dcl 90 ref 575 bitcnt 000107 automatic fixed bin(24,0) dcl 46 set ref 207* 226 block_end 000115 automatic bit(18) dcl 52 set ref 292* 294* 296 560* 564* 567 block_length 6(18) based bit(18) level 3 packed unaligned dcl 4-31 ref 564 cleanup 000342 stack reference condition dcl 94 ref 171 clock builtin function dcl 90 ref 465 code 000111 automatic fixed bin(35,0) dcl 48 set ref 175* 178* 184* 187* 198* 199 201* 207* 208 210* 231* 232 266* 267 418* 420 423* 447* 456* 458 475* 486* 488* 499 501* 519* 524* 591* com_err_ 000026 constant entry external dcl 108 ref 163 195 201 210 423 501 comp 4 based structure array level 2 dcl 9-19 comp_infop 000356 automatic pointer dcl 9-31 set ref 170* 180 180 231* 235 240 243 244* 248 249 253 254* component_info based structure level 1 dcl 9-19 ref 180 243 253 component_info_version_1 000000 constant char(8) initial unaligned dcl 9-33 set ref 231* cu_$arg_count 000020 constant entry external dcl 105 ref 159 cu_$arg_ptr 000022 constant entry external dcl 106 ref 187 def_offset 1 based bit(18) level 2 packed unaligned dcl 4-52 ref 292 def_ptr based pointer level 2 dcl 4-31 ref 555 defp 4 000254 automatic pointer level 2 dcl 81 set ref 301 301 305 312 313 335 defs_in_link 0(30) based bit(6) level 2 packed unaligned dcl 4-52 ref 292 defstartptr 000400 automatic pointer dcl 535 set ref 555* 560 560 560 delete_$ptr 000072 constant entry external dcl 545 ref 591 dir 000171 automatic char(168) unaligned dcl 66 set ref 198* 207* 210* 227* 250* divide builtin function dcl 90 ref 450 450 dummy_init_info 000116 automatic bit(72) dcl 53 set ref 411 empty builtin function dcl 90 ref 479 ent 000243 automatic char(32) unaligned dcl 67 set ref 198* 207* 210* 227* 250* error_table_$bad_link_target_init_info 000012 external static fixed bin(35,0) dcl 96 ref 447 error_table_$badopt 000010 external static fixed bin(35,0) dcl 96 set ref 195* exp_ptr 1 based bit(18) level 2 packed unaligned dcl 4-11 ref 301 exp_word based structure level 1 dcl 4-21 expand_pathname_ 000024 constant entry external dcl 107 ref 198 ext_name 000150 automatic char(65) unaligned dcl 65 set ref 305* 319* 320 320* 323* 325* 338 350* 358* 375 ext_ptr 000142 automatic pointer dcl 60 in procedure "sfc" set ref 313* 314 323 325 ext_ptr 1(18) based bit(18) level 2 in structure "type_pair" packed unaligned dcl 4-25 in procedure "sfc" ref 305 313 fatalsw 000113 automatic bit(1) dcl 50 set ref 155* 196* 203* 212* 260 380 fixed builtin function dcl 90 ref 560 560 fortran_storage_manager_$alloc 000064 constant entry external dcl 131 ref 450 fortran_storage_manager_$free 000066 constant entry external dcl 133 ref 588 found_sw 000114 automatic bit(1) dcl 50 set ref 418* 420 430 ft2 0(30) based bit(6) level 2 packed unaligned dcl 4-11 ref 299 get_system_free_area_ 000032 constant entry external dcl 109 ref 167 get_temp_segments_ 000050 constant entry external dcl 121 ref 184 hcs_$high_low_seg_count 000070 constant entry external dcl 543 ref 549 hcs_$make_seg 000054 constant entry external dcl 123 ref 456 hcs_$terminate_noname 000046 constant entry external dcl 119 ref 175 519 hcscnt 000415 automatic fixed bin(17,0) dcl 539 set ref 549* 551 551 header based structure level 1 dcl 4-31 headptr 000376 automatic pointer dcl 535 set ref 554* 555 556 556 564 564 574 575 high_seg 000416 automatic fixed bin(17,0) dcl 539 set ref 549* 551 i 000102 automatic fixed bin(17,0) dcl 42 set ref 174* 175 175* 186* 187* 263* 266 266 346 350 355 358 374* 390* 392 392 394 396 398 400 403 405 407 408 412 413 416 418 423 435 508* 517* 519 519* index builtin function dcl 90 ref 316 init_info based structure level 1 dcl 2-30 init_info_ptr 000350 automatic pointer dcl 2-27 set ref 335* 340 340 345 348 354 358 366 372 373 397* 398 399 400 406* 407 408 411* 412 413 416* 418* 425 433 440 444 444 475 479 483 488 488 493 506 511 init_owner 3 based fixed bin(17,0) array level 2 dcl 75 set ref 346* 350 355* 358 374* init_ptr based pointer array level 2 in structure "var_info" dcl 75 in procedure "sfc" set ref 343 345* 348 354* 358 372* 392 394 400 403 405 407 413 416 508 init_ptr 6 based pointer level 2 in structure "variable_node" dcl 1-33 in procedure "sfc" set ref 508* init_template 2 based fixed bin(35,0) array level 2 dcl 2-30 set ref 358 358 400* 400 493 init_type 1(24) based fixed bin(11,0) level 2 packed unaligned dcl 1-33 set ref 506* ioa_ 000030 constant entry external dcl 108 ref 350 358 384 435 its based structure level 1 dcl 7-5 its_mod 0(30) based bit(6) level 2 packed unaligned dcl 7-5 ref 569 itsptr 000404 automatic pointer dcl 535 set ref 567* 567* 569 571 575 575* 580 j 000103 automatic fixed bin(17,0) dcl 42 set ref 218* 219* 235* 240 248 249* 316* 317 317 319 337* 338 343 345 346 348 350 354 355 358 358 366 366* k 000120 automatic fixed bin(17,0) dcl 54 set ref 239* 240* link based structure level 1 dcl 4-11 linkage_section_lng 6(18) based bit(18) level 2 packed unaligned dcl 4-52 ref 294 linkp 6 000254 automatic pointer level 2 dcl 81 set ref 292 292 292 294 294 296 296 linkstartptr 000402 automatic pointer dcl 535 set ref 556* 560 560 567 list_init_ 000060 constant entry external dcl 125 ref 475 486 list_init_$variable_already_zero 000062 constant entry external dcl 127 ref 488 list_init_info based structure level 1 dcl 2-41 set ref 407* 407 list_size 2(18) based fixed bin(18,0) level 2 packed unsigned unaligned dcl 2-41 set ref 405 407 407 longsw 000112 automatic bit(1) dcl 50 set ref 154* 190* 435 lot based structure level 1 dcl 6-6 lot_ptr 26 based pointer level 2 dcl 5-26 ref 157 lotp 000354 automatic pointer dcl 6-4 set ref 157* 552 554 lp based pointer array level 2 packed unaligned dcl 6-6 ref 552 554 lptr 000410 automatic pointer dcl 535 set ref 571* 572 max 3 based fixed bin(17,0) level 2 in structure "component_info" dcl 9-19 in procedure "sfc" ref 180 235 243 253 max builtin function dcl 90 in procedure "sfc" ref 366 me 000002 constant char(18) initial unaligned dcl 85 set ref 163* 178* 184* 195* 201* 210* 350* 358* 384* 423* 435* 501* 524* 591* msf_sw 000125 automatic bit(1) unaligned dcl 58 set ref 207* 229 n_segs 000124 automatic fixed bin(17,0) dcl 57 set ref 153* 174 215 216* 216 218 221* 221 225 226 227 236 237* 237 239 242* 242 248 249 250 263 517 name 11 based char level 2 in structure "variable_node" dcl 1-33 in procedure "sfc" set ref 501* name 4 based char(65) array level 2 in structure "var_info" packed unaligned dcl 75 in procedure "sfc" set ref 338 375* 418* 423* 435* name_size 10 based fixed bin(21,0) level 2 dcl 1-33 ref 501 501 nargs 000100 automatic fixed bin(17,0) dcl 42 set ref 159* 161 186 nblocks 000104 automatic fixed bin(17,0) dcl 42 set ref 152* 337 370* 370 372 373 374 375 382 390 new_init_info based fixed bin(35,0) array dcl 140 ref 397 406 425 511 new_vsize 000105 automatic fixed bin(35,0) dcl 44 set ref 391* 396* 397 405* 406 425 425 511 511 node_ptr 000140 automatic pointer dcl 60 set ref 418* 433 439* 450* 450 456 461 464 465 473 475 479 486 488 493 501 506 508 np parameter pointer dcl 535 set ref 530 547 586 588* 591 591 594 596 nsize based fixed bin(8,0) level 2 packed unaligned dcl 146 ref 305 314 316 317 319 323 323 325 325 null builtin function dcl 90 ref 169 170 173 175 180 215 236 244 254 475 475 475 475 475 475 486 486 486 486 486 486 488 488 488 488 519 524 596 object_info based structure level 1 dcl 3-6 object_info_$brief 000042 constant entry external dcl 116 ref 266 object_info_version_2 constant fixed bin(17,0) initial dcl 3-60 ref 265 object_lib_$get_component_info 000036 constant entry external dcl 113 ref 231 object_lib_$initiate 000034 constant entry external dcl 111 ref 207 oi 000254 automatic structure level 1 dcl 81 set ref 266 266 old_variable based bit(36) array unaligned dcl 542 ref 594 original_linkage_ptr 3 based pointer level 2 packed unaligned dcl 4-31 ref 574 p 000132 automatic pointer dcl 60 set ref 296* 296* 299 301* 376 pathname based char(168) array level 2 dcl 70 set ref 227* 250* 350* 350* 358* 358* pathname_ 000040 constant entry external dcl 115 ref 227 250 pl1_operators_$VLA_words_per_seg_ 000016 external static fixed bin(19,0) dcl 102 ref 450 450 450 450 ptr builtin function dcl 90 ref 156 rel builtin function dcl 90 ref 292 294 296 552 560 560 560 564 567 575 575 591 release_temp_segments_ 000052 constant entry external dcl 121 ref 178 524 sb 000352 automatic pointer dcl 5-24 set ref 156* 156 157 397 406 418* 461 466 466 597 597 seg_info based structure array level 1 dcl 70 seg_ptr 000130 automatic pointer dcl 60 in procedure "sfc" set ref 207* 219 225 231* seg_ptr 1 based bit(18) level 2 in structure "type_pair" packed unaligned dcl 4-25 in procedure "sfc" ref 305 312 segno 000414 automatic fixed bin(17,0) dcl 539 set ref 551* 552 554* segnp 000136 automatic pointer dcl 60 set ref 312* 316 317 319 323 325 segp 4 based pointer array level 3 in structure "component_info" dcl 9-19 in procedure "sfc" ref 240 248 segp 52 based pointer array level 2 in structure "seg_info" dcl 70 in procedure "sfc" set ref 175 175* 215* 219 225* 236* 240 248* 266* 519 519* set_ext_variable_ 000044 constant entry external dcl 117 ref 418 size based fixed bin(35,0) level 2 dcl 2-30 set ref 348 348 358 358 366 373 392 398* 400 400 408* 412* 433 440 493 stack_header based structure level 1 dcl 5-26 stats 6 based structure level 2 dcl 4-31 string 0(09) based char level 2 packed unaligned dcl 146 ref 305 316 319 323 323 325 325 substr builtin function dcl 90 ref 193 319 sys_area based area(1024) dcl 56 ref 180 243 253 sys_areap 000122 automatic pointer dcl 55 set ref 167* 180 231* 243 253 sys_info$max_seg_size 000014 external static fixed bin(35,0) dcl 100 ref 442 454 588 sys_link_info_ptr 60 based pointer level 2 dcl 5-26 ref 466 466 597 597 template 3 based bit(36) array level 2 dcl 2-41 set ref 488 488 time_allocated 2 based fixed bin(71,0) level 2 dcl 1-33 set ref 465* total_allocated_size 111 based fixed bin(35,0) level 2 dcl 1-19 set ref 466* 466 597* 597 trap_ptr 0(18) based bit(18) level 2 packed unaligned dcl 4-25 ref 333 335 type 1 based fixed bin(17,0) level 2 in structure "init_info" dcl 2-30 in procedure "sfc" set ref 340 340 343 394 399* 403 413* 413 444 444 475 479 483 506 type based bit(18) level 2 in structure "type_pair" packed unaligned dcl 4-25 in procedure "sfc" ref 302 type 000110 automatic fixed bin(18,0) dcl 47 in procedure "sfc" set ref 302* 303 310 type_pair based structure level 1 dcl 4-25 type_ptr based bit(18) level 2 in structure "exp_word" packed unaligned dcl 4-21 in procedure "sfc" ref 301 type_ptr 000134 automatic pointer dcl 60 in procedure "sfc" set ref 301* 302 305 305 312 313 333 335 unique_chars_ 000056 constant entry external dcl 124 ref 456 unspec builtin function dcl 90 set ref 358 358 400* 400 407* 407 493* 493 user_free_ptr 16 based pointer level 2 dcl 5-26 ref 397 406 461 var_info based structure array level 1 dcl 75 variable based bit(36) array unaligned dcl 142 set ref 461 493* variable_node based structure level 1 dcl 1-33 variable_size 000106 automatic fixed bin(35,0) dcl 44 set ref 440* 442 450 450 454 461 464 466 473* 475* 479 486* 488* 493 variable_table_header based structure level 1 dcl 1-19 vbl_ptr 4 based pointer level 2 dcl 1-33 set ref 450* 456* 461* 475* 479 486* 488* 493 547 591 591* 594 596* vbl_size 1 based fixed bin(24,0) level 2 packed unsigned unaligned dcl 1-33 set ref 433 464* 473 586 version_number 000254 automatic fixed bin(17,0) level 2 dcl 81 set ref 265* viptr 000144 automatic pointer array dcl 62 set ref 169* 173 175 175 178* 184* 215 219 225 226 227 236 240 248 249 250 266 266 338 343 345 346 348 350 350 350 354 355 358 358 358 358 366 366 372 373 374 375 392 392 394 396 398 400 403 405 407 408 412 413 416 418 423 435 508 519 519 524 524* virgin_linkage_header based structure level 1 dcl 4-52 vlp 000406 automatic pointer dcl 535 set ref 574* 575 vptr 000412 automatic pointer dcl 535 set ref 547* 572 vsize 2 based fixed bin(35,0) array level 2 in structure "var_info" dcl 75 in procedure "sfc" set ref 366* 366 373* 392 396 398 408 412 vsize 000417 automatic fixed bin(35,0) dcl 541 in procedure "delete_it" set ref 586* 588 594 597 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ITP_MODIFIER internal static bit(6) initial unaligned dcl 7-56 ITS_MODIFIER internal static bit(6) initial unaligned dcl 7-55 ITS_PTR_INIT internal static fixed bin(3,0) initial unsigned dcl 2-100 PACKED_PTR_INIT internal static fixed bin(3,0) initial unsigned dcl 2-101 PTR_INIT_ISOT internal static fixed bin(17,0) initial dcl 2-104 PTR_INIT_LOT internal static fixed bin(17,0) initial dcl 2-103 PTR_INIT_TEXT internal static fixed bin(17,0) initial dcl 2-102 call_offset internal static fixed bin(17,0) initial dcl 5-78 component_generator automatic char(8) unaligned dcl 68 entry_offset internal static fixed bin(17,0) initial dcl 5-78 heap_header based structure level 1 unaligned dcl 1-64 heap_header_version_1 internal static char(8) initial unaligned dcl 1-71 init_info_single_word based structure level 1 dcl 2-35 init_n_bits_in_datum automatic fixed bin(35,0) dcl 2-93 init_size automatic fixed bin(35,0) dcl 2-28 isot based structure level 1 dcl 6-13 isot1 based structure array level 1 dcl 6-16 isotp automatic pointer dcl 6-12 itp based structure level 1 dcl 7-18 itp_unsigned based structure level 1 dcl 7-43 its_unsigned based structure level 1 dcl 7-30 linkage_header_flags based structure level 1 dcl 4-44 list_template_entry based structure level 1 dcl 2-60 list_template_entry_ptr based structure level 1 dcl 2-73 lot_fault internal static bit(36) initial dcl 6-9 max_component automatic fixed bin(17,0) dcl 9-32 name based structure level 1 dcl 4-70 pointer_init_template based structure level 1 packed unaligned dcl 2-85 push_offset internal static fixed bin(17,0) initial dcl 5-78 return_no_pop_offset internal static fixed bin(17,0) initial dcl 5-78 return_offset internal static fixed bin(17,0) initial dcl 5-78 stack_header_overlay based fixed bin(17,0) array dcl 5-94 std_symbol_header based structure level 1 dcl 8-1 trap_word based structure level 1 dcl 4-66 tv_offset internal static fixed bin(17,0) initial dcl 5-72 NAMES DECLARED BY EXPLICIT CONTEXT. delete_it 003026 constant entry internal dcl 530 ref 439 end_arg_loop 001313 constant label dcl 257 ref 191 204 213 222 245 error1 000657 constant label dcl 201 error2 000757 constant label dcl 210 ref 232 267 init_error 002244 constant label dcl 423 ref 448 458 next_block 002731 constant label dcl 508 ref 430 next_link 002014 constant label dcl 376 ref 299 305 310 317 325 333 367 set_fortran_common 000305 constant entry external dcl 24 sfc 000276 constant entry external dcl 24 terminate 002745 constant label dcl 517 ref 260 380 385 427 503 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3654 3750 3274 3664 Length 4410 3274 74 423 357 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME sfc 438 external procedure is an external procedure. on unit on line 171 86 on unit delete_it internal procedure shares stack frame of external procedure sfc. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME sfc 000100 nargs sfc 000101 alng sfc 000102 i sfc 000103 j sfc 000104 nblocks sfc 000105 new_vsize sfc 000106 variable_size sfc 000107 bitcnt sfc 000110 type sfc 000111 code sfc 000112 longsw sfc 000113 fatalsw sfc 000114 found_sw sfc 000115 block_end sfc 000116 dummy_init_info sfc 000120 k sfc 000122 sys_areap sfc 000124 n_segs sfc 000125 msf_sw sfc 000126 aptr sfc 000130 seg_ptr sfc 000132 p sfc 000134 type_ptr sfc 000136 segnp sfc 000140 node_ptr sfc 000142 ext_ptr sfc 000144 viptr sfc 000150 ext_name sfc 000171 dir sfc 000243 ent sfc 000254 oi sfc 000350 init_info_ptr sfc 000352 sb sfc 000354 lotp sfc 000356 comp_infop sfc 000376 headptr delete_it 000400 defstartptr delete_it 000402 linkstartptr delete_it 000404 itsptr delete_it 000406 vlp delete_it 000410 lptr delete_it 000412 vptr delete_it 000414 segno delete_it 000415 hcscnt delete_it 000416 high_seg delete_it 000417 vsize delete_it THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_out_desc call_ext_out return_mac enable_op shorten_stack ext_entry int_entry set_chars_eis index_chars_eis divide_fx3 op_alloc_ op_freen_ op_empty_ clock_mac THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_ptr delete_$ptr expand_pathname_ fortran_storage_manager_$alloc fortran_storage_manager_$free get_system_free_area_ get_temp_segments_ hcs_$high_low_seg_count hcs_$make_seg hcs_$terminate_noname ioa_ list_init_ list_init_$variable_already_zero object_info_$brief object_lib_$get_component_info object_lib_$initiate pathname_ release_temp_segments_ set_ext_variable_ unique_chars_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_link_target_init_info error_table_$badopt pl1_operators_$VLA_words_per_seg_ sys_info$max_seg_size CONSTANTS 003266 aa 000002000000 003267 aa 000000000000 003270 aa 600000000041 003271 aa 000140000000 000000 aa 143 151 156 146 cinf 000001 aa 157 061 056 060 o1.0 000002 aa 163 145 164 137 set_ 000003 aa 146 157 162 164 fort 000004 aa 162 141 156 137 ran_ 000005 aa 143 157 155 155 comm 000006 aa 157 156 000 000 on 000007 aa 514000000006 000010 aa 524000000025 000011 aa 524000000147 000012 aa 524000000034 000013 aa 524000000073 000014 aa 524000000177 000015 aa 524000000250 000016 aa 526000000101 000017 aa 524000000213 003272 aa 142 137 000 000 b_ 000020 aa 056 143 157 155 .com 000021 aa 524000000004 000022 aa 156 157 156 145 none 000023 aa 526000000010 000024 aa 524000000005 000025 aa 516000000001 000026 aa 404000000030 000027 aa 514000000001 000030 aa 524000000000 000031 aa 526000000040 000032 aa 526000000000 003273 aa 055 000 000 000 - 000033 aa 055 154 147 000 -lg 000034 aa 404000000043 000035 aa 524000000053 000036 aa 526000000022 000037 aa 404000000005 000040 aa 526000000017 000041 aa 526000000250 000042 aa 464000000000 000044 aa 154 151 156 153 link 000045 aa 145 162 000 000 er 000046 aa 163 164 141 164 stat 000047 aa 137 000 000 000 _ 000050 aa 142 154 156 153 blnk 000051 aa 052 143 157 155 *com 000052 aa 136 141 076 136 ^a>^ 000053 aa 141 000 000 000 a 000054 aa 055 154 157 156 -lon 000055 aa 147 000 000 000 g 000056 aa 077777000043 000057 aa 000001000000 000060 aa 143 154 145 141 clea 000061 aa 156 165 160 000 nup 000062 aa 143 157 142 157 cobo 000063 aa 154 137 146 163 l_fs 000064 aa 142 137 000 000 b_ 000065 aa 464100000000 000066 aa 000000000001 000067 aa 000000000002 000070 aa 000000000002 000071 aa 040 167 150 151 whi 000072 aa 154 145 040 162 le r 000073 aa 145 146 145 162 efer 000074 aa 145 156 143 151 enci 000075 aa 156 147 040 136 ng ^ 000076 aa 141 000 000 000 a 000077 aa 111 156 151 164 Init 000100 aa 151 141 154 151 iali 000101 aa 172 151 156 147 zing 000102 aa 040 143 157 155 com 000103 aa 155 157 156 040 mon 000104 aa 142 154 157 143 bloc 000105 aa 153 040 136 141 k ^a 000106 aa 125 163 141 147 Usag 000107 aa 145 040 151 163 e is 000110 aa 072 040 040 163 : s 000111 aa 145 164 137 146 et_f 000112 aa 157 162 164 162 ortr 000113 aa 141 156 137 143 an_c 000114 aa 157 155 155 157 ommo 000115 aa 156 040 160 141 n pa 000116 aa 164 150 163 040 ths 000117 aa 173 055 154 157 {-lo 000120 aa 156 147 175 000 ng} 000121 aa 136 141 072 040 ^a: 000122 aa 040 116 157 156 Non 000123 aa 145 040 157 146 e of 000124 aa 040 164 150 145 the 000125 aa 040 163 160 145 spe 000126 aa 143 151 146 151 cifi 000127 aa 145 144 040 160 ed p 000130 aa 162 157 147 162 rogr 000131 aa 141 155 163 040 ams 000132 aa 150 141 166 145 have 000133 aa 040 141 156 171 any 000134 aa 040 143 157 155 com 000135 aa 155 157 156 040 mon 000136 aa 142 154 157 143 bloc 000137 aa 153 163 056 000 ks. 000140 aa 136 141 072 040 ^a: 000141 aa 040 103 157 155 Com 000142 aa 155 157 156 040 mon 000143 aa 142 154 157 143 bloc 000144 aa 153 040 136 141 k ^a 000145 aa 040 151 163 040 is 000146 aa 141 154 162 145 alre 000147 aa 141 144 171 040 ady 000150 aa 151 156 040 165 in u 000151 aa 163 145 040 167 se w 000152 aa 151 164 150 040 ith 000153 aa 141 040 163 155 a sm 000154 aa 141 154 154 145 alle 000155 aa 162 040 142 154 r bl 000156 aa 157 143 153 040 ock 000157 aa 154 145 156 147 leng 000160 aa 164 150 056 136 th.^ 000161 aa 057 136 055 124 /^-T 000162 aa 150 145 040 157 he o 000163 aa 154 144 040 166 ld v 000164 aa 145 162 163 151 ersi 000165 aa 157 156 040 167 on w 000166 aa 151 154 154 040 ill 000167 aa 142 145 040 144 be d 000170 aa 145 154 145 164 elet 000171 aa 145 144 056 000 ed. 000172 aa 136 141 072 040 ^a: 000173 aa 040 111 156 151 Ini 000174 aa 164 151 141 154 tial 000175 aa 151 172 141 164 izat 000176 aa 151 157 156 040 ion 000177 aa 146 157 162 040 for 000200 aa 143 157 155 155 comm 000201 aa 157 156 040 142 on b 000202 aa 154 157 143 153 lock 000203 aa 040 136 141 040 ^a 000204 aa 144 145 146 151 defi 000205 aa 156 145 144 040 ned 000206 aa 151 156 040 163 in s 000207 aa 165 142 160 162 ubpr 000210 aa 157 147 162 141 ogra 000211 aa 155 040 136 141 m ^a 000212 aa 040 151 163 040 is 000213 aa 151 147 156 157 igno 000214 aa 162 145 144 073 red; 000215 aa 040 136 057 136 ^/^ 000216 aa 055 165 163 151 -usi 000217 aa 156 147 040 151 ng i 000220 aa 156 151 164 151 niti 000221 aa 141 154 151 172 aliz 000222 aa 141 164 151 157 atio 000223 aa 156 040 144 145 n de 000224 aa 146 151 156 145 fine 000225 aa 144 040 151 156 d in 000226 aa 040 163 165 142 sub 000227 aa 160 162 157 147 prog 000230 aa 162 141 155 040 ram 000231 aa 136 141 056 000 ^a. 000232 aa 136 141 072 040 ^a: 000233 aa 040 111 156 151 Ini 000234 aa 164 151 141 154 tial 000235 aa 151 172 141 164 izat 000236 aa 151 157 156 040 ion 000237 aa 146 157 162 040 for 000240 aa 143 157 155 155 comm 000241 aa 157 156 040 142 on b 000242 aa 154 157 143 153 lock 000243 aa 040 136 141 040 ^a 000244 aa 144 145 146 151 defi 000245 aa 156 145 144 040 ned 000246 aa 151 156 040 163 in s 000247 aa 165 142 160 162 ubpr 000250 aa 157 147 162 141 ogra 000251 aa 155 040 136 141 m ^a 000252 aa 136 057 136 055 ^/^- 000253 aa 162 145 160 154 repl 000254 aa 141 143 151 156 acin 000255 aa 147 040 151 156 g in 000256 aa 151 164 151 141 itia 000257 aa 154 151 172 141 liza 000260 aa 164 151 157 156 tion 000261 aa 040 144 145 146 def 000262 aa 151 156 145 144 ined 000263 aa 040 151 156 040 in 000264 aa 163 165 142 160 subp 000265 aa 162 157 147 162 rogr 000266 aa 141 155 040 136 am ^ 000267 aa 141 040 142 145 a be 000270 aa 143 141 165 163 caus 000271 aa 145 040 151 164 e it 000272 aa 040 151 163 040 is 000273 aa 154 157 156 147 long 000274 aa 145 162 056 000 er. BEGIN PROCEDURE sfc ENTRY TO sfc STATEMENT 1 ON LINE 24 set_fortran_common: sfc: proc; 000275 da 000342200000 000276 aa 000700 6270 00 eax7 448 000277 aa 7 00034 3521 20 epp2 pr7|28,* 000300 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000301 aa 000000000000 000302 aa 000000000000 000303 aa 000007 7100 04 tra 7,ic 000312 ENTRY TO set_fortran_common STATEMENT 1 ON LINE 24 set_fortran_common: sfc: proc; 000304 da 000345200000 000305 aa 000700 6270 00 eax7 448 000306 aa 7 00034 3521 20 epp2 pr7|28,* 000307 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000310 aa 000000000000 000311 aa 000000000000 STATEMENT 1 ON LINE 152 nblocks = 0; 000312 aa 6 00104 4501 00 stz pr6|68 nblocks STATEMENT 1 ON LINE 153 n_segs = 0; 000313 aa 6 00124 4501 00 stz pr6|84 n_segs STATEMENT 1 ON LINE 154 longsw = "0"b; 000314 aa 6 00112 4501 00 stz pr6|74 longsw STATEMENT 1 ON LINE 155 fatalsw = "0"b; 000315 aa 6 00113 4501 00 stz pr6|75 fatalsw STATEMENT 1 ON LINE 156 sb = ptr (addr (sb), 0); 000316 aa 6 00352 3735 00 epp7 pr6|234 sb 000317 aa 7 00000 3525 00 epbp2 pr7|0 000320 aa 6 00352 2521 00 spri2 pr6|234 sb STATEMENT 1 ON LINE 157 lotp = sb -> stack_header.lot_ptr; 000321 aa 2 00026 3715 20 epp5 pr2|22,* stack_header.lot_ptr 000322 aa 6 00354 6515 00 spri5 pr6|236 lotp STATEMENT 1 ON LINE 159 call cu_$arg_count (nargs); 000323 aa 6 00100 3521 00 epp2 pr6|64 nargs 000324 aa 6 00424 2521 00 spri2 pr6|276 000325 aa 6 00422 6211 00 eax1 pr6|274 000326 aa 004000 4310 07 fld 2048,dl 000327 la 4 00020 3521 20 epp2 pr4|16,* cu_$arg_count 000330 aa 6 00426 6535 00 spri7 pr6|278 000331 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 161 if nargs = 0 then do; 000332 aa 6 00100 2361 00 ldq pr6|64 nargs 000333 aa 000027 6010 04 tnz 23,ic 000362 STATEMENT 1 ON LINE 163 call com_err_ (0, me, "Usage is: set_fortran_common paths {-long}"); 000334 aa 6 00421 4501 00 stz pr6|273 000335 aa 000 100 100 404 mlr (ic),(pr),fill(000) 000336 aa 777551 00 0054 desc9a -151,44 000106 = 125163141147 000337 aa 6 00430 00 0054 desc9a pr6|280,44 000340 aa 6 00421 3521 00 epp2 pr6|273 000341 aa 6 00446 2521 00 spri2 pr6|294 000342 aa 777440 3520 04 epp2 -224,ic 000002 = 163145164137 000343 aa 6 00450 2521 00 spri2 pr6|296 000344 aa 6 00430 3521 00 epp2 pr6|280 000345 aa 6 00452 2521 00 spri2 pr6|298 000346 aa 777471 3520 04 epp2 -199,ic 000037 = 404000000005 000347 aa 6 00454 2521 00 spri2 pr6|300 000350 aa 777466 3520 04 epp2 -202,ic 000036 = 526000000022 000351 aa 6 00456 2521 00 spri2 pr6|302 000352 aa 777463 3520 04 epp2 -205,ic 000035 = 524000000053 000353 aa 6 00460 2521 00 spri2 pr6|304 000354 aa 6 00444 6211 00 eax1 pr6|292 000355 aa 014000 4310 07 fld 6144,dl 000356 aa 6 00044 3701 20 epp4 pr6|36,* 000357 la 4 00026 3521 20 epp2 pr4|22,* com_err_ 000360 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 164 return; 000361 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 165 end; STATEMENT 1 ON LINE 167 sys_areap = get_system_free_area_ (); 000362 aa 6 00122 3521 00 epp2 pr6|82 sys_areap 000363 aa 6 00424 2521 00 spri2 pr6|276 000364 aa 6 00422 6211 00 eax1 pr6|274 000365 aa 004000 4310 07 fld 2048,dl 000366 aa 6 00044 3701 20 epp4 pr6|36,* 000367 la 4 00032 3521 20 epp2 pr4|26,* get_system_free_area_ 000370 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 169 viptr (1) = null; 000371 aa 777465 2370 04 ldaq -203,ic 000056 = 077777000043 000001000000 000372 aa 6 00144 7571 00 staq pr6|100 viptr STATEMENT 1 ON LINE 170 comp_infop = null; 000373 aa 6 00356 7571 00 staq pr6|238 comp_infop STATEMENT 1 ON LINE 171 on cleanup begin; 000374 aa 000007 7260 07 lxl6 7,dl 000375 aa 777463 3520 04 epp2 -205,ic 000060 = 143154145141 000376 aa 0 00717 7001 00 tsx0 pr0|463 enable_op 000377 aa 000004 7100 04 tra 4,ic 000403 000400 aa 000342000000 000401 aa 000107 7100 04 tra 71,ic 000510 BEGIN CONDITION cleanup.1 ENTRY TO cleanup.1 STATEMENT 1 ON LINE 171 on cleanup begin; 000402 da 000353200000 000403 aa 000140 6270 00 eax7 96 000404 aa 7 00034 3521 20 epp2 pr7|28,* 000405 aa 2 01047 2721 00 tsp2 pr2|551 int_entry 000406 aa 000000000000 000407 aa 000000000000 STATEMENT 1 ON LINE 173 if viptr (1) ^= null then do; 000410 aa 6 00040 3735 20 epp7 pr6|32,* 000411 aa 7 00144 2371 00 ldaq pr7|100 viptr 000412 aa 777444 6770 04 eraq -220,ic 000056 = 077777000043 000001000000 000413 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 000414 aa 000057 6000 04 tze 47,ic 000473 STATEMENT 1 ON LINE 174 do i = 1 to n_segs; 000415 aa 7 00124 2361 00 ldq pr7|84 n_segs 000416 aa 6 00100 7561 00 stq pr6|64 000417 aa 000001 2360 07 ldq 1,dl 000420 aa 7 00102 7561 00 stq pr7|66 i 000421 aa 000000 0110 03 nop 0,du 000422 aa 6 00040 3735 20 epp7 pr6|32,* 000423 aa 7 00102 2361 00 ldq pr7|66 i 000424 aa 6 00100 1161 00 cmpq pr6|64 000425 aa 000025 6054 04 tpnz 21,ic 000452 STATEMENT 1 ON LINE 175 if seg_info (i).segp ^= null then call hcs_$terminate_noname (seg_info (i).segp, code); 000426 aa 000056 4020 07 mpy 46,dl 000427 aa 7 00146 3715 20 epp5 pr7|102,* viptr 000430 aa 6 00101 7561 00 stq pr6|65 000431 aa 5 77774 2371 06 ldaq pr5|-4,ql seg_info.segp 000432 aa 777424 6770 04 eraq -236,ic 000056 = 077777000043 000001000000 000433 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 000434 aa 000013 6000 04 tze 11,ic 000447 000435 aa 6 00101 7271 00 lxl7 pr6|65 000436 aa 5 77774 3521 17 epp2 pr5|-4,7 seg_info.segp 000437 aa 6 00104 2521 00 spri2 pr6|68 000440 aa 7 00111 3521 00 epp2 pr7|73 code 000441 aa 6 00106 2521 00 spri2 pr6|70 000442 aa 6 00102 6211 00 eax1 pr6|66 000443 aa 010000 4310 07 fld 4096,dl 000444 aa 6 00044 3701 20 epp4 pr6|36,* 000445 la 4 00046 3521 20 epp2 pr4|38,* hcs_$terminate_noname 000446 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 177 end; 000447 aa 6 00040 3735 20 epp7 pr6|32,* 000450 aa 7 00102 0541 00 aos pr7|66 i 000451 aa 777751 7100 04 tra -23,ic 000422 STATEMENT 1 ON LINE 178 call release_temp_segments_ (me, viptr, code); 000452 aa 777330 3520 04 epp2 -296,ic 000002 = 163145164137 000453 aa 6 00112 2521 00 spri2 pr6|74 000454 aa 7 00144 3521 00 epp2 pr7|100 viptr 000455 aa 6 00114 2521 00 spri2 pr6|76 000456 aa 7 00111 3521 00 epp2 pr7|73 code 000457 aa 6 00116 2521 00 spri2 pr6|78 000460 aa 777356 3520 04 epp2 -274,ic 000036 = 526000000022 000461 aa 6 00120 2521 00 spri2 pr6|80 000462 aa 777403 3520 04 epp2 -253,ic 000065 = 464100000000 000463 aa 6 00122 2521 00 spri2 pr6|82 000464 aa 777350 3520 04 epp2 -280,ic 000034 = 404000000043 000465 aa 6 00124 2521 00 spri2 pr6|84 000466 aa 6 00110 6211 00 eax1 pr6|72 000467 aa 014000 4310 07 fld 6144,dl 000470 aa 6 00044 3701 20 epp4 pr6|36,* 000471 la 4 00052 3521 20 epp2 pr4|42,* release_temp_segments_ 000472 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 179 end; STATEMENT 1 ON LINE 180 if comp_infop ^= null then free component_info in (sys_area); 000473 aa 6 00040 3735 20 epp7 pr6|32,* 000474 aa 7 00356 2371 00 ldaq pr7|238 comp_infop 000475 aa 777361 6770 04 eraq -271,ic 000056 = 077777000043 000001000000 000476 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 000477 aa 000010 6000 04 tze 8,ic 000507 000500 aa 7 00356 3715 20 epp5 pr7|238,* comp_infop 000501 aa 5 00003 2361 00 ldq pr5|3 component_info.max 000502 aa 000001 0760 07 adq 1,dl 000503 aa 000072 4020 07 mpy 58,dl 000504 aa 000004 0760 07 adq 4,dl 000505 aa 7 00356 3715 00 epp5 pr7|238 comp_infop 000506 aa 0 01404 7001 00 tsx0 pr0|772 op_freen_ STATEMENT 1 ON LINE 182 end; 000507 aa 0 00631 7101 00 tra pr0|409 return_mac END CONDITION cleanup.1 STATEMENT 1 ON LINE 184 call get_temp_segments_ (me, viptr, code); 000510 aa 777272 3520 04 epp2 -326,ic 000002 = 163145164137 000511 aa 6 00446 2521 00 spri2 pr6|294 000512 aa 6 00144 3521 00 epp2 pr6|100 viptr 000513 aa 6 00450 2521 00 spri2 pr6|296 000514 aa 6 00111 3521 00 epp2 pr6|73 code 000515 aa 6 00452 2521 00 spri2 pr6|298 000516 aa 777320 3520 04 epp2 -304,ic 000036 = 526000000022 000517 aa 6 00454 2521 00 spri2 pr6|300 000520 aa 777345 3520 04 epp2 -283,ic 000065 = 464100000000 000521 aa 6 00456 2521 00 spri2 pr6|302 000522 aa 777312 3520 04 epp2 -310,ic 000034 = 404000000043 000523 aa 6 00460 2521 00 spri2 pr6|304 000524 aa 6 00444 6211 00 eax1 pr6|292 000525 aa 014000 4310 07 fld 6144,dl 000526 aa 6 00044 3701 20 epp4 pr6|36,* 000527 la 4 00050 3521 20 epp2 pr4|40,* get_temp_segments_ 000530 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 186 do i = 1 to nargs; 000531 aa 6 00100 2361 00 ldq pr6|64 nargs 000532 aa 6 00360 7561 00 stq pr6|240 000533 aa 000001 2360 07 ldq 1,dl 000534 aa 6 00102 7561 00 stq pr6|66 i 000535 aa 000000 0110 03 nop 0,du 000536 aa 6 00102 2361 00 ldq pr6|66 i 000537 aa 6 00360 1161 00 cmpq pr6|240 000540 aa 000555 6054 04 tpnz 365,ic 001315 STATEMENT 1 ON LINE 187 call cu_$arg_ptr (i, aptr, alng, code); 000541 aa 6 00102 3521 00 epp2 pr6|66 i 000542 aa 6 00432 2521 00 spri2 pr6|282 000543 aa 6 00126 3521 00 epp2 pr6|86 aptr 000544 aa 6 00434 2521 00 spri2 pr6|284 000545 aa 6 00101 3521 00 epp2 pr6|65 alng 000546 aa 6 00436 2521 00 spri2 pr6|286 000547 aa 6 00111 3521 00 epp2 pr6|73 code 000550 aa 6 00440 2521 00 spri2 pr6|288 000551 aa 6 00430 6211 00 eax1 pr6|280 000552 aa 020000 4310 07 fld 8192,dl 000553 aa 6 00044 3701 20 epp4 pr6|36,* 000554 la 4 00022 3521 20 epp2 pr4|18,* cu_$arg_ptr 000555 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 188 if (arg = "-long") | (arg = "-lg") then do; 000556 aa 6 00126 3735 20 epp7 pr6|86,* aptr 000557 aa 6 00101 7271 00 lxl7 pr6|65 alng 000560 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 000561 aa 7 00000 00 0017 desc9a pr7|0,x7 arg 000562 aa 777274 00 0005 desc9a -324,5 000054 = 055154157156 000563 aa 000005 6000 04 tze 5,ic 000570 000564 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 000565 aa 7 00000 00 0017 desc9a pr7|0,x7 arg 000566 aa 777247 00 0003 desc9a -345,3 000033 = 055154147000 000567 aa 000004 6010 04 tnz 4,ic 000573 STATEMENT 1 ON LINE 190 longsw = "1"b; 000570 aa 400000 2350 03 lda 131072,du 000571 aa 6 00112 7551 00 sta pr6|74 longsw STATEMENT 1 ON LINE 191 goto end_arg_loop; 000572 aa 000521 7100 04 tra 337,ic 001313 STATEMENT 1 ON LINE 192 end; STATEMENT 1 ON LINE 193 else if substr (arg, 1, 1) = "-" then do; 000573 aa 040 004 106 500 cmpc (pr),(ic),fill(040) 000574 aa 7 00000 00 0001 desc9a pr7|0,1 arg 000575 aa 002500 00 0001 desc9a 1344,1 003273 = 055000000000 000576 aa 000027 6010 04 tnz 23,ic 000625 STATEMENT 1 ON LINE 195 call com_err_ (error_table_$badopt, me, arg); 000577 aa 6 00101 2361 00 ldq pr6|65 alng 000600 aa 526000 2760 03 orq 175104,du 000601 aa 6 00421 7561 00 stq pr6|273 000602 aa 6 00044 3701 20 epp4 pr6|36,* 000603 la 4 00010 3521 20 epp2 pr4|8,* error_table_$badopt 000604 aa 6 00446 2521 00 spri2 pr6|294 000605 aa 777175 3520 04 epp2 -387,ic 000002 = 163145164137 000606 aa 6 00450 2521 00 spri2 pr6|296 000607 aa 7 00000 3521 00 epp2 pr7|0 arg 000610 aa 6 00452 2521 00 spri2 pr6|298 000611 aa 777223 3520 04 epp2 -365,ic 000034 = 404000000043 000612 aa 6 00454 2521 00 spri2 pr6|300 000613 aa 777223 3520 04 epp2 -365,ic 000036 = 526000000022 000614 aa 6 00456 2521 00 spri2 pr6|302 000615 aa 6 00421 3521 00 epp2 pr6|273 000616 aa 6 00460 2521 00 spri2 pr6|304 000617 aa 6 00444 6211 00 eax1 pr6|292 000620 aa 014000 4310 07 fld 6144,dl 000621 la 4 00026 3521 20 epp2 pr4|22,* com_err_ 000622 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 196 fatalsw = "1"b; 000623 aa 400000 2350 03 lda 131072,du 000624 aa 6 00113 7551 00 sta pr6|75 fatalsw STATEMENT 1 ON LINE 197 end; STATEMENT 1 ON LINE 198 call expand_pathname_ (arg, dir, ent, code); 000625 aa 6 00101 2361 00 ldq pr6|65 alng 000626 aa 526000 2760 03 orq 175104,du 000627 aa 6 00421 7561 00 stq pr6|273 000630 aa 6 00126 3521 20 epp2 pr6|86,* arg 000631 aa 6 00464 2521 00 spri2 pr6|308 000632 aa 6 00171 3521 00 epp2 pr6|121 dir 000633 aa 6 00466 2521 00 spri2 pr6|310 000634 aa 6 00243 3521 00 epp2 pr6|163 ent 000635 aa 6 00470 2521 00 spri2 pr6|312 000636 aa 6 00111 3521 00 epp2 pr6|73 code 000637 aa 6 00472 2521 00 spri2 pr6|314 000640 aa 6 00421 3521 00 epp2 pr6|273 000641 aa 6 00474 2521 00 spri2 pr6|316 000642 aa 777177 3520 04 epp2 -385,ic 000041 = 526000000250 000643 aa 6 00476 2521 00 spri2 pr6|318 000644 aa 777165 3520 04 epp2 -395,ic 000031 = 526000000040 000645 aa 6 00500 2521 00 spri2 pr6|320 000646 aa 777166 3520 04 epp2 -394,ic 000034 = 404000000043 000647 aa 6 00502 2521 00 spri2 pr6|322 000650 aa 6 00462 6211 00 eax1 pr6|306 000651 aa 020000 4310 07 fld 8192,dl 000652 aa 6 00044 3701 20 epp4 pr6|36,* 000653 la 4 00024 3521 20 epp2 pr4|20,* expand_pathname_ 000654 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 199 if code ^= 0 then do; 000655 aa 6 00111 2361 00 ldq pr6|73 code 000656 aa 000030 6000 04 tze 24,ic 000706 STATEMENT 1 ON LINE 201 error1: call com_err_ (code, me, arg); 000657 aa 6 00101 2361 00 ldq pr6|65 alng 000660 aa 526000 2760 03 orq 175104,du 000661 aa 6 00421 7561 00 stq pr6|273 000662 aa 6 00111 3521 00 epp2 pr6|73 code 000663 aa 6 00446 2521 00 spri2 pr6|294 000664 aa 777116 3520 04 epp2 -434,ic 000002 = 163145164137 000665 aa 6 00450 2521 00 spri2 pr6|296 000666 aa 6 00126 3521 20 epp2 pr6|86,* arg 000667 aa 6 00452 2521 00 spri2 pr6|298 000670 aa 777144 3520 04 epp2 -412,ic 000034 = 404000000043 000671 aa 6 00454 2521 00 spri2 pr6|300 000672 aa 777144 3520 04 epp2 -412,ic 000036 = 526000000022 000673 aa 6 00456 2521 00 spri2 pr6|302 000674 aa 6 00421 3521 00 epp2 pr6|273 000675 aa 6 00460 2521 00 spri2 pr6|304 000676 aa 6 00444 6211 00 eax1 pr6|292 000677 aa 014000 4310 07 fld 6144,dl 000700 aa 6 00044 3701 20 epp4 pr6|36,* 000701 la 4 00026 3521 20 epp2 pr4|22,* com_err_ 000702 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 203 fatalsw = "1"b; 000703 aa 400000 2350 03 lda 131072,du 000704 aa 6 00113 7551 00 sta pr6|75 fatalsw STATEMENT 1 ON LINE 204 goto end_arg_loop; 000705 aa 000406 7100 04 tra 262,ic 001313 STATEMENT 1 ON LINE 205 end; STATEMENT 1 ON LINE 207 call object_lib_$initiate (dir, ent, "", "1"b, seg_ptr, bitcnt, msf_sw, code); 000706 aa 400000 2350 03 lda 131072,du 000707 aa 6 00443 7551 00 sta pr6|291 000710 aa 6 00171 3521 00 epp2 pr6|121 dir 000711 aa 6 00506 2521 00 spri2 pr6|326 000712 aa 6 00243 3521 00 epp2 pr6|163 ent 000713 aa 6 00510 2521 00 spri2 pr6|328 000714 aa 6 00421 3521 00 epp2 pr6|273 000715 aa 6 00512 2521 00 spri2 pr6|330 000716 aa 6 00443 3521 00 epp2 pr6|291 000717 aa 6 00514 2521 00 spri2 pr6|332 000720 aa 6 00130 3521 00 epp2 pr6|88 seg_ptr 000721 aa 6 00516 2521 00 spri2 pr6|334 000722 aa 6 00107 3521 00 epp2 pr6|71 bitcnt 000723 aa 6 00520 2521 00 spri2 pr6|336 000724 aa 6 00125 3521 00 epp2 pr6|85 msf_sw 000725 aa 6 00522 2521 00 spri2 pr6|338 000726 aa 6 00111 3521 00 epp2 pr6|73 code 000727 aa 6 00524 2521 00 spri2 pr6|340 000730 aa 777111 3520 04 epp2 -439,ic 000041 = 526000000250 000731 aa 6 00526 2521 00 spri2 pr6|342 000732 aa 777077 3520 04 epp2 -449,ic 000031 = 526000000040 000733 aa 6 00530 2521 00 spri2 pr6|344 000734 aa 777074 3520 04 epp2 -452,ic 000030 = 524000000000 000735 aa 6 00532 2521 00 spri2 pr6|346 000736 aa 777071 3520 04 epp2 -455,ic 000027 = 514000000001 000737 aa 6 00534 2521 00 spri2 pr6|348 000740 aa 777102 3520 04 epp2 -446,ic 000042 = 464000000000 000741 aa 6 00536 2521 00 spri2 pr6|350 000742 aa 777064 3520 04 epp2 -460,ic 000026 = 404000000030 000743 aa 6 00540 2521 00 spri2 pr6|352 000744 aa 777061 3520 04 epp2 -463,ic 000025 = 516000000001 000745 aa 6 00542 2521 00 spri2 pr6|354 000746 aa 777066 3520 04 epp2 -458,ic 000034 = 404000000043 000747 aa 6 00544 2521 00 spri2 pr6|356 000750 aa 6 00504 6211 00 eax1 pr6|324 000751 aa 040000 4310 07 fld 16384,dl 000752 aa 6 00044 3701 20 epp4 pr6|36,* 000753 la 4 00034 3521 20 epp2 pr4|28,* object_lib_$initiate 000754 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 208 if code ^= 0 then do; 000755 aa 6 00111 2361 00 ldq pr6|73 code 000756 aa 000037 6000 04 tze 31,ic 001015 STATEMENT 1 ON LINE 210 error2: call com_err_ (code, me, "^a>^a", dir, ent); 000757 aa 777073 2370 04 ldaq -453,ic 000052 = 136141076136 141000000000 000760 aa 6 00546 7571 00 staq pr6|358 000761 aa 6 00111 3521 00 epp2 pr6|73 code 000762 aa 6 00506 2521 00 spri2 pr6|326 000763 aa 777017 3520 04 epp2 -497,ic 000002 = 163145164137 000764 aa 6 00510 2521 00 spri2 pr6|328 000765 aa 6 00546 3521 00 epp2 pr6|358 000766 aa 6 00512 2521 00 spri2 pr6|330 000767 aa 6 00171 3521 00 epp2 pr6|121 dir 000770 aa 6 00514 2521 00 spri2 pr6|332 000771 aa 6 00243 3521 00 epp2 pr6|163 ent 000772 aa 6 00516 2521 00 spri2 pr6|334 000773 aa 777041 3520 04 epp2 -479,ic 000034 = 404000000043 000774 aa 6 00520 2521 00 spri2 pr6|336 000775 aa 777041 3520 04 epp2 -479,ic 000036 = 526000000022 000776 aa 6 00522 2521 00 spri2 pr6|338 000777 aa 777025 3520 04 epp2 -491,ic 000024 = 524000000005 001000 aa 6 00524 2521 00 spri2 pr6|340 001001 aa 777040 3520 04 epp2 -480,ic 000041 = 526000000250 001002 aa 6 00526 2521 00 spri2 pr6|342 001003 aa 777026 3520 04 epp2 -490,ic 000031 = 526000000040 001004 aa 6 00530 2521 00 spri2 pr6|344 001005 aa 6 00504 6211 00 eax1 pr6|324 001006 aa 024000 4310 07 fld 10240,dl 001007 aa 6 00044 3701 20 epp4 pr6|36,* 001010 la 4 00026 3521 20 epp2 pr4|22,* com_err_ 001011 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 212 fatalsw = "1"b; 001012 aa 400000 2350 03 lda 131072,du 001013 aa 6 00113 7551 00 sta pr6|75 fatalsw STATEMENT 1 ON LINE 213 goto end_arg_loop; 001014 aa 000277 7100 04 tra 191,ic 001313 STATEMENT 1 ON LINE 214 end; STATEMENT 1 ON LINE 215 seg_info (n_segs+1).segp = null; 001015 aa 6 00124 2361 00 ldq pr6|84 n_segs 001016 aa 000056 4020 07 mpy 46,dl 001017 aa 000000 6270 06 eax7 0,ql 001020 aa 777036 2370 04 ldaq -482,ic 000056 = 077777000043 000001000000 001021 aa 6 00146 3735 20 epp7 pr6|102,* viptr 001022 aa 7 00052 7571 17 staq pr7|42,7 seg_info.segp STATEMENT 1 ON LINE 216 n_segs = n_segs + 1; 001023 aa 6 00124 0541 00 aos pr6|84 n_segs STATEMENT 1 ON LINE 218 do j = 1 to n_segs - 1; 001024 aa 6 00124 2361 00 ldq pr6|84 n_segs 001025 aa 000001 1760 07 sbq 1,dl 001026 aa 6 00361 7561 00 stq pr6|241 001027 aa 000001 2360 07 ldq 1,dl 001030 aa 6 00103 7561 00 stq pr6|67 j 001031 aa 000000 0110 03 nop 0,du 001032 aa 6 00103 2361 00 ldq pr6|67 j 001033 aa 6 00361 1161 00 cmpq pr6|241 001034 aa 000014 6054 04 tpnz 12,ic 001050 STATEMENT 1 ON LINE 219 if seg_info (j).segp = seg_ptr then do; 001035 aa 000056 4020 07 mpy 46,dl 001036 aa 6 00146 3735 20 epp7 pr6|102,* viptr 001037 aa 7 77774 2371 06 ldaq pr7|-4,ql seg_info.segp 001040 aa 6 00130 6771 00 eraq pr6|88 seg_ptr 001041 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 001042 aa 000004 6010 04 tnz 4,ic 001046 STATEMENT 1 ON LINE 221 n_segs = n_segs - 1; 001043 aa 000001 3360 07 lcq 1,dl 001044 aa 6 00124 0561 00 asq pr6|84 n_segs STATEMENT 1 ON LINE 222 goto end_arg_loop; 001045 aa 000246 7100 04 tra 166,ic 001313 STATEMENT 1 ON LINE 223 end; STATEMENT 1 ON LINE 224 end; 001046 aa 6 00103 0541 00 aos pr6|67 j 001047 aa 777763 7100 04 tra -13,ic 001032 STATEMENT 1 ON LINE 225 seg_info (n_segs).segp = seg_ptr; 001050 aa 6 00124 2361 00 ldq pr6|84 n_segs 001051 aa 000056 4020 07 mpy 46,dl 001052 aa 6 00130 3735 20 epp7 pr6|88,* seg_ptr 001053 aa 6 00146 3715 20 epp5 pr6|102,* viptr 001054 aa 5 77774 6535 06 spri7 pr5|-4,ql seg_info.segp STATEMENT 1 ON LINE 226 seg_info (n_segs).bc = bitcnt; 001055 aa 000000 6270 06 eax7 0,ql 001056 aa 6 00107 2361 00 ldq pr6|71 bitcnt 001057 aa 5 77776 7561 17 stq pr5|-2,7 seg_info.bc STATEMENT 1 ON LINE 227 seg_info (n_segs).pathname = pathname_ (dir, ent); 001060 aa 6 00124 2361 00 ldq pr6|84 n_segs 001061 aa 000056 4020 07 mpy 46,dl 001062 aa 6 00171 3521 00 epp2 pr6|121 dir 001063 aa 6 00446 2521 00 spri2 pr6|294 001064 aa 6 00243 3521 00 epp2 pr6|163 ent 001065 aa 6 00450 2521 00 spri2 pr6|296 001066 aa 6 00550 3521 00 epp2 pr6|360 001067 aa 6 00452 2521 00 spri2 pr6|298 001070 aa 776751 3520 04 epp2 -535,ic 000041 = 526000000250 001071 aa 6 00454 2521 00 spri2 pr6|300 001072 aa 6 00460 2521 00 spri2 pr6|304 001073 aa 776736 3520 04 epp2 -546,ic 000031 = 526000000040 001074 aa 6 00456 2521 00 spri2 pr6|302 001075 aa 6 00443 7561 00 stq pr6|291 001076 aa 6 00444 6211 00 eax1 pr6|292 001077 aa 014000 4310 07 fld 6144,dl 001100 aa 6 00044 3701 20 epp4 pr6|36,* 001101 la 4 00040 3521 20 epp2 pr4|32,* pathname_ 001102 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc 001103 aa 6 00443 7271 00 lxl7 pr6|291 001104 aa 6 00146 3735 20 epp7 pr6|102,* viptr 001105 aa 7 77722 3735 17 epp7 pr7|-46,7 seg_info.pathname 001106 aa 000 100 100 500 mlr (pr),(pr),fill(000) 001107 aa 6 00550 00 0250 desc9a pr6|360,168 001110 aa 7 00000 00 0250 desc9a pr7|0,168 seg_info.pathname STATEMENT 1 ON LINE 229 if msf_sw then do; 001111 aa 6 00125 2351 00 lda pr6|85 msf_sw 001112 aa 400000 3150 03 cana 131072,du 001113 aa 000200 6000 04 tze 128,ic 001313 STATEMENT 1 ON LINE 231 call object_lib_$get_component_info (seg_ptr, sys_areap, component_info_version_1, "none", comp_infop, code); 001114 aa 776706 2350 04 lda -570,ic 000022 = 156157156145 001115 aa 6 00443 7551 00 sta pr6|291 001116 aa 6 00130 3521 00 epp2 pr6|88 seg_ptr 001117 aa 6 00506 2521 00 spri2 pr6|326 001120 aa 6 00122 3521 00 epp2 pr6|82 sys_areap 001121 aa 6 00510 2521 00 spri2 pr6|328 001122 aa 776656 3520 04 epp2 -594,ic 000000 = 143151156146 001123 aa 6 00512 2521 00 spri2 pr6|330 001124 aa 6 00443 3521 00 epp2 pr6|291 001125 aa 6 00514 2521 00 spri2 pr6|332 001126 aa 6 00356 3521 00 epp2 pr6|238 comp_infop 001127 aa 6 00516 2521 00 spri2 pr6|334 001130 aa 6 00111 3521 00 epp2 pr6|73 code 001131 aa 6 00520 2521 00 spri2 pr6|336 001132 aa 776710 3520 04 epp2 -568,ic 000042 = 464000000000 001133 aa 6 00522 2521 00 spri2 pr6|338 001134 aa 6 00524 2521 00 spri2 pr6|340 001135 aa 6 00532 2521 00 spri2 pr6|346 001136 aa 776665 3520 04 epp2 -587,ic 000023 = 526000000010 001137 aa 6 00526 2521 00 spri2 pr6|342 001140 aa 776661 3520 04 epp2 -591,ic 000021 = 524000000004 001141 aa 6 00530 2521 00 spri2 pr6|344 001142 aa 776672 3520 04 epp2 -582,ic 000034 = 404000000043 001143 aa 6 00534 2521 00 spri2 pr6|348 001144 aa 6 00504 6211 00 eax1 pr6|324 001145 aa 030000 4310 07 fld 12288,dl 001146 aa 6 00044 3701 20 epp4 pr6|36,* 001147 la 4 00036 3521 20 epp2 pr4|30,* object_lib_$get_component_info 001150 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 232 if code ^= 0 then goto error2; 001151 aa 6 00111 2361 00 ldq pr6|73 code 001152 aa 777605 6010 04 tnz -123,ic 000757 STATEMENT 1 ON LINE 235 do j = 1 to component_info.max; 001153 aa 6 00356 3735 20 epp7 pr6|238,* comp_infop 001154 aa 7 00003 2361 00 ldq pr7|3 component_info.max 001155 aa 6 00362 7561 00 stq pr6|242 001156 aa 000001 2360 07 ldq 1,dl 001157 aa 6 00103 7561 00 stq pr6|67 j 001160 aa 6 00103 2361 00 ldq pr6|67 j 001161 aa 6 00362 1161 00 cmpq pr6|242 001162 aa 000120 6054 04 tpnz 80,ic 001302 STATEMENT 1 ON LINE 236 seg_info (n_segs+1).segp = null; 001163 aa 6 00124 2361 00 ldq pr6|84 n_segs 001164 aa 000056 4020 07 mpy 46,dl 001165 aa 000000 6270 06 eax7 0,ql 001166 aa 776670 2370 04 ldaq -584,ic 000056 = 077777000043 000001000000 001167 aa 6 00146 3735 20 epp7 pr6|102,* viptr 001170 aa 7 00052 7571 17 staq pr7|42,7 seg_info.segp STATEMENT 1 ON LINE 237 n_segs = n_segs + 1; 001171 aa 6 00124 0541 00 aos pr6|84 n_segs STATEMENT 1 ON LINE 239 do k = 1 to n_segs - 1; 001172 aa 6 00124 2361 00 ldq pr6|84 n_segs 001173 aa 000001 1760 07 sbq 1,dl 001174 aa 6 00363 7561 00 stq pr6|243 001175 aa 000001 2360 07 ldq 1,dl 001176 aa 6 00120 7561 00 stq pr6|80 k 001177 aa 000000 0110 03 nop 0,du 001200 aa 6 00120 2361 00 ldq pr6|80 k 001201 aa 6 00363 1161 00 cmpq pr6|243 001202 aa 000031 6054 04 tpnz 25,ic 001233 STATEMENT 1 ON LINE 240 if seg_info (k).segp = component_info.comp (j).segp then do; 001203 aa 000056 4020 07 mpy 46,dl 001204 aa 000000 6270 06 eax7 0,ql 001205 aa 6 00103 2361 00 ldq pr6|67 j 001206 aa 000072 4020 07 mpy 58,dl 001207 aa 6 00146 3735 20 epp7 pr6|102,* viptr 001210 aa 000000 6260 06 eax6 0,ql 001211 aa 7 77774 2371 17 ldaq pr7|-4,7 seg_info.segp 001212 aa 6 00356 3715 20 epp5 pr6|238,* comp_infop 001213 aa 5 00004 6771 16 eraq pr5|4,6 component_info.segp 001214 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 001215 aa 000014 6010 04 tnz 12,ic 001231 STATEMENT 1 ON LINE 242 n_segs = n_segs - 1; 001216 aa 000001 3360 07 lcq 1,dl 001217 aa 6 00124 0561 00 asq pr6|84 n_segs STATEMENT 1 ON LINE 243 free component_info in (sys_area); 001220 aa 5 00003 2361 00 ldq pr5|3 component_info.max 001221 aa 000001 0760 07 adq 1,dl 001222 aa 000072 4020 07 mpy 58,dl 001223 aa 000004 0760 07 adq 4,dl 001224 aa 6 00356 3715 00 epp5 pr6|238 comp_infop 001225 aa 0 01404 7001 00 tsx0 pr0|772 op_freen_ STATEMENT 1 ON LINE 244 comp_infop = null; 001226 aa 776630 2370 04 ldaq -616,ic 000056 = 077777000043 000001000000 001227 aa 6 00356 7571 00 staq pr6|238 comp_infop STATEMENT 1 ON LINE 245 goto end_arg_loop; 001230 aa 000063 7100 04 tra 51,ic 001313 STATEMENT 1 ON LINE 246 end; STATEMENT 1 ON LINE 247 end; 001231 aa 6 00120 0541 00 aos pr6|80 k 001232 aa 777746 7100 04 tra -26,ic 001200 STATEMENT 1 ON LINE 248 seg_info (n_segs).segp = component_info.comp (j).segp; 001233 aa 6 00124 2361 00 ldq pr6|84 n_segs 001234 aa 000056 4020 07 mpy 46,dl 001235 aa 000000 6270 06 eax7 0,ql 001236 aa 6 00103 2361 00 ldq pr6|67 j 001237 aa 000072 4020 07 mpy 58,dl 001240 aa 6 00356 3735 20 epp7 pr6|238,* comp_infop 001241 aa 7 00004 3735 26 epp7 pr7|4,ql* component_info.segp 001242 aa 6 00146 3715 20 epp5 pr6|102,* viptr 001243 aa 5 77774 6535 17 spri7 pr5|-4,7 seg_info.segp STATEMENT 1 ON LINE 249 seg_info (n_segs).bc = component_info.comp (j).bc; 001244 aa 6 00356 3535 20 epp3 pr6|238,* comp_infop 001245 aa 3 00006 2361 06 ldq pr3|6,ql component_info.bc 001246 aa 5 77776 7561 17 stq pr5|-2,7 seg_info.bc STATEMENT 1 ON LINE 250 seg_info (n_segs).pathname = pathname_ (dir, ent); 001247 aa 6 00124 2361 00 ldq pr6|84 n_segs 001250 aa 000056 4020 07 mpy 46,dl 001251 aa 6 00171 3521 00 epp2 pr6|121 dir 001252 aa 6 00446 2521 00 spri2 pr6|294 001253 aa 6 00243 3521 00 epp2 pr6|163 ent 001254 aa 6 00450 2521 00 spri2 pr6|296 001255 aa 6 00550 3521 00 epp2 pr6|360 001256 aa 6 00452 2521 00 spri2 pr6|298 001257 aa 776562 3520 04 epp2 -654,ic 000041 = 526000000250 001260 aa 6 00454 2521 00 spri2 pr6|300 001261 aa 6 00460 2521 00 spri2 pr6|304 001262 aa 776547 3520 04 epp2 -665,ic 000031 = 526000000040 001263 aa 6 00456 2521 00 spri2 pr6|302 001264 aa 6 00443 7561 00 stq pr6|291 001265 aa 6 00444 6211 00 eax1 pr6|292 001266 aa 014000 4310 07 fld 6144,dl 001267 aa 6 00044 3701 20 epp4 pr6|36,* 001270 la 4 00040 3521 20 epp2 pr4|32,* pathname_ 001271 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc 001272 aa 6 00443 7271 00 lxl7 pr6|291 001273 aa 6 00146 3735 20 epp7 pr6|102,* viptr 001274 aa 7 77722 3735 17 epp7 pr7|-46,7 seg_info.pathname 001275 aa 000 100 100 500 mlr (pr),(pr),fill(000) 001276 aa 6 00550 00 0250 desc9a pr6|360,168 001277 aa 7 00000 00 0250 desc9a pr7|0,168 seg_info.pathname STATEMENT 1 ON LINE 251 end; 001300 aa 6 00103 0541 00 aos pr6|67 j 001301 aa 777657 7100 04 tra -81,ic 001160 STATEMENT 1 ON LINE 253 free component_info in (sys_area); 001302 aa 6 00356 3735 20 epp7 pr6|238,* comp_infop 001303 aa 7 00003 2361 00 ldq pr7|3 component_info.max 001304 aa 000001 0760 07 adq 1,dl 001305 aa 000072 4020 07 mpy 58,dl 001306 aa 000004 0760 07 adq 4,dl 001307 aa 6 00356 3715 00 epp5 pr6|238 comp_infop 001310 aa 0 01404 7001 00 tsx0 pr0|772 op_freen_ STATEMENT 1 ON LINE 254 comp_infop = null; 001311 aa 776545 2370 04 ldaq -667,ic 000056 = 077777000043 000001000000 001312 aa 6 00356 7571 00 staq pr6|238 comp_infop STATEMENT 1 ON LINE 255 end; STATEMENT 1 ON LINE 257 end_arg_loop: end; 001313 aa 6 00102 0541 00 aos pr6|66 i 001314 aa 777222 7100 04 tra -366,ic 000536 STATEMENT 1 ON LINE 260 if fatalsw then goto terminate; 001315 aa 6 00113 2351 00 lda pr6|75 fatalsw 001316 aa 001427 6010 04 tnz 791,ic 002745 STATEMENT 1 ON LINE 263 do i = 1 to n_segs; 001317 aa 6 00124 2361 00 ldq pr6|84 n_segs 001320 aa 6 00364 7561 00 stq pr6|244 001321 aa 000001 2360 07 ldq 1,dl 001322 aa 6 00102 7561 00 stq pr6|66 i 001323 aa 000000 0110 03 nop 0,du 001324 aa 6 00102 2361 00 ldq pr6|66 i 001325 aa 6 00364 1161 00 cmpq pr6|244 001326 aa 000474 6054 04 tpnz 316,ic 002022 STATEMENT 1 ON LINE 265 oi.version_number = object_info_version_2; 001327 aa 000002 2360 07 ldq 2,dl 001330 aa 6 00254 7561 00 stq pr6|172 oi.version_number STATEMENT 1 ON LINE 266 call object_info_$brief (seg_info (i).segp, seg_info (i).bc, addr (oi), code); 001331 aa 6 00102 2361 00 ldq pr6|66 i 001332 aa 000056 4020 07 mpy 46,dl 001333 aa 6 00254 3735 00 epp7 pr6|172 oi 001334 aa 6 00546 6535 00 spri7 pr6|358 001335 aa 6 00146 3715 20 epp5 pr6|102,* viptr 001336 aa 5 77774 3521 06 epp2 pr5|-4,ql seg_info.segp 001337 aa 6 00432 2521 00 spri2 pr6|282 001340 aa 5 77776 3521 06 epp2 pr5|-2,ql seg_info.bc 001341 aa 6 00434 2521 00 spri2 pr6|284 001342 aa 6 00546 3521 00 epp2 pr6|358 001343 aa 6 00436 2521 00 spri2 pr6|286 001344 aa 6 00111 3521 00 epp2 pr6|73 code 001345 aa 6 00440 2521 00 spri2 pr6|288 001346 aa 6 00430 6211 00 eax1 pr6|280 001347 aa 020000 4310 07 fld 8192,dl 001350 aa 6 00044 3701 20 epp4 pr6|36,* 001351 la 4 00042 3521 20 epp2 pr4|34,* object_info_$brief 001352 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 267 if code ^= 0 then goto error2; 001353 aa 6 00111 2361 00 ldq pr6|73 code 001354 aa 777403 6010 04 tnz -253,ic 000757 STATEMENT 1 ON LINE 292 if oi.linkp -> virgin_linkage_header.defs_in_link = "010000"b then block_end = rel (addrel (oi.linkp, oi.linkp -> virgin_linkage_header.def_offset)); 001355 aa 6 00262 2351 20 lda pr6|178,* virgin_linkage_header.defs_in_link 001356 aa 000036 7350 00 als 30 001357 aa 200000 1150 03 cmpa 65536,du 001360 aa 000011 6010 04 tnz 9,ic 001371 001361 aa 6 00262 3735 20 epp7 pr6|178,* oi.linkp 001362 aa 7 00001 2351 00 lda pr7|1 virgin_linkage_header.def_offset 001363 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 001364 aa 7 00000 3521 01 epp2 pr7|0,au 001365 aa 000000 0520 03 adwp2 0,du 001366 aa 2 00000 6351 00 eaa pr2|0 001367 aa 6 00115 7551 00 sta pr6|77 block_end 001370 aa 000010 7100 04 tra 8,ic 001400 STATEMENT 1 ON LINE 294 else block_end = rel (addrel (oi.linkp, oi.linkp -> virgin_linkage_header.linkage_section_lng)); 001371 aa 6 00262 3735 20 epp7 pr6|178,* oi.linkp 001372 aa 7 00006 2351 00 lda pr7|6 virgin_linkage_header.linkage_section_lng 001373 aa 000022 7350 00 als 18 001374 aa 7 00000 3521 01 epp2 pr7|0,au 001375 aa 000000 0520 03 adwp2 0,du 001376 aa 2 00000 6351 00 eaa pr2|0 001377 aa 6 00115 7551 00 sta pr6|77 block_end 001400 aa 6 00546 2521 00 spri2 pr6|358 STATEMENT 1 ON LINE 296 do p = addrel (oi.linkp, oi.linkp -> header.stats.begin_links) repeat (addrel (p, 2)) while (rel (p) < block_end); 001401 aa 7 00006 2351 00 lda pr7|6 header.begin_links 001402 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 001403 aa 7 00000 3521 01 epp2 pr7|0,au 001404 aa 000000 0520 03 adwp2 0,du 001405 aa 6 00132 2521 00 spri2 pr6|90 p 001406 aa 6 00132 6351 20 eaa pr6|90,* p 001407 aa 6 00115 1151 00 cmpa pr6|77 block_end 001410 aa 000410 6030 04 trc 264,ic 002020 STATEMENT 1 ON LINE 299 if p -> link.ft2 = Fault_Tag_2 then do; 001411 aa 6 00132 2351 20 lda pr6|90,* link.ft2 001412 aa 000036 7350 00 als 30 001413 aa 460000 1150 03 cmpa 155648,du 001414 aa 000400 6010 04 tnz 256,ic 002014 STATEMENT 1 ON LINE 301 type_ptr = addrel (oi.defp, (addrel (oi.defp, p -> link.exp_ptr) -> exp_word.type_ptr)); 001415 aa 6 00132 3735 20 epp7 pr6|90,* p 001416 aa 7 00001 2351 00 lda pr7|1 link.exp_ptr 001417 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 001420 aa 6 00260 3521 61 epp2 pr6|176,*au oi.defp 001421 aa 000000 0520 03 adwp2 0,du 001422 aa 2 00000 2351 00 lda pr2|0 exp_word.type_ptr 001423 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 001424 aa 6 00260 3521 61 epp2 pr6|176,*au oi.defp 001425 aa 000000 0520 03 adwp2 0,du 001426 aa 6 00134 2521 00 spri2 pr6|92 type_ptr STATEMENT 1 ON LINE 302 type = bin (type_ptr -> type_pair.type, 18); 001427 aa 2 00000 2351 00 lda pr2|0 type_pair.type 001430 aa 000066 7730 00 lrl 54 001431 aa 6 00110 7561 00 stq pr6|72 type STATEMENT 1 ON LINE 303 if type = 5 then do; 001432 aa 000005 1160 07 cmpq 5,dl 001433 aa 000017 6010 04 tnz 15,ic 001452 STATEMENT 1 ON LINE 305 if bin (type_ptr -> type_pair.seg_ptr, 18) = 5 /* *system */ then ext_name = addrel (oi.defp, type_ptr -> type_pair.ext_ptr) -> acc_name.string; 001434 aa 2 00001 2351 00 lda pr2|1 type_pair.seg_ptr 001435 aa 000066 7730 00 lrl 54 001436 aa 000005 1160 07 cmpq 5,dl 001437 aa 000355 6010 04 tnz 237,ic 002014 001440 aa 2 00001 2351 00 lda pr2|1 type_pair.ext_ptr 001441 aa 000022 7350 00 als 18 001442 aa 6 00260 3515 61 epp1 pr6|176,*au oi.defp 001443 aa 000000 0510 03 adwp1 0,du 001444 aa 1 00000 2351 00 lda pr1|0 acc_name.nsize 001445 aa 000077 7330 00 lrs 63 001446 aa 040 100 100 540 mlr (pr,rl),(pr),fill(040) 001447 aa 1 00000 20 0006 desc9a pr1|0(1),ql acc_name.string 001450 aa 6 00150 00 0101 desc9a pr6|104,65 ext_name STATEMENT 1 ON LINE 309 end; 001451 aa 000116 7100 04 tra 78,ic 001567 STATEMENT 1 ON LINE 310 else if type = 6 then do; 001452 aa 000006 1160 07 cmpq 6,dl 001453 aa 000341 6010 04 tnz 225,ic 002014 STATEMENT 1 ON LINE 312 segnp = addrel (oi.defp, type_ptr -> type_pair.seg_ptr); 001454 aa 2 00001 2351 00 lda pr2|1 type_pair.seg_ptr 001455 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 001456 aa 6 00260 3515 61 epp1 pr6|176,*au oi.defp 001457 aa 000000 0510 03 adwp1 0,du 001460 aa 6 00136 2515 00 spri1 pr6|94 segnp STATEMENT 1 ON LINE 313 ext_ptr = addrel (oi.defp, type_ptr -> type_pair.ext_ptr); 001461 aa 2 00001 2351 00 lda pr2|1 type_pair.ext_ptr 001462 aa 000022 7350 00 als 18 001463 aa 6 00260 3535 61 epp3 pr6|176,*au oi.defp 001464 aa 000000 0530 03 adwp3 0,du 001465 aa 6 00142 2535 00 spri3 pr6|98 ext_ptr STATEMENT 1 ON LINE 314 if ext_ptr -> acc_name.nsize = 0 then do; 001466 aa 3 00000 2351 00 lda pr3|0 acc_name.nsize 001467 aa 000077 7330 00 lrs 63 001470 aa 6 00443 7561 00 stq pr6|291 acc_name.nsize 001471 aa 000036 6010 04 tnz 30,ic 001527 STATEMENT 1 ON LINE 316 j = index (segnp -> acc_name.string, ".com"); 001472 aa 1 00000 2351 00 lda pr1|0 acc_name.nsize 001473 aa 000077 7330 00 lrs 63 001474 aa 000001 7270 07 lxl7 1,dl 001475 aa 1 00000 3521 00 epp2 pr1|0 acc_name.string 001476 aa 2 00000 5005 17 a9bd pr2|0,7 001477 aa 0 01227 7001 00 tsx0 pr0|663 set_chars_eis 001500 aa 6 00421 7561 00 stq pr6|273 acc_name.nsize 001501 aa 000004 2360 07 ldq 4,dl 001502 aa 776316 3520 04 epp2 -818,ic 000020 = 056143157155 001503 aa 0 01231 7001 00 tsx0 pr0|665 index_chars_eis 001504 aa 6 00103 7561 00 stq pr6|67 j STATEMENT 1 ON LINE 317 if (j = 0) | (j < (segnp -> acc_name.nsize - 3)) then goto next_link; 001505 aa 000307 6000 04 tze 199,ic 002014 001506 aa 6 00421 2361 00 ldq pr6|273 acc_name.nsize 001507 aa 000003 1760 07 sbq 3,dl 001510 aa 6 00103 1161 00 cmpq pr6|67 j 001511 aa 000303 6054 04 tpnz 195,ic 002014 STATEMENT 1 ON LINE 319 ext_name = substr (segnp -> acc_name.string, 1, j - 1); 001512 aa 6 00103 2361 00 ldq pr6|67 j 001513 aa 000001 1760 07 sbq 1,dl 001514 aa 040 100 100 540 mlr (pr,rl),(pr),fill(040) 001515 aa 1 00000 20 0006 desc9a pr1|0(1),ql acc_name.string 001516 aa 6 00150 00 0101 desc9a pr6|104,65 ext_name STATEMENT 1 ON LINE 320 if ext_name = "b_" then ext_name = "blnk*com"; 001517 aa 040 004 106 500 cmpc (pr),(ic),fill(040) 001520 aa 6 00150 00 0101 desc9a pr6|104,65 ext_name 001521 aa 001553 00 0002 desc9a 875,2 003272 = 142137000000 001522 aa 000044 6010 04 tnz 36,ic 001566 001523 aa 040 100 100 404 mlr (ic),(pr),fill(040) 001524 aa 776325 00 0010 desc9a -811,8 000050 = 142154156153 001525 aa 6 00150 00 0101 desc9a pr6|104,65 ext_name STATEMENT 1 ON LINE 322 end; 001526 aa 000040 7100 04 tra 32,ic 001566 STATEMENT 1 ON LINE 323 else if segnp -> acc_name.string = "stat_" then ext_name = ext_ptr -> acc_name.string; 001527 aa 1 00000 2351 00 lda pr1|0 acc_name.nsize 001530 aa 000077 7330 00 lrs 63 001531 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 001532 aa 1 00000 20 0006 desc9a pr1|0(1),ql acc_name.string 001533 aa 776315 00 0005 desc9a -819,5 000046 = 163164141164 001534 aa 6 00421 7561 00 stq pr6|273 001535 aa 000006 6010 04 tnz 6,ic 001543 001536 aa 6 00443 7271 00 lxl7 pr6|291 acc_name.nsize 001537 aa 040 100 100 540 mlr (pr,rl),(pr),fill(040) 001540 aa 3 00000 20 0017 desc9a pr3|0(1),x7 acc_name.string 001541 aa 6 00150 00 0101 desc9a pr6|104,65 ext_name 001542 aa 000024 7100 04 tra 20,ic 001566 STATEMENT 1 ON LINE 325 else if segnp -> acc_name.string = "cobol_fsb_" then ext_name = "cobol_fsb_" || ext_ptr -> acc_name.string; 001543 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 001544 aa 1 00000 20 0006 desc9a pr1|0(1),ql acc_name.string 001545 aa 776317 00 0012 desc9a -817,10 000062 = 143157142157 001546 aa 000246 6010 04 tnz 166,ic 002014 001547 aa 6 00443 7271 00 lxl7 pr6|291 acc_name.nsize 001550 aa 000012 2360 07 ldq 10,dl 001551 aa 6 00443 4501 00 stz pr6|291 001552 aa 6 00443 4471 00 sxl7 pr6|291 001553 aa 6 00443 0761 00 adq pr6|291 001554 aa 0 00551 7001 00 tsx0 pr0|361 alloc_char_temp 001555 aa 040 100 100 404 mlr (ic),(pr),fill(040) 001556 aa 776305 00 0012 desc9a -827,10 000062 = 143157142157 001557 aa 2 00000 00 0012 desc9a pr2|0,10 001560 aa 040 140 100 540 mlr (pr,rl),(pr,rl),fill(040) 001561 aa 3 00000 20 0017 desc9a pr3|0(1),x7 acc_name.string 001562 aa 2 00002 40 0017 desc9a pr2|2(2),x7 001563 aa 040 100 100 540 mlr (pr,rl),(pr),fill(040) 001564 aa 2 00000 00 0006 desc9a pr2|0,ql 001565 aa 6 00150 00 0101 desc9a pr6|104,65 ext_name STATEMENT 1 ON LINE 328 end; 001566 aa 0 01014 7001 00 tsx0 pr0|524 shorten_stack STATEMENT 1 ON LINE 330 end; STATEMENT 1 ON LINE 333 if type_ptr -> type_pair.trap_ptr = "0"b then goto next_link; 001567 aa 6 00134 2351 20 lda pr6|92,* type_pair.trap_ptr 001570 aa 000022 7350 00 als 18 001571 aa 000223 6000 04 tze 147,ic 002014 STATEMENT 1 ON LINE 335 init_info_ptr = addrel (oi.defp, type_ptr -> type_pair.trap_ptr); 001572 aa 6 00260 3521 61 epp2 pr6|176,*au oi.defp 001573 aa 000000 0520 03 adwp2 0,du 001574 aa 6 00350 2521 00 spri2 pr6|232 init_info_ptr STATEMENT 1 ON LINE 337 do j = 1 to nblocks; 001575 aa 6 00104 2361 00 ldq pr6|68 nblocks 001576 aa 6 00365 7561 00 stq pr6|245 001577 aa 000001 2360 07 ldq 1,dl 001600 aa 6 00103 7561 00 stq pr6|67 j 001601 aa 000000 0110 03 nop 0,du 001602 aa 6 00103 2361 00 ldq pr6|67 j 001603 aa 6 00365 1161 00 cmpq pr6|245 001604 aa 000171 6054 04 tpnz 121,ic 001775 STATEMENT 1 ON LINE 338 if ext_name = var_info (j).name then do; 001605 aa 000026 4020 07 mpy 22,dl 001606 aa 6 00144 3735 20 epp7 pr6|100,* viptr 001607 aa 7 77756 3715 06 epp5 pr7|-18,ql var_info.name 001610 aa 040 100 106 500 cmpc (pr),(pr),fill(040) 001611 aa 6 00150 00 0101 desc9a pr6|104,65 ext_name 001612 aa 5 00000 00 0101 desc9a pr5|0,65 var_info.name 001613 aa 6 00443 7561 00 stq pr6|291 001614 aa 000157 6010 04 tnz 111,ic 001773 STATEMENT 1 ON LINE 340 if init_info_ptr -> init_info.type > NO_INIT & init_info_ptr -> init_info.type ^= INIT_DEFERRED then do; 001615 aa 6 00350 3535 20 epp3 pr6|232,* init_info_ptr 001616 aa 3 00001 2361 00 ldq pr3|1 init_info.type 001617 aa 000142 6044 04 tmoz 98,ic 001761 001620 aa 000006 1160 07 cmpq 6,dl 001621 aa 000140 6000 04 tze 96,ic 001761 STATEMENT 1 ON LINE 343 if var_info (j).init_ptr -> init_info.type = NO_INIT then do; 001622 aa 6 00443 7271 00 lxl7 pr6|291 001623 aa 7 77752 3515 37 epp1 pr7|-22,7* var_info.init_ptr 001624 aa 1 00001 2361 00 ldq pr1|1 init_info.type 001625 aa 000005 6010 04 tnz 5,ic 001632 STATEMENT 1 ON LINE 345 var_info (j).init_ptr = init_info_ptr; 001626 aa 7 77752 2535 17 spri3 pr7|-22,7 var_info.init_ptr STATEMENT 1 ON LINE 346 var_info (j).init_owner = i; 001627 aa 6 00102 2361 00 ldq pr6|66 i 001630 aa 7 77755 7561 17 stq pr7|-19,7 var_info.init_owner STATEMENT 1 ON LINE 347 end; 001631 aa 000130 7100 04 tra 88,ic 001761 STATEMENT 1 ON LINE 348 else if var_info (j).init_ptr -> init_info.size < init_info_ptr -> init_info.size then do; 001632 aa 1 00000 2361 00 ldq pr1|0 init_info.size 001633 aa 3 00000 1161 00 cmpq pr3|0 init_info.size 001634 aa 000053 6050 04 tpl 43,ic 001707 STATEMENT 1 ON LINE 350 call ioa_ ( "^a: Initialization for common block ^a defined in subprogram ^a^/^-replacing initialization defined in subprogram ^a because it is longer.", me, ext_name, seg_info (i).pathname, seg_info (var_info (j).init_owner).pathname); 001635 aa 000 100 100 404 mlr (ic),(pr),fill(000) 001636 aa 776375 00 0214 desc9a -771,140 000232 = 136141072040 001637 aa 6 00550 00 0214 desc9a pr6|360,140 001640 aa 6 00102 2361 00 ldq pr6|66 i 001641 aa 000056 4020 07 mpy 46,dl 001642 aa 000000 6260 06 eax6 0,ql 001643 aa 7 77755 2361 17 ldq pr7|-19,7 var_info.init_owner 001644 aa 000056 4020 07 mpy 46,dl 001645 aa 6 00550 3521 00 epp2 pr6|360 001646 aa 6 00506 2521 00 spri2 pr6|326 001647 aa 776133 3520 04 epp2 -933,ic 000002 = 163145164137 001650 aa 6 00510 2521 00 spri2 pr6|328 001651 aa 6 00150 3521 00 epp2 pr6|104 ext_name 001652 aa 6 00512 2521 00 spri2 pr6|330 001653 aa 6 00146 3715 20 epp5 pr6|102,* viptr 001654 aa 5 77722 3521 16 epp2 pr5|-46,6 seg_info.pathname 001655 aa 6 00514 2521 00 spri2 pr6|332 001656 aa 5 77722 3521 06 epp2 pr5|-46,ql seg_info.pathname 001657 aa 6 00516 2521 00 spri2 pr6|334 001660 aa 776137 3520 04 epp2 -929,ic 000017 = 524000000213 001661 aa 6 00520 2521 00 spri2 pr6|336 001662 aa 776154 3520 04 epp2 -916,ic 000036 = 526000000022 001663 aa 6 00522 2521 00 spri2 pr6|338 001664 aa 776132 3520 04 epp2 -934,ic 000016 = 526000000101 001665 aa 6 00524 2521 00 spri2 pr6|340 001666 aa 776127 3520 04 epp2 -937,ic 000015 = 524000000250 001667 aa 6 00526 2521 00 spri2 pr6|342 001670 aa 6 00530 2521 00 spri2 pr6|344 001671 aa 6 00504 6211 00 eax1 pr6|324 001672 aa 024000 4310 07 fld 10240,dl 001673 aa 6 00044 3701 20 epp4 pr6|36,* 001674 la 4 00030 3521 20 epp2 pr4|24,* ioa_ 001675 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 354 var_info (j).init_ptr = init_info_ptr; 001676 aa 6 00103 2361 00 ldq pr6|67 j 001677 aa 000026 4020 07 mpy 22,dl 001700 aa 6 00350 3735 20 epp7 pr6|232,* init_info_ptr 001701 aa 6 00144 3715 20 epp5 pr6|100,* viptr 001702 aa 5 77752 6535 06 spri7 pr5|-22,ql var_info.init_ptr STATEMENT 1 ON LINE 355 var_info (j).init_owner = i; 001703 aa 000000 6270 06 eax7 0,ql 001704 aa 6 00102 2361 00 ldq pr6|66 i 001705 aa 5 77755 7561 17 stq pr5|-19,7 var_info.init_owner STATEMENT 1 ON LINE 356 end; 001706 aa 000053 7100 04 tra 43,ic 001761 STATEMENT 1 ON LINE 357 else do; STATEMENT 1 ON LINE 358 if unspec (var_info (j).init_ptr -> init_info.init_template) ^= unspec (init_info_ptr -> init_info.init_template) then call ioa_ ( "^a: Initialization for common block ^a defined in subprogram ^a is ignored; ^/^-using initialization defined in subprogram ^a.", me, ext_name, seg_info (i).pathname, seg_info (var_info (j).init_owner).pathname); 001707 aa 000044 4020 07 mpy 36,dl 001710 aa 6 00421 7561 00 stq pr6|273 001711 aa 3 00000 2361 00 ldq pr3|0 init_info.size 001712 aa 000044 4020 07 mpy 36,dl 001713 aa 6 00421 2351 00 lda pr6|273 001714 aa 000 140 066 540 cmpb (pr,rl),(pr,rl),fill(0) 001715 aa 1 00002 00 0005 descb pr1|2,al 001716 aa 3 00002 00 0006 descb pr3|2,ql 001717 aa 000042 6000 04 tze 34,ic 001761 001720 aa 000 100 100 404 mlr (ic),(pr),fill(000) 001721 aa 776252 00 0200 desc9a -854,128 000172 = 136141072040 001722 aa 6 00504 00 0200 desc9a pr6|324,128 001723 aa 6 00102 2361 00 ldq pr6|66 i 001724 aa 000056 4020 07 mpy 46,dl 001725 aa 000000 6260 06 eax6 0,ql 001726 aa 7 77755 2361 17 ldq pr7|-19,7 var_info.init_owner 001727 aa 000056 4020 07 mpy 46,dl 001730 aa 6 00504 3521 00 epp2 pr6|324 001731 aa 6 00552 2521 00 spri2 pr6|362 001732 aa 776050 3520 04 epp2 -984,ic 000002 = 163145164137 001733 aa 6 00554 2521 00 spri2 pr6|364 001734 aa 6 00150 3521 00 epp2 pr6|104 ext_name 001735 aa 6 00556 2521 00 spri2 pr6|366 001736 aa 6 00146 3515 20 epp1 pr6|102,* viptr 001737 aa 1 77722 3521 16 epp2 pr1|-46,6 seg_info.pathname 001740 aa 6 00560 2521 00 spri2 pr6|368 001741 aa 1 77722 3521 06 epp2 pr1|-46,ql seg_info.pathname 001742 aa 6 00562 2521 00 spri2 pr6|370 001743 aa 776051 3520 04 epp2 -983,ic 000014 = 524000000177 001744 aa 6 00564 2521 00 spri2 pr6|372 001745 aa 776071 3520 04 epp2 -967,ic 000036 = 526000000022 001746 aa 6 00566 2521 00 spri2 pr6|374 001747 aa 776047 3520 04 epp2 -985,ic 000016 = 526000000101 001750 aa 6 00570 2521 00 spri2 pr6|376 001751 aa 776044 3520 04 epp2 -988,ic 000015 = 524000000250 001752 aa 6 00572 2521 00 spri2 pr6|378 001753 aa 6 00574 2521 00 spri2 pr6|380 001754 aa 6 00550 6211 00 eax1 pr6|360 001755 aa 024000 4310 07 fld 10240,dl 001756 aa 6 00044 3701 20 epp4 pr6|36,* 001757 la 4 00030 3521 20 epp2 pr4|24,* ioa_ 001760 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 364 end; STATEMENT 1 ON LINE 365 end; STATEMENT 1 ON LINE 366 var_info (j).vsize = max (var_info (j).vsize, init_info_ptr -> init_info.size); 001761 aa 6 00103 2361 00 ldq pr6|67 j 001762 aa 000026 4020 07 mpy 22,dl 001763 aa 6 00144 3735 20 epp7 pr6|100,* viptr 001764 aa 000000 6270 06 eax7 0,ql 001765 aa 7 77754 2361 06 ldq pr7|-20,ql var_info.vsize 001766 aa 6 00350 1161 20 cmpq pr6|232,* init_info.size 001767 aa 000002 6050 04 tpl 2,ic 001771 001770 aa 6 00350 2361 20 ldq pr6|232,* init_info.size 001771 aa 7 77754 7561 17 stq pr7|-20,7 var_info.vsize STATEMENT 1 ON LINE 367 goto next_link; 001772 aa 000022 7100 04 tra 18,ic 002014 STATEMENT 1 ON LINE 368 end; STATEMENT 1 ON LINE 369 end; 001773 aa 6 00103 0541 00 aos pr6|67 j 001774 aa 777606 7100 04 tra -122,ic 001602 STATEMENT 1 ON LINE 370 nblocks = nblocks + 1; 001775 aa 6 00104 0541 00 aos pr6|68 nblocks STATEMENT 1 ON LINE 372 var_info (nblocks).init_ptr = init_info_ptr; 001776 aa 6 00104 2361 00 ldq pr6|68 nblocks 001777 aa 000026 4020 07 mpy 22,dl 002000 aa 6 00350 3735 20 epp7 pr6|232,* init_info_ptr 002001 aa 6 00144 3715 20 epp5 pr6|100,* viptr 002002 aa 5 77752 6535 06 spri7 pr5|-22,ql var_info.init_ptr STATEMENT 1 ON LINE 373 var_info (nblocks).vsize = init_info_ptr -> init_info.size; 002003 aa 000000 6270 06 eax7 0,ql 002004 aa 7 00000 2361 00 ldq pr7|0 init_info.size 002005 aa 5 77754 7561 17 stq pr5|-20,7 var_info.vsize STATEMENT 1 ON LINE 374 var_info (nblocks).init_owner = i; 002006 aa 6 00102 2361 00 ldq pr6|66 i 002007 aa 5 77755 7561 17 stq pr5|-19,7 var_info.init_owner STATEMENT 1 ON LINE 375 var_info (nblocks).name = ext_name; 002010 aa 5 77756 3535 17 epp3 pr5|-18,7 var_info.name 002011 aa 040 100 100 500 mlr (pr),(pr),fill(040) 002012 aa 6 00150 00 0101 desc9a pr6|104,65 ext_name 002013 aa 3 00000 00 0101 desc9a pr3|0,65 var_info.name STATEMENT 1 ON LINE 376 next_link: end; 002014 aa 6 00132 3521 20 epp2 pr6|90,* p 002015 aa 000002 0520 03 adwp2 2,du 002016 aa 6 00132 2521 00 spri2 pr6|90 p 002017 aa 777367 7100 04 tra -265,ic 001406 STATEMENT 1 ON LINE 378 end; 002020 aa 6 00102 0541 00 aos pr6|66 i 002021 aa 777303 7100 04 tra -317,ic 001324 STATEMENT 1 ON LINE 380 if fatalsw then goto terminate; 002022 aa 6 00113 2351 00 lda pr6|75 fatalsw 002023 aa 000722 6010 04 tnz 466,ic 002745 STATEMENT 1 ON LINE 382 if nblocks = 0 then do; 002024 aa 6 00104 2361 00 ldq pr6|68 nblocks 002025 aa 000022 6010 04 tnz 18,ic 002047 STATEMENT 1 ON LINE 384 call ioa_ ("^a: None of the specified programs have any common blocks.", me); 002026 aa 000 100 100 404 mlr (ic),(pr),fill(000) 002027 aa 776073 00 0074 desc9a -965,60 000121 = 136141072040 002030 aa 6 00462 00 0074 desc9a pr6|306,60 002031 aa 6 00462 3521 00 epp2 pr6|306 002032 aa 6 00432 2521 00 spri2 pr6|282 002033 aa 775747 3520 04 epp2 -1049,ic 000002 = 163145164137 002034 aa 6 00434 2521 00 spri2 pr6|284 002035 aa 775756 3520 04 epp2 -1042,ic 000013 = 524000000073 002036 aa 6 00436 2521 00 spri2 pr6|286 002037 aa 775777 3520 04 epp2 -1025,ic 000036 = 526000000022 002040 aa 6 00440 2521 00 spri2 pr6|288 002041 aa 6 00430 6211 00 eax1 pr6|280 002042 aa 010000 4310 07 fld 4096,dl 002043 aa 6 00044 3701 20 epp4 pr6|36,* 002044 la 4 00030 3521 20 epp2 pr4|24,* ioa_ 002045 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 385 goto terminate; 002046 aa 000677 7100 04 tra 447,ic 002745 STATEMENT 1 ON LINE 386 end; STATEMENT 1 ON LINE 390 do i = 1 to nblocks; 002047 aa 6 00366 7561 00 stq pr6|246 002050 aa 000001 2360 07 ldq 1,dl 002051 aa 6 00102 7561 00 stq pr6|66 i 002052 aa 6 00102 2361 00 ldq pr6|66 i 002053 aa 6 00366 1161 00 cmpq pr6|246 002054 aa 000671 6054 04 tpnz 441,ic 002745 STATEMENT 1 ON LINE 391 new_vsize = 0; 002055 aa 6 00105 4501 00 stz pr6|69 new_vsize STATEMENT 1 ON LINE 392 if var_info (i).vsize > var_info (i).init_ptr -> init_info.size then do; 002056 aa 000026 4020 07 mpy 22,dl 002057 aa 6 00144 3735 20 epp7 pr6|100,* viptr 002060 aa 000000 6270 06 eax7 0,ql 002061 aa 7 77754 2361 06 ldq pr7|-20,ql var_info.vsize 002062 aa 7 77752 1161 37 cmpq pr7|-22,7* init_info.size 002063 aa 6 00421 7471 00 stx7 pr6|273 002064 aa 000113 6044 04 tmoz 75,ic 002177 STATEMENT 1 ON LINE 394 if var_info (i).init_ptr -> init_info.type = TEMPLATE_INIT then do; 002065 aa 7 77752 3715 37 epp5 pr7|-22,7* var_info.init_ptr 002066 aa 5 00001 2361 00 ldq pr5|1 init_info.type 002067 aa 000003 1160 07 cmpq 3,dl 002070 aa 000036 6010 04 tnz 30,ic 002126 STATEMENT 1 ON LINE 396 new_vsize = var_info (i).vsize + 2; 002071 aa 7 77754 2351 17 lda pr7|-20,7 var_info.vsize 002072 aa 000044 7330 00 lrs 36 002073 aa 000002 0330 07 adl 2,dl 002074 aa 6 00105 7561 00 stq pr6|69 new_vsize STATEMENT 1 ON LINE 397 allocate new_init_info in (sb -> stack_header.user_free_ptr -> based_area) set (init_info_ptr); 002075 aa 6 00105 2361 00 ldq pr6|69 new_vsize 002076 aa 6 00352 3735 20 epp7 pr6|234,* sb 002077 aa 7 00016 3521 20 epp2 pr7|14,* based_area 002100 aa 0 01402 7001 00 tsx0 pr0|770 op_alloc_ 002101 aa 777774 7100 04 tra -4,ic 002075 002102 aa 6 00350 2521 00 spri2 pr6|232 init_info_ptr STATEMENT 1 ON LINE 398 init_info_ptr -> init_info.size = var_info (i).vsize; 002103 aa 6 00102 2361 00 ldq pr6|66 i 002104 aa 000026 4020 07 mpy 22,dl 002105 aa 6 00144 3735 20 epp7 pr6|100,* viptr 002106 aa 000000 6270 06 eax7 0,ql 002107 aa 7 77754 2361 06 ldq pr7|-20,ql var_info.vsize 002110 aa 2 00000 7561 00 stq pr2|0 init_info.size STATEMENT 1 ON LINE 399 init_info_ptr -> init_info.type = TEMPLATE_INIT; 002111 aa 000003 2360 07 ldq 3,dl 002112 aa 2 00001 7561 00 stq pr2|1 init_info.type STATEMENT 1 ON LINE 400 unspec (init_info_ptr -> init_info.init_template) = unspec (var_info (i).init_ptr -> init_info.init_template); 002113 aa 2 00000 2361 00 ldq pr2|0 init_info.size 002114 aa 000044 4020 07 mpy 36,dl 002115 aa 6 00443 7561 00 stq pr6|291 002116 aa 7 77752 2361 37 ldq pr7|-22,7* init_info.size 002117 aa 000044 4020 07 mpy 36,dl 002120 aa 7 77752 3715 37 epp5 pr7|-22,7* var_info.init_ptr 002121 aa 6 00443 2351 00 lda pr6|291 002122 aa 003 140 060 540 csl (pr,rl),(pr,rl),fill(0),bool(move) 002123 aa 5 00002 00 0006 descb pr5|2,ql 002124 aa 2 00002 00 0005 descb pr2|2,al STATEMENT 1 ON LINE 402 end; 002125 aa 000054 7100 04 tra 44,ic 002201 STATEMENT 1 ON LINE 403 else if var_info (i).init_ptr -> init_info.type = LIST_TEMPLATE_INIT then do; 002126 aa 000005 1160 07 cmpq 5,dl 002127 aa 000041 6010 04 tnz 33,ic 002170 STATEMENT 1 ON LINE 405 new_vsize = var_info (i).init_ptr -> list_init_info.list_size + 3; 002130 aa 5 00002 2361 00 ldq pr5|2 list_init_info.list_size 002131 aa 0 00374 3771 00 anaq pr0|252 = 000000000000 000000777777 002132 aa 000003 0760 07 adq 3,dl 002133 aa 6 00105 7561 00 stq pr6|69 new_vsize STATEMENT 1 ON LINE 406 allocate new_init_info in (sb -> stack_header.user_free_ptr -> based_area) set (init_info_ptr); 002134 aa 6 00105 2361 00 ldq pr6|69 new_vsize 002135 aa 6 00352 3735 20 epp7 pr6|234,* sb 002136 aa 7 00016 3521 20 epp2 pr7|14,* based_area 002137 aa 0 01402 7001 00 tsx0 pr0|770 op_alloc_ 002140 aa 777774 7100 04 tra -4,ic 002134 002141 aa 6 00350 2521 00 spri2 pr6|232 init_info_ptr STATEMENT 1 ON LINE 407 unspec (init_info_ptr -> list_init_info) = unspec (var_info (i).init_ptr -> list_init_info); 002142 aa 2 00002 2361 00 ldq pr2|2 list_init_info.list_size 002143 aa 0 00374 3771 00 anaq pr0|252 = 000000000000 000000777777 002144 aa 000003 0760 07 adq 3,dl 002145 aa 000044 4020 07 mpy 36,dl 002146 aa 6 00443 7561 00 stq pr6|291 002147 aa 6 00102 2361 00 ldq pr6|66 i 002150 aa 000026 4020 07 mpy 22,dl 002151 aa 6 00144 3735 20 epp7 pr6|100,* viptr 002152 aa 7 77752 3715 26 epp5 pr7|-22,ql* var_info.init_ptr 002153 aa 5 00002 2351 00 lda pr5|2 list_init_info.list_size 002154 aa 000022 7350 00 als 18 002155 aa 000000 6270 06 eax7 0,ql 002156 aa 000066 7730 00 lrl 54 002157 aa 000003 0760 07 adq 3,dl 002160 aa 000044 4020 07 mpy 36,dl 002161 aa 6 00443 2351 00 lda pr6|291 002162 aa 003 140 060 540 csl (pr,rl),(pr,rl),fill(0),bool(move) 002163 aa 5 00000 00 0006 descb pr5|0,ql 002164 aa 2 00000 00 0005 descb pr2|0,al STATEMENT 1 ON LINE 408 init_info_ptr -> init_info.size = var_info (i).vsize; 002165 aa 7 77754 2361 17 ldq pr7|-20,7 var_info.vsize 002166 aa 2 00000 7561 00 stq pr2|0 init_info.size STATEMENT 1 ON LINE 409 end; 002167 aa 000012 7100 04 tra 10,ic 002201 STATEMENT 1 ON LINE 410 else do; STATEMENT 1 ON LINE 411 init_info_ptr = addr (dummy_init_info); 002170 aa 6 00116 3535 00 epp3 pr6|78 dummy_init_info 002171 aa 6 00350 2535 00 spri3 pr6|232 init_info_ptr STATEMENT 1 ON LINE 412 init_info_ptr -> init_info.size = var_info (i).vsize; 002172 aa 7 77754 2361 17 ldq pr7|-20,7 var_info.vsize 002173 aa 3 00000 7561 00 stq pr3|0 init_info.size STATEMENT 1 ON LINE 413 init_info_ptr -> init_info.type = var_info (i).init_ptr -> init_info.type; 002174 aa 5 00001 2361 00 ldq pr5|1 init_info.type 002175 aa 3 00001 7561 00 stq pr3|1 init_info.type STATEMENT 1 ON LINE 414 end; STATEMENT 1 ON LINE 415 end; 002176 aa 000003 7100 04 tra 3,ic 002201 STATEMENT 1 ON LINE 416 else init_info_ptr = var_info (i).init_ptr; 002177 aa 7 77752 3715 37 epp5 pr7|-22,7* var_info.init_ptr 002200 aa 6 00350 6515 00 spri5 pr6|232 init_info_ptr STATEMENT 1 ON LINE 418 call set_ext_variable_ (var_info (i).name, init_info_ptr, sb, found_sw, node_ptr, code); 002201 aa 6 00102 2361 00 ldq pr6|66 i 002202 aa 000026 4020 07 mpy 22,dl 002203 aa 6 00144 3735 20 epp7 pr6|100,* viptr 002204 aa 7 77756 3521 06 epp2 pr7|-18,ql var_info.name 002205 aa 6 00506 2521 00 spri2 pr6|326 002206 aa 6 00350 3521 00 epp2 pr6|232 init_info_ptr 002207 aa 6 00510 2521 00 spri2 pr6|328 002210 aa 6 00352 3521 00 epp2 pr6|234 sb 002211 aa 6 00512 2521 00 spri2 pr6|330 002212 aa 6 00114 3521 00 epp2 pr6|76 found_sw 002213 aa 6 00514 2521 00 spri2 pr6|332 002214 aa 6 00140 3521 00 epp2 pr6|96 node_ptr 002215 aa 6 00516 2521 00 spri2 pr6|334 002216 aa 6 00111 3521 00 epp2 pr6|73 code 002217 aa 6 00520 2521 00 spri2 pr6|336 002220 aa 775576 3520 04 epp2 -1154,ic 000016 = 526000000101 002221 aa 6 00522 2521 00 spri2 pr6|338 002222 aa 775620 3520 04 epp2 -1136,ic 000042 = 464000000000 002223 aa 6 00524 2521 00 spri2 pr6|340 002224 aa 6 00526 2521 00 spri2 pr6|342 002225 aa 6 00532 2521 00 spri2 pr6|346 002226 aa 775601 3520 04 epp2 -1151,ic 000027 = 514000000001 002227 aa 6 00530 2521 00 spri2 pr6|344 002230 aa 775604 3520 04 epp2 -1148,ic 000034 = 404000000043 002231 aa 6 00534 2521 00 spri2 pr6|348 002232 aa 6 00504 6211 00 eax1 pr6|324 002233 aa 030000 4310 07 fld 12288,dl 002234 aa 6 00044 3701 20 epp4 pr6|36,* 002235 la 4 00044 3521 20 epp2 pr4|36,* set_ext_variable_ 002236 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 420 if code ^= 0 then if ^found_sw then do; 002237 aa 6 00111 2361 00 ldq pr6|73 code 002240 aa 000044 6000 04 tze 36,ic 002304 002241 aa 6 00114 2351 00 lda pr6|76 found_sw 002242 aa 400000 3150 03 cana 131072,du 002243 aa 000041 6010 04 tnz 33,ic 002304 STATEMENT 1 ON LINE 423 init_error: call com_err_ (code, me, "Initializing common block ^a", var_info (i).name); 002244 aa 000 100 100 404 mlr (ic),(pr),fill(000) 002245 aa 775633 00 0034 desc9a -1125,28 000077 = 111156151164 002246 aa 6 00430 00 0034 desc9a pr6|280,28 002247 aa 6 00102 2361 00 ldq pr6|66 i 002250 aa 000026 4020 07 mpy 22,dl 002251 aa 6 00111 3521 00 epp2 pr6|73 code 002252 aa 6 00464 2521 00 spri2 pr6|308 002253 aa 775527 3520 04 epp2 -1193,ic 000002 = 163145164137 002254 aa 6 00466 2521 00 spri2 pr6|310 002255 aa 6 00430 3521 00 epp2 pr6|280 002256 aa 6 00470 2521 00 spri2 pr6|312 002257 aa 6 00144 3735 20 epp7 pr6|100,* viptr 002260 aa 7 77756 3521 06 epp2 pr7|-18,ql var_info.name 002261 aa 6 00472 2521 00 spri2 pr6|314 002262 aa 775552 3520 04 epp2 -1174,ic 000034 = 404000000043 002263 aa 6 00474 2521 00 spri2 pr6|316 002264 aa 775552 3520 04 epp2 -1174,ic 000036 = 526000000022 002265 aa 6 00476 2521 00 spri2 pr6|318 002266 aa 775524 3520 04 epp2 -1196,ic 000012 = 524000000034 002267 aa 6 00500 2521 00 spri2 pr6|320 002270 aa 775526 3520 04 epp2 -1194,ic 000016 = 526000000101 002271 aa 6 00502 2521 00 spri2 pr6|322 002272 aa 6 00462 6211 00 eax1 pr6|306 002273 aa 020000 4310 07 fld 8192,dl 002274 aa 6 00044 3701 20 epp4 pr6|36,* 002275 la 4 00026 3521 20 epp2 pr4|22,* com_err_ 002276 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 425 if new_vsize > 0 then free init_info_ptr -> new_init_info; 002277 aa 6 00105 2361 00 ldq pr6|69 new_vsize 002300 aa 000445 6044 04 tmoz 293,ic 002745 002301 aa 6 00350 3715 00 epp5 pr6|232 init_info_ptr 002302 aa 0 01404 7001 00 tsx0 pr0|772 op_freen_ STATEMENT 1 ON LINE 427 goto terminate; 002303 aa 000442 7100 04 tra 290,ic 002745 STATEMENT 1 ON LINE 428 end; STATEMENT 1 ON LINE 430 if ^found_sw then goto next_block; 002304 aa 6 00114 2351 00 lda pr6|76 found_sw 002305 aa 400000 3150 03 cana 131072,du 002306 aa 000423 6000 04 tze 275,ic 002731 STATEMENT 1 ON LINE 433 if node_ptr -> variable_node.vbl_size < init_info_ptr -> init_info.size then do; 002307 aa 6 00140 3735 20 epp7 pr6|96,* node_ptr 002310 aa 7 00001 2351 00 lda pr7|1 variable_node.vbl_size 002311 aa 000060 7730 00 lrl 48 002312 aa 6 00350 1161 20 cmpq pr6|232,* init_info.size 002313 aa 000217 6050 04 tpl 143,ic 002532 STATEMENT 1 ON LINE 435 if longsw then call ioa_ ( "^a: Common block ^a is already in use with a smaller block length.^/^-The old version will be deleted.", me, var_info (i).name); 002314 aa 6 00112 2351 00 lda pr6|74 longsw 002315 aa 000030 6000 04 tze 24,ic 002345 002316 aa 000 100 100 404 mlr (ic),(pr),fill(000) 002317 aa 775622 00 0150 desc9a -1134,104 000140 = 136141072040 002320 aa 6 00504 00 0150 desc9a pr6|324,104 002321 aa 6 00102 2361 00 ldq pr6|66 i 002322 aa 000026 4020 07 mpy 22,dl 002323 aa 6 00504 3521 00 epp2 pr6|324 002324 aa 6 00446 2521 00 spri2 pr6|294 002325 aa 775455 3520 04 epp2 -1235,ic 000002 = 163145164137 002326 aa 6 00450 2521 00 spri2 pr6|296 002327 aa 6 00144 3715 20 epp5 pr6|100,* viptr 002330 aa 5 77756 3521 06 epp2 pr5|-18,ql var_info.name 002331 aa 6 00452 2521 00 spri2 pr6|298 002332 aa 775457 3520 04 epp2 -1233,ic 000011 = 524000000147 002333 aa 6 00454 2521 00 spri2 pr6|300 002334 aa 775502 3520 04 epp2 -1214,ic 000036 = 526000000022 002335 aa 6 00456 2521 00 spri2 pr6|302 002336 aa 775460 3520 04 epp2 -1232,ic 000016 = 526000000101 002337 aa 6 00460 2521 00 spri2 pr6|304 002340 aa 6 00444 6211 00 eax1 pr6|292 002341 aa 014000 4310 07 fld 6144,dl 002342 aa 6 00044 3701 20 epp4 pr6|36,* 002343 la 4 00030 3521 20 epp2 pr4|24,* ioa_ 002344 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 439 call delete_it (node_ptr); 002345 aa 000721 3520 04 epp2 465,ic 003266 = 000002000000 002346 aa 000460 6700 04 tsp4 304,ic 003026 STATEMENT 1 ON LINE 440 variable_size = init_info_ptr -> init_info.size; 002347 aa 6 00350 2361 20 ldq pr6|232,* init_info.size 002350 aa 6 00106 7561 00 stq pr6|70 variable_size STATEMENT 1 ON LINE 442 if variable_size > sys_info$max_seg_size then do; 002351 aa 6 00044 3701 20 epp4 pr6|36,* 002352 la 4 00014 1161 20 cmpq pr4|12,* sys_info$max_seg_size 002353 aa 000037 6044 04 tmoz 31,ic 002412 STATEMENT 1 ON LINE 444 if (init_info_ptr -> init_info.type ^= NO_INIT) & (init_info_ptr -> init_info.type ^= LIST_TEMPLATE_INIT) then do; 002354 aa 6 00350 3735 20 epp7 pr6|232,* init_info_ptr 002355 aa 7 00001 2361 00 ldq pr7|1 init_info.type 002356 aa 000006 6000 04 tze 6,ic 002364 002357 aa 000005 1160 07 cmpq 5,dl 002360 aa 000004 6000 04 tze 4,ic 002364 STATEMENT 1 ON LINE 447 code = error_table_$bad_link_target_init_info; 002361 la 4 00012 2361 20 ldq pr4|10,* error_table_$bad_link_target_init_info 002362 aa 6 00111 7561 00 stq pr6|73 code STATEMENT 1 ON LINE 448 go to init_error; 002363 aa 777661 7100 04 tra -79,ic 002244 STATEMENT 1 ON LINE 449 end; STATEMENT 1 ON LINE 450 call fortran_storage_manager_$alloc ( divide (variable_size + pl1_operators_$VLA_words_per_seg_ - 1, pl1_operators_$VLA_words_per_seg_, 17), node_ptr, node_ptr -> variable_node.vbl_ptr); 002364 aa 6 00106 2351 00 lda pr6|70 variable_size 002365 aa 000044 7330 00 lrs 36 002366 la 4 00016 0331 20 adl pr4|14,* pl1_operators_$VLA_words_per_seg_ 002367 aa 000000 5330 00 negl 0 002370 aa 000001 0330 07 adl 1,dl 002371 aa 000000 5330 00 negl 0 002372 la 4 00016 3521 20 epp2 pr4|14,* pl1_operators_$VLA_words_per_seg_ 002373 aa 0 01264 7001 00 tsx0 pr0|692 divide_fx3 002374 aa 000000000000 002375 aa 6 00421 7561 00 stq pr6|273 002376 aa 6 00421 3521 00 epp2 pr6|273 002377 aa 6 00432 2521 00 spri2 pr6|282 002400 aa 6 00140 3521 00 epp2 pr6|96 node_ptr 002401 aa 6 00434 2521 00 spri2 pr6|284 002402 aa 2 00000 3715 20 epp5 pr2|0,* node_ptr 002403 aa 5 00004 3521 00 epp2 pr5|4 variable_node.vbl_ptr 002404 aa 6 00436 2521 00 spri2 pr6|286 002405 aa 6 00430 6211 00 eax1 pr6|280 002406 aa 014000 4310 07 fld 6144,dl 002407 la 4 00064 3521 20 epp2 pr4|52,* fortran_storage_manager_$alloc 002410 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 453 end; 002411 aa 000104 7100 04 tra 68,ic 002515 STATEMENT 1 ON LINE 454 else if variable_size > (sys_info$max_seg_size - 50) then do; 002412 la 4 00014 3361 20 lcq pr4|12,* sys_info$max_seg_size 002413 aa 000044 7770 00 llr 36 002414 aa 000044 7330 00 lrs 36 002415 aa 000062 0330 07 adl 50,dl 002416 aa 000000 5330 00 negl 0 002417 aa 6 00624 7571 00 staq pr6|404 002420 aa 6 00106 2351 00 lda pr6|70 variable_size 002421 aa 000044 7330 00 lrs 36 002422 aa 6 00624 1171 00 cmpaq pr6|404 002423 aa 000063 6044 04 tmoz 51,ic 002506 STATEMENT 1 ON LINE 456 call hcs_$make_seg ("", unique_chars_ (""b) || "linker", "", 01110b, node_ptr -> variable_node.vbl_ptr, code); 002424 aa 000000 2350 07 lda 0,dl 002425 aa 6 00421 7551 00 sta pr6|273 002426 aa 6 00421 3521 00 epp2 pr6|273 002427 aa 6 00432 2521 00 spri2 pr6|282 002430 aa 6 00422 3521 00 epp2 pr6|274 002431 aa 6 00434 2521 00 spri2 pr6|284 002432 aa 6 00430 6211 00 eax1 pr6|280 002433 aa 010000 4310 07 fld 4096,dl 002434 la 4 00056 3521 20 epp2 pr4|46,* unique_chars_ 002435 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out 002436 aa 040 100 100 500 mlr (pr),(pr),fill(040) 002437 aa 6 00422 00 0017 desc9a pr6|274,15 002440 aa 6 00430 00 0017 desc9a pr6|280,15 002441 aa 040 100 100 404 mlr (ic),(pr),fill(040) 002442 aa 775403 00 0006 desc9a -1277,6 000044 = 154151156153 002443 aa 6 00433 60 0006 desc9a pr6|283(3),6 002444 aa 000016 2360 07 ldq 14,dl 002445 aa 6 00622 7561 00 stq pr6|402 002446 aa 6 00623 3521 00 epp2 pr6|403 002447 aa 6 00506 2521 00 spri2 pr6|326 002450 aa 6 00430 3521 00 epp2 pr6|280 002451 aa 6 00510 2521 00 spri2 pr6|328 002452 aa 6 00421 3521 00 epp2 pr6|273 002453 aa 6 00512 2521 00 spri2 pr6|330 002454 aa 6 00622 3521 00 epp2 pr6|402 002455 aa 6 00514 2521 00 spri2 pr6|332 002456 aa 6 00140 3735 20 epp7 pr6|96,* node_ptr 002457 aa 7 00004 3521 00 epp2 pr7|4 variable_node.vbl_ptr 002460 aa 6 00516 2521 00 spri2 pr6|334 002461 aa 6 00111 3521 00 epp2 pr6|73 code 002462 aa 6 00520 2521 00 spri2 pr6|336 002463 aa 775345 3520 04 epp2 -1307,ic 000030 = 524000000000 002464 aa 6 00522 2521 00 spri2 pr6|338 002465 aa 6 00526 2521 00 spri2 pr6|342 002466 aa 775322 3520 04 epp2 -1326,ic 000010 = 524000000025 002467 aa 6 00524 2521 00 spri2 pr6|340 002470 aa 775347 3520 04 epp2 -1305,ic 000037 = 404000000005 002471 aa 6 00530 2521 00 spri2 pr6|344 002472 aa 775350 3520 04 epp2 -1304,ic 000042 = 464000000000 002473 aa 6 00532 2521 00 spri2 pr6|346 002474 aa 775340 3520 04 epp2 -1312,ic 000034 = 404000000043 002475 aa 6 00534 2521 00 spri2 pr6|348 002476 aa 6 00504 6211 00 eax1 pr6|324 002477 aa 030000 4310 07 fld 12288,dl 002500 aa 6 00044 3701 20 epp4 pr6|36,* 002501 la 4 00054 3521 20 epp2 pr4|44,* hcs_$make_seg 002502 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 458 if code ^= 0 then go to init_error; 002503 aa 6 00111 2361 00 ldq pr6|73 code 002504 aa 777540 6010 04 tnz -160,ic 002244 STATEMENT 1 ON LINE 460 end; 002505 aa 000010 7100 04 tra 8,ic 002515 STATEMENT 1 ON LINE 461 else allocate variable in (sb -> stack_header.user_free_ptr -> based_area) set (node_ptr -> variable_node.vbl_ptr); 002506 aa 6 00106 2361 00 ldq pr6|70 variable_size 002507 aa 6 00352 3735 20 epp7 pr6|234,* sb 002510 aa 7 00016 3521 20 epp2 pr7|14,* based_area 002511 aa 0 01402 7001 00 tsx0 pr0|770 op_alloc_ 002512 aa 777774 7100 04 tra -4,ic 002506 002513 aa 6 00140 3735 20 epp7 pr6|96,* node_ptr 002514 aa 7 00004 2521 00 spri2 pr7|4 variable_node.vbl_ptr STATEMENT 1 ON LINE 464 node_ptr -> variable_node.vbl_size = variable_size; 002515 aa 6 00106 2361 00 ldq pr6|70 variable_size 002516 aa 000060 7370 00 lls 48 002517 aa 6 00140 3735 20 epp7 pr6|96,* node_ptr 002520 aa 7 00001 7511 74 stca pr7|1,74 variable_node.vbl_size STATEMENT 1 ON LINE 465 node_ptr -> variable_node.time_allocated = clock (); 002521 aa 0 01435 7001 00 tsx0 pr0|797 clock_mac 002522 aa 6 00140 3735 20 epp7 pr6|96,* node_ptr 002523 aa 7 00002 7571 00 staq pr7|2 variable_node.time_allocated STATEMENT 1 ON LINE 466 sb -> stack_header.sys_link_info_ptr -> variable_table_header.total_allocated_size = sb -> stack_header.sys_link_info_ptr -> variable_table_header.total_allocated_size + variable_size; 002524 aa 6 00352 3715 20 epp5 pr6|234,* sb 002525 aa 5 00060 3535 20 epp3 pr5|48,* stack_header.sys_link_info_ptr 002526 aa 3 00111 2351 00 lda pr3|73 variable_table_header.total_allocated_size 002527 aa 000044 7330 00 lrs 36 002530 aa 6 00106 0331 00 adl pr6|70 variable_size 002531 aa 3 00111 7561 00 stq pr3|73 variable_table_header.total_allocated_size STATEMENT 1 ON LINE 469 end; STATEMENT 1 ON LINE 473 variable_size = node_ptr -> variable_node.vbl_size; 002532 aa 7 00001 2351 00 lda pr7|1 variable_node.vbl_size 002533 aa 000060 7730 00 lrl 48 002534 aa 6 00106 7561 00 stq pr6|70 variable_size STATEMENT 1 ON LINE 475 if init_info_ptr -> init_info.type = NO_INIT then call list_init_ (node_ptr -> variable_node.vbl_ptr, null (), variable_size, null(), null(), code); 002535 aa 6 00350 3715 20 epp5 pr6|232,* init_info_ptr 002536 aa 5 00001 2361 00 ldq pr5|1 init_info.type 002537 aa 000027 6010 04 tnz 23,ic 002566 002540 aa 775316 3534 24 epp3 -1330,ic* 002541 aa 6 00624 2535 00 spri3 pr6|404 002542 aa 6 00626 2535 00 spri3 pr6|406 002543 aa 6 00630 2535 00 spri3 pr6|408 002544 aa 7 00004 3521 00 epp2 pr7|4 variable_node.vbl_ptr 002545 aa 6 00446 2521 00 spri2 pr6|294 002546 aa 6 00624 3521 00 epp2 pr6|404 002547 aa 6 00450 2521 00 spri2 pr6|296 002550 aa 6 00106 3521 00 epp2 pr6|70 variable_size 002551 aa 6 00452 2521 00 spri2 pr6|298 002552 aa 6 00626 3521 00 epp2 pr6|406 002553 aa 6 00454 2521 00 spri2 pr6|300 002554 aa 6 00630 3521 00 epp2 pr6|408 002555 aa 6 00456 2521 00 spri2 pr6|302 002556 aa 6 00111 3521 00 epp2 pr6|73 code 002557 aa 6 00460 2521 00 spri2 pr6|304 002560 aa 6 00444 6211 00 eax1 pr6|292 002561 aa 030000 4310 07 fld 12288,dl 002562 aa 6 00044 3701 20 epp4 pr6|36,* 002563 la 4 00060 3521 20 epp2 pr4|48,* list_init_ 002564 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out 002565 aa 000101 7100 04 tra 65,ic 002666 STATEMENT 1 ON LINE 479 else if init_info_ptr -> init_info.type = EMPTY_AREA_INIT /* this would not be a fortran link */ then node_ptr -> variable_node.vbl_ptr -> based_area = empty; 002566 aa 000004 1160 07 cmpq 4,dl 002567 aa 000005 6010 04 tnz 5,ic 002574 002570 aa 6 00106 2361 00 ldq pr6|70 variable_size 002571 aa 7 00004 3521 20 epp2 pr7|4,* based_area 002572 aa 0 01405 7001 00 tsx0 pr0|773 op_empty_ 002573 aa 000073 7100 04 tra 59,ic 002666 STATEMENT 1 ON LINE 483 else if init_info_ptr -> init_info.type = LIST_TEMPLATE_INIT /* list_template init */ then do; 002574 aa 000005 1160 07 cmpq 5,dl 002575 aa 000057 6010 04 tnz 47,ic 002654 STATEMENT 1 ON LINE 486 call list_init_ (node_ptr -> variable_node.vbl_ptr, null (), variable_size, null(), null(), code); 002576 aa 775260 3534 24 epp3 -1360,ic* 002577 aa 6 00630 2535 00 spri3 pr6|408 002600 aa 6 00626 2535 00 spri3 pr6|406 002601 aa 6 00624 2535 00 spri3 pr6|404 002602 aa 7 00004 3521 00 epp2 pr7|4 variable_node.vbl_ptr 002603 aa 6 00446 2521 00 spri2 pr6|294 002604 aa 6 00630 3521 00 epp2 pr6|408 002605 aa 6 00450 2521 00 spri2 pr6|296 002606 aa 6 00106 3521 00 epp2 pr6|70 variable_size 002607 aa 6 00452 2521 00 spri2 pr6|298 002610 aa 6 00626 3521 00 epp2 pr6|406 002611 aa 6 00454 2521 00 spri2 pr6|300 002612 aa 6 00624 3521 00 epp2 pr6|404 002613 aa 6 00456 2521 00 spri2 pr6|302 002614 aa 6 00111 3521 00 epp2 pr6|73 code 002615 aa 6 00460 2521 00 spri2 pr6|304 002616 aa 6 00444 6211 00 eax1 pr6|292 002617 aa 030000 4310 07 fld 12288,dl 002620 aa 6 00044 3701 20 epp4 pr6|36,* 002621 la 4 00060 3521 20 epp2 pr4|48,* list_init_ 002622 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 488 call list_init_$variable_already_zero ( node_ptr -> variable_node.vbl_ptr, addr (init_info_ptr -> list_init_info.template), variable_size, null(), null(), code); 002623 aa 6 00350 3735 20 epp7 pr6|232,* init_info_ptr 002624 aa 7 00003 3735 00 epp7 pr7|3 list_init_info.template 002625 aa 6 00624 6535 00 spri7 pr6|404 002626 aa 775230 3714 24 epp5 -1384,ic* 002627 aa 6 00626 6515 00 spri5 pr6|406 002630 aa 6 00630 6515 00 spri5 pr6|408 002631 aa 6 00140 3535 20 epp3 pr6|96,* node_ptr 002632 aa 3 00004 3521 00 epp2 pr3|4 variable_node.vbl_ptr 002633 aa 6 00446 2521 00 spri2 pr6|294 002634 aa 6 00624 3521 00 epp2 pr6|404 002635 aa 6 00450 2521 00 spri2 pr6|296 002636 aa 6 00106 3521 00 epp2 pr6|70 variable_size 002637 aa 6 00452 2521 00 spri2 pr6|298 002640 aa 6 00626 3521 00 epp2 pr6|406 002641 aa 6 00454 2521 00 spri2 pr6|300 002642 aa 6 00630 3521 00 epp2 pr6|408 002643 aa 6 00456 2521 00 spri2 pr6|302 002644 aa 6 00111 3521 00 epp2 pr6|73 code 002645 aa 6 00460 2521 00 spri2 pr6|304 002646 aa 6 00444 6211 00 eax1 pr6|292 002647 aa 030000 4310 07 fld 12288,dl 002650 aa 6 00044 3701 20 epp4 pr6|36,* 002651 la 4 00062 3521 20 epp2 pr4|50,* list_init_$variable_already_zero 002652 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 492 end; 002653 aa 000013 7100 04 tra 11,ic 002666 STATEMENT 1 ON LINE 493 else unspec (node_ptr -> variable_node.vbl_ptr -> variable) = unspec (init_info_ptr -> init_info.init_template); 002654 aa 6 00106 2361 00 ldq pr6|70 variable_size 002655 aa 000044 4020 07 mpy 36,dl 002656 aa 6 00622 7561 00 stq pr6|402 002657 aa 5 00000 2361 00 ldq pr5|0 init_info.size 002660 aa 000044 4020 07 mpy 36,dl 002661 aa 7 00004 3535 20 epp3 pr7|4,* variable_node.vbl_ptr 002662 aa 6 00622 2351 00 lda pr6|402 002663 aa 003 140 060 540 csl (pr,rl),(pr,rl),fill(0),bool(move) 002664 aa 5 00002 00 0006 descb pr5|2,ql 002665 aa 3 00000 00 0005 descb pr3|0,al STATEMENT 1 ON LINE 499 if code ^= 0 then do; 002666 aa 6 00111 2361 00 ldq pr6|73 code 002667 aa 000036 6000 04 tze 30,ic 002725 STATEMENT 1 ON LINE 501 call com_err_ (code,me, " while referencing ^a", node_ptr->variable_node.name); 002670 aa 6 00140 3735 20 epp7 pr6|96,* node_ptr 002671 aa 7 00010 2361 00 ldq pr7|8 variable_node.name_size 002672 aa 524000 2760 03 orq 174080,du 002673 aa 6 00622 7561 00 stq pr6|402 002674 aa 000 100 100 404 mlr (ic),(pr),fill(000) 002675 aa 775175 00 0030 desc9a -1411,24 000071 = 040167150151 002676 aa 6 00430 00 0030 desc9a pr6|280,24 002677 aa 6 00111 3521 00 epp2 pr6|73 code 002700 aa 6 00464 2521 00 spri2 pr6|308 002701 aa 775101 3520 04 epp2 -1471,ic 000002 = 163145164137 002702 aa 6 00466 2521 00 spri2 pr6|310 002703 aa 6 00430 3521 00 epp2 pr6|280 002704 aa 6 00470 2521 00 spri2 pr6|312 002705 aa 7 00011 3521 00 epp2 pr7|9 variable_node.name 002706 aa 6 00472 2521 00 spri2 pr6|314 002707 aa 775125 3520 04 epp2 -1451,ic 000034 = 404000000043 002710 aa 6 00474 2521 00 spri2 pr6|316 002711 aa 775125 3520 04 epp2 -1451,ic 000036 = 526000000022 002712 aa 6 00476 2521 00 spri2 pr6|318 002713 aa 775075 3520 04 epp2 -1475,ic 000010 = 524000000025 002714 aa 6 00500 2521 00 spri2 pr6|320 002715 aa 6 00622 3521 00 epp2 pr6|402 002716 aa 6 00502 2521 00 spri2 pr6|322 002717 aa 6 00462 6211 00 eax1 pr6|306 002720 aa 020000 4310 07 fld 8192,dl 002721 aa 6 00044 3701 20 epp4 pr6|36,* 002722 la 4 00026 3521 20 epp2 pr4|22,* com_err_ 002723 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 503 goto terminate; 002724 aa 000021 7100 04 tra 17,ic 002745 STATEMENT 1 ON LINE 504 end; STATEMENT 1 ON LINE 506 node_ptr -> variable_node.init_type = init_info_ptr -> init_info.type; 002725 aa 6 00350 3735 20 epp7 pr6|232,* init_info_ptr 002726 aa 7 00001 2361 00 ldq pr7|1 init_info.type 002727 aa 6 00140 3715 20 epp5 pr6|96,* node_ptr 002730 aa 5 00001 7521 03 stcq pr5|1,03 variable_node.init_type STATEMENT 1 ON LINE 508 next_block: node_ptr -> variable_node.init_ptr = var_info (i).init_ptr; 002731 aa 6 00102 2361 00 ldq pr6|66 i 002732 aa 000026 4020 07 mpy 22,dl 002733 aa 6 00144 3735 20 epp7 pr6|100,* viptr 002734 aa 7 77752 3735 26 epp7 pr7|-22,ql* var_info.init_ptr 002735 aa 6 00140 3715 20 epp5 pr6|96,* node_ptr 002736 aa 5 00006 6535 00 spri7 pr5|6 variable_node.init_ptr STATEMENT 1 ON LINE 511 if new_vsize > 0 then free init_info_ptr -> new_init_info; 002737 aa 6 00105 2361 00 ldq pr6|69 new_vsize 002740 aa 000003 6044 04 tmoz 3,ic 002743 002741 aa 6 00350 3715 00 epp5 pr6|232 init_info_ptr 002742 aa 0 01404 7001 00 tsx0 pr0|772 op_freen_ STATEMENT 1 ON LINE 513 end; 002743 aa 6 00102 0541 00 aos pr6|66 i 002744 aa 777106 7100 04 tra -442,ic 002052 STATEMENT 1 ON LINE 517 terminate: do i = 1 to n_segs; 002745 aa 6 00124 2361 00 ldq pr6|84 n_segs 002746 aa 6 00367 7561 00 stq pr6|247 002747 aa 000001 2360 07 ldq 1,dl 002750 aa 6 00102 7561 00 stq pr6|66 i 002751 aa 000000 0110 03 nop 0,du 002752 aa 6 00102 2361 00 ldq pr6|66 i 002753 aa 6 00367 1161 00 cmpq pr6|247 002754 aa 000024 6054 04 tpnz 20,ic 003000 STATEMENT 1 ON LINE 519 if seg_info (i).segp ^= null then call hcs_$terminate_noname (seg_info (i).segp, code); 002755 aa 000056 4020 07 mpy 46,dl 002756 aa 6 00146 3735 20 epp7 pr6|102,* viptr 002757 aa 6 00622 7561 00 stq pr6|402 002760 aa 7 77774 2371 06 ldaq pr7|-4,ql seg_info.segp 002761 aa 775075 6770 04 eraq -1475,ic 000056 = 077777000043 000001000000 002762 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 002763 aa 000013 6000 04 tze 11,ic 002776 002764 aa 6 00622 7271 00 lxl7 pr6|402 002765 aa 7 77774 3521 17 epp2 pr7|-4,7 seg_info.segp 002766 aa 6 00432 2521 00 spri2 pr6|282 002767 aa 6 00111 3521 00 epp2 pr6|73 code 002770 aa 6 00434 2521 00 spri2 pr6|284 002771 aa 6 00430 6211 00 eax1 pr6|280 002772 aa 010000 4310 07 fld 4096,dl 002773 aa 6 00044 3701 20 epp4 pr6|36,* 002774 la 4 00046 3521 20 epp2 pr4|38,* hcs_$terminate_noname 002775 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 521 end; 002776 aa 6 00102 0541 00 aos pr6|66 i 002777 aa 777753 7100 04 tra -21,ic 002752 STATEMENT 1 ON LINE 524 if viptr (1) ^= null then call release_temp_segments_ (me, viptr, code); 003000 aa 6 00144 2371 00 ldaq pr6|100 viptr 003001 aa 775055 6770 04 eraq -1491,ic 000056 = 077777000043 000001000000 003002 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 003003 aa 000022 6000 04 tze 18,ic 003025 003004 aa 774776 3520 04 epp2 -1538,ic 000002 = 163145164137 003005 aa 6 00446 2521 00 spri2 pr6|294 003006 aa 6 00144 3521 00 epp2 pr6|100 viptr 003007 aa 6 00450 2521 00 spri2 pr6|296 003010 aa 6 00111 3521 00 epp2 pr6|73 code 003011 aa 6 00452 2521 00 spri2 pr6|298 003012 aa 775024 3520 04 epp2 -1516,ic 000036 = 526000000022 003013 aa 6 00454 2521 00 spri2 pr6|300 003014 aa 775051 3520 04 epp2 -1495,ic 000065 = 464100000000 003015 aa 6 00456 2521 00 spri2 pr6|302 003016 aa 775016 3520 04 epp2 -1522,ic 000034 = 404000000043 003017 aa 6 00460 2521 00 spri2 pr6|304 003020 aa 6 00444 6211 00 eax1 pr6|292 003021 aa 014000 4310 07 fld 6144,dl 003022 aa 6 00044 3701 20 epp4 pr6|36,* 003023 la 4 00052 3521 20 epp2 pr4|42,* release_temp_segments_ 003024 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 527 return; 003025 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 625 end; BEGIN PROCEDURE delete_it ENTRY TO delete_it STATEMENT 1 ON LINE 530 delete_it: proc (np); 003026 aa 6 00370 6501 00 spri4 pr6|248 003027 aa 6 00372 2521 00 spri2 pr6|250 STATEMENT 1 ON LINE 547 vptr = np -> variable_node.vbl_ptr; 003030 aa 2 00002 3735 20 epp7 pr2|2,* np 003031 aa 7 00000 3735 20 epp7 pr7|0,* np 003032 aa 7 00004 3715 20 epp5 pr7|4,* variable_node.vbl_ptr 003033 aa 6 00412 6515 00 spri5 pr6|266 vptr STATEMENT 1 ON LINE 549 call hcs_$high_low_seg_count (high_seg, hcscnt); 003034 aa 6 00416 3521 00 epp2 pr6|270 high_seg 003035 aa 6 00634 2521 00 spri2 pr6|412 003036 aa 6 00415 3521 00 epp2 pr6|269 hcscnt 003037 aa 6 00636 2521 00 spri2 pr6|414 003040 aa 6 00632 6211 00 eax1 pr6|410 003041 aa 010000 4310 07 fld 4096,dl 003042 aa 6 00044 3701 20 epp4 pr6|36,* 003043 la 4 00070 3521 20 epp2 pr4|56,* hcs_$high_low_seg_count 003044 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 551 do segno = hcscnt + 1 to hcscnt + high_seg; 003045 aa 6 00415 2361 00 ldq pr6|269 hcscnt 003046 aa 6 00416 0761 00 adq pr6|270 high_seg 003047 aa 6 00420 7561 00 stq pr6|272 003050 aa 6 00415 2361 00 ldq pr6|269 hcscnt 003051 aa 000001 0760 07 adq 1,dl 003052 aa 6 00414 7561 00 stq pr6|268 segno 003053 aa 000000 0110 03 nop 0,du 003054 aa 6 00414 2361 00 ldq pr6|268 segno 003055 aa 6 00420 1161 00 cmpq pr6|272 003056 aa 000117 6054 04 tpnz 79,ic 003175 STATEMENT 1 ON LINE 552 if rel (lotp -> lot.lp (segno)) ^= "0"b then do; 003057 aa 6 00354 2351 66 lda pr6|236,*ql lot.lp 003060 aa 000022 7350 00 als 18 003061 aa 000112 6000 04 tze 74,ic 003173 STATEMENT 1 ON LINE 554 headptr = lotp -> lot.lp (segno); 003062 aa 6 00354 7671 66 lprp7 pr6|236,*ql lot.lp 003063 aa 6 00376 6535 00 spri7 pr6|254 headptr STATEMENT 1 ON LINE 555 defstartptr = headptr -> header.def_ptr; 003064 aa 7 00000 3715 20 epp5 pr7|0,* header.def_ptr 003065 aa 6 00400 6515 00 spri5 pr6|256 defstartptr STATEMENT 1 ON LINE 556 linkstartptr = addrel (headptr, headptr -> header.stats.begin_links); 003066 aa 7 00006 2351 00 lda pr7|6 header.begin_links 003067 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 003070 aa 7 00000 3521 01 epp2 pr7|0,au 003071 aa 000000 0520 03 adwp2 0,du 003072 aa 6 00402 2521 00 spri2 pr6|258 linkstartptr STATEMENT 1 ON LINE 560 if (baseno (linkstartptr) = baseno (defstartptr)) & (fixed (rel (defstartptr), 18) > fixed (rel (linkstartptr), 18)) then block_end = rel (defstartptr); 003073 aa 5 00000 2131 00 epaq pr5|0 defstartptr 003074 aa 077777 3750 03 ana 32767,du 003075 aa 6 00640 7551 00 sta pr6|416 003076 aa 2 00000 2131 00 epaq pr2|0 linkstartptr 003077 aa 077777 3750 03 ana 32767,du 003100 aa 6 00640 1151 00 cmpa pr6|416 003101 aa 000013 6010 04 tnz 11,ic 003114 003102 aa 2 00000 6351 00 eaa pr2|0 linkstartptr 003103 aa 000066 7730 00 lrl 54 003104 aa 6 00640 7561 00 stq pr6|416 003105 aa 5 00000 6351 00 eaa pr5|0 defstartptr 003106 aa 000066 7730 00 lrl 54 003107 aa 6 00640 1161 00 cmpq pr6|416 003110 aa 000004 6044 04 tmoz 4,ic 003114 003111 aa 5 00000 6351 00 eaa pr5|0 defstartptr 003112 aa 6 00115 7551 00 sta pr6|77 block_end 003113 aa 000007 7100 04 tra 7,ic 003122 STATEMENT 1 ON LINE 564 else block_end = rel (addrel (headptr, headptr -> header.stats.block_length)); 003114 aa 7 00006 2351 00 lda pr7|6 header.block_length 003115 aa 000022 7350 00 als 18 003116 aa 7 00000 3515 01 epp1 pr7|0,au 003117 aa 000000 0510 03 adwp1 0,du 003120 aa 1 00000 6351 00 eaa pr1|0 003121 aa 6 00115 7551 00 sta pr6|77 block_end 003122 aa 6 00642 2515 00 spri1 pr6|418 STATEMENT 1 ON LINE 567 do itsptr = linkstartptr repeat (addrel (itsptr, 2)) /* loop through all links */ while (rel (itsptr) < block_end); 003123 aa 6 00404 2521 00 spri2 pr6|260 itsptr 003124 aa 6 00404 6351 20 eaa pr6|260,* itsptr 003125 aa 6 00115 1151 00 cmpa pr6|77 block_end 003126 aa 6 00641 7551 00 sta pr6|417 003127 aa 000044 6030 04 trc 36,ic 003173 STATEMENT 1 ON LINE 569 if itsptr -> its.its_mod = "100011"b then do; 003130 aa 6 00404 2351 20 lda pr6|260,* its.its_mod 003131 aa 000036 7350 00 als 30 003132 aa 430000 1150 03 cmpa 143360,du 003133 aa 000034 6010 04 tnz 28,ic 003167 STATEMENT 1 ON LINE 571 lptr = itsptr -> based_ptr; 003134 aa 6 00404 3735 20 epp7 pr6|260,* based_ptr 003135 aa 7 00000 3735 20 epp7 pr7|0,* based_ptr 003136 aa 6 00410 6535 00 spri7 pr6|264 lptr STATEMENT 1 ON LINE 572 if lptr = vptr then do; 003137 aa 6 00410 2371 00 ldaq pr6|264 lptr 003140 aa 6 00412 6771 00 eraq pr6|266 vptr 003141 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 003142 aa 000025 6010 04 tnz 21,ic 003167 STATEMENT 1 ON LINE 574 vlp = headptr -> header.original_linkage_ptr; 003143 aa 6 00376 3715 20 epp5 pr6|254,* headptr 003144 aa 5 00003 7651 00 lprp5 pr5|3 header.original_linkage_ptr 003145 aa 6 00406 6515 00 spri5 pr6|262 vlp STATEMENT 1 ON LINE 575 itsptr -> based_double = addrel (vlp, bit (bin (bin (rel (itsptr), 18) - bin (rel (headptr), 18), 18))) -> based_double; 003146 aa 6 00376 6351 20 eaa pr6|254,* headptr 003147 aa 000066 7730 00 lrl 54 003150 aa 6 00640 7561 00 stq pr6|416 003151 aa 6 00641 2351 00 lda pr6|417 003152 aa 000066 7730 00 lrl 54 003153 aa 6 00640 1761 00 sbq pr6|416 003154 aa 000003 6050 04 tpl 3,ic 003157 003155 aa 0 00110 6761 00 erq pr0|72 = 777777777777 003156 aa 000001 0760 07 adq 1,dl 003157 aa 000066 7370 00 lls 54 003160 aa 5 00000 3521 01 epp2 pr5|0,au 003161 aa 000000 0520 03 adwp2 0,du 003162 aa 2 00000 2351 00 lda pr2|0 based_double 003163 aa 2 00001 2361 00 ldq pr2|1 based_double 003164 aa 6 00404 3535 20 epp3 pr6|260,* itsptr 003165 aa 3 00000 7551 00 sta pr3|0 based_double 003166 aa 3 00001 7561 00 stq pr3|1 based_double STATEMENT 1 ON LINE 578 end; STATEMENT 1 ON LINE 579 end; STATEMENT 1 ON LINE 580 end; 003167 aa 6 00404 3521 20 epp2 pr6|260,* itsptr 003170 aa 000002 0520 03 adwp2 2,du 003171 aa 6 00404 2521 00 spri2 pr6|260 itsptr 003172 aa 777732 7100 04 tra -38,ic 003124 STATEMENT 1 ON LINE 581 end; STATEMENT 1 ON LINE 582 end; 003173 aa 6 00414 0541 00 aos pr6|268 segno 003174 aa 777660 7100 04 tra -80,ic 003054 STATEMENT 1 ON LINE 586 vsize = np -> variable_node.vbl_size; 003175 aa 6 00372 3735 20 epp7 pr6|250,* 003176 aa 7 00002 3715 20 epp5 pr7|2,* np 003177 aa 5 00000 3715 20 epp5 pr5|0,* np 003200 aa 5 00001 2351 00 lda pr5|1 variable_node.vbl_size 003201 aa 000060 7730 00 lrl 48 003202 aa 6 00417 7561 00 stq pr6|271 vsize STATEMENT 1 ON LINE 588 if vsize > sys_info$max_seg_size then call fortran_storage_manager_$free (np); 003203 aa 6 00044 3701 20 epp4 pr6|36,* 003204 la 4 00014 1161 20 cmpq pr4|12,* sys_info$max_seg_size 003205 aa 000010 6044 04 tmoz 8,ic 003215 003206 aa 7 00002 3521 20 epp2 pr7|2,* np 003207 aa 6 00634 2521 00 spri2 pr6|412 003210 aa 6 00632 6211 00 eax1 pr6|410 003211 aa 004000 4310 07 fld 2048,dl 003212 la 4 00066 3521 20 epp2 pr4|54,* fortran_storage_manager_$free 003213 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out 003214 aa 000034 7100 04 tra 28,ic 003250 STATEMENT 1 ON LINE 591 else if rel (np -> variable_node.vbl_ptr) = "0"b /* separate seg was created outside area */ then call delete_$ptr (np -> variable_node.vbl_ptr, "010100"b, me, code); 003215 aa 5 00004 6351 20 eaa pr5|4,* variable_node.vbl_ptr 003216 aa 000030 6010 04 tnz 24,ic 003246 003217 aa 240000 2350 03 lda 81920,du 003220 aa 6 00640 7551 00 sta pr6|416 003221 aa 5 00004 3521 00 epp2 pr5|4 variable_node.vbl_ptr 003222 aa 6 00646 2521 00 spri2 pr6|422 003223 aa 6 00640 3521 00 epp2 pr6|416 003224 aa 6 00650 2521 00 spri2 pr6|424 003225 aa 774555 3520 04 epp2 -1683,ic 000002 = 163145164137 003226 aa 6 00652 2521 00 spri2 pr6|426 003227 aa 6 00111 3521 00 epp2 pr6|73 code 003230 aa 6 00654 2521 00 spri2 pr6|428 003231 aa 774611 3520 04 epp2 -1655,ic 000042 = 464000000000 003232 aa 6 00656 2521 00 spri2 pr6|430 003233 aa 774554 3520 04 epp2 -1684,ic 000007 = 514000000006 003234 aa 6 00660 2521 00 spri2 pr6|432 003235 aa 774601 3520 04 epp2 -1663,ic 000036 = 526000000022 003236 aa 6 00662 2521 00 spri2 pr6|434 003237 aa 774575 3520 04 epp2 -1667,ic 000034 = 404000000043 003240 aa 6 00664 2521 00 spri2 pr6|436 003241 aa 6 00644 6211 00 eax1 pr6|420 003242 aa 020000 4310 07 fld 8192,dl 003243 la 4 00072 3521 20 epp2 pr4|58,* delete_$ptr 003244 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc 003245 aa 000003 7100 04 tra 3,ic 003250 STATEMENT 1 ON LINE 594 else free np -> variable_node.vbl_ptr -> old_variable; 003246 aa 5 00004 3715 00 epp5 pr5|4 variable_node.vbl_ptr 003247 aa 0 01404 7001 00 tsx0 pr0|772 op_freen_ STATEMENT 1 ON LINE 596 np -> variable_node.vbl_ptr = null; 003250 aa 774606 2370 04 ldaq -1658,ic 000056 = 077777000043 000001000000 003251 aa 6 00372 3735 20 epp7 pr6|250,* 003252 aa 7 00002 3715 20 epp5 pr7|2,* np 003253 aa 5 00000 3715 20 epp5 pr5|0,* np 003254 aa 5 00004 7571 00 staq pr5|4 variable_node.vbl_ptr STATEMENT 1 ON LINE 597 sb -> stack_header.sys_link_info_ptr -> variable_table_header.total_allocated_size = sb -> stack_header.sys_link_info_ptr -> variable_table_header.total_allocated_size - vsize; 003255 aa 6 00352 3535 20 epp3 pr6|234,* sb 003256 aa 3 00060 3515 20 epp1 pr3|48,* stack_header.sys_link_info_ptr 003257 aa 1 00111 3361 00 lcq pr1|73 variable_table_header.total_allocated_size 003260 aa 000044 7770 00 llr 36 003261 aa 000044 7330 00 lrs 36 003262 aa 6 00417 0331 00 adl pr6|271 vsize 003263 aa 000000 5330 00 negl 0 003264 aa 1 00111 7561 00 stq pr1|73 variable_table_header.total_allocated_size STATEMENT 1 ON LINE 600 return; 003265 aa 6 00370 6101 00 rtcd pr6|248 STATEMENT 1 ON LINE 602 end; END PROCEDURE delete_it END PROCEDURE sfc ----------------------------------------------------------- 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