COMPILATION LISTING OF SEGMENT run_ Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-18_1140.55_Tue_mdt Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396), 17* audit(86-08-01,Schroth), install(86-11-20,MR12.0-1222): 18* null variable node seg ptr in cleanup_old_linkage_section 19* 2) change(88-05-03,Farley), approve(88-05-26,MCR7901), audit(88-06-07,GWMay), 20* install(88-07-05,MR12.2-1053): 21* Changed RNT area manipulation code to use stack_header.rnt_ptr directly, 22* instead of copying to the automatic rntp variable. The RNT area can move 23* and using the stack_header is the only sure way of referencing the correct 24* location. Also inhibit interrupts during this period. 25* END HISTORY COMMENTS */ 26 27 28 /* format: style3,^indnoniterdo */ 29 run_: 30 proc (main_entry, arglist_ptr, ca_ptr, code); 31 32 /* coded December 1977 by Melanie Weaver */ 33 /* modified June 1979 by Melanie Weaver to add -old_reference_names handling */ 34 /* modified February 1983 by Melanie Weaver to clean up vla segments */ 35 36 /* Parameters */ 37 38 dcl main_entry entry variable; 39 dcl arglist_ptr ptr; 40 dcl ca_ptr ptr; 41 dcl code fixed bin (35); 42 43 /* Static */ 44 45 dcl in_run bit (1) aligned static init ("0"b); 46 /* init important for stop_run */ 47 dcl run_sp ptr static init (null); 48 dcl static_abort_label label static; 49 dcl 1 saved_ptrs aligned static like env_ptrs; 50 dcl saved_vla_flag bit (1) aligned static; /* Automatic */ 51 52 dcl (i, j, old_cur_lot_size, old_rnt_size, rnt_size, nwords, linkage_lng, static_lng, hcscnt, highseg) 53 fixed bin; 54 dcl xcode fixed bin (35); 55 dcl mask bit (36) aligned; 56 dcl timer_set bit (1) aligned; 57 dcl Its_mod bit (6) aligned static options (constant) init ("100011"b); 58 dcl perprocess_array (4096) bit (1) unaligned; 59 dcl (new_lot_ptr, new_isot_ptr, new_sct_ptr, area_ptr, new_rnt_areap, tss_ptr, old_rntp, new_rntp, linkp, run_stp, 60 stp, tp, np, link_ptr, temp_ptr, table_ptr) 61 ptr; 62 dcl (outer_env_linkage_ptr, run_unit_linkage_ptr) 63 ptr unaligned; 64 dcl search_rule_entry_var 65 entry (ptr, fixed bin (35)) variable; 66 dcl 1 search_rules aligned, 67 2 number fixed bin, 68 2 name (21) char (168) aligned; 69 70 dcl 1 auto_run_control_structure 71 aligned like run_control_structure; 72 73 dcl 1 ainfo aligned like area_info; 74 75 dcl 1 finish_info aligned, 76 2 header aligned like condition_info_header, 77 2 type char (8); 78 79 dcl 1 cond_info aligned like condition_info; 80 81 /* Based */ 82 83 dcl sct_array (128) bit (36) aligned based; 84 dcl based_array (nwords) fixed bin (35) based; 85 dcl based_area area based; 86 dcl based_bit bit (72) aligned based; 87 dcl rnt_area area (rnt_size) based; 88 dcl old_rnt_area area (old_rnt_size) based; 89 dcl linkage_section (linkage_lng) fixed bin (35) based; 90 dcl static_section (static_lng) fixed bin (35) based; 91 dcl 1 control_args aligned based (ca_ptr), 92 2 flags aligned, 93 3 ec bit (1) unaligned, 94 3 crn bit (1) unaligned, 95 3 pad bit (34) unaligned, 96 2 time_limit fixed bin (35); 97 dcl 1 temp_seg_struc aligned based (tss_ptr), 98 2 ntemps fixed bin, 99 2 segno (2000) fixed bin; 100 101 102 /* Builtins */ 103 104 dcl (addr, addrel, baseno, baseptr, bin, empty, hbound, lbound, null, stackbaseptr, stackframeptr) 105 builtin; 106 dcl (ptr, rel, size, string, unspec) 107 builtin; 108 109 /* Conditions */ 110 111 dcl (any_other, cleanup, finish, command_abort_) 112 condition; 113 114 /* externals */ 115 116 dcl sys_info$max_seg_size 117 ext fixed bin (19); 118 dcl error_table_$run_unit_not_recursive 119 external fixed bin (35); 120 121 dcl (get_temp_segment_, release_temp_segment_) 122 entry (char (*), ptr, fixed bin (35)); 123 dcl define_area_ entry (ptr, fixed bin (35)); 124 dcl hcs_$high_low_seg_count 125 entry (fixed bin, fixed bin); 126 dcl hcs_$initiate_search_rules 127 entry (ptr, fixed bin (35)); 128 dcl find_command_$clear entry (); 129 dcl ( 130 hcs_$set_ips_mask, 131 hcs_$reset_ips_mask 132 ) entry (bit (36) aligned, bit (36) aligned); 133 dcl timer_manager_$cpu_call 134 entry (fixed bin (71), bit (2), entry); 135 dcl timer_manager_$reset_cpu_call 136 entry (entry); 137 dcl cu_$generate_call entry (entry, ptr); 138 dcl execute_epilogue_ entry (bit (1) aligned); 139 dcl get_temp_segments_$list_segnos 140 entry (ptr); 141 dcl hcs_$terminate_seg entry (ptr, fixed bin (1), fixed bin (35)); 142 dcl link_unsnap_ entry (ptr, ptr, ptr, fixed bin, fixed bin); 143 dcl release_area_ entry (ptr); 144 dcl find_condition_info_ 145 entry (ptr, ptr, fixed bin (35)); 146 dcl continue_to_signal_ entry (fixed bin (35)); 147 dcl signal_ entry (char (*), ptr, ptr); 148 dcl hcs_$get_search_rules 149 entry (ptr); 150 dcl fortran_storage_manager_$get_vla_segnos 151 entry ((4096) bit (1) unaligned); 152 dcl fortran_storage_manager_$free 153 entry (ptr); 154 155 if in_run 156 then do; /* do not allow recursive invocation because it won't work */ 157 code = error_table_$run_unit_not_recursive; 158 return; 159 end; 160 161 code = 0; 162 area_ptr = null; 163 temp_ptr = null; 164 165 if ca_ptr -> run_control_structure.version = run_control_structure_version_1 166 then run_cs_ptr = ca_ptr; /* caller used include file */ 167 else do; /* copy items into standard structure */ 168 run_cs_ptr = addr (auto_run_control_structure); 169 run_control_structure.flags.ec = control_args.flags.ec; 170 if control_args.flags.crn 171 then run_control_structure.reference_name_switch = COPY_REFERENCE_NAMES; 172 else run_control_structure.reference_name_switch = NEW_REFERENCE_NAMES; 173 run_control_structure.time_limit = control_args.time_limit; 174 end; 175 176 mask = "0"b; 177 on cleanup 178 begin; 179 if temp_ptr ^= null 180 then call release_temp_segment_ ("run_", temp_ptr, code); 181 if mask 182 then call hcs_$reset_ips_mask (mask, mask); 183 end; 184 185 call get_temp_segment_ ("run_", temp_ptr, code); 186 if code ^= 0 187 then return; 188 189 call hcs_$set_ips_mask ("0"b, mask); 190 191 run_sp = stackframeptr; /* save for environment_info entry point */ 192 sb = stackbaseptr; 193 new_lot_ptr = temp_ptr; 194 old_cur_lot_size = sb -> stack_header.cur_lot_size; 195 new_isot_ptr, new_sct_ptr = addrel (new_lot_ptr, old_cur_lot_size); 196 lotp = sb -> stack_header.lot_ptr; 197 isotp = sb -> stack_header.isot_ptr; 198 199 /* fill in run unit lot */ 200 /* WARNING: If this code is changed to combine new linkage sections for perprocess static segments 201* (copying active static sections), stack_header.trans_op_tv_ptr must be pushed, 202* since it must point to the actual links being used. 203* This assumes that operator_pointers_ is still perprocess static. */ 204 205 call hcs_$high_low_seg_count (highseg, hcscnt); 206 do i = hcscnt to hcscnt + highseg; 207 if baseno (lotp -> lot.lp (i)) = "0"b 208 then do; /* either 0 or lot fault; just copy entry */ 209 unspec (new_lot_ptr -> lot.lp (i)) = unspec (lotp -> lot.lp (i)); 210 /* use bit copy to avoid possible fault */ 211 unspec (new_isot_ptr -> isot.isp (i)) = unspec (isotp -> isot.isp (i)); 212 end; 213 else if ^lotp -> lot.lp (i) -> linkage_header_flags.perprocess_static 214 then unspec (new_lot_ptr -> lot.lp (i)) = lot_fault; 215 else do; /* perprocess static; use same linkage and static */ 216 new_lot_ptr -> lot.lp (i) = lotp -> lot.lp (i); 217 /* this should combine if there was a lot fault */ 218 new_isot_ptr -> isot.isp (i) = isotp -> isot.isp (i); 219 /* we want any isot faults to handled at this time 220* so static will be in the right place */ 221 end; 222 end; 223 224 new_isot_ptr -> sct_array = isotp -> sct_array; /* copy static condition table */ 225 226 /* set up the area for linkage sections, etc. */ 227 228 ainfo.version = area_info_version_1; 229 ainfo.size = sys_info$max_seg_size - 2 * old_cur_lot_size; 230 /* everything except lot annd isot */ 231 area_ptr, ainfo.areap = addrel (new_isot_ptr, old_cur_lot_size); 232 string (ainfo.control) = "0"b; 233 ainfo.control.extend = "1"b; 234 ainfo.control.zero_on_free = "1"b; 235 ainfo.control.system = "1"b; 236 ainfo.owner = "run_"; 237 238 call define_area_ (addr (ainfo), code); 239 if code ^= 0 240 then do; 241 call release_temp_segment_ ("run_", temp_ptr, xcode); 242 call hcs_$reset_ips_mask (mask, mask); 243 return; 244 end; 245 246 /* allocate new rnt area and initialize rnt if necessary */ 247 248 if run_control_structure.reference_name_switch ^= OLD_REFERENCE_NAMES 249 then do; /* set up new name space */ 250 allocate_new_rnt: 251 rnt_size = sb -> stack_header.rnt_ptr -> rnt.rnt_area_size; 252 allocate rnt_area in (area_ptr -> based_area) set (new_rnt_areap); 253 if run_control_structure.reference_name_switch = COPY_REFERENCE_NAMES 254 then do; /* copy whole area and update ptrs in rnt */ 255 new_rnt_areap -> rnt_area = empty; 256 new_rnt_areap -> rnt_area = sb -> stack_header.rnt_ptr -> rnt.areap -> rnt_area; 257 if rnt_size ^= sb -> stack_header.rnt_ptr -> rnt.rnt_area_size 258 then do; /* Has RNT grown/moved during the copy? */ 259 free new_rnt_areap -> rnt_area; /* remove the new area */ 260 goto allocate_new_rnt; /* and try again */ 261 end; 262 new_rntp = 263 addrel (new_rnt_areap, 264 (bin (rel (sb -> stack_header.rnt_ptr), 18) 265 - bin (rel (sb -> stack_header.rnt_ptr -> rnt.areap), 18))); 266 new_rntp -> rnt.srulep = 267 addrel (new_rnt_areap, 268 (bin (rel (sb -> stack_header.rnt_ptr -> rnt.srulep), 18) 269 - bin (rel (sb -> stack_header.rnt_ptr -> rnt.areap), 18))); 270 end; 271 else do; /* initialize rnt and set up to init search rules */ 272 ainfo.control.extend = "0"b; /* other control settings are ok */ 273 ainfo.owner = "rnt"; 274 ainfo.size = rnt_size; 275 ainfo.areap = new_rnt_areap; 276 call define_area_ (addr (ainfo), code); 277 if code ^= 0 278 then do; 279 call release_temp_segment_ ("run_", temp_ptr, xcode); 280 call hcs_$reset_ips_mask (mask, mask); 281 return; 282 end; 283 allocate rnt in (new_rnt_areap -> based_rnt_area) set (new_rntp); 284 new_rntp -> rnt.name_hash_table (*) = null; 285 new_rntp -> rnt.segno_hash_table (*) = null; 286 new_rntp -> rnt.srulep = null; 287 call hcs_$get_search_rules (addr (search_rules)); 288 /* use existing rules by default */ 289 search_rule_entry_var = hcs_$initiate_search_rules; 290 /* must snap link before entering run environment */ 291 end; 292 293 new_rntp -> rnt.areap = new_rnt_areap; /* same for both cases */ 294 new_rntp -> rnt.rnt_area_size = rnt_size; 295 296 end; 297 else new_rntp = sb -> stack_header.rnt_ptr; /* no net change when keep same name space */ 298 299 300 /* save current environment pointers in static */ 301 302 saved_ptrs.version = 1; 303 saved_ptrs.pad = 0; 304 saved_ptrs.lot_ptr = lotp; 305 saved_ptrs.isot_ptr = isotp; 306 saved_ptrs.clr_ptr = sb -> stack_header.clr_ptr; 307 saved_ptrs.combined_stat_ptr = sb -> stack_header.combined_stat_ptr; 308 saved_ptrs.user_free_ptr = sb -> stack_header.user_free_ptr; 309 saved_ptrs.sys_link_info_ptr = sb -> stack_header.sys_link_info_ptr; 310 saved_ptrs.rnt_ptr = sb -> stack_header.rnt_ptr; 311 saved_ptrs.sct_ptr = sb -> stack_header.sct_ptr; 312 saved_vla_flag = sb -> stack_header.have_static_vlas; 313 314 /* set up condition handlers */ 315 316 on finish 317 begin; 318 dcl 1 based_finish_info aligned based like finish_info; 319 320 call find_condition_info_ (null, addr (cond_info), xcode); 321 if cond_info.info_ptr = null 322 then call continue_to_signal_ (xcode); 323 else if cond_info.info_ptr -> based_finish_info.type ^= "run" 324 then call continue_to_signal_ (xcode); /* stop signalling if finish is just for run */ 325 end; 326 on any_other system; /* set up wall */ 327 328 run_sp -> stack_frame_flags.run_unit_manager = "1"b; 329 /* mark stack frame for PL/I options (main) */ 330 331 call find_command_$clear; /* reset command processor's associative memory */ 332 333 on cleanup 334 begin; 335 call restore_environment; 336 if temp_ptr ^= null 337 then call release_temp_segment_ ("run_", temp_ptr, code); 338 if mask 339 then call hcs_$reset_ips_mask (mask, mask); 340 end; 341 342 /* change to run environment */ 343 344 sb -> stack_header.lot_ptr = new_lot_ptr; 345 sb -> stack_header.isot_ptr, sb -> stack_header.sct_ptr = new_isot_ptr; 346 sb -> stack_header.clr_ptr = area_ptr; 347 sb -> stack_header.combined_stat_ptr = area_ptr; 348 sb -> stack_header.user_free_ptr = area_ptr; 349 sb -> stack_header.sys_link_info_ptr = null; 350 sb -> stack_header.rnt_ptr = new_rntp; 351 sb -> stack_header.have_static_vlas = "0"b; 352 353 if run_control_structure.reference_name_switch = NEW_REFERENCE_NAMES 354 /* fill in search rules without snapping links */ 355 then call search_rule_entry_var (addr (search_rules), code); 356 357 call hcs_$reset_ips_mask (mask, mask); /* unmask now */ 358 359 timer_set = "0"b; 360 on cleanup call Clean_up; 361 362 if run_control_structure.time_limit > 0 363 then do; 364 timer_set = "1"b; /* doesn't hurt to set it ahead of time */ 365 call timer_manager_$cpu_call ((run_control_structure.time_limit), "11"b, interrupt_run); 366 end; 367 368 static_abort_label = abort; 369 in_run = "1"b; 370 sb -> stack_header.main_proc_invoked = 0; /* be sure this is set correctly */ 371 sb -> stack_header.run_unit_depth = 1; 372 373 call cu_$generate_call (main_entry, arglist_ptr); /* start running */ 374 375 abort: 376 on cleanup call quick_cleanup; /* be sure critical environment changing is done */ 377 call Clean_up; 378 379 return; 380 381 Clean_up: 382 proc; 383 384 if timer_set 385 then call timer_manager_$reset_cpu_call (interrupt_run); 386 387 388 if in_run 389 then do; /* probably did something before stopping */ 390 call execute_epilogue_ ("1"b); /* just run epilogue_ handlers */ 391 if old_cur_lot_size < sb -> stack_header.cur_lot_size 392 then do; /* lot has grown; grow the outer env lot also */ 393 394 /* This code is similar to that in link_man$grow_lot, which cannot be used here 395* . because it updates the stack header itself, which has already been done within the run unit. */ 396 397 nwords = 2 * sb -> stack_header.max_lot_size; 398 allocate based_array in (saved_ptrs.clr_ptr -> based_area) set (saved_ptrs.lot_ptr); 399 /* allocate new lot and isot */ 400 saved_ptrs.isot_ptr = addrel (saved_ptrs.lot_ptr, sb -> stack_header.max_lot_size); 401 nwords = old_cur_lot_size; 402 saved_ptrs.lot_ptr -> based_array = lotp -> based_array; 403 /* copy old lot and isot */ 404 saved_ptrs.isot_ptr -> based_array = isotp -> based_array; 405 lotp = saved_ptrs.lot_ptr; 406 isotp = saved_ptrs.isot_ptr; 407 old_cur_lot_size = sb -> stack_header.max_lot_size; 408 409 new_lot_ptr = sb -> stack_header.lot_ptr; 410 /* update run copies also */ 411 412 new_isot_ptr = sb -> stack_header.isot_ptr; 413 414 end; 415 416 /* Now, if VLA external variables have been used, we must check 417* all the external variables and free any attached VLA segments. 418* We do not need to free the variables themselves because they 419* will go away anyway. 420**/ 421 422 table_ptr = sb -> stack_header.sys_link_info_ptr; 423 if table_ptr ^= null 424 then if table_ptr -> variable_table_header.flags.have_vla_variables 425 then call free_vla_common (); 426 427 call hcs_$high_low_seg_count (highseg, hcscnt); 428 /* find current range of segment numbers */ 429 430 if run_control_structure.reference_name_switch ^= OLD_REFERENCE_NAMES 431 then do; /* terminate segs initiated only in run unit 432* and adjust outer environment LOT */ 433 434 /* obtain list of non-procedure perprocess_segments */ 435 436 string (perprocess_array) = "0"b; 437 438 call find_area_components (saved_ptrs.clr_ptr); 439 /* find all extensions of outer clr area */ 440 441 if saved_ptrs.combined_stat_ptr ^= saved_ptrs.clr_ptr 442 then call find_area_components (saved_ptrs.combined_stat_ptr); 443 444 if (sb -> stack_header.system_free_ptr ^= saved_ptrs.clr_ptr) 445 & (sb -> stack_header.system_free_ptr ^= saved_ptrs.combined_stat_ptr) 446 then call find_area_components (sb -> stack_header.system_free_ptr); 447 448 if (saved_ptrs.user_free_ptr ^= saved_ptrs.clr_ptr) 449 & (saved_ptrs.user_free_ptr ^= saved_ptrs.combined_stat_ptr) 450 & (saved_ptrs.user_free_ptr ^= sb -> stack_header.system_free_ptr) 451 then call find_area_components (saved_ptrs.user_free_ptr); 452 453 call find_area_components (area_ptr); /* note components in own area; they should 454* be terminated and deleted later by release_area_ 455* if they are not temp segments */ 456 457 call get_temp_segments_$list_segnos (tss_ptr); 458 /* find all the temp segs */ 459 do i = 1 to temp_seg_struc.ntemps; 460 perprocess_array (temp_seg_struc.segno (i)) = "1"b; 461 end; 462 free tss_ptr -> temp_seg_struc; 463 464 if sb -> stack_header.have_static_vlas 465 then call fortran_storage_manager_$get_vla_segnos (perprocess_array); 466 /* Note segments used in VLAs so they won't 467* be terminated prematurely. 468* fsm$free wants to truncate them first. */ 469 470 /* The following code updates the outer environment LOT with the permanent changes that 471* have taken place during the run unit. This comment explains what the possibilities 472* are and what actions are taken for each case. 473* 474* 475* . Run Unit 476* . Environment 477* 478* . 0 lot fault linkage ptr 479* . ____________________________________ 480* . 0 | no change | *1 | *2 | 481* . Outer _|____________|____________|___________| 482* . Environment lot fault | *5 | no change | *3 | 483* . _|____________|____________|____________| 484* . linkage ptr | *4 | no change | *6 | 485* . _|____________|____________|____________| 486* 487* . *1 lot fault if non object perprocess segment; otherwise terminate 488* 489* . *2 if perprocess, allocate linkage in outer, copy virgin linkage, copy static from run unit, 490* . and update outer lot; if not perprocess, terminate 491* 492* . *3 if perprocess, same as *2 perprocess; otherwise do not change 493* 494* . *4 (segment terminated during run unit) do everything term_ does except terminating, 495* . before environment is restored (don't risk reuse of segno in meantime) 496* 497* . *5 (segment terminated during run unit) zero LOT entry and unsnap links to seg in outer 498* 499* . *6 if perprocess, unsnap all links snapped during run unit because some are 500* invalid; otherwise (shouldn't be possible) do not change 501* 502**/ 503 504 do i = hcscnt to hcscnt + highseg; 505 unspec (outer_env_linkage_ptr) = unspec (lotp -> lot.lp (i)); 506 unspec (run_unit_linkage_ptr) = unspec (new_lot_ptr -> lot.lp (i)); 507 if unspec (outer_env_linkage_ptr) = unspec (run_unit_linkage_ptr) 508 then do; 509 if baseno (outer_env_linkage_ptr) 510 /* had linkage ptr in outer env */ 511 then if outer_env_linkage_ptr -> linkage_header_flags.perprocess_static 512 /* superfluous; wouldn't be = if not perprocess */ 513 then call unsnap_links_in_outer_pps_linkage (i); 514 end; 515 516 else if unspec (outer_env_linkage_ptr) = "0"b 517 then do; /* seg not known before run unit */ 518 if unspec (run_unit_linkage_ptr) = lot_fault 519 then do; /* no active linkage section */ 520 if perprocess_array (i) 521 then unspec (lotp -> lot.lp (i)) = lot_fault; 522 /* don't forget about temp segs, etc. */ 523 else call hcs_$terminate_seg (baseptr (i), 0, code); 524 end; 525 else do; /* segment with linkage section */ 526 if run_unit_linkage_ptr -> linkage_header_flags.perprocess_static 527 then call copy_linkage (i); 528 else do; 529 if run_unit_linkage_ptr -> linkage_header_flags.static_vlas 530 then call fortran_storage_manager_$free ((run_unit_linkage_ptr)); 531 call hcs_$terminate_seg (baseptr (i), 0, code); 532 end; 533 end; 534 end; 535 536 else if unspec (outer_env_linkage_ptr) = lot_fault 537 then do; /* segment initiated before run unit but no linkage in outer */ 538 if unspec (run_unit_linkage_ptr) = "0"b 539 then do; 540 call link_unsnap_ (lotp, isotp, addrel (baseptr (i), -1), hcscnt, highseg); 541 /* indicate no linkage section by offset of -1 */ 542 lotp -> lot.lp (i) = baseptr (0); 543 /* indicate termination in outer env */ 544 end; 545 else do; /* seg has linkage section in run unit only */ 546 if run_unit_linkage_ptr -> linkage_header_flags.perprocess_static 547 then call copy_linkage (i); 548 else if run_unit_linkage_ptr -> linkage_header_flags.static_vlas 549 then call fortran_storage_manager_$free ((run_unit_linkage_ptr)); 550 /* leave a lot fault but free "attached" VLAs 551* before throwing away linkage section from run unit */ 552 end; 553 end; 554 else do; /* seg with linkage section in outer environment */ 555 if unspec (run_unit_linkage_ptr) = "0"b 556 then call cleanup_old_linkage_section (i); 557 /* seg has since been terminated; clean up outer env */ 558 else if unspec (run_unit_linkage_ptr) ^= lot_fault 559 /* non-pps linkage section in run unit; 560* free "attached" VLAs before throwing it away */ 561 then if run_unit_linkage_ptr -> linkage_header_flags.static_vlas 562 then call fortran_storage_manager_$free ((run_unit_linkage_ptr)); 563 end; 564 565 end; 566 567 end; /* of new_name_space cleanup */ 568 569 else do; /* same name space case -- same RNT is used 570* and segs are not terminated */ 571 if sb -> stack_header.rnt_ptr ^= saved_ptrs.rnt_ptr 572 then do; /* RNT got reallocated (grown) in run unit's area; 573* copy it back into outer environment */ 574 575 call hcs_$set_ips_mask ("0"b, mask); 576 reallocate_new_rnt: 577 rnt_size = sb -> stack_header.rnt_ptr -> rnt.rnt_area_size; 578 allocate rnt_area in (saved_ptrs.clr_ptr -> based_area) set (new_rnt_areap); 579 /* allocate new RNT in outer environment */ 580 new_rnt_areap -> rnt_area = empty; /* PL/I areas must be initiaslized 581* before being used in any way */ 582 new_rnt_areap -> rnt_area = sb -> stack_header.rnt_ptr -> rnt.areap -> rnt_area; 583 /* copy it out */ 584 if rnt_size ^= sb -> stack_header.rnt_ptr -> rnt.rnt_area_size 585 then do; /* Has RNT grown/moved during the copy? */ 586 free new_rnt_areap -> rnt_area; 587 /* remove the new area */ 588 goto reallocate_new_rnt; /* and try again */ 589 end; 590 new_rntp = 591 addrel (new_rnt_areap, 592 bin (rel (sb -> stack_header.rnt_ptr), 18) 593 - bin (rel (sb -> stack_header.rnt_ptr -> rnt.areap), 18)); 594 /* locate copy of RNT within area */ 595 new_rntp -> rnt.areap = new_rnt_areap; 596 new_rntp -> rnt.srulep = 597 addrel (new_rnt_areap, 598 bin (rel (sb -> stack_header.rnt_ptr -> rnt.srulep), 18) 599 - bin (rel (sb -> stack_header.rnt_ptr -> rnt.areap), 18)); 600 /* must relocate search rule ptr in new area */ 601 old_rntp = sb -> stack_header.rnt_ptr; 602 old_rnt_size = sb -> stack_header.rnt_ptr -> rnt.rnt_area_size; 603 sb -> stack_header.rnt_ptr = new_rntp; 604 free old_rntp -> rnt.areap -> old_rnt_area; 605 call hcs_$reset_ips_mask (mask, mask); 606 end; 607 608 /* The following code updates the outer environment LOT with the permanent changes that 609* have taken place during the run unit. This comment explains what the possibilities 610* are and what actions are taken for each case. 611* 612* 613* . Run Unit 614* . Environment 615* 616* . 0 lot fault linkage ptr 617* . ____________________________________ 618* . 0 | no change | lot fault | *1 | 619* . Outer _|____________|____________|___________| 620* . Environment lot fault | *2 | no change | *1 | 621* . _|____________|____________|____________| 622* . linkage ptr | *3 | no change | *4 | 623* . _|____________|____________|____________| 624* 625* *1 if perprocess, allocate linkage in outer, copy virgin linkage, copy static from run unit, 626* and update outer LOT; if not perprocess, set lot fault 627* 628* *2 (segment terminated during run unit) zero LOT entry and unsnap links to segment in outer 629* 630* *3 (segment terminated during run unit) do everything term_ does except terminating, 631* before environment is restored 632* 633* . *4 if perprocess, unsnap all links snapped during run unit because some are 634* invalid; otherwise (shouldn't be possible) do not change 635* 636**/ 637 638 do i = hcscnt to hcscnt + highseg; 639 unspec (outer_env_linkage_ptr) = unspec (lotp -> lot.lp (i)); 640 unspec (run_unit_linkage_ptr) = unspec (new_lot_ptr -> lot.lp (i)); 641 642 if unspec (outer_env_linkage_ptr) = unspec (run_unit_linkage_ptr) 643 then do; 644 if baseno (outer_env_linkage_ptr) 645 /* had linkage ptr in outer env */ 646 then if outer_env_linkage_ptr -> linkage_header_flags.perprocess_static 647 /* superfluous; wouldn't be = if not perprocess */ 648 then call unsnap_links_in_outer_pps_linkage (i); 649 end; 650 651 else if unspec (outer_env_linkage_ptr) = "0"b 652 then do; /* segment was not known before run unit */ 653 if unspec (run_unit_linkage_ptr) = lot_fault 654 then unspec (lotp -> lot.lp (i)) = lot_fault; 655 else do; 656 if run_unit_linkage_ptr -> linkage_header_flags.perprocess_static 657 then call copy_linkage (i); 658 else do; 659 if run_unit_linkage_ptr -> linkage_header_flags.static_vlas 660 then call fortran_storage_manager_$free ((run_unit_linkage_ptr)); 661 unspec (lotp -> lot.lp (i)) = lot_fault; 662 end; 663 end; 664 end; 665 666 else if unspec (outer_env_linkage_ptr) = lot_fault 667 then do; /* segment was initiated before run unit but 668* had no linkage in outer */ 669 if unspec (run_unit_linkage_ptr) = "0"b 670 then do; 671 call link_unsnap_ (lotp, isotp, addrel (baseptr (i), -1), hcscnt, highseg); 672 /* indicate no linkage section by offset of -1 */ 673 lotp -> lot.lp (i) = baseptr (0); 674 /* indicate termination in outer environment */ 675 end; 676 else do; 677 if run_unit_linkage_ptr -> linkage_header_flags.perprocess_static 678 then call copy_linkage (i); 679 else if run_unit_linkage_ptr -> linkage_header_flags.static_vlas 680 then call fortran_storage_manager_$free ((run_unit_linkage_ptr)); 681 end; 682 end; 683 684 else do; /* segment with linkage section in outer environment */ 685 if unspec (run_unit_linkage_ptr) = "0"b 686 then call cleanup_old_linkage_section (i); 687 /* segment has since been terminated; 688* clean up outer environment */ 689 else if unspec (run_unit_linkage_ptr) ^= lot_fault 690 /* non-pps linkage section in run unit; 691* free "attached" VLAs before throwing it away */ 692 then if run_unit_linkage_ptr -> linkage_header_flags.static_vlas 693 then call fortran_storage_manager_$free ((run_unit_linkage_ptr)); 694 end; 695 696 end; /* of LOT entry comparison loop */ 697 698 end; /* of code to cleanup same name space case */ 699 700 end; /* of stuff done when in_run is on */ 701 702 /* now restore the outer environment */ 703 704 705 call quick_cleanup; 706 707 code = 0; /* just in case */ 708 end; 709 710 interrupt_run: 711 proc (mcptr, cname); 712 713 /* This is the routine called by timer_manager_ when the user specifies a time limit. */ 714 715 dcl mcptr ptr; 716 dcl cname char (*); 717 dcl answer char (10) varying; 718 dcl command_query_ entry options (variable); 719 dcl 1 query_info aligned, 720 2 version fixed bin init (2), 721 2 yes_or_no_sw bit (1) unaligned init ("1"b), 722 2 suppress_name_sw 723 bit (1) unaligned init ("0"b), 724 2 code fixed bin (35) init (0), 725 2 query_code fixed bin (35) init (0); 726 727 call command_query_ (addr (query_info), answer, "run", 728 "Time limit reached. Do you want to continue the program? "); 729 if answer = "no" 730 then goto abort; 731 call timer_manager_$cpu_call ((run_control_structure.time_limit), "11"b, interrupt_run); 732 733 end; 734 735 quick_cleanup: 736 proc; 737 738 /* this procedure does the most essential cleaning up of the environment and static variables */ 739 740 sb -> stack_header.run_unit_depth = 0; 741 sb -> stack_header.main_proc_invoked = 0; 742 mask = "0"b; 743 on cleanup 744 begin; 745 if mask 746 then call hcs_$reset_ips_mask (mask, mask); 747 end; 748 749 call hcs_$set_ips_mask ("0"b, mask); 750 call restore_environment; 751 in_run = "0"b; 752 call hcs_$reset_ips_mask (mask, mask); 753 754 run_sp = null; 755 call find_command_$clear; /* clear command processor assoc. memory again */ 756 757 end; 758 759 restore_environment: 760 proc; 761 762 /* restore original stack header variables and release temp seg */ 763 764 sb -> stack_header.lot_ptr = saved_ptrs.lot_ptr; 765 sb -> stack_header.isot_ptr = saved_ptrs.isot_ptr; 766 sb -> stack_header.clr_ptr = saved_ptrs.clr_ptr; 767 sb -> stack_header.combined_stat_ptr = saved_ptrs.combined_stat_ptr; 768 sb -> stack_header.user_free_ptr = saved_ptrs.user_free_ptr; 769 sb -> stack_header.sys_link_info_ptr = saved_ptrs.sys_link_info_ptr; 770 sb -> stack_header.sct_ptr = saved_ptrs.sct_ptr; 771 if run_control_structure.reference_name_switch ^= OLD_REFERENCE_NAMES 772 then sb -> stack_header.rnt_ptr = saved_ptrs.rnt_ptr; 773 sb -> stack_header.have_static_vlas = saved_vla_flag; 774 775 if area_ptr ^= null 776 then call release_area_ (area_ptr); /* clean up any area extensions */ 777 if temp_ptr ^= null 778 then call release_temp_segment_ ("run_", temp_ptr, code); 779 780 end; 781 782 copy_linkage: 783 proc (segno); 784 785 /* copy original linkage section and static section from run unit into outer environment */ 786 787 dcl segno fixed bin; 788 789 790 linkage_lng = bin (run_unit_linkage_ptr -> header.stats.block_length, 18); 791 allocate linkage_section in (saved_ptrs.clr_ptr -> based_area) set (linkp); 792 linkp -> linkage_section = run_unit_linkage_ptr -> header.original_linkage_ptr -> linkage_section; 793 /* copy virgin linkage into outer env */ 794 linkage_lng = size (header); 795 linkp -> linkage_section = run_unit_linkage_ptr -> linkage_section; 796 /* copy active header stuff */ 797 static_lng = bin (linkp -> header.stats.static_length, 18); 798 if static_lng > 0 799 then do; /* have a static section */ 800 run_stp = new_isot_ptr -> isot.isp (segno); 801 if run_stp ^= run_unit_linkage_ptr /* separate static */ 802 then allocate static_section in (saved_ptrs.combined_stat_ptr -> based_area) set (stp); 803 else do; 804 stp = addrel (linkp, size (header)); 805 run_stp = addrel (run_stp, size (header)); 806 end; 807 stp -> static_section = run_stp -> static_section; 808 /* copy static */ 809 if new_isot_ptr -> isot.isp (segno) = run_unit_linkage_ptr 810 then stp = linkp; 811 end; 812 else stp = linkp; /* no static; isote = lote by default */ 813 814 saved_ptrs.lot_ptr -> lot.lp (segno) = linkp; /* update original lot, isot */ 815 saved_ptrs.isot_ptr -> isot.isp (segno) = stp; 816 817 end; 818 819 unsnap_links_in_outer_pps_linkage: 820 proc (segno); 821 822 /* This procedure unsnaps all links in a perprocess segment that were snapped during the run unit 823* because they may have been snapped to segments being terminated. This wouldn't be necessary 824* if perprocess segments also got new linkage sections during run units. 825**/ 826 827 declare segno fixed bin; 828 829 linkp = lotp -> lot.lp (segno); 830 do j = bin (linkp -> header.stats.begin_links, 18) to bin (linkp -> header.stats.block_length, 18) - 1 by 2; 831 link_ptr = addrel (linkp, j); 832 if link_ptr -> link.ft2 = Its_mod /* snapped link */ 833 then if link_ptr -> link.run_depth > 0 /* snapped during run unit */ 834 then link_ptr -> based_bit = addrel (linkp -> header.original_linkage_ptr, j) -> based_bit; 835 end; 836 837 return; 838 839 end; 840 841 cleanup_old_linkage_section: 842 proc (segno); 843 844 /* This procedure does what term_ does but in the outer environment (except terminating). */ 845 846 dcl segno fixed bin; 847 848 call link_unsnap_ (lotp, isotp, (outer_env_linkage_ptr), hcscnt, highseg); 849 if saved_ptrs.sys_link_info_ptr ^= null 850 then do; /* there are *system links */ 851 tp = saved_ptrs.sys_link_info_ptr; 852 do j = lbound (tp -> variable_table_header.hash_table, 1) 853 to hbound (tp -> variable_table_header.hash_table, 1); 854 do np = tp -> variable_table_header.hash_table (j) repeat np -> variable_node.forward_thread 855 while (np ^= null); 856 if bin (baseno (np -> variable_node.init_ptr), 15) = i 857 then do; /* zap init ptrs to terminated seg */ 858 np -> variable_node.init_ptr = null; 859 np -> variable_node.seg_ptr = null; 860 end; 861 862 end; 863 end; 864 end; 865 866 /* now free static and linkage */ 867 if isotp -> isot.isp (segno) ^= outer_env_linkage_ptr 868 then if isotp -> isot1 (segno).flags.fault ^= "11"b 869 then do; /* have separate static section to free */ 870 free isotp -> isot.isp (segno) -> static_section; 871 end; 872 unspec (isotp -> isot.isp (segno)) = "0"b; /* 0 the isot slot to be discarded */ 873 free outer_env_linkage_ptr -> linkage_section; 874 unspec (lotp -> lot.lp (segno)) = "0"b; 875 876 return; 877 878 end /* cleanup_old_linkage_section */; 879 880 find_area_components: 881 proc (a_area_ptr); 882 883 /* this subroutine turns on a bit in the perprocess array for each segment 884* contained in the given area. */ 885 886 dcl (a_area_ptr, area_ptr) 887 ptr; 888 dcl ii fixed bin; 889 890 area_ptr = a_area_ptr; 891 do ii = 1 to 500 while (area_ptr ^= null); /* set limit to avoid infinite loop */ 892 perprocess_array (bin (baseno (area_ptr), 15)) = "1"b; 893 if area_ptr -> area_header.extend_info 894 then area_ptr = addrel (area_ptr, area_ptr -> area_header.extend_info) -> extend_block.next_area; 895 else area_ptr = null; 896 end; 897 898 end; 899 900 free_vla_common: 901 proc (); 902 903 dcl node_ptr ptr; 904 dcl hash_index fixed bin; 905 906 if table_ptr -> variable_table_header.cur_num_of_variables < 1 907 then return; 908 909 do hash_index = lbound (table_ptr -> variable_table_header.hash_table, 1) 910 to hbound (table_ptr -> variable_table_header.hash_table, 1); 911 912 node_ptr = table_ptr -> variable_table_header.hash_table (hash_index); 913 do while (node_ptr ^= null); 914 if node_ptr -> variable_node.vbl_size > sys_info$max_seg_size 915 then call fortran_storage_manager_$free (node_ptr); 916 node_ptr = node_ptr -> variable_node.forward_thread; 917 end; 918 end; 919 920 return; 921 end; 922 923 environment_info: 924 entry (asp, ep, ecode); 925 926 /* This entry returns stack header information which is relevant for a given stack frame */ 927 928 dcl (asp, ep) ptr; 929 dcl ecode fixed bin (35); 930 931 ecode = 0; 932 933 if in_run & (bin (rel (asp), 18) < bin (rel (run_sp), 18)) 934 then do; 935 ep -> env_ptrs = saved_ptrs; 936 end; 937 938 else do; /* in run unit; return current info */ 939 sb = ptr (addr (sb), 0); 940 ep -> env_ptrs.lot_ptr = sb -> stack_header.lot_ptr; 941 ep -> env_ptrs.isot_ptr = sb -> stack_header.isot_ptr; 942 ep -> env_ptrs.clr_ptr = sb -> stack_header.clr_ptr; 943 ep -> env_ptrs.combined_stat_ptr = sb -> stack_header.combined_stat_ptr; 944 ep -> env_ptrs.user_free_ptr = sb -> stack_header.user_free_ptr; 945 ep -> env_ptrs.sys_link_info_ptr = sb -> stack_header.sys_link_info_ptr; 946 ep -> env_ptrs.rnt_ptr = sb -> stack_header.rnt_ptr; 947 ep -> env_ptrs.sct_ptr = sb -> stack_header.sct_ptr; 948 end; 949 950 return; 951 952 stop_run: 953 entry; 954 955 /* This entry is a command and is also called by the PL/I and fortran stop statements */ 956 957 if in_run 958 then do; /* set up structure for signalling finish */ 959 finish_info.header.length = size (finish_info); 960 finish_info.header.version = 1; 961 string (finish_info.header.action_flags) = "0"b; 962 finish_info.header.default_restart = "1"b; 963 finish_info.header.info_string = ""; 964 finish_info.header.status_code = 0; 965 finish_info.type = "run"; 966 call signal_ ("finish", null, addr (finish_info)); 967 968 goto static_abort_label; 969 end; 970 971 else do; 972 signal command_abort_; 973 return; 974 end; 975 1 1 /* BEGIN INCLUDE FILE ... run_control_structure.incl.pl1 */ 1 2 1 3 /* written 3 April 1979 by Melanie Weaver */ 1 4 1 5 declare run_cs_ptr pointer; 1 6 1 7 declare 1 run_control_structure 1 8 aligned based (run_cs_ptr), 1 9 2 version fixed bin, 1 10 2 flags aligned, 1 11 3 ec bit (1) unaligned, /* on if run_ is to call exec_com */ 1 12 3 pad bit (35) unaligned, 1 13 2 reference_name_switch 1 14 fixed bin, /* indicates what reference names are used in run unit */ 1 15 2 time_limit fixed bin (35); /* interval in cpu seconds after which program is 1 16* to be interrupted */ 1 17 1 18 declare NEW_REFERENCE_NAMES fixed bin internal static options (constant) init (0); 1 19 declare COPY_REFERENCE_NAMES fixed bin internal static options (constant) init (1); 1 20 declare OLD_REFERENCE_NAMES fixed bin internal static options (constant) init (2); 1 21 1 22 declare run_control_structure_version_1 1 23 fixed bin internal static options (constant) init (1); 1 24 1 25 /* END INCLUDE FILE ... run_control_structure.incl.pl1 */ 976 977 2 1 /* BEGIN INCLUDE FILE ... env_ptrs.incl.pl1 */ 2 2 2 3 /* coded December 19, 1977 by Melanie Weaver */ 2 4 2 5 dcl 1 env_ptrs aligned based, 2 6 2 version fixed bin, 2 7 2 pad fixed bin (35), 2 8 2 lot_ptr ptr, 2 9 2 isot_ptr ptr, 2 10 2 clr_ptr ptr, 2 11 2 combined_stat_ptr ptr, 2 12 2 user_free_ptr ptr, 2 13 2 sys_link_info_ptr ptr, 2 14 2 rnt_ptr ptr, 2 15 2 sct_ptr ptr; 2 16 2 17 /* END INCLUDE FILE ... env_ptrs.incl.pl1 */ 978 979 980 3 1 /* BEGIN INCLUDE FILE -- lot.incl.pl1 S.Webber 9/74, Modified by R. Bratt 04/76, modified by M. Weaver 7/76 */ 3 2 /* modified by M. Weaver 3/77 */ 3 3 3 4 dcl lotp ptr; 3 5 3 6 dcl 1 lot based (lotp) aligned, 3 7 2 lp (0:9999) ptr unaligned; /* array of packed pointers to linkage sections */ 3 8 3 9 dcl lot_fault bit (36) aligned static options (constant) init ("111000000000000000000000000000000000"b); 3 10 /* lot fault has fault code = 0 and offset = 0 */ 3 11 3 12 dcl isotp ptr; 3 13 dcl 1 isot based (isotp) aligned, 3 14 2 isp (0:9999) ptr unaligned; 3 15 3 16 dcl 1 isot1 (0 :9999) aligned based, 3 17 2 flags unaligned, 3 18 3 fault bit (2) unaligned, 3 19 3 system bit (1) unaligned, 3 20 3 mbz bit (6) unaligned, 3 21 2 fault_code fixed bin (8) unaligned, 3 22 2 static_offset bit (18) unaligned; 3 23 3 24 3 25 /* END INCLUDE FILE lot.incl.pl1 */ 981 982 4 1 /* BEGIN INCLUDE FILE area_info.incl.pl1 12/75 */ 4 2 4 3 dcl area_info_version_1 fixed bin static init (1) options (constant); 4 4 4 5 dcl area_infop ptr; 4 6 4 7 dcl 1 area_info aligned based (area_infop), 4 8 2 version fixed bin, /* version number for this structure is 1 */ 4 9 2 control aligned like area_control, /* control bits for the area */ 4 10 2 owner char (32) unal, /* creator of the area */ 4 11 2 n_components fixed bin, /* number of components in the area (returned only) */ 4 12 2 size fixed bin (18), /* size of the area in words */ 4 13 2 version_of_area fixed bin, /* version of area (returned only) */ 4 14 2 areap ptr, /* pointer to the area (first component on multisegment area) */ 4 15 2 allocated_blocks fixed bin, /* number of blocks allocated */ 4 16 2 free_blocks fixed bin, /* number of free blocks not in virgin */ 4 17 2 allocated_words fixed bin (30), /* number of words allocated in the area */ 4 18 2 free_words fixed bin (30); /* number of words free in area not in virgin */ 4 19 4 20 dcl 1 area_control aligned based, 4 21 2 extend bit (1) unal, /* says area is extensible */ 4 22 2 zero_on_alloc bit (1) unal, /* says block gets zerod at allocation time */ 4 23 2 zero_on_free bit (1) unal, /* says block gets zerod at free time */ 4 24 2 dont_free bit (1) unal, /* debugging aid, turns off free requests */ 4 25 2 no_freeing bit (1) unal, /* for allocation method without freeing */ 4 26 2 system bit (1) unal, /* says area is managed by system */ 4 27 2 pad bit (30) unal; 4 28 4 29 /* END INCLUDE FILE area_info.incl.pl1 */ 983 984 985 5 1 /* BEGIN INCLUDE FILE area_structures.incl.pl1 10/75 */ 5 2 /* Modified September 1981 by J. Bongiovanni for allocation_p_clock */ 5 3 5 4 dcl area_version_1 fixed bin static init (1); /* version number for this area format */ 5 5 5 6 dcl areap ptr; 5 7 5 8 dcl 1 area_header aligned based (areap), 5 9 2 version fixed bin (35), /* 0 for buddy system, 1 for current areas */ 5 10 2 last_usable bit (18), /* rel pointer to end of area */ 5 11 2 next_virgin bit (18), /* rel pointer to next slot in virgin territory */ 5 12 2 flags, 5 13 3 extend bit (1) unal, /* says area is extensible */ 5 14 3 zero_on_alloc bit (1) unal, /* says to zero after allocation */ 5 15 3 zero_on_free bit (1) unal, /* says to zero after freeing */ 5 16 3 dont_free bit (1) unal, /* dont honor free request -- debugging tool */ 5 17 3 defined_by_call bit (1) unal, /* says area seg got via define_area_ call */ 5 18 3 system bit (1) unal, /* ayss area is managed by the system */ 5 19 3 mbz bit (30) unal, 5 20 2 allocation_method fixed bin, /* 0 is standard, 1 is no_freeing method */ 5 21 2 last_size bit (18), /* size of last allocated block before virgin territory */ 5 22 2 last_block bit (18), /* rel pointer to last allocated block before virgin territory */ 5 23 2 freep (3:16), /* free list info */ 5 24 3 relp bit (18) unal, /* pointer to first block on list */ 5 25 3 max_block_size bit (18) unal, /* size of largest block on list, if known. else zero */ 5 26 2 allocation_p_clock bit (36) aligned, /* counter to prevent IPS race */ 5 27 2 extend_info bit (18) unal, /* offset to extend info block */ 5 28 2 recovery_info bit (18) unal, /* eventually will hold recovery info relp */ 5 29 2 n_allocated fixed bin (17) unal, /* number of allocated blocks */ 5 30 2 n_free fixed bin (17) unal; /* number of free blocks */ 5 31 5 32 dcl (STANDARD_ALLOCATION_METHOD init (0), 5 33 NO_FREEING_ALLOCATION_METHOD init (1) 5 34 ) fixed bin internal static; 5 35 5 36 dcl extend_blockp ptr; 5 37 5 38 dcl 1 extend_block aligned based (extend_blockp), /* contents of extend block for extensible areas */ 5 39 2 first_area ptr unal, /* pointer to first area */ 5 40 2 next_area ptr unal, /* pointer to next area in chain */ 5 41 2 sequence_no fixed bin, /* sequence number for this component */ 5 42 2 name char (32), /* owner of the area */ 5 43 2 pad fixed; /* brings it to an even, 12 word allocation */ 5 44 5 45 dcl alloc_blkhdrsz static internal init(2); 5 46 dcl 1 no_free_area_header aligned based(areap), /* overlay for no_free areas */ 5 47 2 pad(4) ptr, 5 48 2 current_component ptr; /* points to component from which we are allocating */ 5 49 5 50 dcl blockp ptr; 5 51 5 52 dcl 1 block aligned based (blockp), /* declaration for block header */ 5 53 2 prev_size bit (18) unal, /* size of preceding block */ 5 54 2 cur_size bit (18) unal, /* size of current block */ 5 55 2 buddy_pad bit (8) unal, /* non_zero for buddy system area */ 5 56 2 prev_busy bit (1) unal, /* previous-block-is-used flag */ 5 57 2 marked bit (1) unal, 5 58 2 q_no bit (8) unal, /* stratum number when in free list */ 5 59 2 header bit (18) unal, /* pointer to head of area */ 5 60 2 fp bit (18) unal, /* forward free list thread */ 5 61 2 bp bit (18) unal; /* backward free list thread */ 5 62 5 63 dcl min_block_size fixed bin static init (8); /* minimum allowed block size */ 5 64 5 65 /* END INCLUDE FILE area_structures.incl.pl1 */ 986 987 6 1 /* BEGIN INCLUDE FILE RNT.INCL.PL1 - WRITTEN SEPTEMBER 1974 BY R. BRATT */ 6 2 /* modified July 1976 by R. Bratt; updated March 1977 by M. Weaver */ 6 3 /* modified November 1977 by M. Weaver to use PL/I offsets instead of pointers */ 6 4 6 5 dcl (rntp, rntep) ptr; 6 6 dcl lth fixed bin (17); 6 7 dcl based_rnt_area area based; 6 8 6 9 dcl 1 rnt aligned based (rntp), 6 10 2 areap ptr, /* pointer to area for rnte allocations */ 6 11 2 meters, 6 12 3 insert, 6 13 4 trys fixed bin (17) unaligned, 6 14 4 wins fixed bin (17) unaligned, 6 15 3 get_segno like insert, 6 16 3 get_refnames like insert, 6 17 3 delete_segno like insert, 6 18 3 delete_name like insert, 6 19 2 rnt_area_size fixed bin, 6 20 2 srulep ptr, 6 21 2 name_hash_table (0:127) offset (rnt.areap -> based_rnt_area), 6 22 2 segno_hash_table (0:127) offset (rnt.areap -> based_rnt_area); 6 23 6 24 dcl 1 rnte aligned based (rntep), 6 25 2 name_fp offset (rnt.areap -> based_rnt_area), 6 26 2 segno_fp offset (rnt.areap -> based_rnt_area), 6 27 (2 segno fixed bin (17), 6 28 2 length fixed bin (17), 6 29 2 name char (lth refer (rnte.length)))unaligned; 6 30 6 31 /* --------------------END RNT.INCL.PL1--------------------- */ 988 989 7 1 /* BEGIN INCLUDE FILE ... stack_header.incl.pl1 .. 3/72 Bill Silver */ 7 2 /* modified 7/76 by M. Weaver for *system links and more system use of areas */ 7 3 /* modified 3/77 by M. Weaver to add rnt_ptr */ 7 4 /* Modified April 1983 by C. Hornig for tasking */ 7 5 7 6 /****^ HISTORY COMMENTS: 7 7* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396), 7 8* audit(86-08-05,Schroth), install(86-11-03,MR12.0-1206): 7 9* added the heap_header_ptr definition. 7 10* 2) change(86-08-12,Kissel), approve(86-08-12,MCR7473), 7 11* audit(86-10-10,Fawcett), install(86-11-03,MR12.0-1206): 7 12* Modified to support control point management. These changes were actually 7 13* made in February 1985 by G. Palter. 7 14* 3) change(86-10-22,Fawcett), approve(86-10-22,MCR7473), 7 15* audit(86-10-22,Farley), install(86-11-03,MR12.0-1206): 7 16* Remove the old_lot pointer and replace it with cpm_data_ptr. Use the 18 7 17* bit pad after cur_lot_size for the cpm_enabled. This was done to save some 7 18* space int the stack header and change the cpd_ptr unal to cpm_data_ptr 7 19* (ITS pair). 7 20* END HISTORY COMMENTS */ 7 21 7 22 /* format: style2 */ 7 23 7 24 dcl sb ptr; /* the main pointer to the stack header */ 7 25 7 26 dcl 1 stack_header based (sb) aligned, 7 27 2 pad1 (4) fixed bin, /* (0) also used as arg list by outward_call_handler */ 7 28 2 cpm_data_ptr ptr, /* (4) pointer to control point which owns this stack */ 7 29 2 combined_stat_ptr ptr, /* (6) pointer to area containing separate static */ 7 30 2 clr_ptr ptr, /* (8) pointer to area containing linkage sections */ 7 31 2 max_lot_size fixed bin (17) unal, /* (10) DU number of words allowed in lot */ 7 32 2 main_proc_invoked fixed bin (11) unal, /* (10) DL nonzero if main procedure invoked in run unit */ 7 33 2 have_static_vlas bit (1) unal, /* (10) DL "1"b if (very) large arrays are being used in static */ 7 34 2 pad4 bit (2) unal, 7 35 2 run_unit_depth fixed bin (2) unal, /* (10) DL number of active run units stacked */ 7 36 2 cur_lot_size fixed bin (17) unal, /* (11) DU number of words (entries) in lot */ 7 37 2 cpm_enabled bit (18) unal, /* (11) DL non-zero if control point management is enabled */ 7 38 2 system_free_ptr ptr, /* (12) pointer to system storage area */ 7 39 2 user_free_ptr ptr, /* (14) pointer to user storage area */ 7 40 2 null_ptr ptr, /* (16) */ 7 41 2 stack_begin_ptr ptr, /* (18) pointer to first stack frame on the stack */ 7 42 2 stack_end_ptr ptr, /* (20) pointer to next useable stack frame */ 7 43 2 lot_ptr ptr, /* (22) pointer to the lot for the current ring */ 7 44 2 signal_ptr ptr, /* (24) pointer to signal procedure for current ring */ 7 45 2 bar_mode_sp ptr, /* (26) value of sp before entering bar mode */ 7 46 2 pl1_operators_ptr ptr, /* (28) pointer to pl1_operators_$operator_table */ 7 47 2 call_op_ptr ptr, /* (30) pointer to standard call operator */ 7 48 2 push_op_ptr ptr, /* (32) pointer to standard push operator */ 7 49 2 return_op_ptr ptr, /* (34) pointer to standard return operator */ 7 50 2 return_no_pop_op_ptr 7 51 ptr, /* (36) pointer to standard return / no pop operator */ 7 52 2 entry_op_ptr ptr, /* (38) pointer to standard entry operator */ 7 53 2 trans_op_tv_ptr ptr, /* (40) pointer to translator operator ptrs */ 7 54 2 isot_ptr ptr, /* (42) pointer to ISOT */ 7 55 2 sct_ptr ptr, /* (44) pointer to System Condition Table */ 7 56 2 unwinder_ptr ptr, /* (46) pointer to unwinder for current ring */ 7 57 2 sys_link_info_ptr ptr, /* (48) pointer to *system link name table */ 7 58 2 rnt_ptr ptr, /* (50) pointer to Reference Name Table */ 7 59 2 ect_ptr ptr, /* (52) pointer to event channel table */ 7 60 2 assign_linkage_ptr ptr, /* (54) pointer to storage for (obsolete) hcs_$assign_linkage */ 7 61 2 heap_header_ptr ptr, /* (56) pointer to the heap header for this ring */ 7 62 2 trace, 7 63 3 frames, 7 64 4 count fixed bin, /* (58) number of trace frames */ 7 65 4 top_ptr ptr unal, /* (59) pointer to last trace frame */ 7 66 3 in_trace bit (36) aligned, /* (60) trace antirecursion flag */ 7 67 2 pad2 bit (36), /* (61) */ 7 68 2 pad5 pointer; /* (62) pointer to future stuff */ 7 69 7 70 /* The following offset refers to a table within the pl1 operator table. */ 7 71 7 72 dcl tv_offset fixed bin init (361) internal static; 7 73 /* (551) octal */ 7 74 7 75 7 76 /* The following constants are offsets within this transfer vector table. */ 7 77 7 78 dcl ( 7 79 call_offset fixed bin init (271), 7 80 push_offset fixed bin init (272), 7 81 return_offset fixed bin init (273), 7 82 return_no_pop_offset fixed bin init (274), 7 83 entry_offset fixed bin init (275) 7 84 ) internal static; 7 85 7 86 7 87 7 88 7 89 7 90 /* The following declaration is an overlay of the whole stack header. Procedures which 7 91* move the whole stack header should use this overlay. 7 92**/ 7 93 7 94 dcl stack_header_overlay (size (stack_header)) fixed bin based (sb); 7 95 7 96 7 97 7 98 /* END INCLUDE FILE ... stack_header.incl.pl1 */ 990 991 8 1 /* BEGIN INCLUDE FILE linkdcl.incl.pl1 --- last modified 15 Nov 1971 by C Garman */ 8 2 8 3 /* Last Modified (Date and Reason): 8 4* 6/75 by M.Weaver to add virgin_linkage_header declaration 8 5* 6/75 by S.Webber to comment existing structures better 8 6* 9/77 by M. Weaver to add run_depth to link 8 7* 2/83 by M. Weaver to add linkage header flags and change run_depth precision 8 8**/ 8 9 8 10 /* format: style3 */ 8 11 dcl 1 link based aligned, /* link pair in linkage section */ 8 12 2 head_ptr bit (18) unal, /* rel pointer to beginning of linkage section */ 8 13 2 ringno bit (3) unal, 8 14 2 mbz bit (6) unal, 8 15 2 run_depth fixed bin (2) unal, /* run unit depth, filled when link is snapped */ 8 16 2 ft2 bit (6) unal, /* fault tag. 46(8) if not snapped, 43(8) if snapped */ 8 17 2 exp_ptr bit (18) unal, /* pointer (rel to defs) of expression word */ 8 18 2 mbz2 bit (12) unal, 8 19 2 modifier bit (6) unal; /* modifier to be left in snapped link */ 8 20 8 21 dcl 1 exp_word based aligned, /* expression word in link definition */ 8 22 2 type_ptr bit (18) unal, /* pointer (rel to defs) of type pair structure */ 8 23 2 exp bit (18) unal; /* constant expression to be added in when snapping link */ 8 24 8 25 dcl 1 type_pair based aligned, /* type pair in link definition */ 8 26 2 type bit (18) unal, /* type of link. may be 1,2,3,4,5, or 6 */ 8 27 2 trap_ptr bit (18) unal, /* pointer (rel to defs) to the trap word */ 8 28 2 seg_ptr bit (18) unal, /* pointer to ACC reference name for segment referenced */ 8 29 2 ext_ptr bit (18) unal; /* pointer (rel to defs) of ACC segdef name */ 8 30 8 31 dcl 1 header based aligned, /* linkage block header */ 8 32 2 def_ptr ptr, /* pointer to definition section */ 8 33 2 symbol_ptr ptr unal, /* pointer to symbol section in object segment */ 8 34 2 original_linkage_ptr 8 35 ptr unal, /* pointer to linkage section in object segment */ 8 36 2 unused bit (72), 8 37 2 stats, 8 38 3 begin_links bit (18) unal, /* offset (rel to this section) of first link */ 8 39 3 block_length bit (18) unal, /* number of words in this linkage section */ 8 40 3 segment_number 8 41 bit (18) unal, /* text segment number associated with this section */ 8 42 3 static_length bit (18) unal; /* number of words of static for this segment */ 8 43 8 44 dcl 1 linkage_header_flags 8 45 aligned based, /* overlay of def_ptr for flags */ 8 46 2 pad1 bit (28) unaligned, /* flags are in first word */ 8 47 2 static_vlas bit (1) unaligned, /* static section "owns" some LA/VLA segments */ 8 48 2 perprocess_static 8 49 bit (1) unaligned, /* 1 copy of static section is used by all tasks/run units */ 8 50 2 pad2 bit (6) unaligned; 8 51 8 52 dcl 1 virgin_linkage_header 8 53 aligned based, /* template for linkage header in object segment */ 8 54 2 pad bit (30) unaligned, /* is filled in by linker */ 8 55 2 defs_in_link bit (6) unaligned, /* =o20 if defs in linkage (nonstandard) */ 8 56 2 def_offset bit (18) unaligned, /* offset of definition section */ 8 57 2 first_ref_relp bit (18) unaligned, /* offset of trap-at-first-reference offset array */ 8 58 2 filled_in_later bit (144), 8 59 2 link_begin bit (18) unaligned, /* offset of first link */ 8 60 2 linkage_section_lng 8 61 bit (18) unaligned, /* length of linkage section */ 8 62 2 segno_pad bit (18) unaligned, /* will be segment number of copied linkage */ 8 63 2 static_length bit (18) unaligned; /* length of static section */ 8 64 8 65 8 66 dcl 1 trap_word based aligned, /* trap word in link definition */ 8 67 2 call_ptr bit (18) unal, /* pointer (rel to link) of link to trap procedure */ 8 68 2 arg_ptr bit (18) unal; /* pointer (rel to link) of link to arg info for trap proc */ 8 69 8 70 dcl 1 name based aligned, /* storage of ASCII names in definitions */ 8 71 2 nchars bit (9) unaligned, /* number of characters in name */ 8 72 2 char_string char (31) unaligned; /* 31-character name */ 8 73 8 74 /* END INCLUDE FILE linkdcl.incl.pl1 */ 992 993 994 995 996 997 998 9 1 /* BEGIN INCLUDE FILE ... system_link_names.incl.pl1 */ 9 2 9 3 9 4 /****^ HISTORY COMMENTS: 9 5* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396), audit(86-11-12,Zwick), 9 6* install(86-11-20,MR12.0-1222): 9 7* added the declaration of the heap_header. 9 8* 2) change(86-10-20,DGHowe), approve(86-10-20,MCR7420), audit(86-11-12,Zwick), 9 9* install(86-11-20,MR12.0-1222): 9 10* add the seg ptr to the variable node structure. 9 11* END HISTORY COMMENTS */ 9 12 9 13 9 14 /* created by M. Weaver 7/28/76 */ 9 15 /* Modified: 82-11-19 by T. Oke to add LIST_TEMPLATE_INIT. */ 9 16 /* Modified 02/11/83 by M. Weaver to add have_vla_variables flag */ 9 17 9 18 9 19 dcl 1 variable_table_header aligned based, /* header for name table */ 9 20 2 hash_table (0:63) ptr unaligned, /* hash table for variable nodes */ 9 21 2 total_search_time fixed bin (71), /* total time to search for variables */ 9 22 2 total_allocation_time fixed bin (71), /* total time spent allocating and initializing nodes and variables */ 9 23 2 number_of_searches fixed bin, /* number of times names were looked up */ 9 24 2 number_of_variables fixed bin (35), /* number of variables allocated by the linker, incl deletions */ 9 25 2 flags unaligned, 9 26 3 have_vla_variables bit (1) unaligned, /* on if some variables are > sys_info$max_seg_size */ 9 27 3 pad bit (11) unaligned, 9 28 2 cur_num_of_variables fixed bin (24) unal, /* current number of variables allocated */ 9 29 2 number_of_steps fixed bin, /* total number of nodes looked at */ 9 30 2 total_allocated_size fixed bin (35); /* current amount of storage in user area */ 9 31 9 32 9 33 dcl 1 variable_node aligned based, /* individual variable information */ 9 34 2 forward_thread ptr unaligned, /* thread to next node off same hash bucket */ 9 35 2 vbl_size fixed bin (24) unsigned unaligned, /* length in words of variable */ 9 36 2 init_type fixed bin (11) unaligned, /* 0=not init; 3=init template; 4=area 5=list_template*/ 9 37 2 time_allocated fixed bin (71), /* time when variable was allocated */ 9 38 2 vbl_ptr ptr, /* pointer to variable's storage */ 9 39 2 init_ptr ptr, /* pointer to original init info in object seg */ 9 40 2 name_size fixed bin(21) aligned, /* length of name in characters */ 9 41 2 name char (nchars refer (variable_node.name_size)), /* name of variable */ 9 42 2 seg_ptr pointer; 9 43 9 44 /* variable_node.seg_ptr 9 45* Is a pointer to the segment containing the initialization information 9 46* for this variable. It is used as a segment base pointer for external 9 47* pointer initialization via list_init_. 9 48* 9 49* The init_ptr can not be used as a reference to the defining segment 9 50* due to the possibility of set_fortran_common being used to initialize 9 51* the external variables. sfc will generate an initialization information 9 52* structure if multiple intialization sizes are found in the specified 9 53* segments. sfc stores the address of this structure in the init_ptr field. 9 54* This is one reason why sfc does not perform external pointer 9 55* initialization. 9 56* 9 57* The seg_ptr is set to point at the segment used to define the 9 58* initialization information. term_ sets this field to null on termination 9 59* due to the possiblity of executing a different segment which defines 9 60* initialization information. In this way the seg_ptr field will either 9 61* be valid or null. 9 62**/ 9 63 9 64 dcl 1 heap_header based, 9 65 2 version char(8), /* specifies the verison of the header */ 9 66 2 heap_name_list_ptr pointer, /* points to the variable_table_header for this heap */ 9 67 2 previous_heap_ptr pointer, /* points to the previous heap or is null */ 9 68 2 area_ptr pointer, /* points to the heap area */ 9 69 2 execution_level fixed bin (17); /* specifies the execution level this header deals with */ 9 70 9 71 dcl heap_header_version_1 char(8) static options (constant) 9 72 init ("Heap_v01"); 9 73 9 74 9 75 /* END INCLUDE FILE ... system_link_names.incl.pl1 */ 999 1000 10 1 /* BEGIN INCLUDE FILE ... stack_frame.incl.pl1 ... */ 10 2 10 3 /* format: off */ 10 4 10 5 /* Modified: 16 Dec 1977, D. Levin - to add fio_ps_ptr and pl1_ps_ptr */ 10 6 /* Modified: 3 Feb 1978, P. Krupp - to add run_unit_manager bit & main_proc bit */ 10 7 /* Modified: 21 March 1978, D. Levin - change fio_ps_ptr to support_ptr */ 10 8 /* Modified: 03/01/84, S. Herbst - Added RETURN_PTR_MASK */ 10 9 10 10 10 11 /****^ HISTORY COMMENTS: 10 12* 1) change(86-09-15,Kissel), approve(86-09-15,MCR7473), 10 13* audit(86-10-01,Fawcett), install(86-11-03,MR12.0-1206): 10 14* Modified to add constants for the translator_id field in the stack_frame 10 15* structure. 10 16* END HISTORY COMMENTS */ 10 17 10 18 10 19 dcl RETURN_PTR_MASK bit (72) int static options (constant) /* mask to be AND'd with stack_frame.return_ptr */ 10 20 init ("777777777777777777000000"b3); /* when copying, to ignore bits that a call fills */ 10 21 /* with indicators (nonzero for Fortran hexfp caller) */ 10 22 /* say: unspec(ptr) = unspec(stack_frame.return_ptr) & RETURN_PTR_MASK; */ 10 23 10 24 dcl TRANSLATOR_ID_PL1V2 bit (18) internal static options (constant) init ("000000"b3); 10 25 dcl TRANSLATOR_ID_ALM bit (18) internal static options (constant) init ("000001"b3); 10 26 dcl TRANSLATOR_ID_PL1V1 bit (18) internal static options (constant) init ("000002"b3); 10 27 dcl TRANSLATOR_ID_SIGNAL_CALLER bit (18) internal static options (constant) init ("000003"b3); 10 28 dcl TRANSLATOR_ID_SIGNALLER bit (18) internal static options (constant) init ("000004"b3); 10 29 10 30 10 31 dcl sp pointer; /* pointer to beginning of stack frame */ 10 32 10 33 dcl stack_frame_min_length fixed bin static init(48); 10 34 10 35 10 36 dcl 1 stack_frame based(sp) aligned, 10 37 2 pointer_registers(0 : 7) ptr, 10 38 2 prev_sp pointer, 10 39 2 next_sp pointer, 10 40 2 return_ptr pointer, 10 41 2 entry_ptr pointer, 10 42 2 operator_and_lp_ptr ptr, /* serves as both */ 10 43 2 arg_ptr pointer, 10 44 2 static_ptr ptr unaligned, 10 45 2 support_ptr ptr unal, /* only used by fortran I/O */ 10 46 2 on_unit_relp1 bit(18) unaligned, 10 47 2 on_unit_relp2 bit(18) unaligned, 10 48 2 translator_id bit(18) unaligned, /* Translator ID (see constants above) 10 49* 0 => PL/I version II 10 50* 1 => ALM 10 51* 2 => PL/I version I 10 52* 3 => signal caller frame 10 53* 4 => signaller frame */ 10 54 2 operator_return_offset bit(18) unaligned, 10 55 2 x(0: 7) bit(18) unaligned, /* index registers */ 10 56 2 a bit(36), /* accumulator */ 10 57 2 q bit(36), /* q-register */ 10 58 2 e bit(36), /* exponent */ 10 59 2 timer bit(27) unaligned, /* timer */ 10 60 2 pad bit(6) unaligned, 10 61 2 ring_alarm_reg bit(3) unaligned; 10 62 10 63 10 64 dcl 1 stack_frame_flags based(sp) aligned, 10 65 2 pad(0 : 7) bit(72), /* skip over prs */ 10 66 2 xx0 bit(22) unal, 10 67 2 main_proc bit(1) unal, /* on if frame belongs to a main procedure */ 10 68 2 run_unit_manager bit(1) unal, /* on if frame belongs to run unit manager */ 10 69 2 signal bit(1) unal, /* on if frame belongs to logical signal_ */ 10 70 2 crawl_out bit(1) unal, /* on if this is a signal caller frame */ 10 71 2 signaller bit(1) unal, /* on if next frame is signaller's */ 10 72 2 link_trap bit(1) unal, /* on if this frame was made by the linker */ 10 73 2 support bit(1) unal, /* on if frame belongs to a support proc */ 10 74 2 condition bit(1) unal, /* on if condition established in this frame */ 10 75 2 xx0a bit(6) unal, 10 76 2 xx1 fixed bin, 10 77 2 xx2 fixed bin, 10 78 2 xx3 bit(25) unal, 10 79 2 old_crawl_out bit (1) unal, /* on if this is a signal caller frame */ 10 80 2 old_signaller bit(1) unal, /* on if next frame is signaller's */ 10 81 2 xx3a bit(9) unaligned, 10 82 2 xx4(9) bit(72) aligned, 10 83 2 v2_pl1_op_ret_base ptr, /* When a V2 PL/I program calls an operator the 10 84* * operator puts a pointer to the base of 10 85* * the calling procedure here. (text base ptr) */ 10 86 2 xx5 bit(72) aligned, 10 87 2 pl1_ps_ptr ptr; /* ptr to ps for this frame; also used by fio. */ 10 88 10 89 /* format: on */ 10 90 10 91 /* END INCLUDE FILE ... stack_frame.incl.pl1 */ 1001 1002 1003 1004 11 1 /* BEGIN INCLUDE FILE condition_info_header.incl.pl1 BIM 1981 */ 11 2 /* format: style2 */ 11 3 11 4 declare condition_info_header_ptr 11 5 pointer; 11 6 declare 1 condition_info_header 11 7 aligned based (condition_info_header_ptr), 11 8 2 length fixed bin, /* length in words of this structure */ 11 9 2 version fixed bin, /* version number of this structure */ 11 10 2 action_flags aligned, /* tell handler how to proceed */ 11 11 3 cant_restart bit (1) unaligned, /* caller doesn't ever want to be returned to */ 11 12 3 default_restart bit (1) unaligned, /* caller can be returned to with no further action */ 11 13 3 quiet_restart bit (1) unaligned, /* return, and print no message */ 11 14 3 support_signal bit (1) unaligned, /* treat this signal as if the signalling procedure had the support bit set */ 11 15 /* if the signalling procedure had the support bit set, do the same for its caller */ 11 16 3 pad bit (32) unaligned, 11 17 2 info_string char (256) varying, /* may contain printable message */ 11 18 2 status_code fixed bin (35); /* if^=0, code interpretable by com_err_ */ 11 19 11 20 /* END INCLUDE FILE condition_info_header.incl.pl1 */ 1005 1006 12 1 /* BEGIN INCLUDE FILE ... condition_info.incl.pl1 */ 12 2 12 3 /* Structure for find_condition_info_. 12 4* 12 5* Written 1-Mar-79 by M. N. Davidoff. 12 6**/ 12 7 12 8 /* automatic */ 12 9 12 10 declare condition_info_ptr pointer; 12 11 12 12 /* based */ 12 13 12 14 declare 1 condition_info aligned based (condition_info_ptr), 12 15 2 mc_ptr pointer, /* pointer to machine conditions at fault time */ 12 16 2 version fixed binary, /* Must be 1 */ 12 17 2 condition_name char (32) varying, /* name of condition */ 12 18 2 info_ptr pointer, /* pointer to the condition data structure */ 12 19 2 wc_ptr pointer, /* pointer to wall crossing machine conditions */ 12 20 2 loc_ptr pointer, /* pointer to location where condition occured */ 12 21 2 flags unaligned, 12 22 3 crawlout bit (1), /* on if condition occured in lower ring */ 12 23 3 pad1 bit (35), 12 24 2 pad2 bit (36), 12 25 2 user_loc_ptr pointer, /* ptr to most recent nonsupport loc before condition occurred */ 12 26 2 pad3 (4) bit (36); 12 27 12 28 /* internal static */ 12 29 12 30 declare condition_info_version_1 12 31 fixed binary internal static options (constant) initial (1); 12 32 12 33 /* END INCLUDE FILE ... condition_info.incl.pl1 */ 1007 1008 1009 1010 1011 1012 1013 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/00 1140.5 run_.pl1 >udd>sm>ds>w>ml>run_.pl1 976 1 03/27/82 0539.3 run_control_structure.incl.pl1 >ldd>incl>run_control_structure.incl.pl1 978 2 07/24/78 1804.7 env_ptrs.incl.pl1 >ldd>incl>env_ptrs.incl.pl1 981 3 08/05/77 1122.4 lot.incl.pl1 >ldd>incl>lot.incl.pl1 983 4 06/11/76 1143.4 area_info.incl.pl1 >ldd>incl>area_info.incl.pl1 986 5 09/14/81 1447.6 area_structures.incl.pl1 >ldd>incl>area_structures.incl.pl1 988 6 01/27/78 1811.4 rnt.incl.pl1 >ldd>incl>rnt.incl.pl1 990 7 11/07/86 1650.3 stack_header.incl.pl1 >ldd>incl>stack_header.incl.pl1 992 8 07/27/83 1010.0 linkdcl.incl.pl1 >ldd>incl>linkdcl.incl.pl1 999 9 11/24/86 1326.9 system_link_names.incl.pl1 >ldd>incl>system_link_names.incl.pl1 1001 10 11/07/86 1650.3 stack_frame.incl.pl1 >ldd>incl>stack_frame.incl.pl1 1005 11 03/24/82 1447.2 condition_info_header.incl.pl1 >ldd>incl>condition_info_header.incl.pl1 1007 12 06/28/79 1304.8 condition_info.incl.pl1 >ldd>incl>condition_info.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. COPY_REFERENCE_NAMES constant fixed bin(17,0) initial dcl 1-19 ref 170 253 Its_mod constant bit(6) initial dcl 57 ref 832 NEW_REFERENCE_NAMES constant fixed bin(17,0) initial dcl 1-18 ref 172 353 OLD_REFERENCE_NAMES constant fixed bin(17,0) initial dcl 1-20 ref 248 430 771 a_area_ptr parameter pointer dcl 886 ref 880 890 action_flags 2 002162 automatic structure level 3 dcl 75 set ref 961* addr builtin function dcl 104 ref 168 238 238 276 276 287 287 320 320 353 353 727 727 939 966 966 addrel builtin function dcl 104 ref 195 231 262 266 400 540 540 590 596 671 671 804 805 831 832 893 ainfo 002136 automatic structure level 1 dcl 73 set ref 238 238 276 276 answer 000100 automatic varying char(10) dcl 717 set ref 727* 729 any_other 002324 stack reference condition dcl 111 ref 326 area_control based structure level 1 dcl 4-20 area_header based structure level 1 dcl 5-8 area_info based structure level 1 dcl 4-7 area_info_version_1 constant fixed bin(17,0) initial dcl 4-3 ref 228 area_ptr 000136 automatic pointer dcl 886 in procedure "find_area_components" set ref 890* 891 892 893 893* 893 893 895* area_ptr 000306 automatic pointer dcl 59 in procedure "run_" set ref 162* 231* 252 346 347 348 453* 775 775* areap based pointer level 2 in structure "rnt" dcl 6-9 in procedure "run_" set ref 256 262 266 293* 582 590 595* 596 604 areap 16 002136 automatic pointer level 2 in structure "ainfo" dcl 73 in procedure "run_" set ref 231* 275* arglist_ptr parameter pointer dcl 39 set ref 29 373* asp parameter pointer dcl 928 ref 923 933 auto_run_control_structure 002131 automatic structure level 1 dcl 70 set ref 168 based_area based area(1024) dcl 85 ref 252 398 578 791 801 based_array based fixed bin(35,0) array dcl 84 set ref 398 402* 402 404* 404 based_bit based bit(72) dcl 86 set ref 832* 832 based_finish_info based structure level 1 dcl 318 based_rnt_area based area(1024) dcl 6-7 ref 283 baseno builtin function dcl 104 ref 207 509 644 856 892 baseptr builtin function dcl 104 ref 523 523 531 531 540 540 542 671 671 673 begin_links 6 based bit(18) level 3 packed packed unaligned dcl 8-31 ref 830 bin builtin function dcl 104 ref 262 262 266 266 590 590 596 596 790 797 830 830 856 892 933 933 block_length 6(18) based bit(18) level 3 packed packed unaligned dcl 8-31 ref 790 830 ca_ptr parameter pointer dcl 40 ref 29 165 165 169 170 173 cleanup 002332 stack reference condition dcl 111 ref 177 333 360 375 743 clr_ptr 6 000020 internal static pointer level 2 in structure "saved_ptrs" dcl 49 in procedure "run_" set ref 306* 398 438* 441 444 448 578 766 791 clr_ptr 6 based pointer level 2 in structure "env_ptrs" dcl 2-5 in procedure "run_" set ref 942* clr_ptr 10 based pointer level 2 in structure "stack_header" dcl 7-26 in procedure "run_" set ref 306 346* 766* 942 cname parameter char packed unaligned dcl 716 ref 710 code 2 000104 automatic fixed bin(35,0) initial level 2 in structure "query_info" dcl 719 in procedure "interrupt_run" set ref 719* code parameter fixed bin(35,0) dcl 41 in procedure "run_" set ref 29 157* 161* 179* 185* 186 238* 239 276* 277 336* 353* 523* 531* 707* 777* combined_stat_ptr 6 based pointer level 2 in structure "stack_header" dcl 7-26 in procedure "run_" set ref 307 347* 767* 943 combined_stat_ptr 10 000020 internal static pointer level 2 in structure "saved_ptrs" dcl 49 in procedure "run_" set ref 307* 441 441* 444 448 767 801 combined_stat_ptr 10 based pointer level 2 in structure "env_ptrs" dcl 2-5 in procedure "run_" set ref 943* command_abort_ 002346 stack reference condition dcl 111 ref 972 command_query_ 000126 constant entry external dcl 718 ref 727 cond_info 002272 automatic structure level 1 dcl 79 set ref 320 320 condition_info based structure level 1 dcl 12-14 condition_info_header based structure level 1 dcl 11-6 continue_to_signal_ 000114 constant entry external dcl 146 ref 321 323 control 1 002136 automatic structure level 2 dcl 73 set ref 232* control_args based structure level 1 dcl 91 crn 0(01) based bit(1) level 3 packed packed unaligned dcl 91 ref 170 cu_$generate_call 000076 constant entry external dcl 137 ref 373 cur_lot_size 13 based fixed bin(17,0) level 2 packed packed unaligned dcl 7-26 ref 194 391 cur_num_of_variables 106(12) based fixed bin(24,0) level 2 packed packed unaligned dcl 9-19 ref 906 default_restart 2(01) 002162 automatic bit(1) level 4 packed packed unaligned dcl 75 set ref 962* define_area_ 000056 constant entry external dcl 123 ref 238 276 ec based bit(1) level 3 in structure "control_args" packed packed unaligned dcl 91 in procedure "run_" ref 169 ec 1 based bit(1) level 3 in structure "run_control_structure" packed packed unaligned dcl 1-7 in procedure "run_" set ref 169* ecode parameter fixed bin(35,0) dcl 929 set ref 923 931* empty builtin function dcl 104 ref 252 255 578 580 env_ptrs based structure level 1 dcl 2-5 set ref 935* ep parameter pointer dcl 928 ref 923 935 940 941 942 943 944 945 946 947 error_table_$run_unit_not_recursive 000050 external static fixed bin(35,0) dcl 118 ref 157 execute_epilogue_ 000100 constant entry external dcl 138 ref 390 extend 1 002136 automatic bit(1) level 3 packed packed unaligned dcl 73 set ref 233* 272* extend_block based structure level 1 dcl 5-38 extend_info 26 based bit(18) level 2 packed packed unaligned dcl 5-8 ref 893 893 fault based bit(2) array level 3 packed packed unaligned dcl 3-16 ref 867 find_command_$clear 000064 constant entry external dcl 128 ref 331 755 find_condition_info_ 000112 constant entry external dcl 144 ref 320 finish 002340 stack reference condition dcl 111 ref 316 finish_info 002162 automatic structure level 1 dcl 75 set ref 959 966 966 flags based structure level 2 in structure "control_args" dcl 91 in procedure "run_" flags 1 based structure level 2 in structure "run_control_structure" dcl 1-7 in procedure "run_" flags 106 based structure level 2 in structure "variable_table_header" packed packed unaligned dcl 9-19 in procedure "run_" flags based structure array level 2 in structure "isot1" packed packed unaligned dcl 3-16 in procedure "run_" fortran_storage_manager_$free 000124 constant entry external dcl 152 ref 529 548 558 659 679 689 914 fortran_storage_manager_$get_vla_segnos 000122 constant entry external dcl 150 ref 464 forward_thread based pointer level 2 packed packed unaligned dcl 9-33 ref 862 916 ft2 0(30) based bit(6) level 2 packed packed unaligned dcl 8-11 ref 832 get_temp_segment_ 000052 constant entry external dcl 121 ref 185 get_temp_segments_$list_segnos 000102 constant entry external dcl 139 ref 457 hash_index 000152 automatic fixed bin(17,0) dcl 904 set ref 909* 912* hash_table based pointer array level 2 packed packed unaligned dcl 9-19 ref 852 852 854 909 909 912 have_static_vlas 12(30) based bit(1) level 2 packed packed unaligned dcl 7-26 set ref 312 351* 464 773* have_vla_variables 106 based bit(1) level 3 packed packed unaligned dcl 9-19 ref 423 hbound builtin function dcl 104 ref 852 909 hcs_$get_search_rules 000120 constant entry external dcl 148 ref 287 hcs_$high_low_seg_count 000060 constant entry external dcl 124 ref 205 427 hcs_$initiate_search_rules 000062 constant entry external dcl 126 ref 289 hcs_$reset_ips_mask 000070 constant entry external dcl 129 ref 181 242 280 338 357 605 745 752 hcs_$set_ips_mask 000066 constant entry external dcl 129 ref 189 575 749 hcs_$terminate_seg 000104 constant entry external dcl 141 ref 523 531 hcscnt 000110 automatic fixed bin(17,0) dcl 52 set ref 205* 206 206 427* 504 504 540* 638 638 671* 848* header 002162 automatic structure level 2 in structure "finish_info" dcl 75 in procedure "run_" header based structure level 1 dcl 8-31 in procedure "run_" ref 794 804 805 highseg 000111 automatic fixed bin(17,0) dcl 52 set ref 205* 206 427* 504 540* 638 671* 848* i 000100 automatic fixed bin(17,0) dcl 52 set ref 206* 207 209 209 211 211 213 213 216 216 218 218* 459* 460* 504* 505 506 509* 520 520 523 523 526* 531 531 540 540 542 546* 555* 638* 639 640 644* 653 656* 661 671 671 673 677* 685* 856 ii 000140 automatic fixed bin(17,0) dcl 888 set ref 891* in_run 000010 internal static bit(1) initial dcl 45 set ref 155 369* 388 751* 933 957 info_ptr 14 002272 automatic pointer level 2 dcl 79 set ref 321 323 info_string 3 002162 automatic varying char(256) level 3 dcl 75 set ref 963* init_ptr 6 based pointer level 2 dcl 9-33 set ref 856 858* insert 2 based structure level 3 dcl 6-9 isot based structure level 1 dcl 3-13 isot1 based structure array level 1 dcl 3-16 isot_ptr 4 based pointer level 2 in structure "env_ptrs" dcl 2-5 in procedure "run_" set ref 941* isot_ptr 52 based pointer level 2 in structure "stack_header" dcl 7-26 in procedure "run_" set ref 197 345* 412 765* 941 isot_ptr 4 000020 internal static pointer level 2 in structure "saved_ptrs" dcl 49 in procedure "run_" set ref 305* 400* 404 406 765 815 isotp 002360 automatic pointer dcl 3-12 set ref 197* 211 218 224 305 404 406* 540* 671* 848* 867 867 870 872 isp based pointer array level 2 packed packed unaligned dcl 3-13 set ref 211* 211 218* 218 800 809 815* 867 870 872* j 000101 automatic fixed bin(17,0) dcl 52 set ref 830* 831 832* 852* 854* lbound builtin function dcl 104 ref 852 909 length 002162 automatic fixed bin(17,0) level 3 dcl 75 set ref 959* link based structure level 1 dcl 8-11 link_ptr 000332 automatic pointer dcl 59 set ref 831* 832 832 832 link_unsnap_ 000106 constant entry external dcl 142 ref 540 671 848 linkage_header_flags based structure level 1 dcl 8-44 linkage_lng 000106 automatic fixed bin(17,0) dcl 52 set ref 790* 791 792 794* 795 873 linkage_section based fixed bin(35,0) array dcl 89 set ref 791 792* 792 795* 795 873 linkp 000320 automatic pointer dcl 59 set ref 791* 792 795 797 804 809 812 814 829* 830 830 831 832 lot based structure level 1 dcl 3-6 lot_fault constant bit(36) initial dcl 3-9 ref 213 518 520 536 558 653 653 661 666 689 lot_ptr 26 based pointer level 2 in structure "stack_header" dcl 7-26 in procedure "run_" set ref 196 344* 409 764* 940 lot_ptr 2 000020 internal static pointer level 2 in structure "saved_ptrs" dcl 49 in procedure "run_" set ref 304* 398* 400 402 405 764 814 lot_ptr 2 based pointer level 2 in structure "env_ptrs" dcl 2-5 in procedure "run_" set ref 940* lotp 002356 automatic pointer dcl 3-4 set ref 196* 207 209 213 216 304 402 405* 505 520 540* 542 639 653 661 671* 673 829 848* 874 lp based pointer array level 2 packed packed unaligned dcl 3-6 set ref 207 209* 209 213 213* 216* 216 505 506 520* 542* 639 640 653* 661* 673* 814* 829 874* main_entry parameter entry variable dcl 38 set ref 29 373* main_proc_invoked 12(18) based fixed bin(11,0) level 2 packed packed unaligned dcl 7-26 set ref 370* 741* mask 000113 automatic bit(36) dcl 55 set ref 176* 181 181* 181* 189* 242* 242* 280* 280* 338 338* 338* 357* 357* 575* 605* 605* 742* 745 745* 745* 749* 752* 752* max_lot_size 12 based fixed bin(17,0) level 2 packed packed unaligned dcl 7-26 ref 397 400 407 mcptr parameter pointer dcl 715 ref 710 meters 2 based structure level 2 dcl 6-9 name_hash_table 12 based offset array level 2 dcl 6-9 set ref 284* name_size 10 based fixed bin(21,0) level 2 dcl 9-33 ref 859 new_isot_ptr 000302 automatic pointer dcl 59 set ref 195* 211 218 224 231 345 412* 800 809 new_lot_ptr 000300 automatic pointer dcl 59 set ref 193* 195 209 213 216 344 409* 506 640 new_rnt_areap 000310 automatic pointer dcl 59 set ref 252* 255 256 259 262 266 275 283 293 578* 580 582 586 590 595 596 new_rntp 000316 automatic pointer dcl 59 set ref 262* 266 283* 284 285 286 293 294 297* 350 590* 595 596 603 new_sct_ptr 000304 automatic pointer dcl 59 set ref 195* next_area 1 based pointer level 2 packed packed unaligned dcl 5-38 ref 893 node_ptr 000150 automatic pointer dcl 903 set ref 912* 913 914 914* 916* 916 np 000330 automatic pointer dcl 59 set ref 854* 854* 856 858 859* 862 ntemps based fixed bin(17,0) level 2 dcl 97 ref 459 null builtin function dcl 104 ref 162 163 179 284 285 286 320 320 321 336 349 423 754 775 777 849 854 858 859 891 895 913 966 966 nwords 000105 automatic fixed bin(17,0) dcl 52 set ref 397* 398 401* 402 404 old_cur_lot_size 000102 automatic fixed bin(17,0) dcl 52 set ref 194* 195 229 231 391 401 407* old_rnt_area based area dcl 88 ref 604 old_rnt_size 000103 automatic fixed bin(17,0) dcl 52 set ref 602* 604 old_rntp 000314 automatic pointer dcl 59 set ref 601* 604 original_linkage_ptr 3 based pointer level 2 packed packed unaligned dcl 8-31 ref 792 832 outer_env_linkage_ptr 000340 automatic pointer packed unaligned dcl 62 set ref 505* 507 509 509 516 536 639* 642 644 644 651 666 848 867 873 owner 2 002136 automatic char(32) level 2 packed packed unaligned dcl 73 set ref 236* 273* pad 1 000020 internal static fixed bin(35,0) level 2 dcl 49 set ref 303* perprocess_array 000115 automatic bit(1) array packed unaligned dcl 58 set ref 436* 460* 464* 520 892* perprocess_static 0(29) based bit(1) level 2 packed packed unaligned dcl 8-44 ref 213 509 526 546 644 656 677 ptr builtin function dcl 106 ref 939 query_code 3 000104 automatic fixed bin(35,0) initial level 2 dcl 719 set ref 719* query_info 000104 automatic structure level 1 dcl 719 set ref 727 727 reference_name_switch 2 based fixed bin(17,0) level 2 dcl 1-7 set ref 170* 172* 248 253 353 430 771 rel builtin function dcl 106 ref 262 262 266 266 590 590 596 596 933 933 release_area_ 000110 constant entry external dcl 143 ref 775 release_temp_segment_ 000054 constant entry external dcl 121 ref 179 241 279 336 777 rnt based structure level 1 dcl 6-9 set ref 283 rnt_area based area dcl 87 set ref 252 252* 255* 256* 256 259 578 578* 580* 582* 582 586 rnt_area_size 7 based fixed bin(17,0) level 2 dcl 6-9 set ref 250 257 294* 576 584 602 rnt_ptr 16 based pointer level 2 in structure "env_ptrs" dcl 2-5 in procedure "run_" set ref 946* rnt_ptr 16 000020 internal static pointer level 2 in structure "saved_ptrs" dcl 49 in procedure "run_" set ref 310* 571 771 rnt_ptr 62 based pointer level 2 in structure "stack_header" dcl 7-26 in procedure "run_" set ref 250 256 257 262 262 266 266 297 310 350* 571 576 582 584 590 590 596 596 601 602 603* 771* 946 rnt_size 000104 automatic fixed bin(17,0) dcl 52 set ref 250* 252 252 255 257 259 274 294 576* 578 578 580 584 586 run_control_structure based structure level 1 dcl 1-7 run_control_structure_version_1 constant fixed bin(17,0) initial dcl 1-22 ref 165 run_cs_ptr 002354 automatic pointer dcl 1-5 set ref 165* 168* 169 170 172 173 248 253 353 362 365 430 731 771 run_depth 0(27) based fixed bin(2,0) level 2 packed packed unaligned dcl 8-11 ref 832 run_sp 000012 internal static pointer initial dcl 47 set ref 191* 328 754* 933 run_stp 000322 automatic pointer dcl 59 set ref 800* 801 805* 805 807 run_unit_depth 12(33) based fixed bin(2,0) level 2 packed packed unaligned dcl 7-26 set ref 371* 740* run_unit_linkage_ptr 000341 automatic pointer packed unaligned dcl 62 set ref 506* 507 518 526 529 529 538 546 548 548 555 558 558 558 640* 642 653 656 659 659 669 677 679 679 685 689 689 689 790 792 795 801 809 run_unit_manager 20(23) based bit(1) level 2 packed packed unaligned dcl 10-64 set ref 328* saved_ptrs 000020 internal static structure level 1 dcl 49 set ref 935 saved_vla_flag 000042 internal static bit(1) dcl 50 set ref 312* 773 sb 002362 automatic pointer dcl 7-24 set ref 192* 194 196 197 250 256 257 262 262 266 266 297 306 307 308 309 310 311 312 344 345 345 346 347 348 349 350 351 370 371 391 397 400 407 409 412 422 444 444 444 448 464 571 576 582 584 590 590 596 596 601 602 603 740 741 764 765 766 767 768 769 770 771 773 939* 939 940 941 942 943 944 945 946 947 sct_array based bit(36) array dcl 83 set ref 224* 224 sct_ptr 20 based pointer level 2 in structure "env_ptrs" dcl 2-5 in procedure "run_" set ref 947* sct_ptr 54 based pointer level 2 in structure "stack_header" dcl 7-26 in procedure "run_" set ref 311 345* 770* 947 sct_ptr 20 000020 internal static pointer level 2 in structure "saved_ptrs" dcl 49 in procedure "run_" set ref 311* 770 search_rule_entry_var 000342 automatic entry variable dcl 64 set ref 289* 353 search_rules 000346 automatic structure level 1 dcl 66 set ref 287 287 353 353 seg_ptr based pointer level 2 dcl 9-33 set ref 859* segno parameter fixed bin(17,0) dcl 787 in procedure "copy_linkage" ref 782 800 809 814 815 segno 1 based fixed bin(17,0) array level 2 in structure "temp_seg_struc" dcl 97 in procedure "run_" ref 460 segno parameter fixed bin(17,0) dcl 846 in procedure "cleanup_old_linkage_section" ref 841 867 867 870 872 874 segno parameter fixed bin(17,0) dcl 827 in procedure "unsnap_links_in_outer_pps_linkage" ref 819 829 segno_hash_table 212 based offset array level 2 dcl 6-9 set ref 285* signal_ 000116 constant entry external dcl 147 ref 966 size 13 002136 automatic fixed bin(18,0) level 2 in structure "ainfo" dcl 73 in procedure "run_" set ref 229* 274* size builtin function dcl 106 in procedure "run_" ref 794 804 805 959 srulep 10 based pointer level 2 dcl 6-9 set ref 266* 266 286* 596* 596 stack_frame_flags based structure level 1 dcl 10-64 stack_header based structure level 1 dcl 7-26 stackbaseptr builtin function dcl 104 ref 192 stackframeptr builtin function dcl 104 ref 191 static_abort_label 000014 internal static label variable dcl 48 set ref 368* 968 static_length 7(18) based bit(18) level 3 packed packed unaligned dcl 8-31 ref 797 static_lng 000107 automatic fixed bin(17,0) dcl 52 set ref 797* 798 801 807 870 static_section based fixed bin(35,0) array dcl 90 set ref 801 807* 807 870 static_vlas 0(28) based bit(1) level 2 packed packed unaligned dcl 8-44 ref 529 548 558 659 679 689 stats 6 based structure level 2 dcl 8-31 status_code 104 002162 automatic fixed bin(35,0) level 3 dcl 75 set ref 964* stp 000324 automatic pointer dcl 59 set ref 801* 804* 807 809* 812* 815 string builtin function dcl 106 set ref 232* 436* 961* suppress_name_sw 1(01) 000104 automatic bit(1) initial level 2 packed packed unaligned dcl 719 set ref 719* sys_info$max_seg_size 000046 external static fixed bin(19,0) dcl 116 ref 229 914 sys_link_info_ptr 60 based pointer level 2 in structure "stack_header" dcl 7-26 in procedure "run_" set ref 309 349* 422 769* 945 sys_link_info_ptr 14 based pointer level 2 in structure "env_ptrs" dcl 2-5 in procedure "run_" set ref 945* sys_link_info_ptr 14 000020 internal static pointer level 2 in structure "saved_ptrs" dcl 49 in procedure "run_" set ref 309* 769 849 851 system 1(05) 002136 automatic bit(1) level 3 packed packed unaligned dcl 73 set ref 235* system_free_ptr 14 based pointer level 2 dcl 7-26 set ref 444 444 444* 448 table_ptr 000336 automatic pointer dcl 59 set ref 422* 423 423 906 909 909 912 temp_ptr 000334 automatic pointer dcl 59 set ref 163* 179 179* 185* 193 241* 279* 336 336* 777 777* temp_seg_struc based structure level 1 dcl 97 ref 462 time_limit 3 based fixed bin(35,0) level 2 in structure "run_control_structure" dcl 1-7 in procedure "run_" set ref 173* 362 365 731 time_limit 1 based fixed bin(35,0) level 2 in structure "control_args" dcl 91 in procedure "run_" ref 173 timer_manager_$cpu_call 000072 constant entry external dcl 133 ref 365 731 timer_manager_$reset_cpu_call 000074 constant entry external dcl 135 ref 384 timer_set 000114 automatic bit(1) dcl 56 set ref 359* 364* 384 tp 000326 automatic pointer dcl 59 set ref 851* 852 852 854 tss_ptr 000312 automatic pointer dcl 59 set ref 457* 459 460 462 type 105 based char(8) level 2 in structure "based_finish_info" dcl 318 in on unit on line 316 ref 323 type 105 002162 automatic char(8) level 2 in structure "finish_info" dcl 75 in procedure "run_" set ref 965* unspec builtin function dcl 106 set ref 209* 209 211* 211 213* 505* 505 506* 506 507 507 516 518 520* 536 538 555 558 639* 639 640* 640 642 642 651 653 653* 661* 666 669 685 689 872* 874* user_free_ptr 16 based pointer level 2 in structure "stack_header" dcl 7-26 in procedure "run_" set ref 308 348* 768* 944 user_free_ptr 12 based pointer level 2 in structure "env_ptrs" dcl 2-5 in procedure "run_" set ref 944* user_free_ptr 12 000020 internal static pointer level 2 in structure "saved_ptrs" dcl 49 in procedure "run_" set ref 308* 448 448 448 448* 768 variable_node based structure level 1 dcl 9-33 variable_table_header based structure level 1 dcl 9-19 vbl_size 1 based fixed bin(24,0) level 2 packed packed unsigned unaligned dcl 9-33 ref 914 version 1 002162 automatic fixed bin(17,0) level 3 in structure "finish_info" dcl 75 in procedure "run_" set ref 960* version 000104 automatic fixed bin(17,0) initial level 2 in structure "query_info" dcl 719 in procedure "interrupt_run" set ref 719* version based fixed bin(17,0) level 2 in structure "run_control_structure" dcl 1-7 in procedure "run_" ref 165 version 002136 automatic fixed bin(17,0) level 2 in structure "ainfo" dcl 73 in procedure "run_" set ref 228* version 000020 internal static fixed bin(17,0) level 2 in structure "saved_ptrs" dcl 49 in procedure "run_" set ref 302* xcode 000112 automatic fixed bin(35,0) dcl 54 set ref 241* 279* 320* 321* 323* yes_or_no_sw 1 000104 automatic bit(1) initial level 2 packed packed unaligned dcl 719 set ref 719* zero_on_free 1(02) 002136 automatic bit(1) level 3 packed packed unaligned dcl 73 set ref 234* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. NO_FREEING_ALLOCATION_METHOD internal static fixed bin(17,0) initial dcl 5-32 RETURN_PTR_MASK internal static bit(72) initial packed unaligned dcl 10-19 STANDARD_ALLOCATION_METHOD internal static fixed bin(17,0) initial dcl 5-32 TRANSLATOR_ID_ALM internal static bit(18) initial packed unaligned dcl 10-25 TRANSLATOR_ID_PL1V1 internal static bit(18) initial packed unaligned dcl 10-26 TRANSLATOR_ID_PL1V2 internal static bit(18) initial packed unaligned dcl 10-24 TRANSLATOR_ID_SIGNALLER internal static bit(18) initial packed unaligned dcl 10-28 TRANSLATOR_ID_SIGNAL_CALLER internal static bit(18) initial packed unaligned dcl 10-27 alloc_blkhdrsz internal static fixed bin(17,0) initial dcl 5-45 area_infop automatic pointer dcl 4-5 area_version_1 internal static fixed bin(17,0) initial dcl 5-4 areap automatic pointer dcl 5-6 block based structure level 1 dcl 5-52 blockp automatic pointer dcl 5-50 call_offset internal static fixed bin(17,0) initial dcl 7-78 condition_info_header_ptr automatic pointer dcl 11-4 condition_info_ptr automatic pointer dcl 12-10 condition_info_version_1 internal static fixed bin(17,0) initial dcl 12-30 entry_offset internal static fixed bin(17,0) initial dcl 7-78 exp_word based structure level 1 dcl 8-21 extend_blockp automatic pointer dcl 5-36 heap_header based structure level 1 unaligned dcl 9-64 heap_header_version_1 internal static char(8) initial packed unaligned dcl 9-71 lth automatic fixed bin(17,0) dcl 6-6 min_block_size internal static fixed bin(17,0) initial dcl 5-63 name based structure level 1 dcl 8-70 no_free_area_header based structure level 1 dcl 5-46 push_offset internal static fixed bin(17,0) initial dcl 7-78 return_no_pop_offset internal static fixed bin(17,0) initial dcl 7-78 return_offset internal static fixed bin(17,0) initial dcl 7-78 rnte based structure level 1 dcl 6-24 rntep automatic pointer dcl 6-5 rntp automatic pointer dcl 6-5 sp automatic pointer dcl 10-31 stack_frame based structure level 1 dcl 10-36 stack_frame_min_length internal static fixed bin(17,0) initial dcl 10-33 stack_header_overlay based fixed bin(17,0) array dcl 7-94 trap_word based structure level 1 dcl 8-66 tv_offset internal static fixed bin(17,0) initial dcl 7-72 type_pair based structure level 1 dcl 8-25 virgin_linkage_header based structure level 1 dcl 8-52 NAMES DECLARED BY EXPLICIT CONTEXT. Clean_up 001565 constant entry internal dcl 381 ref 360 377 abort 001343 constant label dcl 375 ref 368 729 allocate_new_rnt 000462 constant label dcl 250 ref 260 cleanup_old_linkage_section 003547 constant entry internal dcl 841 ref 555 685 copy_linkage 003354 constant entry internal dcl 782 ref 526 546 656 677 environment_info 001376 constant entry external dcl 923 find_area_components 003702 constant entry internal dcl 880 ref 438 441 444 448 453 free_vla_common 003747 constant entry internal dcl 900 ref 423 interrupt_run 003007 constant entry internal dcl 710 ref 365 365 384 384 731 731 quick_cleanup 003126 constant entry internal dcl 735 ref 375 705 reallocate_new_rnt 002417 constant label dcl 576 ref 588 restore_environment 003240 constant entry internal dcl 759 ref 335 750 run_ 000061 constant entry external dcl 29 stop_run 001504 constant entry external dcl 952 unsnap_links_in_outer_pps_linkage 003474 constant entry internal dcl 819 ref 509 644 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4524 4654 4024 4534 Length 5370 4024 130 500 500 34 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME run_ 1306 external procedure is an external procedure. on unit on line 177 80 on unit on unit on line 316 76 on unit on unit on line 326 64 on unit on unit on line 333 80 on unit on unit on line 360 64 on unit on unit on line 375 64 on unit Clean_up 174 internal procedure is called by several nonquick procedures. interrupt_run 110 internal procedure is assigned to an entry variable. quick_cleanup 78 internal procedure enables or reverts conditions. on unit on line 743 70 on unit restore_environment 84 internal procedure is called by several nonquick procedures. copy_linkage internal procedure shares stack frame of internal procedure Clean_up. unsnap_links_in_outer_pps_linkage internal procedure shares stack frame of internal procedure Clean_up. cleanup_old_linkage_section internal procedure shares stack frame of internal procedure Clean_up. find_area_components internal procedure shares stack frame of internal procedure Clean_up. free_vla_common internal procedure shares stack frame of internal procedure Clean_up. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 in_run run_ 000012 run_sp run_ 000014 static_abort_label run_ 000020 saved_ptrs run_ 000042 saved_vla_flag run_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME Clean_up 000136 area_ptr find_area_components 000140 ii find_area_components 000150 node_ptr free_vla_common 000152 hash_index free_vla_common interrupt_run 000100 answer interrupt_run 000104 query_info interrupt_run run_ 000100 i run_ 000101 j run_ 000102 old_cur_lot_size run_ 000103 old_rnt_size run_ 000104 rnt_size run_ 000105 nwords run_ 000106 linkage_lng run_ 000107 static_lng run_ 000110 hcscnt run_ 000111 highseg run_ 000112 xcode run_ 000113 mask run_ 000114 timer_set run_ 000115 perprocess_array run_ 000300 new_lot_ptr run_ 000302 new_isot_ptr run_ 000304 new_sct_ptr run_ 000306 area_ptr run_ 000310 new_rnt_areap run_ 000312 tss_ptr run_ 000314 old_rntp run_ 000316 new_rntp run_ 000320 linkp run_ 000322 run_stp run_ 000324 stp run_ 000326 tp run_ 000330 np run_ 000332 link_ptr run_ 000334 temp_ptr run_ 000336 table_ptr run_ 000340 outer_env_linkage_ptr run_ 000341 run_unit_linkage_ptr run_ 000342 search_rule_entry_var run_ 000346 search_rules run_ 002131 auto_run_control_structure run_ 002136 ainfo run_ 002162 finish_info run_ 002272 cond_info run_ 002354 run_cs_ptr run_ 002356 lotp run_ 002360 isotp run_ 002362 sb run_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. unpk_to_pk call_ent_var call_ext_out_desc call_ext_out call_int_this call_int_other return_mac move_label_var make_label_var tra_ext_1 tra_ext_2 signal_op enable_op ext_entry int_entry int_entry_desc op_alloc_ op_freen_ op_empty_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. area_assign_ command_query_ continue_to_signal_ cu_$generate_call define_area_ execute_epilogue_ find_command_$clear find_condition_info_ fortran_storage_manager_$free fortran_storage_manager_$get_vla_segnos get_temp_segment_ get_temp_segments_$list_segnos hcs_$get_search_rules hcs_$high_low_seg_count hcs_$initiate_search_rules hcs_$reset_ips_mask hcs_$set_ips_mask hcs_$terminate_seg link_unsnap_ release_area_ release_temp_segment_ signal_ timer_manager_$cpu_call timer_manager_$reset_cpu_call THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$run_unit_not_recursive sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 29 000054 155 000066 157 000070 158 000073 161 000074 162 000076 163 000100 165 000101 168 000110 169 000112 170 000116 172 000124 173 000126 176 000131 177 000132 179 000146 181 000176 183 000211 185 000212 186 000236 189 000241 191 000254 192 000256 193 000260 194 000262 195 000265 196 000272 197 000274 205 000276 206 000306 207 000317 209 000322 211 000324 212 000326 213 000327 216 000337 218 000342 222 000344 224 000346 228 000353 229 000355 231 000364 232 000372 233 000373 234 000375 235 000377 236 000401 238 000404 239 000417 241 000422 242 000445 243 000455 248 000456 250 000462 252 000466 253 000475 255 000501 256 000504 257 000523 259 000530 260 000532 262 000533 266 000544 270 000552 272 000553 273 000555 274 000560 275 000562 276 000564 277 000600 279 000603 280 000626 281 000636 283 000637 284 000644 285 000656 286 000670 287 000672 289 000703 293 000710 294 000712 296 000715 297 000716 302 000721 303 000724 304 000725 305 000727 306 000731 307 000734 308 000737 309 000742 310 000745 311 000750 312 000753 316 000760 320 000774 321 001014 323 001031 325 001050 326 001051 328 001066 331 001072 333 001076 335 001112 336 001117 338 001150 340 001163 344 001164 345 001167 346 001174 347 001177 348 001201 349 001203 350 001206 351 001211 353 001214 357 001232 359 001242 360 001243 362 001265 364 001270 365 001272 368 001315 369 001321 370 001323 371 001326 373 001332 375 001343 377 001365 379 001371 923 001372 931 001403 933 001405 935 001421 936 001426 939 001427 940 001432 941 001436 942 001443 943 001450 944 001455 945 001462 946 001467 947 001474 948 001501 950 001502 952 001503 957 001511 959 001514 960 001516 961 001520 962 001521 963 001523 964 001524 965 001525 966 001530 968 001555 972 001560 973 001563 381 001564 384 001572 388 001610 390 001613 391 001623 397 001631 398 001635 400 001645 401 001654 402 001656 404 001663 405 001671 406 001672 407 001673 409 001677 412 001701 422 001703 423 001705 427 001715 430 001727 436 001734 438 001740 441 001747 444 001762 448 002003 453 002030 457 002037 459 002047 460 002060 461 002064 462 002066 464 002070 504 002104 505 002116 506 002120 507 002122 509 002124 514 002141 516 002142 518 002144 520 002147 523 002156 524 002176 526 002177 529 002213 531 002227 534 002251 536 002252 538 002254 540 002256 542 002303 544 002311 546 002312 548 002326 553 002342 555 002343 558 002354 565 002373 567 002376 571 002377 575 002405 576 002417 578 002424 580 002436 582 002442 584 002463 586 002471 588 002473 590 002474 595 002505 596 002507 601 002524 602 002527 603 002531 604 002533 605 002535 638 002546 639 002560 640 002562 642 002564 644 002566 649 002603 651 002604 653 002606 656 002614 659 002630 661 002644 664 002650 666 002651 669 002653 671 002655 673 002702 675 002710 677 002711 679 002725 682 002741 685 002742 689 002753 696 002772 705 002775 707 003002 708 003005 710 003006 719 003022 727 003032 729 003065 731 003075 733 003124 735 003125 740 003133 741 003141 742 003143 743 003144 745 003160 747 003173 749 003174 750 003210 751 003215 752 003217 754 003227 755 003232 757 003236 759 003237 764 003245 765 003251 766 003254 767 003257 768 003262 769 003265 770 003270 771 003273 773 003302 775 003310 777 003322 780 003353 782 003354 790 003356 791 003364 792 003374 794 003403 795 003405 797 003411 798 003414 800 003416 801 003422 804 003437 805 003442 807 003444 809 003453 811 003462 812 003463 814 003464 815 003471 817 003473 819 003474 829 003476 830 003503 831 003516 832 003521 835 003543 837 003546 841 003547 848 003551 849 003574 851 003601 852 003604 854 003612 856 003621 858 003627 859 003631 862 003642 863 003645 867 003647 870 003661 872 003665 873 003671 874 003675 876 003701 880 003702 890 003704 891 003707 892 003721 893 003730 895 003742 896 003744 898 003746 900 003747 906 003750 909 003761 912 003765 913 003770 914 003774 916 004010 917 004012 918 004013 920 004015 ----------------------------------------------------------- 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