COMPILATION LISTING OF SEGMENT fortran_storage_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 11/20/86 1158.2 mst Thu Options: optimize list 1 /****^ ****************************************** 2* * * 3* * Copyright, (C) Honeywell Limited, 1983 * 4* * * 5* ****************************************** */ 6 7 8 9 /****^ HISTORY COMMENTS: 10* 1) change(86-09-18,DGHowe), approve(86-09-18,MCR7420), 11* audit(86-09-19,Schroth), install(86-11-20,MR12.0-1222): 12* changed the calling sequence of list_init_. 13* END HISTORY COMMENTS */ 14 15 16 /* format: style3,^delnl,linecom */ 17 fortran_storage_: 18 proc (sp, lp, tp) options (support); 19 create: 20 entry (sp, lp, tp); 21 22 23 /* This driver receives control from pl1_operators_ when a call is received 24* from a fortran program to create and/or initialize external data storage, 25* such as Large and Very Large Arrays. 26* 27* Entry Conditions: 28* 29* sp This is the stack pointer to the stack frame of the fortran 30* program making the request. 31* lp This is the linkage pointer to the linkage section of the 32* program making the request. 33* tp This is a pointer to the text section parameter word. This 34* word is in the format: 35* 36* vfd 18/create_relative_offset,18/initialize_relative_offset 37* 38* These pointers are offsets from the base of the segment of tp. 39* 40**/ 41 42 /* Create 82-09-07 by T. Oke (UNCA) */ 43 44 /* Modification History: 45* 46* Modified: 27 June 1986, DH & BW - Use new interface to list_init_ and 47* set_external_variable_. 48* Modified: 16 June 1983, TO- Use condition_info_header, have 49* options (support). 50* Modified: 29 May 1983, MW - To call sub_err_ if find perprocess static 51* Modified: 16 February 1983, TO- Set stack_header.have_static_vlas for use 52* of run_. 53* Modified: 15 February 1983, TO- Set linkage_header_flags.static_vlas for 54* use of run_. 55* Modified: 26 January 1983, HH - Replaced 'fill_VLA_addressors' routine. 56* Modified: 18 January 1983, TO - Match with CISL implementation of link 57* snapping to VLA COMMON from the linker. 58**/ 59 60 61 62 dcl lp ptr; /* Pointer to base of linkage section */ 63 dcl sp ptr; /* Pointer to stack frame of caller */ 64 dcl tp ptr; /* Pointer to parameter word */ 65 66 dcl (alp, asp, atp) ptr; /* actual running pointers */ 67 68 dcl 1 parm based (tp), 69 2 create_relp bit (18) unaligned, /* relative offset from tp to creation data */ 70 2 init_relp bit (18) unaligned; /* relative offfset from tp to initialization data */ 71 1 1 /* BEGIN include file fortran_storage.incl.pl1 */ 1 2 1 3 /* Created 82-09-21 by T. Oke (UNCA) */ 1 4 1 5 /* Modification History: 1 6* 1 7*Modified: 1 October 1982, TO - add pointer_count and pointer entries. 1 8*Modified: 9 November 1982, TO - Move pointer_count, add common_link. 1 9**/ 1 10 1 11 /* Definitions of the structures controlling the creation of and initialization 1 12* lists for fortran_storage_driver. */ 1 13 1 14 /* For VLA entries there may be a number of pointers, each of which points to a 1 15* single VLA entity within the VLA. Each such pointer supplies an offset and 1 16* is stored by 'fortran_storage_'. 1 17* 1 18* For VLA COMMON, there is a pointer to the link in the linkage section. The 1 19* unsnapped link (which is in the template linkage section) supplies an offset 1 20* to find the expression_word in the definition section, which offsets to the 1 21* type_pair, which supplies the initialization information. */ 1 22 1 23 dcl 1 create_entry based, /* creation list entry */ 1 24 2 location fixed bin (18) unsigned unaligned, /* location of base */ 1 25 2 flags unaligned structure, 1 26 3 auto bit (1) unaligned, /* automatic storage entry */ 1 27 3 static bit (1) unaligned, /* static storage entry */ 1 28 3 common bit (1) unaligned, /* common storage entry */ 1 29 3 LA bit (1) unaligned, /* Large Array (255K) */ 1 30 3 VLA bit (1) unaligned, /* Very Large Array (>255K) */ 1 31 3 K256 bit (1) unaligned, /* alloc 256K segs */ 1 32 3 init bit (1) unaligned, /* initialized */ 1 33 3 pad bit (2) unaligned, /* FUTURE EXPANSION */ 1 34 3 pointer_count fixed bin (9) unsigned unaligned, /* number of pointers to fill in */ 1 35 2 length fixed bin (24) aligned, /* number of words required */ 1 36 2 next fixed bin (18) unsigned unaligned, /* offset to next create entry */ 1 37 2 name_length fixed bin (17) unaligned, /* size of block name field */ 1 38 2 common_link fixed bin (18) unsigned unaligned, /* location of link if COMMON */ 1 39 1 40 2 block_name char (0 refer (create_entry.name_length)), 1 41 2 pointer_offsets (0 refer (create_entry.pointer_count)) aligned, 1 42 3 pad bit (12) unaligned, 1 43 3 offset fixed bin (24) unsigned unaligned; 1 44 1 45 /* Pointers will be created for each VLA sub-entity, so the pointer_count field 1 46* indicates how many pointers follow the block_name. */ 1 47 1 48 1 49 1 50 1 51 /* Initialization data. The length and datum are bit items, to permit a wide 1 52* range of inputs. 1 53* 1 54* 1. A 'repeat' of '0' signifies skipping of 'length' bits. 1 55* 2. A 'length' of '0' signifies the last item of the list. 1 56* 1 57* COMMON, VLA's, and LA's, are presumed to start at the base pointer of their 1 58* particular storage section. */ 1 59 1 60 1 61 dcl 1 create_init_entry based, 1 62 2 length fixed bin (35) aligned, /* size of datum */ 1 63 2 pad bit (6) unaligned, /* FUTURE EXPANSION */ 1 64 2 repeat fixed bin (30) unsigned unaligned, /* number of times to repeat datum */ 1 65 2 datum bit (0 refer (create_init_entry.length)); 1 66 1 67 1 68 /* END include file fortran_storage.incl.pl1 */ 72 73 74 /* Based Variables */ 75 76 dcl based_ptr ptr based; 77 dcl LA_base_addressor ptr based (base_addressor_ptr); 78 dcl VLA_base_addressor ptr unaligned based (base_addressor_ptr); 79 80 /* Automatic Storage */ 81 82 dcl base_addressor_ptr ptr; 83 dcl code fixed bin (35); 84 dcl cp ptr; /* pointer to create entry */ 85 dcl defp ptr; /* pointer to definition section */ 86 dcl found_sw bit (1) aligned; /* external was found */ 87 dcl length fixed bin (24); /* number of words needed */ 88 dcl linkp ptr; /* pointer to link */ 89 dcl looping bit (1); /* true while doing lists */ 90 dcl namep ptr; /* pointer to block name from link */ 91 dcl num_segs_needed fixed bin; /* number of segments needed */ 92 dcl storage_ptr ptr; 93 dcl textp ptr; /* pointer to text section */ 94 dcl type_ptr ptr; /* pointer to type_pair */ 95 dcl variablep ptr; /* pointer to variable_node */ 96 97 dcl pl1_operators_$VLA_words_per_seg_ 98 fixed bin (19) external; 99 100 dcl fortran_storage_manager_$alloc 101 entry (fixed bin, ptr, ptr); 102 dcl list_init_ entry (ptr, ptr, fixed bin (35), ptr, ptr, fixed bin (35)); 103 dcl set_ext_variable_ entry (char (*), ptr, ptr, bit (1) aligned, ptr, fixed bin (35)); 104 dcl sub_err_ entry options (variable); 105 106 107 dcl (addr, addrel, baseno, currentsize, divide, fixed, null, ptr, rel, rtrim, stackbaseptr, string, substr, unspec) 108 builtin; 109 110 textp = ptr (tp, "000000"b3); /* get pointer to text section */ 111 atp = tp; 112 alp = lp; 113 asp = sp; 114 code = 0; 115 116 117 118 /* process Storage creation. */ 119 120 looping = "1"b; 121 if parm.create_relp ^= "777777"b3 /* list exists */ 122 then do cp = ptr (atp, parm.create_relp) repeat ptr (atp, unspec (cp -> create_entry.next)) while (looping); 123 124 length = cp -> create_entry.length; 125 126 /* pl1_operators_$VLA_words_per_seg_ determines the actual addressing which will occur in 127* this execution. It is used to determine the number of segments required. */ 128 129 num_segs_needed = 130 divide (length + pl1_operators_$VLA_words_per_seg_ - 1, pl1_operators_$VLA_words_per_seg_, 17); 131 132 if cp -> create_entry.flags.auto 133 then do; /* Automatic storage */ 134 call fortran_storage_manager_$alloc (num_segs_needed, asp, storage_ptr); 135 if cp -> create_entry.init 136 then call list_init_ (storage_ptr, 137 addrel (cp, currentsize (cp -> create_entry)), 138 (cp -> create_entry.length), 139 stackbaseptr (), null (), code); 140 base_addressor_ptr = addrel (asp, cp -> create_entry.location); 141 if cp -> create_entry.flags.LA 142 then LA_base_addressor = storage_ptr; 143 else call fill_VLA_addressors; 144 end; 145 146 else if cp -> create_entry.flags.static 147 then do; /* Static if not init */ 148 base_addressor_ptr = addrel (alp, cp -> create_entry.location); 149 if cp -> create_entry.flags.LA 150 then do; 151 if LA_base_addressor = null () 152 then do; 153 if alp -> linkage_header_flags.perprocess_static 154 then call signal_sub_error; 155 call fortran_storage_manager_$alloc (num_segs_needed, alp, storage_ptr); 156 if cp -> create_entry.init 157 then call list_init_ (storage_ptr, 158 addrel (cp, currentsize (cp -> create_entry)), 159 (cp -> create_entry.length), stackbaseptr (), 160 null (), code); 161 LA_base_addressor = storage_ptr; 162 end; 163 end; 164 else do; 165 if VLA_base_addressor = null () 166 then do; 167 if alp -> linkage_header_flags.perprocess_static 168 then call signal_sub_error; 169 call fortran_storage_manager_$alloc (num_segs_needed, alp, storage_ptr); 170 if cp -> create_entry.init 171 then call list_init_ (storage_ptr, 172 addrel (cp, currentsize (cp -> create_entry)), 173 (cp -> create_entry.length), stackbaseptr (), 174 null (), code); 175 call fill_VLA_addressors; 176 end; 177 end; 178 179 /* Set stack_header.have_statis_vlas and linkage_header_flags.static_vlas to 180* inform run_ that there will be external segments to preserve. */ 181 182 ptr (asp, "0"b) -> stack_header.have_static_vlas = "1"b; 183 alp -> linkage_header_flags.static_vlas = "1"b; 184 185 end; 186 187 else if cp -> create_entry.flags.common 188 then do; 189 190 /* Find pointer to addressor (base_addressor_ptr -> VLA_base_addressor), and pointer to true full 191* link (linkp -> link). */ 192 193 base_addressor_ptr = addrel (alp, cp -> create_entry.location); 194 linkp = addrel (alp, cp -> create_entry.common_link); 195 196 /* If link is unsnapped, or disagrees with 'VLA_base_addressor' then update 'VLA_base_addressor' */ 197 198 if linkp -> link.ft2 ^= "46"b3/* snapped */ 199 then if linkp -> based_ptr ^= VLA_base_addressor 200 /* wrong VLA_base_addressor */ 201 then do; /* take link */ 202 storage_ptr = linkp -> based_ptr; 203 call fill_VLA_addressors; 204 end; 205 else ; 206 207 else do; /* snap link and fill pointers */ 208 re_try_snap: 209 call snap_link (code); 210 if code ^= 0 211 then do; 212 call signal_fortran_storage_error (code, 213 " COMMON block " || cp -> create_entry.block_name); 214 goto re_try_snap; 215 end; 216 call fill_VLA_addressors; 217 end; 218 end; 219 220 if code ^= 0 221 then do; 222 call sub_err_ (code, "fortran_storage_", 223 ACTION_CANT_RESTART, null, 0, 224 "An error has occurred while initializing ^a.", 225 cp -> create_entry.block_name); 226 return; 227 end; 228 if cp -> create_entry.next = 0 229 then looping = "0"b; 230 end; 231 return; 232 233 /* Resolve a linkage error for VLA COMMON. */ 234 235 resolve_VLA_COMMON_link: 236 entry (a_link_ptr, a_def_ptr, a_type_ptr, a_code); 237 238 239 dcl a_code fixed bin (35); /* error code */ 240 dcl a_def_ptr ptr; /* definition ptr, also text section ptr */ 241 dcl a_link_ptr ptr; /* pointer to link to snap */ 242 dcl a_type_ptr ptr; /* pointer to type_word */ 243 244 245 /* When the linker finds a link to VLA COMMON 'link_trap_caller_' will call 246* us to resolve the link and initialize it. We in turn simply call our 247* local 'snap_link' procedure. */ 248 249 linkp = a_link_ptr; 250 251 /* setup for snapping the link and creation of the COMMON. 252* 253* text pointer is taken from a_def_ptr, which should be into the text segment 254* and therefore usable in our case. */ 255 256 atp = ptr (a_def_ptr, "0"b); 257 alp = addrel (linkp, linkp -> link.head_ptr); 258 call snap_link (a_code); 259 return; 260 261 fill_VLA_addressors: 262 proc; 263 264 /* Function: to calculate and store the addressors of the base and various */ 265 /* offsets of a VLA. The logical address of the VLA is stored in the */ 266 /* base addressor and the packed pointer to the offset is stored in each */ 267 /* offset addressor. (The logical address of a storage location is just */ 268 /* its segment number times the maximum length in words of its segment */ 269 /* plus its word offset in the segment. For 256K segments, it is just */ 270 /* the packed pointer to the location, considered as an integer.) */ 271 272 /* Global Arguments: */ 273 /* */ 274 /* base_addressor_ptr (Input) */ 275 /* is the address where the value of the base addressor of the VLA is to */ 276 /* be stored. The addressors of any offsets into the VLA are stored in */ 277 /* successive locations. */ 278 /* */ 279 /* cp (Input) */ 280 /* is the address of the 'creation_entry' structure which specifies any */ 281 /* offsets into the VLA and whether the calling program can operate with */ 282 /* other than 256K segments. */ 283 /* */ 284 /* storage_ptr (Input) */ 285 /* is the address of the storage that has been assigned to the VLA. */ 286 287 dcl error_table_$resource_unavailable 288 fixed bin (35) ext; 289 290 dcl 01 VLA_addressors aligned based (base_addressor_ptr), 291 02 addressor_of_base 292 fixed bin (30), 293 02 addressor_of_offset 294 (offset_cnt) fixed bin (30); 295 296 dcl offset (offset_cnt) fixed bin (24) based (offset_ptr); 297 298 dcl i fixed bin, 299 logical_address_of_base 300 fixed bin (30), 301 logical_address_of_offset 302 fixed bin (30), 303 offset_cnt fixed bin, 304 offset_ptr ptr, 305 VLA_base_ptr ptr unaligned; 306 307 /* Copy various input values to local storage so we can get faster access. */ 308 309 offset_cnt = cp -> create_entry.pointer_count; 310 if offset_cnt > 0 311 then offset_ptr = addr (cp -> create_entry.pointer_offsets); 312 VLA_base_ptr = storage_ptr; 313 314 /* If the 256K flag is set, we must ensure that storage is being allocated */ 315 /* in 256K segments, since otherwise the calling program will not operate */ 316 /* correctly. */ 317 318 if cp -> create_entry.K256 319 then do while (pl1_operators_$VLA_words_per_seg_ ^= 262144); 320 call signal_fortran_storage_error (error_table_$resource_unavailable, 321 "Program requires storage to be allocated in 256K segments."); 322 end; 323 324 /* Fill in the addressors of the base and offsets into the VLA. If storage */ 325 /* is allocated in 256K segments, logical addresses are also packed ptrs */ 326 /* and so we can use simpler code which runs much faster. */ 327 328 if pl1_operators_$VLA_words_per_seg_ = 262144 329 then do; /* Logical addresses are also packed pointers. */ 330 unspec (logical_address_of_base) = unspec (VLA_base_ptr); 331 VLA_addressors.addressor_of_base = logical_address_of_base; 332 do i = 1 to offset_cnt; 333 VLA_addressors.addressor_of_offset (i) = logical_address_of_base + offset (i); 334 end; 335 end; 336 else do; /* Logical addresses are different than packed pointers. */ 337 logical_address_of_base = 338 fixed (baseno (VLA_base_ptr), 12) * pl1_operators_$VLA_words_per_seg_ 339 + fixed (rel (VLA_base_ptr), 18); 340 VLA_addressors.addressor_of_base = logical_address_of_base; 341 do i = 1 to offset_cnt; 342 logical_address_of_offset = logical_address_of_base + offset (i); 343 VLA_addressors.addressor_of_offset (i) = 344 logical_address_of_offset 345 + fixed (262144 - pl1_operators_$VLA_words_per_seg_, 18) 346 * divide (logical_address_of_offset, pl1_operators_$VLA_words_per_seg_, 12); 347 end; 348 end; 349 end fill_VLA_addressors; 350 351 signal_fortran_storage_error: 352 proc (status, details); 353 354 /* Function: to signal the restartable condition 'fortran_storage_error'. */ 355 356 /* Arguments: */ 357 /* */ 358 /* status (Input) */ 359 /* is a standard system status code describing why the condition is */ 360 /* being signalled. */ 361 /* */ 362 /* details (Input) */ 363 /* is supplementary information regarding why the condition is being */ 364 /* signalled. */ 365 366 dcl status fixed bin (35), 367 details char (*); 368 369 dcl signal_ entry options (variable); 370 371 dcl size builtin; 372 2 1 /* BEGIN INCLUDE FILE condition_info_header.incl.pl1 BIM 1981 */ 2 2 /* format: style2 */ 2 3 2 4 declare condition_info_header_ptr 2 5 pointer; 2 6 declare 1 condition_info_header 2 7 aligned based (condition_info_header_ptr), 2 8 2 length fixed bin, /* length in words of this structure */ 2 9 2 version fixed bin, /* version number of this structure */ 2 10 2 action_flags aligned, /* tell handler how to proceed */ 2 11 3 cant_restart bit (1) unaligned, /* caller doesn't ever want to be returned to */ 2 12 3 default_restart bit (1) unaligned, /* caller can be returned to with no further action */ 2 13 3 quiet_restart bit (1) unaligned, /* return, and print no message */ 2 14 3 support_signal bit (1) unaligned, /* treat this signal as if the signalling procedure had the support bit set */ 2 15 /* if the signalling procedure had the support bit set, do the same for its caller */ 2 16 3 pad bit (32) unaligned, 2 17 2 info_string char (256) varying, /* may contain printable message */ 2 18 2 status_code fixed bin (35); /* if^=0, code interpretable by com_err_ */ 2 19 2 20 /* END INCLUDE FILE condition_info_header.incl.pl1 */ 373 374 375 dcl 01 condition_info aligned like condition_info_header; 376 377 condition_info.length = size (condition_info); 378 condition_info.version = 1; 379 unspec (condition_info.action_flags) = ""b; 380 condition_info.info_string = rtrim (details); 381 condition_info.status_code = status; 382 call signal_ ("fortran_storage_error", null, addr (condition_info)); 383 end signal_fortran_storage_error; 384 385 /* Snap a VLA Common link. */ 386 387 snap_link: 388 proc (code); 389 390 dcl code fixed bin (35); 391 392 /* Routine to snap a link, if it is unsnapped, and create the VLA common. */ 393 394 /* Global Inputs: 395* atp Text pointer. Pointer to some point in the text section. 396* alp Linkage ptr. Pointer to start of linkage section in area.linker. 397* linkp Link pointer. Pointer to the link ptr to be snapped. 398* 399* Local Inputs 400* 401* code return error code. 402* 403* Outputs: 404* storage_ptr Has pointer to start of variable, whether created or not. 405* */ 406 407 dcl block_name char (32) varying; 408 409 /* if link is unsnapped, then snap it and create the common if necessary. */ 410 /* set_ext_variable_ will also initialize the common. */ 411 412 if linkp -> link.ft2 = "46"b3 /* unsnapped */ 413 then do; 414 415 /* defp is pointer to definition section. */ 416 /* type_pair points to type_pair word. */ 417 /* init_info_ptr is initialization block. */ 418 419 defp = ptr (atp, alp -> virgin_linkage_header.def_offset); 420 type_ptr = addrel (defp, (addrel (defp, linkp -> link.exp_ptr) -> exp_word.type_ptr)); 421 namep = addrel (defp, type_ptr -> type_pair.ext_ptr); 422 block_name = substr (namep -> name.char_string, 1, fixed (namep -> name.nchars, 9)); 423 init_info_ptr = addrel (defp, type_ptr -> type_pair.trap_ptr); 424 call set_ext_variable_ ((block_name), init_info_ptr, stackbaseptr (), found_sw, variablep, code); 425 if code ^= 0 426 then if ^found_sw 427 then return; 428 429 storage_ptr = variablep -> variable_node.vbl_ptr; 430 linkp -> based_ptr = storage_ptr; /* snap link too */ 431 end; 432 433 /* accept the previously snapped link. */ 434 435 else storage_ptr = linkp -> based_ptr; 436 return; 437 end snap_link; 438 439 signal_sub_error: 440 proc; 441 442 /* Subroutine to call sub_err_ if the program has both perprocess static and 443* static LA/VLAs. For now we specify action_cant_restart because 444* there is no easy way to reset the active perprocess static flag. 445**/ 446 447 dcl retval fixed bin (35); 448 dcl hcs_$fs_get_path_name 449 entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); 450 dcl dirname char (168); 451 dcl entryname char (32); 452 dcl dirname_length fixed bin; 453 454 retval = 0; 455 call hcs_$fs_get_path_name (textp, dirname, dirname_length, entryname, code); 456 call sub_err_ (0, "fortran_storage_", ACTION_CANT_RESTART, null, retval, 457 "Attempt by perprocess static segment ^a>^a^/to use static (very) large arrays. This combination is illegal." 458 , 459 dirname, entryname); 460 return; /* should never get here */ 461 462 end signal_sub_error; 463 3 1 /* Begin include file ... system_link_init_info.incl.pl1 ... 5/6/80 MRJ */ 3 2 3 3 3 4 3 5 /****^ HISTORY COMMENTS: 3 6* 1) change(86-05-02,Elhard), approve(86-05-02,MCR7391), 3 7* audit(86-07-18,DGHowe), install(86-11-20,MR12.0-1222): 3 8* Modified to declare DEFERRED_INIT type constant. 3 9* 2) change(86-06-24,DGHowe), approve(86-06-24,MCR7420), audit(86-11-12,Zwick), 3 10* install(86-11-20,MR12.0-1222): 3 11* added the external pointer initialization structure and the constants 3 12* required to use them. 3 13* END HISTORY COMMENTS */ 3 14 3 15 3 16 /* Modified: 82-11-17 by T. Oke to add list_init_info and LIST_TEMPLATE_INIT. */ 3 17 3 18 /* format: style3,idind25 */ 3 19 3 20 /* NOTE -------------------------------------------------- 3 21* the following structures defining initialization information can also 3 22* be found in fortran_storage.incl.pl1 definition_dcls.incl.pl1 3 23* and should be kept equivalent 3 24* ------------------------------------------------------- 3 25**/ 3 26 3 27 dcl init_info_ptr ptr; /* ptr to structure below */ 3 28 dcl init_size fixed bin (35); /* size (in words) of initialization template */ 3 29 3 30 dcl 1 init_info aligned based (init_info_ptr), 3 31 2 size fixed bin (35), /* size (in words) of data */ 3 32 2 type fixed bin, /* type of initialization: see below */ 3 33 2 init_template (init_size refer (init_info.size)) fixed bin (35); 3 34 3 35 dcl 1 init_info_single_word aligned based (init_info_ptr), 3 36 /* for convenience of people like ssi */ 3 37 2 size fixed bin (19), /* = 1 */ 3 38 2 type fixed bin, /* = TEMPLATE_INIT */ 3 39 2 init_template (1) fixed bin (35); /* = value */ 3 40 3 41 dcl 1 list_init_info aligned based, 3 42 2 size fixed bin (35), /* length of variable */ 3 43 2 type fixed bin, /* LIST_TEMPLATE_INIT */ 3 44 2 pad bit (18) unaligned, 3 45 2 list_size fixed bin (18) unsigned unaligned, 3 46 /* size in words of template */ 3 47 2 template (0 refer (list_init_info.list_size)) bit (36); 3 48 /* first create_entry position */ 3 49 3 50 /* A list template consists of a series of entries with the following 3 51* description, concatenated together. n_bits and datum are bit items, 3 52* to permit a wide range of inputs. 3 53* 3 54* 1. A 'repeat' of '0' signifies skipping of 'n_bits' bits. 3 55* 2. A 'n_bits' of '0' signifies the last item of the list. 3 56* 3 57* COMMON, VLA's, and LA's are presumed to start at the base pointer 3 58* of their particular storage section. */ 3 59 3 60 dcl 1 list_template_entry aligned based, 3 61 2 n_bits fixed bin (35) aligned, /* size of datum */ 3 62 2 mbz bit (3) unaligned, /* future expansion */ 3 63 2 init_type fixed bin (3) unsigned unaligned, /* 0 normal init, 1 ptr init, 2 packed ptr init */ 3 64 2 repeat fixed bin (30) unsigned unaligned, 3 65 /* number of times to repeat datum */ 3 66 2 datum bit (init_n_bits_in_datum refer (list_template_entry.n_bits)); 3 67 3 68 /* list_template_entry_ptr is defined such that it can be used as an 3 69* automatic definition overlay with a fixed size datum. it has a declared 3 70* size of 72 to allow for the its pointer sixe of 72 bits. 3 71**/ 3 72 3 73 dcl 1 list_template_entry_ptr aligned based, 3 74 2 n_bits fixed bin (35) aligned, 3 75 2 mbz bit(3) unaligned, 3 76 2 init_type fixed bin (3) unsigned unaligned, 3 77 2 repeat fixed bin (30) unsigned unaligned, 3 78 2 datum bit(72); 3 79 3 80 /* the pointer_init_template represents the initialization information 3 81* for ITS and packed pointers. Both pointer types require the entire 3 82* 72 bit structure. 3 83**/ 3 84 3 85 dcl 1 pointer_init_template based, 3 86 2 ptr_type fixed bin (18) unsigned unaligned, /* 0 text section, 1 linkage section, 2 static section */ 3 87 2 section_offset fixed bin (18) unsigned unaligned, /* offset to item in specified section */ 3 88 2 word_offset fixed bin (18) unsigned unaligned, /* word offset from section item to target */ 3 89 2 mbz bit (12) unaligned, 3 90 2 bit_offset fixed bin (6) unsigned unaligned; /* bit offset from section item|word offset to target */ 3 91 3 92 3 93 dcl init_n_bits_in_datum fixed bin (35); 3 94 3 95 dcl NO_INIT fixed bin static options (constant) init (0); 3 96 dcl TEMPLATE_INIT fixed bin static options (constant) init (3); 3 97 dcl EMPTY_AREA_INIT fixed bin static options (constant) init (4); 3 98 dcl LIST_TEMPLATE_INIT fixed bin static options (constant) init (5); 3 99 dcl INIT_DEFERRED fixed bin static options (constant) init (6); 3 100 dcl ITS_PTR_INIT fixed bin (3) unsigned static options (constant) init(1); 3 101 dcl PACKED_PTR_INIT fixed bin (3) unsigned static options (constant) init(2); 3 102 dcl PTR_INIT_TEXT fixed bin (17) static options (constant) init(0); 3 103 dcl PTR_INIT_LOT fixed bin (17) static options (constant) init(1); 3 104 dcl PTR_INIT_ISOT fixed bin (17) static options (constant) init(2); 3 105 3 106 3 107 /* End include file ... system_link_init_info.incl.pl1 */ 464 4 1 /* BEGIN INCLUDE FILE linkdcl.incl.pl1 --- last modified 15 Nov 1971 by C Garman */ 4 2 4 3 /* Last Modified (Date and Reason): 4 4* 6/75 by M.Weaver to add virgin_linkage_header declaration 4 5* 6/75 by S.Webber to comment existing structures better 4 6* 9/77 by M. Weaver to add run_depth to link 4 7* 2/83 by M. Weaver to add linkage header flags and change run_depth precision 4 8**/ 4 9 4 10 /* format: style3 */ 4 11 dcl 1 link based aligned, /* link pair in linkage section */ 4 12 2 head_ptr bit (18) unal, /* rel pointer to beginning of linkage section */ 4 13 2 ringno bit (3) unal, 4 14 2 mbz bit (6) unal, 4 15 2 run_depth fixed bin (2) unal, /* run unit depth, filled when link is snapped */ 4 16 2 ft2 bit (6) unal, /* fault tag. 46(8) if not snapped, 43(8) if snapped */ 4 17 2 exp_ptr bit (18) unal, /* pointer (rel to defs) of expression word */ 4 18 2 mbz2 bit (12) unal, 4 19 2 modifier bit (6) unal; /* modifier to be left in snapped link */ 4 20 4 21 dcl 1 exp_word based aligned, /* expression word in link definition */ 4 22 2 type_ptr bit (18) unal, /* pointer (rel to defs) of type pair structure */ 4 23 2 exp bit (18) unal; /* constant expression to be added in when snapping link */ 4 24 4 25 dcl 1 type_pair based aligned, /* type pair in link definition */ 4 26 2 type bit (18) unal, /* type of link. may be 1,2,3,4,5, or 6 */ 4 27 2 trap_ptr bit (18) unal, /* pointer (rel to defs) to the trap word */ 4 28 2 seg_ptr bit (18) unal, /* pointer to ACC reference name for segment referenced */ 4 29 2 ext_ptr bit (18) unal; /* pointer (rel to defs) of ACC segdef name */ 4 30 4 31 dcl 1 header based aligned, /* linkage block header */ 4 32 2 def_ptr ptr, /* pointer to definition section */ 4 33 2 symbol_ptr ptr unal, /* pointer to symbol section in object segment */ 4 34 2 original_linkage_ptr 4 35 ptr unal, /* pointer to linkage section in object segment */ 4 36 2 unused bit (72), 4 37 2 stats, 4 38 3 begin_links bit (18) unal, /* offset (rel to this section) of first link */ 4 39 3 block_length bit (18) unal, /* number of words in this linkage section */ 4 40 3 segment_number 4 41 bit (18) unal, /* text segment number associated with this section */ 4 42 3 static_length bit (18) unal; /* number of words of static for this segment */ 4 43 4 44 dcl 1 linkage_header_flags 4 45 aligned based, /* overlay of def_ptr for flags */ 4 46 2 pad1 bit (28) unaligned, /* flags are in first word */ 4 47 2 static_vlas bit (1) unaligned, /* static section "owns" some LA/VLA segments */ 4 48 2 perprocess_static 4 49 bit (1) unaligned, /* 1 copy of static section is used by all tasks/run units */ 4 50 2 pad2 bit (6) unaligned; 4 51 4 52 dcl 1 virgin_linkage_header 4 53 aligned based, /* template for linkage header in object segment */ 4 54 2 pad bit (30) unaligned, /* is filled in by linker */ 4 55 2 defs_in_link bit (6) unaligned, /* =o20 if defs in linkage (nonstandard) */ 4 56 2 def_offset bit (18) unaligned, /* offset of definition section */ 4 57 2 first_ref_relp bit (18) unaligned, /* offset of trap-at-first-reference offset array */ 4 58 2 filled_in_later bit (144), 4 59 2 link_begin bit (18) unaligned, /* offset of first link */ 4 60 2 linkage_section_lng 4 61 bit (18) unaligned, /* length of linkage section */ 4 62 2 segno_pad bit (18) unaligned, /* will be segment number of copied linkage */ 4 63 2 static_length bit (18) unaligned; /* length of static section */ 4 64 4 65 4 66 dcl 1 trap_word based aligned, /* trap word in link definition */ 4 67 2 call_ptr bit (18) unal, /* pointer (rel to link) of link to trap procedure */ 4 68 2 arg_ptr bit (18) unal; /* pointer (rel to link) of link to arg info for trap proc */ 4 69 4 70 dcl 1 name based aligned, /* storage of ASCII names in definitions */ 4 71 2 nchars bit (9) unaligned, /* number of characters in name */ 4 72 2 char_string char (31) unaligned; /* 31-character name */ 4 73 4 74 /* END INCLUDE FILE linkdcl.incl.pl1 */ 465 5 1 /* BEGIN INCLUDE FILE ... system_link_names.incl.pl1 */ 5 2 5 3 5 4 /****^ HISTORY COMMENTS: 5 5* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396), audit(86-11-12,Zwick), 5 6* install(86-11-20,MR12.0-1222): 5 7* added the declaration of the heap_header. 5 8* 2) change(86-10-20,DGHowe), approve(86-10-20,MCR7420), audit(86-11-12,Zwick), 5 9* install(86-11-20,MR12.0-1222): 5 10* add the seg ptr to the variable node structure. 5 11* END HISTORY COMMENTS */ 5 12 5 13 5 14 /* created by M. Weaver 7/28/76 */ 5 15 /* Modified: 82-11-19 by T. Oke to add LIST_TEMPLATE_INIT. */ 5 16 /* Modified 02/11/83 by M. Weaver to add have_vla_variables flag */ 5 17 5 18 5 19 dcl 1 variable_table_header aligned based, /* header for name table */ 5 20 2 hash_table (0:63) ptr unaligned, /* hash table for variable nodes */ 5 21 2 total_search_time fixed bin (71), /* total time to search for variables */ 5 22 2 total_allocation_time fixed bin (71), /* total time spent allocating and initializing nodes and variables */ 5 23 2 number_of_searches fixed bin, /* number of times names were looked up */ 5 24 2 number_of_variables fixed bin (35), /* number of variables allocated by the linker, incl deletions */ 5 25 2 flags unaligned, 5 26 3 have_vla_variables bit (1) unaligned, /* on if some variables are > sys_info$max_seg_size */ 5 27 3 pad bit (11) unaligned, 5 28 2 cur_num_of_variables fixed bin (24) unal, /* current number of variables allocated */ 5 29 2 number_of_steps fixed bin, /* total number of nodes looked at */ 5 30 2 total_allocated_size fixed bin (35); /* current amount of storage in user area */ 5 31 5 32 5 33 dcl 1 variable_node aligned based, /* individual variable information */ 5 34 2 forward_thread ptr unaligned, /* thread to next node off same hash bucket */ 5 35 2 vbl_size fixed bin (24) unsigned unaligned, /* length in words of variable */ 5 36 2 init_type fixed bin (11) unaligned, /* 0=not init; 3=init template; 4=area 5=list_template*/ 5 37 2 time_allocated fixed bin (71), /* time when variable was allocated */ 5 38 2 vbl_ptr ptr, /* pointer to variable's storage */ 5 39 2 init_ptr ptr, /* pointer to original init info in object seg */ 5 40 2 name_size fixed bin(21) aligned, /* length of name in characters */ 5 41 2 name char (nchars refer (variable_node.name_size)), /* name of variable */ 5 42 2 seg_ptr pointer; 5 43 5 44 /* variable_node.seg_ptr 5 45* Is a pointer to the segment containing the initialization information 5 46* for this variable. It is used as a segment base pointer for external 5 47* pointer initialization via list_init_. 5 48* 5 49* The init_ptr can not be used as a reference to the defining segment 5 50* due to the possibility of set_fortran_common being used to initialize 5 51* the external variables. sfc will generate an initialization information 5 52* structure if multiple intialization sizes are found in the specified 5 53* segments. sfc stores the address of this structure in the init_ptr field. 5 54* This is one reason why sfc does not perform external pointer 5 55* initialization. 5 56* 5 57* The seg_ptr is set to point at the segment used to define the 5 58* initialization information. term_ sets this field to null on termination 5 59* due to the possiblity of executing a different segment which defines 5 60* initialization information. In this way the seg_ptr field will either 5 61* be valid or null. 5 62**/ 5 63 5 64 dcl 1 heap_header based, 5 65 2 version char(8), /* specifies the verison of the header */ 5 66 2 heap_name_list_ptr pointer, /* points to the variable_table_header for this heap */ 5 67 2 previous_heap_ptr pointer, /* points to the previous heap or is null */ 5 68 2 area_ptr pointer, /* points to the heap area */ 5 69 2 execution_level fixed bin (17); /* specifies the execution level this header deals with */ 5 70 5 71 dcl heap_header_version_1 char(8) static options (constant) 5 72 init ("Heap_v01"); 5 73 5 74 5 75 /* END INCLUDE FILE ... system_link_names.incl.pl1 */ 466 6 1 /* BEGIN INCLUDE FILE ... stack_header.incl.pl1 .. 3/72 Bill Silver */ 6 2 /* modified 7/76 by M. Weaver for *system links and more system use of areas */ 6 3 /* modified 3/77 by M. Weaver to add rnt_ptr */ 6 4 /* Modified April 1983 by C. Hornig for tasking */ 6 5 6 6 /****^ HISTORY COMMENTS: 6 7* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396), 6 8* audit(86-08-05,Schroth), install(86-11-03,MR12.0-1206): 6 9* added the heap_header_ptr definition. 6 10* 2) change(86-08-12,Kissel), approve(86-08-12,MCR7473), 6 11* audit(86-10-10,Fawcett), install(86-11-03,MR12.0-1206): 6 12* Modified to support control point management. These changes were actually 6 13* made in February 1985 by G. Palter. 6 14* 3) change(86-10-22,Fawcett), approve(86-10-22,MCR7473), 6 15* audit(86-10-22,Farley), install(86-11-03,MR12.0-1206): 6 16* Remove the old_lot pointer and replace it with cpm_data_ptr. Use the 18 6 17* bit pad after cur_lot_size for the cpm_enabled. This was done to save some 6 18* space int the stack header and change the cpd_ptr unal to cpm_data_ptr 6 19* (ITS pair). 6 20* END HISTORY COMMENTS */ 6 21 6 22 /* format: style2 */ 6 23 6 24 dcl sb ptr; /* the main pointer to the stack header */ 6 25 6 26 dcl 1 stack_header based (sb) aligned, 6 27 2 pad1 (4) fixed bin, /* (0) also used as arg list by outward_call_handler */ 6 28 2 cpm_data_ptr ptr, /* (4) pointer to control point which owns this stack */ 6 29 2 combined_stat_ptr ptr, /* (6) pointer to area containing separate static */ 6 30 2 clr_ptr ptr, /* (8) pointer to area containing linkage sections */ 6 31 2 max_lot_size fixed bin (17) unal, /* (10) DU number of words allowed in lot */ 6 32 2 main_proc_invoked fixed bin (11) unal, /* (10) DL nonzero if main procedure invoked in run unit */ 6 33 2 have_static_vlas bit (1) unal, /* (10) DL "1"b if (very) large arrays are being used in static */ 6 34 2 pad4 bit (2) unal, 6 35 2 run_unit_depth fixed bin (2) unal, /* (10) DL number of active run units stacked */ 6 36 2 cur_lot_size fixed bin (17) unal, /* (11) DU number of words (entries) in lot */ 6 37 2 cpm_enabled bit (18) unal, /* (11) DL non-zero if control point management is enabled */ 6 38 2 system_free_ptr ptr, /* (12) pointer to system storage area */ 6 39 2 user_free_ptr ptr, /* (14) pointer to user storage area */ 6 40 2 null_ptr ptr, /* (16) */ 6 41 2 stack_begin_ptr ptr, /* (18) pointer to first stack frame on the stack */ 6 42 2 stack_end_ptr ptr, /* (20) pointer to next useable stack frame */ 6 43 2 lot_ptr ptr, /* (22) pointer to the lot for the current ring */ 6 44 2 signal_ptr ptr, /* (24) pointer to signal procedure for current ring */ 6 45 2 bar_mode_sp ptr, /* (26) value of sp before entering bar mode */ 6 46 2 pl1_operators_ptr ptr, /* (28) pointer to pl1_operators_$operator_table */ 6 47 2 call_op_ptr ptr, /* (30) pointer to standard call operator */ 6 48 2 push_op_ptr ptr, /* (32) pointer to standard push operator */ 6 49 2 return_op_ptr ptr, /* (34) pointer to standard return operator */ 6 50 2 return_no_pop_op_ptr 6 51 ptr, /* (36) pointer to standard return / no pop operator */ 6 52 2 entry_op_ptr ptr, /* (38) pointer to standard entry operator */ 6 53 2 trans_op_tv_ptr ptr, /* (40) pointer to translator operator ptrs */ 6 54 2 isot_ptr ptr, /* (42) pointer to ISOT */ 6 55 2 sct_ptr ptr, /* (44) pointer to System Condition Table */ 6 56 2 unwinder_ptr ptr, /* (46) pointer to unwinder for current ring */ 6 57 2 sys_link_info_ptr ptr, /* (48) pointer to *system link name table */ 6 58 2 rnt_ptr ptr, /* (50) pointer to Reference Name Table */ 6 59 2 ect_ptr ptr, /* (52) pointer to event channel table */ 6 60 2 assign_linkage_ptr ptr, /* (54) pointer to storage for (obsolete) hcs_$assign_linkage */ 6 61 2 heap_header_ptr ptr, /* (56) pointer to the heap header for this ring */ 6 62 2 trace, 6 63 3 frames, 6 64 4 count fixed bin, /* (58) number of trace frames */ 6 65 4 top_ptr ptr unal, /* (59) pointer to last trace frame */ 6 66 3 in_trace bit (36) aligned, /* (60) trace antirecursion flag */ 6 67 2 pad2 bit (36), /* (61) */ 6 68 2 pad5 pointer; /* (62) pointer to future stuff */ 6 69 6 70 /* The following offset refers to a table within the pl1 operator table. */ 6 71 6 72 dcl tv_offset fixed bin init (361) internal static; 6 73 /* (551) octal */ 6 74 6 75 6 76 /* The following constants are offsets within this transfer vector table. */ 6 77 6 78 dcl ( 6 79 call_offset fixed bin init (271), 6 80 push_offset fixed bin init (272), 6 81 return_offset fixed bin init (273), 6 82 return_no_pop_offset fixed bin init (274), 6 83 entry_offset fixed bin init (275) 6 84 ) internal static; 6 85 6 86 6 87 6 88 6 89 6 90 /* The following declaration is an overlay of the whole stack header. Procedures which 6 91* move the whole stack header should use this overlay. 6 92**/ 6 93 6 94 dcl stack_header_overlay (size (stack_header)) fixed bin based (sb); 6 95 6 96 6 97 6 98 /* END INCLUDE FILE ... stack_header.incl.pl1 */ 467 468 7 1 /* BEGIN INCLUDE FILE sub_err_flags.incl.pl1 BIM 11/81 */ 7 2 /* format: style3 */ 7 3 7 4 /* These constants are to be used for the flags argument of sub_err_ */ 7 5 /* They are just "string (condition_info_header.action_flags)" */ 7 6 7 7 declare ( 7 8 ACTION_CAN_RESTART init (""b), 7 9 ACTION_CANT_RESTART init ("1"b), 7 10 ACTION_DEFAULT_RESTART 7 11 init ("01"b), 7 12 ACTION_QUIET_RESTART 7 13 init ("001"b), 7 14 ACTION_SUPPORT_SIGNAL 7 15 init ("0001"b) 7 16 ) bit (36) aligned internal static options (constant); 7 17 7 18 /* End include file */ 469 470 471 end fortran_storage_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/20/86 1142.5 fortran_storage_.pl1 >special_ldd>install>MR12.0-1222>fortran_storage_.pl1 72 1 10/12/83 1515.6 fortran_storage.incl.pl1 >ldd>include>fortran_storage.incl.pl1 373 2 03/24/82 1347.2 condition_info_header.incl.pl1 >ldd>include>condition_info_header.incl.pl1 464 3 11/20/86 1035.4 system_link_init_info.incl.pl1 >special_ldd>install>MR12.0-1222>system_link_init_info.incl.pl1 465 4 07/27/83 0910.0 linkdcl.incl.pl1 >ldd>include>linkdcl.incl.pl1 466 5 11/20/86 1035.4 system_link_names.incl.pl1 >special_ldd>install>MR12.0-1222>system_link_names.incl.pl1 467 6 11/07/86 1550.3 stack_header.incl.pl1 >ldd>include>stack_header.incl.pl1 469 7 04/16/82 0958.1 sub_err_flags.incl.pl1 >ldd>include>sub_err_flags.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. ACTION_CANT_RESTART 000016 constant bit(36) initial dcl 7-7 set ref 222* 456* K256 0(23) based bit(1) level 3 packed unaligned dcl 1-23 ref 318 LA 0(21) based bit(1) level 3 packed unaligned dcl 1-23 ref 141 149 LA_base_addressor based pointer dcl 77 set ref 141* 151 161* VLA_addressors based structure level 1 dcl 290 VLA_base_addressor based pointer unaligned dcl 78 ref 165 198 VLA_base_ptr 000156 automatic pointer unaligned dcl 298 set ref 312* 330 337 337 a_code parameter fixed bin(35,0) dcl 239 set ref 235 258* a_def_ptr parameter pointer dcl 240 ref 235 256 a_link_ptr parameter pointer dcl 241 ref 235 249 a_type_ptr parameter pointer dcl 242 ref 235 addr builtin function dcl 107 ref 310 382 382 addrel builtin function dcl 107 ref 135 135 140 148 156 156 170 170 193 194 257 420 420 421 423 addressor_of_base based fixed bin(30,0) level 2 dcl 290 set ref 331* 340* addressor_of_offset 1 based fixed bin(30,0) array level 2 dcl 290 set ref 333* 343* alp 000100 automatic pointer dcl 66 set ref 112* 148 153 155* 167 169* 183 193 194 257* 419 asp 000102 automatic pointer dcl 66 set ref 113* 134* 140 182 atp 000104 automatic pointer dcl 66 set ref 111* 121 230 256* 419 auto 0(18) based bit(1) level 3 packed unaligned dcl 1-23 ref 132 base_addressor_ptr 000106 automatic pointer dcl 82 set ref 140* 141 148* 151 161 165 193* 198 331 333 340 343 based_ptr based pointer dcl 76 set ref 198 202 430* 435 baseno builtin function dcl 107 ref 337 block_name 3(18) based char level 2 in structure "create_entry" packed unaligned dcl 1-23 in procedure "fortran_storage_" set ref 212 222* block_name 000170 automatic varying char(32) dcl 407 in procedure "snap_link" set ref 422* 424 char_string 0(09) based char(31) level 2 packed unaligned dcl 4-70 ref 422 code parameter fixed bin(35,0) dcl 390 in procedure "snap_link" set ref 387 424* 425 code 000110 automatic fixed bin(35,0) dcl 83 in procedure "fortran_storage_" set ref 114* 135* 156* 170* 208* 210 212* 220 222* 455* common 0(20) based bit(1) level 3 packed unaligned dcl 1-23 ref 187 common_link 3 based fixed bin(18,0) level 2 packed unsigned unaligned dcl 1-23 ref 194 condition_info 000100 automatic structure level 1 dcl 375 set ref 377 382 382 condition_info_header based structure level 1 dcl 2-6 cp 000112 automatic pointer dcl 84 set ref 121* 124 132 135 135 135 135 135 135 140 141 146 148 149 156 156 156 156 156 156 170 170 170 170 170 170 187 193 194 212 222 228* 230* 309 310 318 create_entry based structure level 1 unaligned dcl 1-23 set ref 135 135 156 156 170 170 create_relp based bit(18) level 2 packed unaligned dcl 68 ref 121 121 currentsize builtin function dcl 107 ref 135 135 156 156 170 170 def_offset 1 based bit(18) level 2 packed unaligned dcl 4-52 ref 419 defp 000114 automatic pointer dcl 85 set ref 419* 420 420 421 423 details parameter char unaligned dcl 366 ref 351 380 dirname 000211 automatic char(168) unaligned dcl 450 set ref 455* 456* dirname_length 000273 automatic fixed bin(17,0) dcl 452 set ref 455* divide builtin function dcl 107 ref 129 343 entryname 000263 automatic char(32) unaligned dcl 451 set ref 455* 456* error_table_$resource_unavailable 000022 external static fixed bin(35,0) dcl 287 set ref 320* exp_ptr 1 based bit(18) level 2 packed unaligned dcl 4-11 ref 420 exp_word based structure level 1 dcl 4-21 ext_ptr 1(18) based bit(18) level 2 packed unaligned dcl 4-25 ref 421 fixed builtin function dcl 107 ref 337 337 343 422 flags 0(18) based structure level 2 packed unaligned dcl 1-23 fortran_storage_manager_$alloc 000012 constant entry external dcl 100 ref 134 155 169 found_sw 000116 automatic bit(1) dcl 86 set ref 424* 425 ft2 0(30) based bit(6) level 2 packed unaligned dcl 4-11 ref 198 412 have_static_vlas 12(30) based bit(1) level 2 packed unaligned dcl 6-26 set ref 182* hcs_$fs_get_path_name 000026 constant entry external dcl 448 ref 455 head_ptr based bit(18) level 2 packed unaligned dcl 4-11 ref 257 i 000150 automatic fixed bin(17,0) dcl 298 set ref 332* 333 333* 341* 342 343* init 0(24) based bit(1) level 3 packed unaligned dcl 1-23 ref 135 156 170 init_info_ptr 000140 automatic pointer dcl 3-27 set ref 423* 424* length 1 based fixed bin(24,0) level 2 in structure "create_entry" dcl 1-23 in procedure "fortran_storage_" ref 124 135 156 170 length 000117 automatic fixed bin(24,0) dcl 87 in procedure "fortran_storage_" set ref 124* 129 link based structure level 1 dcl 4-11 linkage_header_flags based structure level 1 dcl 4-44 linkp 000120 automatic pointer dcl 88 set ref 194* 198 198 202 249* 257 257 412 420 430 435 list_init_ 000014 constant entry external dcl 102 ref 135 156 170 location based fixed bin(18,0) level 2 packed unsigned unaligned dcl 1-23 ref 140 148 193 logical_address_of_base 000151 automatic fixed bin(30,0) dcl 298 set ref 330* 331 333 337* 340 342 logical_address_of_offset 000152 automatic fixed bin(30,0) dcl 298 set ref 342* 343 343 looping 000122 automatic bit(1) unaligned dcl 89 set ref 120* 121 228* lp parameter pointer dcl 62 ref 17 19 112 name based structure level 1 dcl 4-70 name_length 2(18) based fixed bin(17,0) level 2 packed unaligned dcl 1-23 ref 135 135 156 156 170 170 212 222 222 310 namep 000124 automatic pointer dcl 90 set ref 421* 422 422 nchars based bit(9) level 2 packed unaligned dcl 4-70 ref 422 next 2 based fixed bin(18,0) level 2 packed unsigned unaligned dcl 1-23 ref 228 230 null builtin function dcl 107 ref 135 135 151 156 156 165 170 170 222 222 382 382 456 456 num_segs_needed 000126 automatic fixed bin(17,0) dcl 91 set ref 129* 134* 155* 169* offset based fixed bin(24,0) array dcl 296 ref 333 342 offset_cnt 000153 automatic fixed bin(17,0) dcl 298 set ref 309* 310 332 341 offset_ptr 000154 automatic pointer dcl 298 set ref 310* 333 342 parm based structure level 1 packed unaligned dcl 68 perprocess_static 0(29) based bit(1) level 2 packed unaligned dcl 4-44 ref 153 167 pl1_operators_$VLA_words_per_seg_ 000010 external static fixed bin(19,0) dcl 97 ref 129 129 318 328 337 343 343 pointer_count 0(27) based fixed bin(9,0) level 3 packed unsigned unaligned dcl 1-23 ref 135 135 156 156 170 170 309 pointer_offsets based structure array level 2 dcl 1-23 set ref 310 ptr builtin function dcl 107 ref 110 121 182 230 256 419 rel builtin function dcl 107 ref 337 retval 000210 automatic fixed bin(35,0) dcl 447 set ref 454* 456* rtrim builtin function dcl 107 ref 380 set_ext_variable_ 000016 constant entry external dcl 103 ref 424 signal_ 000024 constant entry external dcl 369 ref 382 size builtin function dcl 371 ref 377 sp parameter pointer dcl 63 ref 17 19 113 stack_header based structure level 1 dcl 6-26 stackbaseptr builtin function dcl 107 ref 135 135 156 156 170 170 424 424 static 0(19) based bit(1) level 3 packed unaligned dcl 1-23 ref 146 static_vlas 0(28) based bit(1) level 2 packed unaligned dcl 4-44 set ref 183* status parameter fixed bin(35,0) dcl 366 ref 351 381 storage_ptr 000130 automatic pointer dcl 92 set ref 134* 135* 141 155* 156* 161 169* 170* 202* 312 429* 430 435* sub_err_ 000020 constant entry external dcl 104 ref 222 456 substr builtin function dcl 107 ref 422 textp 000132 automatic pointer dcl 93 set ref 110* 455* tp parameter pointer dcl 64 ref 17 19 110 111 121 121 trap_ptr 0(18) based bit(18) level 2 packed unaligned dcl 4-25 ref 423 type_pair based structure level 1 dcl 4-25 type_ptr 000134 automatic pointer dcl 94 in procedure "fortran_storage_" set ref 420* 421 423 type_ptr based bit(18) level 2 in structure "exp_word" packed unaligned dcl 4-21 in procedure "fortran_storage_" ref 420 unspec builtin function dcl 107 set ref 230 330* 330 379* variable_node based structure level 1 dcl 5-33 variablep 000136 automatic pointer dcl 95 set ref 424* 429 vbl_ptr 4 based pointer level 2 dcl 5-33 ref 429 virgin_linkage_header based structure level 1 dcl 4-52 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ACTION_CAN_RESTART internal static bit(36) initial dcl 7-7 ACTION_DEFAULT_RESTART internal static bit(36) initial dcl 7-7 ACTION_QUIET_RESTART internal static bit(36) initial dcl 7-7 ACTION_SUPPORT_SIGNAL internal static bit(36) initial dcl 7-7 EMPTY_AREA_INIT internal static fixed bin(17,0) initial dcl 3-97 INIT_DEFERRED internal static fixed bin(17,0) initial dcl 3-99 ITS_PTR_INIT internal static fixed bin(3,0) initial unsigned dcl 3-100 LIST_TEMPLATE_INIT internal static fixed bin(17,0) initial dcl 3-98 NO_INIT internal static fixed bin(17,0) initial dcl 3-95 PACKED_PTR_INIT internal static fixed bin(3,0) initial unsigned dcl 3-101 PTR_INIT_ISOT internal static fixed bin(17,0) initial dcl 3-104 PTR_INIT_LOT internal static fixed bin(17,0) initial dcl 3-103 PTR_INIT_TEXT internal static fixed bin(17,0) initial dcl 3-102 TEMPLATE_INIT internal static fixed bin(17,0) initial dcl 3-96 call_offset internal static fixed bin(17,0) initial dcl 6-78 condition_info_header_ptr automatic pointer dcl 2-4 create_init_entry based structure level 1 unaligned dcl 1-61 entry_offset internal static fixed bin(17,0) initial dcl 6-78 header based structure level 1 dcl 4-31 heap_header based structure level 1 unaligned dcl 5-64 heap_header_version_1 internal static char(8) initial unaligned dcl 5-71 init_info based structure level 1 dcl 3-30 init_info_single_word based structure level 1 dcl 3-35 init_n_bits_in_datum automatic fixed bin(35,0) dcl 3-93 init_size automatic fixed bin(35,0) dcl 3-28 list_init_info based structure level 1 dcl 3-41 list_template_entry based structure level 1 dcl 3-60 list_template_entry_ptr based structure level 1 dcl 3-73 pointer_init_template based structure level 1 packed unaligned dcl 3-85 push_offset internal static fixed bin(17,0) initial dcl 6-78 return_no_pop_offset internal static fixed bin(17,0) initial dcl 6-78 return_offset internal static fixed bin(17,0) initial dcl 6-78 sb automatic pointer dcl 6-24 stack_header_overlay based fixed bin(17,0) array dcl 6-94 string builtin function dcl 107 trap_word based structure level 1 dcl 4-66 tv_offset internal static fixed bin(17,0) initial dcl 6-72 variable_table_header based structure level 1 dcl 5-19 NAMES DECLARED BY EXPLICIT CONTEXT. create 000144 constant entry external dcl 19 fill_VLA_addressors 001000 constant entry internal dcl 261 ref 143 175 203 216 fortran_storage_ 000133 constant entry external dcl 17 re_try_snap 000574 constant label dcl 208 ref 214 resolve_VLA_COMMON_link 000747 constant entry external dcl 235 signal_fortran_storage_error 001142 constant entry internal dcl 351 ref 212 320 signal_sub_error 001402 constant entry internal dcl 439 ref 153 167 snap_link 001242 constant entry internal dcl 387 ref 208 258 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1714 1744 1524 1724 Length 2314 1524 30 334 167 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME fortran_storage_ 398 external procedure is an external procedure. fill_VLA_addressors internal procedure shares stack frame of external procedure fortran_storage_. signal_fortran_storage_error 160 internal procedure is called during a stack extension. snap_link internal procedure shares stack frame of external procedure fortran_storage_. signal_sub_error internal procedure shares stack frame of external procedure fortran_storage_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME fortran_storage_ 000100 alp fortran_storage_ 000102 asp fortran_storage_ 000104 atp fortran_storage_ 000106 base_addressor_ptr fortran_storage_ 000110 code fortran_storage_ 000112 cp fortran_storage_ 000114 defp fortran_storage_ 000116 found_sw fortran_storage_ 000117 length fortran_storage_ 000120 linkp fortran_storage_ 000122 looping fortran_storage_ 000124 namep fortran_storage_ 000126 num_segs_needed fortran_storage_ 000130 storage_ptr fortran_storage_ 000132 textp fortran_storage_ 000134 type_ptr fortran_storage_ 000136 variablep fortran_storage_ 000140 init_info_ptr fortran_storage_ 000150 i fill_VLA_addressors 000151 logical_address_of_base fill_VLA_addressors 000152 logical_address_of_offset fill_VLA_addressors 000153 offset_cnt fill_VLA_addressors 000154 offset_ptr fill_VLA_addressors 000156 VLA_base_ptr fill_VLA_addressors 000170 block_name snap_link 000210 retval signal_sub_error 000211 dirname signal_sub_error 000263 entryname signal_sub_error 000273 dirname_length signal_sub_error signal_fortran_storage_error 000100 condition_info signal_fortran_storage_error THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp unpk_to_pk call_ext_out_desc call_ext_out call_int_this_desc return_mac shorten_stack ext_entry int_entry_desc set_support THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. fortran_storage_manager_$alloc hcs_$fs_get_path_name list_init_ set_ext_variable_ signal_ sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$resource_unavailable pl1_operators_$VLA_words_per_seg_ CONSTANTS 001516 aa 000002000000 001517 aa 000000000000 001520 aa 600000000041 001521 aa 000110000000 001522 aa 007777000001 000000 aa 524000000154 000001 aa 526000000040 000002 aa 404000000021 000003 aa 526000000250 000004 aa 514000000001 000005 aa 524000000025 000006 aa 526077777777 000007 aa 524000000072 000010 aa 526000000000 000011 aa 524000000054 000012 aa 404000000005 000013 aa 514000000044 000014 aa 524000000020 000015 aa 524000000000 001523 aa 777777000000 000016 aa 400000000000 000017 aa 404000000043 000020 aa 464000000000 000022 aa 077777000043 000023 aa 000001000000 000024 aa 146 157 162 164 fort 000025 aa 162 141 156 137 ran_ 000026 aa 163 164 157 162 stor 000027 aa 141 147 145 137 age_ 000030 aa 040 103 117 115 COM 000031 aa 115 117 116 040 MON 000032 aa 142 154 157 143 bloc 000033 aa 153 040 000 000 k 000034 aa 146 157 162 164 fort 000035 aa 162 141 156 137 ran_ 000036 aa 163 164 157 162 stor 000037 aa 141 147 145 137 age_ 000040 aa 145 162 162 157 erro 000041 aa 162 000 000 000 r 000042 aa 101 156 040 145 An e 000043 aa 162 162 157 162 rror 000044 aa 040 150 141 163 has 000045 aa 040 157 143 143 occ 000046 aa 165 162 162 145 urre 000047 aa 144 040 167 150 d wh 000050 aa 151 154 145 040 ile 000051 aa 151 156 151 164 init 000052 aa 151 141 154 151 iali 000053 aa 172 151 156 147 zing 000054 aa 040 136 141 056 ^a. 000055 aa 120 162 157 147 Prog 000056 aa 162 141 155 040 ram 000057 aa 162 145 161 165 requ 000060 aa 151 162 145 163 ires 000061 aa 040 163 164 157 sto 000062 aa 162 141 147 145 rage 000063 aa 040 164 157 040 to 000064 aa 142 145 040 141 be a 000065 aa 154 154 157 143 lloc 000066 aa 141 164 145 144 ated 000067 aa 040 151 156 040 in 000070 aa 062 065 066 113 256K 000071 aa 040 163 145 147 seg 000072 aa 155 145 156 164 ment 000073 aa 163 056 000 000 s. 000074 aa 101 164 164 145 Atte 000075 aa 155 160 164 040 mpt 000076 aa 142 171 040 160 by p 000077 aa 145 162 160 162 erpr 000100 aa 157 143 145 163 oces 000101 aa 163 040 163 164 s st 000102 aa 141 164 151 143 atic 000103 aa 040 163 145 147 seg 000104 aa 155 145 156 164 ment 000105 aa 040 136 141 076 ^a> 000106 aa 136 141 136 057 ^a^/ 000107 aa 164 157 040 165 to u 000110 aa 163 145 040 163 se s 000111 aa 164 141 164 151 tati 000112 aa 143 040 050 166 c (v 000113 aa 145 162 171 051 ery) 000114 aa 040 154 141 162 lar 000115 aa 147 145 040 141 ge a 000116 aa 162 162 141 171 rray 000117 aa 163 056 040 040 s. 000120 aa 124 150 151 163 This 000121 aa 040 143 157 155 com 000122 aa 142 151 156 141 bina 000123 aa 164 151 157 156 tion 000124 aa 040 151 163 040 is 000125 aa 151 154 154 145 ille 000126 aa 147 141 154 056 gal. BEGIN PROCEDURE fortran_storage_ ENTRY TO fortran_storage_ STATEMENT 1 ON LINE 17 fortran_storage_: proc (sp, lp, tp) options (support); 000127 at 000003000020 000130 tt 000020000020 000131 ta 000127000000 000132 da 000132300000 000133 aa 000620 6270 00 eax7 400 000134 aa 7 00034 3521 20 epp2 pr7|28,* 000135 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000136 aa 000006000000 000137 aa 000000000000 000140 aa 0 01372 7001 00 tsx0 pr0|762 set_support STATEMENT 1 ON LINE 19 create: entry (sp, lp, tp); 000141 aa 000011 7100 04 tra 9,ic 000152 ENTRY TO create STATEMENT 1 ON LINE 19 create: entry (sp, lp, tp); 000142 ta 000127000000 000143 da 000137300000 000144 aa 000620 6270 00 eax7 400 000145 aa 7 00034 3521 20 epp2 pr7|28,* 000146 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000147 aa 000006000000 000150 aa 000000000000 000151 aa 0 01372 7001 00 tsx0 pr0|762 set_support STATEMENT 1 ON LINE 110 textp = ptr (tp, "000000"b3); 000152 aa 6 00032 3735 20 epp7 pr6|26,* 000153 aa 7 00006 3521 20 epp2 pr7|6,* tp 000154 aa 2 00000 3525 20 epbp2 pr2|0,* tp 000155 aa 6 00132 2521 00 spri2 pr6|90 textp STATEMENT 1 ON LINE 111 atp = tp; 000156 aa 7 00006 3715 20 epp5 pr7|6,* tp 000157 aa 5 00000 3715 20 epp5 pr5|0,* tp 000160 aa 6 00104 6515 00 spri5 pr6|68 atp STATEMENT 1 ON LINE 112 alp = lp; 000161 aa 7 00004 3535 20 epp3 pr7|4,* lp 000162 aa 3 00000 3535 20 epp3 pr3|0,* lp 000163 aa 6 00100 2535 00 spri3 pr6|64 alp STATEMENT 1 ON LINE 113 asp = sp; 000164 aa 7 00002 3515 20 epp1 pr7|2,* sp 000165 aa 1 00000 3515 20 epp1 pr1|0,* sp 000166 aa 6 00102 2515 00 spri1 pr6|66 asp STATEMENT 1 ON LINE 114 code = 0; 000167 aa 6 00110 4501 00 stz pr6|72 code STATEMENT 1 ON LINE 120 looping = "1"b; 000170 aa 400000 2350 03 lda 131072,du 000171 aa 6 00122 7551 00 sta pr6|82 looping STATEMENT 1 ON LINE 121 if parm.create_relp ^= "777777"b3 /* list exists */ then do cp = ptr (atp, parm.create_relp) repeat ptr (atp, unspec (cp -> create_entry.next)) while (looping); 000172 aa 000 004 066 500 cmpb (pr),(ic),fill(0) 000173 aa 5 00000 00 0022 descb pr5|0,18 parm.create_relp 000174 aa 001331 00 0022 descb 729,18 001523 = 777777000000 000175 aa 000544 6000 04 tze 356,ic 000741 000176 aa 003 100 060 500 csl (pr),(pr),fill(0),bool(move) 000177 aa 5 00000 00 0022 descb pr5|0,18 parm.create_relp 000200 aa 6 00056 00 0044 descb pr6|46,36 000201 aa 6 00056 2351 00 lda pr6|46 000202 aa 6 00104 3715 20 epp5 pr6|68,* atp 000203 aa 000000 3314 01 eawp5 0,au 000204 aa 6 00112 6515 00 spri5 pr6|74 cp 000205 aa 000000 0110 03 nop 0,du 000206 aa 6 00122 2351 00 lda pr6|82 looping 000207 aa 000532 6000 04 tze 346,ic 000741 STATEMENT 1 ON LINE 124 length = cp -> create_entry.length; 000210 aa 6 00112 3735 20 epp7 pr6|74,* cp 000211 aa 7 00001 2361 00 ldq pr7|1 create_entry.length 000212 aa 6 00117 7561 00 stq pr6|79 length STATEMENT 1 ON LINE 129 num_segs_needed = divide (length + pl1_operators_$VLA_words_per_seg_ - 1, pl1_operators_$VLA_words_per_seg_, 17); 000213 aa 6 00044 3701 20 epp4 pr6|36,* 000214 la 4 00010 0761 20 adq pr4|8,* pl1_operators_$VLA_words_per_seg_ 000215 aa 000001 1760 07 sbq 1,dl 000216 la 4 00010 5061 20 div pr4|8,* pl1_operators_$VLA_words_per_seg_ 000217 aa 6 00126 7561 00 stq pr6|86 num_segs_needed STATEMENT 1 ON LINE 132 if cp -> create_entry.flags.auto then do; 000220 aa 7 00000 2351 00 lda pr7|0 create_entry.auto 000221 aa 400000 3150 07 cana 131072,dl 000222 aa 000100 6000 04 tze 64,ic 000322 STATEMENT 1 ON LINE 134 call fortran_storage_manager_$alloc (num_segs_needed, asp, storage_ptr); 000223 aa 6 00126 3521 00 epp2 pr6|86 num_segs_needed 000224 aa 6 00276 2521 00 spri2 pr6|190 000225 aa 6 00102 3521 00 epp2 pr6|66 asp 000226 aa 6 00300 2521 00 spri2 pr6|192 000227 aa 6 00130 3521 00 epp2 pr6|88 storage_ptr 000230 aa 6 00302 2521 00 spri2 pr6|194 000231 aa 6 00274 6211 00 eax1 pr6|188 000232 aa 014000 4310 07 fld 6144,dl 000233 la 4 00012 3521 20 epp2 pr4|10,* fortran_storage_manager_$alloc 000234 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 135 if cp -> create_entry.init then call list_init_ (storage_ptr, addrel (cp, currentsize (cp -> create_entry)), (cp -> create_entry.length), stackbaseptr (), null (), code); 000235 aa 6 00112 2351 20 lda pr6|74,* create_entry.init 000236 aa 004000 3150 07 cana 2048,dl 000237 aa 000046 6000 04 tze 38,ic 000305 000240 aa 6 00112 2361 20 ldq pr6|74,* create_entry.pointer_count 000241 aa 0 00416 3771 00 anaq pr0|270 = 000000000000 000000000777 000242 aa 6 00304 7561 00 stq pr6|196 create_entry.pointer_count 000243 aa 6 00112 3735 20 epp7 pr6|74,* cp 000244 aa 7 00002 2351 00 lda pr7|2 create_entry.name_length 000245 aa 000022 7350 00 als 18 000246 aa 000066 7330 00 lrs 54 000247 aa 000016 0760 07 adq 14,dl 000250 aa 000003 0760 07 adq 3,dl 000251 aa 000002 7320 00 qrs 2 000252 aa 6 00304 0761 00 adq pr6|196 create_entry.pointer_count 000253 aa 7 00000 3521 06 epp2 pr7|0,ql 000254 aa 000000 0520 03 adwp2 0,du 000255 aa 6 00306 2521 00 spri2 pr6|198 000256 aa 7 00001 2361 00 ldq pr7|1 create_entry.length 000257 aa 6 00305 7561 00 stq pr6|197 000260 aa 6 00000 3511 00 epbp1 pr6|0 000261 aa 6 00310 2515 00 spri1 pr6|200 000262 aa 777540 3714 24 epp5 -160,ic* 000263 aa 6 00312 6515 00 spri5 pr6|202 000264 aa 6 00130 3521 00 epp2 pr6|88 storage_ptr 000265 aa 6 00316 2521 00 spri2 pr6|206 000266 aa 6 00306 3521 00 epp2 pr6|198 000267 aa 6 00320 2521 00 spri2 pr6|208 000270 aa 6 00305 3521 00 epp2 pr6|197 000271 aa 6 00322 2521 00 spri2 pr6|210 000272 aa 6 00310 3521 00 epp2 pr6|200 000273 aa 6 00324 2521 00 spri2 pr6|212 000274 aa 6 00312 3521 00 epp2 pr6|202 000275 aa 6 00326 2521 00 spri2 pr6|214 000276 aa 6 00110 3521 00 epp2 pr6|72 code 000277 aa 6 00330 2521 00 spri2 pr6|216 000300 aa 6 00314 6211 00 eax1 pr6|204 000301 aa 030000 4310 07 fld 12288,dl 000302 aa 6 00044 3701 20 epp4 pr6|36,* 000303 la 4 00014 3521 20 epp2 pr4|12,* list_init_ 000304 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 140 base_addressor_ptr = addrel (asp, cp -> create_entry.location); 000305 aa 6 00112 2351 20 lda pr6|74,* create_entry.location 000306 aa 000066 7730 00 lrl 54 000307 aa 6 00102 3521 66 epp2 pr6|66,*ql asp 000310 aa 000000 0520 03 adwp2 0,du 000311 aa 6 00106 2521 00 spri2 pr6|70 base_addressor_ptr STATEMENT 1 ON LINE 141 if cp -> create_entry.flags.LA then LA_base_addressor = storage_ptr; 000312 aa 6 00112 2351 20 lda pr6|74,* create_entry.LA 000313 aa 040000 3150 07 cana 16384,dl 000314 aa 000004 6000 04 tze 4,ic 000320 000315 aa 6 00130 3735 20 epp7 pr6|88,* storage_ptr 000316 aa 2 00000 6535 00 spri7 pr2|0 LA_base_addressor 000317 aa 000320 7100 04 tra 208,ic 000637 STATEMENT 1 ON LINE 143 else call fill_VLA_addressors; 000320 aa 000460 6700 04 tsp4 304,ic 001000 STATEMENT 1 ON LINE 144 end; 000321 aa 000316 7100 04 tra 206,ic 000637 STATEMENT 1 ON LINE 146 else if cp -> create_entry.flags.static then do; 000322 aa 7 00000 2351 00 lda pr7|0 create_entry.static 000323 aa 200000 3150 07 cana 65536,dl 000324 aa 000214 6000 04 tze 140,ic 000540 STATEMENT 1 ON LINE 148 base_addressor_ptr = addrel (alp, cp -> create_entry.location); 000325 aa 7 00000 2351 00 lda pr7|0 create_entry.location 000326 aa 000066 7730 00 lrl 54 000327 aa 6 00100 3521 66 epp2 pr6|64,*ql alp 000330 aa 000000 0520 03 adwp2 0,du 000331 aa 6 00106 2521 00 spri2 pr6|70 base_addressor_ptr STATEMENT 1 ON LINE 149 if cp -> create_entry.flags.LA then do; 000332 aa 7 00000 2351 00 lda pr7|0 create_entry.LA 000333 aa 040000 3150 07 cana 16384,dl 000334 aa 000077 6000 04 tze 63,ic 000433 STATEMENT 1 ON LINE 151 if LA_base_addressor = null () then do; 000335 aa 2 00000 2371 00 ldaq pr2|0 LA_base_addressor 000336 aa 777464 6770 04 eraq -204,ic 000022 = 077777000043 000001000000 000337 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 000340 aa 000172 6010 04 tnz 122,ic 000532 STATEMENT 1 ON LINE 153 if alp -> linkage_header_flags.perprocess_static then call signal_sub_error; 000341 aa 6 00100 2351 20 lda pr6|64,* linkage_header_flags.perprocess_static 000342 aa 000100 3150 07 cana 64,dl 000343 aa 000002 6000 04 tze 2,ic 000345 000344 aa 001036 6700 04 tsp4 542,ic 001402 STATEMENT 1 ON LINE 155 call fortran_storage_manager_$alloc (num_segs_needed, alp, storage_ptr); 000345 aa 6 00126 3521 00 epp2 pr6|86 num_segs_needed 000346 aa 6 00276 2521 00 spri2 pr6|190 000347 aa 6 00100 3521 00 epp2 pr6|64 alp 000350 aa 6 00300 2521 00 spri2 pr6|192 000351 aa 6 00130 3521 00 epp2 pr6|88 storage_ptr 000352 aa 6 00302 2521 00 spri2 pr6|194 000353 aa 6 00274 6211 00 eax1 pr6|188 000354 aa 014000 4310 07 fld 6144,dl 000355 aa 6 00044 3701 20 epp4 pr6|36,* 000356 la 4 00012 3521 20 epp2 pr4|10,* fortran_storage_manager_$alloc 000357 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 156 if cp -> create_entry.init then call list_init_ (storage_ptr, addrel (cp, currentsize (cp -> create_entry)), (cp -> create_entry.length), stackbaseptr (), null (), code); 000360 aa 6 00112 2351 20 lda pr6|74,* create_entry.init 000361 aa 004000 3150 07 cana 2048,dl 000362 aa 000046 6000 04 tze 38,ic 000430 000363 aa 6 00112 2361 20 ldq pr6|74,* create_entry.pointer_count 000364 aa 0 00416 3771 00 anaq pr0|270 = 000000000000 000000000777 000365 aa 6 00305 7561 00 stq pr6|197 create_entry.pointer_count 000366 aa 6 00112 3735 20 epp7 pr6|74,* cp 000367 aa 7 00002 2351 00 lda pr7|2 create_entry.name_length 000370 aa 000022 7350 00 als 18 000371 aa 000066 7330 00 lrs 54 000372 aa 000016 0760 07 adq 14,dl 000373 aa 000003 0760 07 adq 3,dl 000374 aa 000002 7320 00 qrs 2 000375 aa 6 00305 0761 00 adq pr6|197 create_entry.pointer_count 000376 aa 7 00000 3521 06 epp2 pr7|0,ql 000377 aa 000000 0520 03 adwp2 0,du 000400 aa 6 00312 2521 00 spri2 pr6|202 000401 aa 7 00001 2361 00 ldq pr7|1 create_entry.length 000402 aa 6 00305 7561 00 stq pr6|197 000403 aa 6 00000 3511 00 epbp1 pr6|0 000404 aa 6 00310 2515 00 spri1 pr6|200 000405 aa 777415 3714 24 epp5 -243,ic* 000406 aa 6 00306 6515 00 spri5 pr6|198 000407 aa 6 00130 3521 00 epp2 pr6|88 storage_ptr 000410 aa 6 00316 2521 00 spri2 pr6|206 000411 aa 6 00312 3521 00 epp2 pr6|202 000412 aa 6 00320 2521 00 spri2 pr6|208 000413 aa 6 00305 3521 00 epp2 pr6|197 000414 aa 6 00322 2521 00 spri2 pr6|210 000415 aa 6 00310 3521 00 epp2 pr6|200 000416 aa 6 00324 2521 00 spri2 pr6|212 000417 aa 6 00306 3521 00 epp2 pr6|198 000420 aa 6 00326 2521 00 spri2 pr6|214 000421 aa 6 00110 3521 00 epp2 pr6|72 code 000422 aa 6 00330 2521 00 spri2 pr6|216 000423 aa 6 00314 6211 00 eax1 pr6|204 000424 aa 030000 4310 07 fld 12288,dl 000425 aa 6 00044 3701 20 epp4 pr6|36,* 000426 la 4 00014 3521 20 epp2 pr4|12,* list_init_ 000427 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 161 LA_base_addressor = storage_ptr; 000430 aa 6 00130 3735 20 epp7 pr6|88,* storage_ptr 000431 aa 6 00106 6535 20 spri7 pr6|70,* LA_base_addressor STATEMENT 1 ON LINE 162 end; STATEMENT 1 ON LINE 163 end; 000432 aa 000100 7100 04 tra 64,ic 000532 STATEMENT 1 ON LINE 164 else do; STATEMENT 1 ON LINE 165 if VLA_base_addressor = null () then do; 000433 aa 003 100 060 500 csl (pr),(pr),fill(0),bool(move) 000434 aa 2 00000 00 0044 descb pr2|0,36 VLA_base_addressor 000435 aa 6 00056 00 0044 descb pr6|46,36 000436 aa 6 00056 2351 00 lda pr6|46 000437 aa 000044 7730 00 lrl 36 000440 aa 001062 1160 04 cmpq 562,ic 001522 = 007777000001 000441 aa 000071 6010 04 tnz 57,ic 000532 STATEMENT 1 ON LINE 167 if alp -> linkage_header_flags.perprocess_static then call signal_sub_error; 000442 aa 6 00100 2351 20 lda pr6|64,* linkage_header_flags.perprocess_static 000443 aa 000100 3150 07 cana 64,dl 000444 aa 000002 6000 04 tze 2,ic 000446 000445 aa 000735 6700 04 tsp4 477,ic 001402 STATEMENT 1 ON LINE 169 call fortran_storage_manager_$alloc (num_segs_needed, alp, storage_ptr); 000446 aa 6 00126 3521 00 epp2 pr6|86 num_segs_needed 000447 aa 6 00276 2521 00 spri2 pr6|190 000450 aa 6 00100 3521 00 epp2 pr6|64 alp 000451 aa 6 00300 2521 00 spri2 pr6|192 000452 aa 6 00130 3521 00 epp2 pr6|88 storage_ptr 000453 aa 6 00302 2521 00 spri2 pr6|194 000454 aa 6 00274 6211 00 eax1 pr6|188 000455 aa 014000 4310 07 fld 6144,dl 000456 aa 6 00044 3701 20 epp4 pr6|36,* 000457 la 4 00012 3521 20 epp2 pr4|10,* fortran_storage_manager_$alloc 000460 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 170 if cp -> create_entry.init then call list_init_ (storage_ptr, addrel (cp, currentsize (cp -> create_entry)), (cp -> create_entry.length), stackbaseptr (), null (), code); 000461 aa 6 00112 2351 20 lda pr6|74,* create_entry.init 000462 aa 004000 3150 07 cana 2048,dl 000463 aa 000046 6000 04 tze 38,ic 000531 000464 aa 6 00112 2361 20 ldq pr6|74,* create_entry.pointer_count 000465 aa 0 00416 3771 00 anaq pr0|270 = 000000000000 000000000777 000466 aa 6 00305 7561 00 stq pr6|197 create_entry.pointer_count 000467 aa 6 00112 3735 20 epp7 pr6|74,* cp 000470 aa 7 00002 2351 00 lda pr7|2 create_entry.name_length 000471 aa 000022 7350 00 als 18 000472 aa 000066 7330 00 lrs 54 000473 aa 000016 0760 07 adq 14,dl 000474 aa 000003 0760 07 adq 3,dl 000475 aa 000002 7320 00 qrs 2 000476 aa 6 00305 0761 00 adq pr6|197 create_entry.pointer_count 000477 aa 7 00000 3521 06 epp2 pr7|0,ql 000500 aa 000000 0520 03 adwp2 0,du 000501 aa 6 00306 2521 00 spri2 pr6|198 000502 aa 7 00001 2361 00 ldq pr7|1 create_entry.length 000503 aa 6 00305 7561 00 stq pr6|197 000504 aa 6 00000 3511 00 epbp1 pr6|0 000505 aa 6 00310 2515 00 spri1 pr6|200 000506 aa 777314 3714 24 epp5 -308,ic* 000507 aa 6 00312 6515 00 spri5 pr6|202 000510 aa 6 00130 3521 00 epp2 pr6|88 storage_ptr 000511 aa 6 00316 2521 00 spri2 pr6|206 000512 aa 6 00306 3521 00 epp2 pr6|198 000513 aa 6 00320 2521 00 spri2 pr6|208 000514 aa 6 00305 3521 00 epp2 pr6|197 000515 aa 6 00322 2521 00 spri2 pr6|210 000516 aa 6 00310 3521 00 epp2 pr6|200 000517 aa 6 00324 2521 00 spri2 pr6|212 000520 aa 6 00312 3521 00 epp2 pr6|202 000521 aa 6 00326 2521 00 spri2 pr6|214 000522 aa 6 00110 3521 00 epp2 pr6|72 code 000523 aa 6 00330 2521 00 spri2 pr6|216 000524 aa 6 00314 6211 00 eax1 pr6|204 000525 aa 030000 4310 07 fld 12288,dl 000526 aa 6 00044 3701 20 epp4 pr6|36,* 000527 la 4 00014 3521 20 epp2 pr4|12,* list_init_ 000530 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 175 call fill_VLA_addressors; 000531 aa 000247 6700 04 tsp4 167,ic 001000 STATEMENT 1 ON LINE 176 end; STATEMENT 1 ON LINE 177 end; STATEMENT 1 ON LINE 182 ptr (asp, "0"b) -> stack_header.have_static_vlas = "1"b; 000532 aa 6 00102 3525 20 epbp2 pr6|66,* asp 000533 aa 000040 2350 07 lda 32,dl 000534 aa 2 00012 2551 00 orsa pr2|10 stack_header.have_static_vlas STATEMENT 1 ON LINE 183 alp -> linkage_header_flags.static_vlas = "1"b; 000535 aa 000200 2350 07 lda 128,dl 000536 aa 6 00100 2551 20 orsa pr6|64,* linkage_header_flags.static_vlas STATEMENT 1 ON LINE 185 end; 000537 aa 000100 7100 04 tra 64,ic 000637 STATEMENT 1 ON LINE 187 else if cp -> create_entry.flags.common then do; 000540 aa 7 00000 2351 00 lda pr7|0 create_entry.common 000541 aa 100000 3150 07 cana 32768,dl 000542 aa 000075 6000 04 tze 61,ic 000637 STATEMENT 1 ON LINE 193 base_addressor_ptr = addrel (alp, cp -> create_entry.location); 000543 aa 7 00000 2351 00 lda pr7|0 create_entry.location 000544 aa 000066 7730 00 lrl 54 000545 aa 6 00100 3521 66 epp2 pr6|64,*ql alp 000546 aa 000000 0520 03 adwp2 0,du 000547 aa 6 00106 2521 00 spri2 pr6|70 base_addressor_ptr STATEMENT 1 ON LINE 194 linkp = addrel (alp, cp -> create_entry.common_link); 000550 aa 7 00003 2351 00 lda pr7|3 create_entry.common_link 000551 aa 000066 7730 00 lrl 54 000552 aa 6 00100 3515 66 epp1 pr6|64,*ql alp 000553 aa 000000 0510 03 adwp1 0,du 000554 aa 6 00120 2515 00 spri1 pr6|80 linkp STATEMENT 1 ON LINE 198 if linkp -> link.ft2 ^= "46"b3/* snapped */ then if linkp -> based_ptr ^= VLA_base_addressor /* wrong VLA_base_addressor */ then do; 000555 aa 1 00000 2351 00 lda pr1|0 link.ft2 000556 aa 000036 7350 00 als 30 000557 aa 460000 1150 03 cmpa 155648,du 000560 aa 000014 6000 04 tze 12,ic 000574 000561 aa 003 100 060 500 csl (pr),(pr),fill(0),bool(move) 000562 aa 2 00000 00 0044 descb pr2|0,36 VLA_base_addressor 000563 aa 6 00305 00 0044 descb pr6|197,36 VLA_base_addressor 000564 aa 1 00000 2371 00 ldaq pr1|0 based_ptr 000565 aa 0 00560 7001 00 tsx0 pr0|368 unpk_to_pk 000566 aa 6 00305 1161 00 cmpq pr6|197 VLA_base_addressor 000567 aa 000050 6000 04 tze 40,ic 000637 STATEMENT 1 ON LINE 202 storage_ptr = linkp -> based_ptr; 000570 aa 1 00000 3715 20 epp5 pr1|0,* based_ptr 000571 aa 6 00130 6515 00 spri5 pr6|88 storage_ptr STATEMENT 1 ON LINE 203 call fill_VLA_addressors; 000572 aa 000206 6700 04 tsp4 134,ic 001000 STATEMENT 1 ON LINE 204 end; STATEMENT 1 ON LINE 205 else ; 000573 aa 000044 7100 04 tra 36,ic 000637 STATEMENT 1 ON LINE 207 else do; STATEMENT 1 ON LINE 208 re_try_snap: call snap_link (code); 000574 aa 000722 3520 04 epp2 466,ic 001516 = 000002000000 000575 aa 000445 6700 04 tsp4 293,ic 001242 STATEMENT 1 ON LINE 210 if code ^= 0 then do; 000576 aa 6 00110 2361 00 ldq pr6|72 code 000577 aa 000037 6000 04 tze 31,ic 000636 STATEMENT 1 ON LINE 212 call signal_fortran_storage_error (code, " COMMON block " || cp -> create_entry.block_name); 000600 aa 6 00112 3735 20 epp7 pr6|74,* cp 000601 aa 7 00002 2351 00 lda pr7|2 create_entry.name_length 000602 aa 000022 7350 00 als 18 000603 aa 000066 7330 00 lrs 54 000604 aa 000000 6270 06 eax7 0,ql 000605 aa 000016 0760 07 adq 14,dl 000606 aa 6 00332 7561 00 stq pr6|218 000607 aa 524000 2760 03 orq 174080,du 000610 aa 6 00305 7561 00 stq pr6|197 000611 aa 6 00332 2361 00 ldq pr6|218 000612 aa 0 00551 7001 00 tsx0 pr0|361 alloc_char_temp 000613 aa 040 100 100 404 mlr (ic),(pr),fill(040) 000614 aa 777215 00 0016 desc9a -371,14 000030 = 040103117115 000615 aa 2 00000 00 0016 desc9a pr2|0,14 000616 aa 040 140 100 540 mlr (pr,rl),(pr,rl),fill(040) 000617 aa 7 00003 40 0017 desc9a pr7|3(2),x7 create_entry.block_name 000620 aa 2 00003 40 0017 desc9a pr2|3(2),x7 000621 aa 6 00320 2521 00 spri2 pr6|208 000622 aa 6 00110 3521 00 epp2 pr6|72 code 000623 aa 6 00316 2521 00 spri2 pr6|206 000624 aa 777173 3520 04 epp2 -389,ic 000017 = 404000000043 000625 aa 6 00324 2521 00 spri2 pr6|212 000626 aa 6 00305 3521 00 epp2 pr6|197 000627 aa 6 00326 2521 00 spri2 pr6|214 000630 aa 6 00314 6211 00 eax1 pr6|204 000631 aa 010000 4310 07 fld 4096,dl 000632 aa 000310 3520 04 epp2 200,ic 001142 = 000240627000 000633 aa 0 00624 7001 00 tsx0 pr0|404 call_int_this_desc STATEMENT 1 ON LINE 214 goto re_try_snap; 000634 aa 0 01014 7001 00 tsx0 pr0|524 shorten_stack 000635 aa 777737 7100 04 tra -33,ic 000574 STATEMENT 1 ON LINE 215 end; STATEMENT 1 ON LINE 216 call fill_VLA_addressors; 000636 aa 000142 6700 04 tsp4 98,ic 001000 STATEMENT 1 ON LINE 217 end; STATEMENT 1 ON LINE 218 end; STATEMENT 1 ON LINE 220 if code ^= 0 then do; 000637 aa 6 00110 2361 00 ldq pr6|72 code 000640 aa 000066 6000 04 tze 54,ic 000726 STATEMENT 1 ON LINE 222 call sub_err_ (code, "fortran_storage_", ACTION_CANT_RESTART, null, 0, "An error has occurred while initializing ^a.", cp -> create_entry.block_name); 000641 aa 6 00112 3735 20 epp7 pr6|74,* cp 000642 aa 7 00002 2351 00 lda pr7|2 create_entry.name_length 000643 aa 000022 7350 00 als 18 000644 aa 000066 7330 00 lrs 54 000645 aa 6 00332 7561 00 stq pr6|218 000646 aa 526000 2760 03 orq 175104,du 000647 aa 6 00305 7561 00 stq pr6|197 000650 aa 777154 2370 04 ldaq -404,ic 000024 = 146157162164 162141156137 000651 aa 6 00274 7571 00 staq pr6|188 000652 aa 777154 2370 04 ldaq -404,ic 000026 = 163164157162 141147145137 000653 aa 6 00276 7571 00 staq pr6|190 000654 aa 777146 3714 24 epp5 -410,ic* 000655 aa 6 00312 6515 00 spri5 pr6|202 000656 aa 6 00304 4501 00 stz pr6|196 000657 aa 000 100 100 404 mlr (ic),(pr),fill(000) 000660 aa 777163 00 0054 desc9a -397,44 000042 = 101156040145 000661 aa 6 00314 00 0054 desc9a pr6|204,44 000662 aa 6 00110 3521 00 epp2 pr6|72 code 000663 aa 6 00336 2521 00 spri2 pr6|222 000664 aa 6 00274 3521 00 epp2 pr6|188 000665 aa 6 00340 2521 00 spri2 pr6|224 000666 aa 777130 3520 04 epp2 -424,ic 000016 = 400000000000 000667 aa 6 00342 2521 00 spri2 pr6|226 000670 aa 6 00312 3521 00 epp2 pr6|202 000671 aa 6 00344 2521 00 spri2 pr6|228 000672 aa 6 00304 3521 00 epp2 pr6|196 000673 aa 6 00346 2521 00 spri2 pr6|230 000674 aa 6 00314 3521 00 epp2 pr6|204 000675 aa 6 00350 2521 00 spri2 pr6|232 000676 aa 000002 7270 07 lxl7 2,dl 000677 aa 7 00003 3521 00 epp2 pr7|3 create_entry.block_name 000700 aa 2 00000 5005 17 a9bd pr2|0,7 000701 aa 6 00352 2521 00 spri2 pr6|234 000702 aa 777115 3520 04 epp2 -435,ic 000017 = 404000000043 000703 aa 6 00354 2521 00 spri2 pr6|236 000704 aa 777110 3520 04 epp2 -440,ic 000014 = 524000000020 000705 aa 6 00356 2521 00 spri2 pr6|238 000706 aa 777105 3520 04 epp2 -443,ic 000013 = 514000000044 000707 aa 6 00360 2521 00 spri2 pr6|240 000710 aa 777110 3520 04 epp2 -440,ic 000020 = 464000000000 000711 aa 6 00362 2521 00 spri2 pr6|242 000712 aa 777100 3520 04 epp2 -448,ic 000012 = 404000000005 000713 aa 6 00364 2521 00 spri2 pr6|244 000714 aa 777075 3520 04 epp2 -451,ic 000011 = 524000000054 000715 aa 6 00366 2521 00 spri2 pr6|246 000716 aa 6 00305 3521 00 epp2 pr6|197 000717 aa 6 00370 2521 00 spri2 pr6|248 000720 aa 6 00334 6211 00 eax1 pr6|220 000721 aa 034000 4310 07 fld 14336,dl 000722 aa 6 00044 3701 20 epp4 pr6|36,* 000723 la 4 00020 3521 20 epp2 pr4|16,* sub_err_ 000724 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 226 return; 000725 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 227 end; STATEMENT 1 ON LINE 228 if cp -> create_entry.next = 0 then looping = "0"b; 000726 aa 6 00112 3735 20 epp7 pr6|74,* cp 000727 aa 7 00002 2351 00 lda pr7|2 create_entry.next 000730 aa 000066 7730 00 lrl 54 000731 aa 000002 6010 04 tnz 2,ic 000733 000732 aa 6 00122 4501 00 stz pr6|82 looping STATEMENT 1 ON LINE 230 end; 000733 aa 7 00002 2351 00 lda pr7|2 000734 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 000735 aa 6 00104 3521 20 epp2 pr6|68,* atp 000736 aa 000000 3120 01 eawp2 0,au 000737 aa 6 00112 2521 00 spri2 pr6|74 cp 000740 aa 777246 7100 04 tra -346,ic 000206 STATEMENT 1 ON LINE 231 return; 000741 aa 0 00631 7101 00 tra pr0|409 return_mac ENTRY TO resolve_VLA_COMMON_link STATEMENT 1 ON LINE 235 resolve_VLA_COMMON_link: entry (a_link_ptr, a_def_ptr, a_type_ptr, a_code); 000742 at 000004000020 000743 tt 000020000020 000744 ta 000017000000 000745 ta 000742000000 000746 da 000150300000 000747 aa 000620 6270 00 eax7 400 000750 aa 7 00034 3521 20 epp2 pr7|28,* 000751 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000752 aa 000010000000 000753 aa 000000000000 000754 aa 0 01372 7001 00 tsx0 pr0|762 set_support STATEMENT 1 ON LINE 249 linkp = a_link_ptr; 000755 aa 6 00032 3735 20 epp7 pr6|26,* 000756 aa 7 00002 3715 20 epp5 pr7|2,* a_link_ptr 000757 aa 5 00000 3715 20 epp5 pr5|0,* a_link_ptr 000760 aa 6 00120 6515 00 spri5 pr6|80 linkp STATEMENT 1 ON LINE 256 atp = ptr (a_def_ptr, "0"b); 000761 aa 7 00004 3521 20 epp2 pr7|4,* a_def_ptr 000762 aa 2 00000 3525 20 epbp2 pr2|0,* a_def_ptr 000763 aa 6 00104 2521 00 spri2 pr6|68 atp STATEMENT 1 ON LINE 257 alp = addrel (linkp, linkp -> link.head_ptr); 000764 aa 5 00000 2351 00 lda pr5|0 link.head_ptr 000765 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 000766 aa 5 00000 3515 01 epp1 pr5|0,au 000767 aa 000000 0510 03 adwp1 0,du 000770 aa 6 00100 2515 00 spri1 pr6|64 alp STATEMENT 1 ON LINE 258 call snap_link (a_code); 000771 aa 7 00010 3521 20 epp2 pr7|8,* a_code 000772 aa 6 00276 2521 00 spri2 pr6|190 000773 aa 6 00274 3521 00 epp2 pr6|188 000774 aa 004000 4310 07 fld 2048,dl 000775 aa 2 00000 7571 00 staq pr2|0 000776 aa 000244 6700 04 tsp4 164,ic 001242 STATEMENT 1 ON LINE 259 return; 000777 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 471 end fortran_storage_; BEGIN PROCEDURE fill_VLA_addressors ENTRY TO fill_VLA_addressors STATEMENT 1 ON LINE 261 fill_VLA_addressors: proc; 001000 aa 6 00142 6501 00 spri4 pr6|98 STATEMENT 1 ON LINE 309 offset_cnt = cp -> create_entry.pointer_count; 001001 aa 6 00112 2361 20 ldq pr6|74,* create_entry.pointer_count 001002 aa 0 00416 3771 00 anaq pr0|270 = 000000000000 000000000777 001003 aa 6 00153 7561 00 stq pr6|107 offset_cnt STATEMENT 1 ON LINE 310 if offset_cnt > 0 then offset_ptr = addr (cp -> create_entry.pointer_offsets); 001004 aa 000012 6044 04 tmoz 10,ic 001016 001005 aa 6 00112 3735 20 epp7 pr6|74,* cp 001006 aa 7 00002 2351 00 lda pr7|2 create_entry.name_length 001007 aa 000022 7350 00 als 18 001010 aa 000066 7330 00 lrs 54 001011 aa 000016 0760 07 adq 14,dl 001012 aa 000003 0760 07 adq 3,dl 001013 aa 000002 7320 00 qrs 2 001014 aa 7 00000 3715 06 epp5 pr7|0,ql create_entry.pointer_offsets 001015 aa 6 00154 6515 00 spri5 pr6|108 offset_ptr STATEMENT 1 ON LINE 312 VLA_base_ptr = storage_ptr; 001016 aa 6 00130 3735 20 epp7 pr6|88,* storage_ptr 001017 aa 6 00156 5471 00 sprp7 pr6|110 VLA_base_ptr STATEMENT 1 ON LINE 318 if cp -> create_entry.K256 then do while (pl1_operators_$VLA_words_per_seg_ ^= 262144); 001020 aa 6 00112 2351 20 lda pr6|74,* create_entry.K256 001021 aa 010000 3150 07 cana 4096,dl 001022 aa 000026 6000 04 tze 22,ic 001050 001023 aa 000000 0110 03 nop 0,du 001024 aa 6 00044 3701 20 epp4 pr6|36,* 001025 la 4 00010 2361 20 ldq pr4|8,* pl1_operators_$VLA_words_per_seg_ 001026 aa 000001 1160 03 cmpq 1,du 001027 aa 000021 6000 04 tze 17,ic 001050 STATEMENT 1 ON LINE 320 call signal_fortran_storage_error (error_table_$resource_unavailable, "Program requires storage to be allocated in 256K segments."); 001030 aa 000 100 100 404 mlr (ic),(pr),fill(000) 001031 aa 777025 00 0074 desc9a -491,60 000055 = 120162157147 001032 aa 6 00372 00 0074 desc9a pr6|250,60 001033 la 4 00022 3521 20 epp2 pr4|18,* error_table_$resource_unavailable 001034 aa 6 00414 2521 00 spri2 pr6|268 001035 aa 6 00372 3521 00 epp2 pr6|250 001036 aa 6 00416 2521 00 spri2 pr6|270 001037 aa 776760 3520 04 epp2 -528,ic 000017 = 404000000043 001040 aa 6 00422 2521 00 spri2 pr6|274 001041 aa 776746 3520 04 epp2 -538,ic 000007 = 524000000072 001042 aa 6 00424 2521 00 spri2 pr6|276 001043 aa 6 00412 6211 00 eax1 pr6|266 001044 aa 010000 4310 07 fld 4096,dl 001045 aa 000075 3520 04 epp2 61,ic 001142 = 000240627000 001046 aa 0 00624 7001 00 tsx0 pr0|404 call_int_this_desc STATEMENT 1 ON LINE 322 end; 001047 aa 777755 7100 04 tra -19,ic 001024 STATEMENT 1 ON LINE 328 if pl1_operators_$VLA_words_per_seg_ = 262144 then do; 001050 aa 6 00044 3701 20 epp4 pr6|36,* 001051 la 4 00010 2361 20 ldq pr4|8,* pl1_operators_$VLA_words_per_seg_ 001052 aa 000001 1160 03 cmpq 1,du 001053 aa 000024 6010 04 tnz 20,ic 001077 STATEMENT 1 ON LINE 330 unspec (logical_address_of_base) = unspec (VLA_base_ptr); 001054 aa 6 00156 2351 00 lda pr6|110 001055 aa 6 00151 7551 00 sta pr6|105 STATEMENT 1 ON LINE 331 VLA_addressors.addressor_of_base = logical_address_of_base; 001056 aa 6 00151 2361 00 ldq pr6|105 logical_address_of_base 001057 aa 6 00106 7561 20 stq pr6|70,* VLA_addressors.addressor_of_base STATEMENT 1 ON LINE 332 do i = 1 to offset_cnt; 001060 aa 6 00153 2361 00 ldq pr6|107 offset_cnt 001061 aa 6 00157 7561 00 stq pr6|111 001062 aa 000001 2360 07 ldq 1,dl 001063 aa 6 00150 7561 00 stq pr6|104 i 001064 aa 6 00150 2361 00 ldq pr6|104 i 001065 aa 6 00157 1161 00 cmpq pr6|111 001066 aa 000052 6054 04 tpnz 42,ic 001140 STATEMENT 1 ON LINE 333 VLA_addressors.addressor_of_offset (i) = logical_address_of_base + offset (i); 001067 aa 6 00151 2361 00 ldq pr6|105 logical_address_of_base 001070 aa 6 00150 7271 00 lxl7 pr6|104 i 001071 aa 6 00154 3735 20 epp7 pr6|108,* offset_ptr 001072 aa 7 77777 0761 17 adq pr7|-1,7 offset 001073 aa 6 00106 7561 77 stq pr6|70,*7 VLA_addressors.addressor_of_offset STATEMENT 1 ON LINE 334 end; 001074 aa 6 00150 0541 00 aos pr6|104 i 001075 aa 777767 7100 04 tra -9,ic 001064 STATEMENT 1 ON LINE 335 end; 001076 aa 000042 7100 04 tra 34,ic 001140 STATEMENT 1 ON LINE 336 else do; STATEMENT 1 ON LINE 337 logical_address_of_base = fixed (baseno (VLA_base_ptr), 12) * pl1_operators_$VLA_words_per_seg_ + fixed (rel (VLA_base_ptr), 18); 001077 aa 6 00156 2361 00 ldq pr6|110 VLA_base_ptr 001100 aa 0 00374 3771 00 anaq pr0|252 = 000000000000 000000777777 001101 aa 6 00411 7561 00 stq pr6|265 001102 aa 6 00156 2351 00 lda pr6|110 VLA_base_ptr 001103 aa 007777 3750 03 ana 4095,du 001104 aa 000066 7730 00 lrl 54 001105 la 4 00010 4021 20 mpy pr4|8,* pl1_operators_$VLA_words_per_seg_ 001106 aa 6 00411 0761 00 adq pr6|265 001107 aa 6 00151 7561 00 stq pr6|105 logical_address_of_base STATEMENT 1 ON LINE 340 VLA_addressors.addressor_of_base = logical_address_of_base; 001110 aa 6 00106 7561 20 stq pr6|70,* VLA_addressors.addressor_of_base STATEMENT 1 ON LINE 341 do i = 1 to offset_cnt; 001111 aa 6 00153 2361 00 ldq pr6|107 offset_cnt 001112 aa 6 00160 7561 00 stq pr6|112 001113 aa 000001 2360 07 ldq 1,dl 001114 aa 6 00150 7561 00 stq pr6|104 i 001115 aa 000000 0110 03 nop 0,du 001116 aa 6 00150 2361 00 ldq pr6|104 i 001117 aa 6 00160 1161 00 cmpq pr6|112 001120 aa 000020 6054 04 tpnz 16,ic 001140 STATEMENT 1 ON LINE 342 logical_address_of_offset = logical_address_of_base + offset (i); 001121 aa 6 00151 2361 00 ldq pr6|105 logical_address_of_base 001122 aa 6 00150 7271 00 lxl7 pr6|104 i 001123 aa 6 00154 3735 20 epp7 pr6|108,* offset_ptr 001124 aa 7 77777 0761 17 adq pr7|-1,7 offset 001125 aa 6 00152 7561 00 stq pr6|106 logical_address_of_offset STATEMENT 1 ON LINE 343 VLA_addressors.addressor_of_offset (i) = logical_address_of_offset + fixed (262144 - pl1_operators_$VLA_words_per_seg_, 18) * divide (logical_address_of_offset, pl1_operators_$VLA_words_per_seg_, 12); 001126 aa 6 00044 3701 20 epp4 pr6|36,* 001127 la 4 00010 5061 20 div pr4|8,* pl1_operators_$VLA_words_per_seg_ 001130 aa 6 00411 7561 00 stq pr6|265 001131 aa 000001 2360 03 ldq 1,du 001132 la 4 00010 1761 20 sbq pr4|8,* pl1_operators_$VLA_words_per_seg_ 001133 aa 6 00411 4021 00 mpy pr6|265 001134 aa 6 00152 0761 00 adq pr6|106 logical_address_of_offset 001135 aa 6 00106 7561 77 stq pr6|70,*7 VLA_addressors.addressor_of_offset STATEMENT 1 ON LINE 347 end; 001136 aa 6 00150 0541 00 aos pr6|104 i 001137 aa 777757 7100 04 tra -17,ic 001116 STATEMENT 1 ON LINE 348 end; STATEMENT 1 ON LINE 349 end fill_VLA_addressors; 001140 aa 6 00142 6101 00 rtcd pr6|98 END PROCEDURE fill_VLA_addressors BEGIN PROCEDURE signal_fortran_storage_error ENTRY TO signal_fortran_storage_error STATEMENT 1 ON LINE 351 signal_fortran_storage_error: proc (status, details); 001141 da 000163200000 001142 aa 000240 6270 00 eax7 160 001143 aa 7 00034 3521 20 epp2 pr7|28,* 001144 aa 2 01050 2721 00 tsp2 pr2|552 int_entry_desc 001145 aa 000004000000 001146 aa 000000000000 001147 aa 0 01372 7001 00 tsx0 pr0|762 set_support 001150 aa 6 00042 3735 20 epp7 pr6|34,* 001151 aa 7 00002 2361 20 ldq pr7|2,* 001152 aa 000002 6040 04 tmi 2,ic 001154 001153 aa 777777 3760 07 anq 262143,dl 001154 aa 0 00250 3761 00 anq pr0|168 = 000077777777 001155 aa 6 00205 7561 00 stq pr6|133 STATEMENT 1 ON LINE 377 condition_info.length = size (condition_info); 001156 aa 000105 2360 07 ldq 69,dl 001157 aa 6 00100 7561 00 stq pr6|64 condition_info.length STATEMENT 1 ON LINE 378 condition_info.version = 1; 001160 aa 000001 2360 07 ldq 1,dl 001161 aa 6 00101 7561 00 stq pr6|65 condition_info.version STATEMENT 1 ON LINE 379 unspec (condition_info.action_flags) = ""b; 001162 aa 6 00102 4501 00 stz pr6|66 STATEMENT 1 ON LINE 380 condition_info.info_string = rtrim (details); 001163 aa 6 00032 3715 20 epp5 pr6|26,* 001164 aa 5 00004 3535 20 epp3 pr5|4,* 001165 aa 6 00205 2351 00 lda pr6|133 001166 aa 000 000 165 540 tctr (pr,rl) 001167 aa 3 00000 00 0005 desc9a pr3|0,al details 001170 aa 0 76605 0001 00 arg pr0|-635 = 777777777777 001171 aa 6 00056 0001 00 arg pr6|46 001172 aa 6 00056 2361 00 ldq pr6|46 001173 aa 0 00242 3761 00 anq pr0|162 = 000777777777 001174 aa 6 00206 7561 00 stq pr6|134 001175 aa 6 00205 2361 00 ldq pr6|133 001176 aa 6 00206 1761 00 sbq pr6|134 001177 aa 000400 1160 07 cmpq 256,dl 001200 aa 000002 6040 04 tmi 2,ic 001202 001201 aa 000400 2360 07 ldq 256,dl 001202 aa 6 00103 7561 00 stq pr6|67 condition_info.info_string 001203 aa 040 140 100 540 mlr (pr,rl),(pr,rl),fill(040) 001204 aa 3 00000 00 0006 desc9a pr3|0,ql details 001205 aa 6 00104 00 0006 desc9a pr6|68,ql condition_info.info_string STATEMENT 1 ON LINE 381 condition_info.status_code = status; 001206 aa 5 00002 2361 20 ldq pr5|2,* status 001207 aa 6 00204 7561 00 stq pr6|132 condition_info.status_code STATEMENT 1 ON LINE 382 call signal_ ("fortran_storage_error", null, addr (condition_info)); 001210 aa 776624 2370 04 ldaq -620,ic 000034 = 146157162164 162141156137 001211 aa 6 00210 7571 00 staq pr6|136 001212 aa 776624 2370 04 ldaq -620,ic 000036 = 163164157162 141147145137 001213 aa 6 00212 7571 00 staq pr6|138 001214 aa 776624 2370 04 ldaq -620,ic 000040 = 145162162157 162000000000 001215 aa 6 00214 7571 00 staq pr6|140 001216 aa 776604 3514 24 epp1 -636,ic* 001217 aa 6 00216 2515 00 spri1 pr6|142 001220 aa 6 00100 3735 00 epp7 pr6|64 condition_info 001221 aa 6 00220 6535 00 spri7 pr6|144 001222 aa 6 00210 3521 00 epp2 pr6|136 001223 aa 6 00224 2521 00 spri2 pr6|148 001224 aa 6 00216 3521 00 epp2 pr6|142 001225 aa 6 00226 2521 00 spri2 pr6|150 001226 aa 6 00220 3521 00 epp2 pr6|144 001227 aa 6 00230 2521 00 spri2 pr6|152 001230 aa 776555 3520 04 epp2 -659,ic 000005 = 524000000025 001231 aa 6 00232 2521 00 spri2 pr6|154 001232 aa 776566 3520 04 epp2 -650,ic 000020 = 464000000000 001233 aa 6 00234 2521 00 spri2 pr6|156 001234 aa 6 00236 2521 00 spri2 pr6|158 001235 aa 6 00222 6211 00 eax1 pr6|146 001236 aa 014000 4310 07 fld 6144,dl 001237 la 4 00024 3521 20 epp2 pr4|20,* signal_ 001240 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 383 end signal_fortran_storage_error; 001241 aa 0 00631 7101 00 tra pr0|409 return_mac END PROCEDURE signal_fortran_storage_error BEGIN PROCEDURE snap_link ENTRY TO snap_link STATEMENT 1 ON LINE 387 snap_link: proc (code); 001242 aa 6 00162 6501 00 spri4 pr6|114 001243 aa 6 00164 2521 00 spri2 pr6|116 STATEMENT 1 ON LINE 412 if linkp -> link.ft2 = "46"b3 /* unsnapped */ then do; 001244 aa 6 00120 2351 20 lda pr6|80,* link.ft2 001245 aa 000036 7350 00 als 30 001246 aa 460000 1150 03 cmpa 155648,du 001247 aa 000127 6010 04 tnz 87,ic 001376 STATEMENT 1 ON LINE 419 defp = ptr (atp, alp -> virgin_linkage_header.def_offset); 001250 aa 6 00100 3735 20 epp7 pr6|64,* alp 001251 aa 7 00001 2351 00 lda pr7|1 virgin_linkage_header.def_offset 001252 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 001253 aa 6 00104 3515 20 epp1 pr6|68,* atp 001254 aa 000000 3114 01 eawp1 0,au 001255 aa 6 00114 2515 00 spri1 pr6|76 defp STATEMENT 1 ON LINE 420 type_ptr = addrel (defp, (addrel (defp, linkp -> link.exp_ptr) -> exp_word.type_ptr)); 001256 aa 6 00120 3715 20 epp5 pr6|80,* linkp 001257 aa 5 00001 2351 00 lda pr5|1 link.exp_ptr 001260 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 001261 aa 1 00000 3535 01 epp3 pr1|0,au 001262 aa 000000 0530 03 adwp3 0,du 001263 aa 3 00000 2351 00 lda pr3|0 exp_word.type_ptr 001264 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 001265 aa 1 00000 3535 01 epp3 pr1|0,au 001266 aa 000000 0530 03 adwp3 0,du 001267 aa 6 00134 2535 00 spri3 pr6|92 type_ptr STATEMENT 1 ON LINE 421 namep = addrel (defp, type_ptr -> type_pair.ext_ptr); 001270 aa 3 00001 2351 00 lda pr3|1 type_pair.ext_ptr 001271 aa 000022 7350 00 als 18 001272 aa 1 00000 3521 01 epp2 pr1|0,au 001273 aa 000000 0520 03 adwp2 0,du 001274 aa 6 00124 2521 00 spri2 pr6|84 namep STATEMENT 1 ON LINE 422 block_name = substr (namep -> name.char_string, 1, fixed (namep -> name.nchars, 9)); 001275 aa 2 00000 2351 00 lda pr2|0 name.nchars 001276 aa 000077 7730 00 lrl 63 001277 aa 000040 1160 07 cmpq 32,dl 001300 aa 000002 6040 04 tmi 2,ic 001302 001301 aa 000040 2360 07 ldq 32,dl 001302 aa 6 00170 7561 00 stq pr6|120 block_name 001303 aa 040 140 100 540 mlr (pr,rl),(pr,rl),fill(040) 001304 aa 2 00000 20 0006 desc9a pr2|0(1),ql name.char_string 001305 aa 6 00171 00 0006 desc9a pr6|121,ql block_name STATEMENT 1 ON LINE 423 init_info_ptr = addrel (defp, type_ptr -> type_pair.trap_ptr); 001306 aa 3 00000 2351 00 lda pr3|0 type_pair.trap_ptr 001307 aa 000022 7350 00 als 18 001310 aa 1 00000 3521 01 epp2 pr1|0,au 001311 aa 000000 0520 03 adwp2 0,du 001312 aa 6 00140 2521 00 spri2 pr6|96 init_info_ptr STATEMENT 1 ON LINE 424 call set_ext_variable_ ((block_name), init_info_ptr, stackbaseptr (), found_sw, variablep, code); 001313 aa 6 00170 2361 00 ldq pr6|120 block_name 001314 aa 524000 2760 03 orq 174080,du 001315 aa 6 00426 7561 00 stq pr6|278 001316 aa 6 00170 2361 00 ldq pr6|120 block_name 001317 aa 0 00551 7001 00 tsx0 pr0|361 alloc_char_temp 001320 aa 6 00436 2521 00 spri2 pr6|286 001321 aa 6 00170 7271 00 lxl7 pr6|120 block_name 001322 aa 040 140 100 540 mlr (pr,rl),(pr,rl),fill(040) 001323 aa 6 00171 00 0017 desc9a pr6|121,x7 block_name 001324 aa 2 00000 00 0006 desc9a pr2|0,ql 001325 aa 6 00000 3731 00 epbp7 pr6|0 001326 aa 6 00432 6535 00 spri7 pr6|282 001327 aa 6 00140 3521 00 epp2 pr6|96 init_info_ptr 001330 aa 6 00440 2521 00 spri2 pr6|288 001331 aa 6 00432 3521 00 epp2 pr6|282 001332 aa 6 00442 2521 00 spri2 pr6|290 001333 aa 6 00116 3521 00 epp2 pr6|78 found_sw 001334 aa 6 00444 2521 00 spri2 pr6|292 001335 aa 6 00136 3521 00 epp2 pr6|94 variablep 001336 aa 6 00446 2521 00 spri2 pr6|294 001337 aa 6 00164 3515 20 epp1 pr6|116,* 001340 aa 1 00002 3521 20 epp2 pr1|2,* code 001341 aa 6 00450 2521 00 spri2 pr6|296 001342 aa 6 00426 3521 00 epp2 pr6|278 001343 aa 6 00452 2521 00 spri2 pr6|298 001344 aa 776454 3520 04 epp2 -724,ic 000020 = 464000000000 001345 aa 6 00454 2521 00 spri2 pr6|300 001346 aa 6 00456 2521 00 spri2 pr6|302 001347 aa 6 00462 2521 00 spri2 pr6|306 001350 aa 776434 3520 04 epp2 -740,ic 000004 = 514000000001 001351 aa 6 00460 2521 00 spri2 pr6|304 001352 aa 776445 3520 04 epp2 -731,ic 000017 = 404000000043 001353 aa 6 00464 2521 00 spri2 pr6|308 001354 aa 6 00434 6211 00 eax1 pr6|284 001355 aa 030000 4310 07 fld 12288,dl 001356 aa 6 00044 3701 20 epp4 pr6|36,* 001357 la 4 00016 3521 20 epp2 pr4|14,* set_ext_variable_ 001360 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 425 if code ^= 0 then if ^found_sw then return; 001361 aa 0 01014 7001 00 tsx0 pr0|524 shorten_stack 001362 aa 6 00164 3735 20 epp7 pr6|116,* 001363 aa 7 00002 2361 20 ldq pr7|2,* code 001364 aa 000005 6000 04 tze 5,ic 001371 001365 aa 6 00116 2351 00 lda pr6|78 found_sw 001366 aa 400000 3150 03 cana 131072,du 001367 aa 000002 6010 04 tnz 2,ic 001371 001370 aa 6 00162 6101 00 rtcd pr6|114 STATEMENT 1 ON LINE 429 storage_ptr = variablep -> variable_node.vbl_ptr; 001371 aa 6 00136 3715 20 epp5 pr6|94,* variablep 001372 aa 5 00004 3715 20 epp5 pr5|4,* variable_node.vbl_ptr 001373 aa 6 00130 6515 00 spri5 pr6|88 storage_ptr STATEMENT 1 ON LINE 430 linkp -> based_ptr = storage_ptr; 001374 aa 6 00120 6515 20 spri5 pr6|80,* based_ptr STATEMENT 1 ON LINE 431 end; 001375 aa 000004 7100 04 tra 4,ic 001401 STATEMENT 1 ON LINE 435 else storage_ptr = linkp -> based_ptr; 001376 aa 6 00120 3735 20 epp7 pr6|80,* based_ptr 001377 aa 7 00000 3735 20 epp7 pr7|0,* based_ptr 001400 aa 6 00130 6535 00 spri7 pr6|88 storage_ptr STATEMENT 1 ON LINE 436 return; 001401 aa 6 00162 6101 00 rtcd pr6|114 STATEMENT 1 ON LINE 437 end snap_link; END PROCEDURE snap_link BEGIN PROCEDURE signal_sub_error ENTRY TO signal_sub_error STATEMENT 1 ON LINE 439 signal_sub_error: proc; 001402 aa 6 00202 6501 00 spri4 pr6|130 STATEMENT 1 ON LINE 454 retval = 0; 001403 aa 6 00210 4501 00 stz pr6|136 retval STATEMENT 1 ON LINE 455 call hcs_$fs_get_path_name (textp, dirname, dirname_length, entryname, code); 001404 aa 6 00132 3521 00 epp2 pr6|90 textp 001405 aa 6 00470 2521 00 spri2 pr6|312 001406 aa 6 00211 3521 00 epp2 pr6|137 dirname 001407 aa 6 00472 2521 00 spri2 pr6|314 001410 aa 6 00273 3521 00 epp2 pr6|187 dirname_length 001411 aa 6 00474 2521 00 spri2 pr6|316 001412 aa 6 00263 3521 00 epp2 pr6|179 entryname 001413 aa 6 00476 2521 00 spri2 pr6|318 001414 aa 6 00110 3521 00 epp2 pr6|72 code 001415 aa 6 00500 2521 00 spri2 pr6|320 001416 aa 776402 3520 04 epp2 -766,ic 000020 = 464000000000 001417 aa 6 00502 2521 00 spri2 pr6|322 001420 aa 776363 3520 04 epp2 -781,ic 000003 = 526000000250 001421 aa 6 00504 2521 00 spri2 pr6|324 001422 aa 776360 3520 04 epp2 -784,ic 000002 = 404000000021 001423 aa 6 00506 2521 00 spri2 pr6|326 001424 aa 776355 3520 04 epp2 -787,ic 000001 = 526000000040 001425 aa 6 00510 2521 00 spri2 pr6|328 001426 aa 776371 3520 04 epp2 -775,ic 000017 = 404000000043 001427 aa 6 00512 2521 00 spri2 pr6|330 001430 aa 6 00466 6211 00 eax1 pr6|310 001431 aa 024000 4310 07 fld 10240,dl 001432 aa 6 00044 3701 20 epp4 pr6|36,* 001433 la 4 00026 3521 20 epp2 pr4|22,* hcs_$fs_get_path_name 001434 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 456 call sub_err_ (0, "fortran_storage_", ACTION_CANT_RESTART, null, retval, "Attempt by perprocess static segment ^a>^a^/to use static (very) large arrays. This combination is illegal." , dirname, entryname); 001435 aa 6 00514 4501 00 stz pr6|332 001436 aa 776366 2370 04 ldaq -778,ic 000024 = 146157162164 162141156137 001437 aa 6 00466 7571 00 staq pr6|310 001440 aa 776366 2370 04 ldaq -778,ic 000026 = 163164157162 141147145137 001441 aa 6 00470 7571 00 staq pr6|312 001442 aa 776360 3734 24 epp7 -784,ic* 001443 aa 6 00516 6535 00 spri7 pr6|334 001444 aa 000 100 100 404 mlr (ic),(pr),fill(000) 001445 aa 776430 00 0154 desc9a -744,108 000074 = 101164164145 001446 aa 6 00520 00 0154 desc9a pr6|336,108 001447 aa 6 00514 3521 00 epp2 pr6|332 001450 aa 6 00556 2521 00 spri2 pr6|366 001451 aa 6 00466 3521 00 epp2 pr6|310 001452 aa 6 00560 2521 00 spri2 pr6|368 001453 aa 776343 3520 04 epp2 -797,ic 000016 = 400000000000 001454 aa 6 00562 2521 00 spri2 pr6|370 001455 aa 6 00516 3521 00 epp2 pr6|334 001456 aa 6 00564 2521 00 spri2 pr6|372 001457 aa 6 00210 3521 00 epp2 pr6|136 retval 001460 aa 6 00566 2521 00 spri2 pr6|374 001461 aa 6 00520 3521 00 epp2 pr6|336 001462 aa 6 00570 2521 00 spri2 pr6|376 001463 aa 6 00211 3521 00 epp2 pr6|137 dirname 001464 aa 6 00572 2521 00 spri2 pr6|378 001465 aa 6 00263 3521 00 epp2 pr6|179 entryname 001466 aa 6 00574 2521 00 spri2 pr6|380 001467 aa 776323 3520 04 epp2 -813,ic 000012 = 404000000005 001470 aa 6 00576 2521 00 spri2 pr6|382 001471 aa 776323 3520 04 epp2 -813,ic 000014 = 524000000020 001472 aa 6 00600 2521 00 spri2 pr6|384 001473 aa 776320 3520 04 epp2 -816,ic 000013 = 514000000044 001474 aa 6 00602 2521 00 spri2 pr6|386 001475 aa 776323 3520 04 epp2 -813,ic 000020 = 464000000000 001476 aa 6 00604 2521 00 spri2 pr6|388 001477 aa 776320 3520 04 epp2 -816,ic 000017 = 404000000043 001500 aa 6 00606 2521 00 spri2 pr6|390 001501 aa 776277 3520 04 epp2 -833,ic 000000 = 524000000154 001502 aa 6 00610 2521 00 spri2 pr6|392 001503 aa 776300 3520 04 epp2 -832,ic 000003 = 526000000250 001504 aa 6 00612 2521 00 spri2 pr6|394 001505 aa 776274 3520 04 epp2 -836,ic 000001 = 526000000040 001506 aa 6 00614 2521 00 spri2 pr6|396 001507 aa 6 00554 6211 00 eax1 pr6|364 001510 aa 040000 4310 07 fld 16384,dl 001511 aa 6 00044 3701 20 epp4 pr6|36,* 001512 la 4 00020 3521 20 epp2 pr4|16,* sub_err_ 001513 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 460 return; 001514 aa 6 00202 6101 00 rtcd pr6|130 STATEMENT 1 ON LINE 462 end signal_sub_error; END PROCEDURE signal_sub_error END PROCEDURE fortran_storage_ ----------------------------------------------------------- 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