COMPILATION LISTING OF SEGMENT dfast_run_unit_manager_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Bull, Phx. Az., Sys-M Compiled on: 08/06/87 1109.7 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 dfast_run_unit_manager_: proc (a_system, a_program_ptr, a_program_lng, a_main_name, 12 a_debug_sw, a_code); 13 14 /* coded by M. Weaver 12/75 */ 15 /* modified 12/76 by M. Weaver to use version 2 compiler_source_info structure */ 16 /* Modified 28 Feb 1980 by C R Davis for new fort_options include file. */ 17 18 /* This program implements the DTSS-compatible FAST susbsystem. 19* It finds all libraries, compiles all source, sets up a name table, 20* does the linking, executes the program and terminates all segments used just by the run unit. */ 21 22 /* arguments */ 23 24 dcl a_system char (8) aligned; /* system name */ 25 dcl a_program_ptr ptr; /* ptr to main program for run unit */ 26 dcl a_program_lng fixed bin (24); /* bit count of input segment */ 27 dcl a_main_name char (168) aligned; /* pathname of main program (used as library name) */ 28 dcl a_debug_sw bit (1) aligned; /* "1"b->in debug mode (i.e. generate symbol table) */ 29 dcl a_code fixed bin (35); /* returned status code */ 30 31 /* pointers */ 32 33 dcl arg_ptr ptr; /* ptr to arglist */ 34 dcl mainp ptr; /* ptr to main entry point */ 35 dcl ftn_io_p ptr; /* points to fortran io_vector */ 36 dcl cur_lib_node_p ptr; /* points to library node currently being examined */ 37 dcl last_lib_node_p ptr; /* points to most recent lib node entry */ 38 dcl scratch_ptr ptr; /* points to beginning of scratch seg */ 39 dcl cur_free_p ptr; /* points to first free word in scratch segment */ 40 dcl blank_common_ptr ptr; /* points to blank common (in scratch seg) */ 41 dcl object_ptr ptr; /* ptr to object segment compiled by run unit */ 42 dcl cp ptr; /* used when looping through lib list */ 43 dcl segptr ptr; 44 dcl rnt_p ptr static; /* ptr to beginning of run unit's rnt */ 45 dcl rp ptr; /* ptr to currently examined rnt node */ 46 dcl program_ptr ptr; /* ptr to current file */ 47 dcl array_p ptr; /* ptr to based_array used by temp seg manager */ 48 dcl source_info_pt ptr; /* ptr to source info structure used by compilers */ 49 dcl new_obj_symbol_p ptr; /* for snapping ftn *symbol links */ 50 dcl ep ptr; 51 dcl based_ptr ptr based; /* for copying pointers */ 52 53 /* fixed bin */ 54 55 dcl max_severity fixed bin; /* max severity of errors encountered */ 56 dcl nfiles fixed bin; /* number of files being chained */ 57 dcl scratch_lng fixed bin (19); /* max length of scratch seg */ 58 dcl ru_area_size fixed bin (18); /* max length of space used by rum itself */ 59 dcl code fixed bin (35); 60 dcl nleft fixed bin (26); 61 dcl (i, j) fixed bin; 62 dcl k fixed bin (18); 63 dcl based_fixed fixed bin (35) based; 64 dcl program_lng fixed bin (24); /* bit count of input seg */ 65 66 /* bit strings */ 67 68 dcl debug_sw bit (1) aligned; /* "1"b->in debug mode */ 69 dcl terminating bit (1) aligned; /* "1"b->in process of terminating run unit */ 70 dcl compiler_invoked bit (1) aligned; /* "1"b->run unit has invoked compiler */ 71 dcl have_chained bit (1) aligned; /* "1"b->main program was chained to */ 72 dcl is_main bit (1) aligned; /* "1"b->are processing the main program */ 73 dcl save_main bit (1) aligned; /* "1"b->are compiling main program */ 74 dcl (mask, oldmask) bit (36) aligned; /* ips masks */ 75 76 /* character strings */ 77 78 dcl temp_dir char (168); /* used by expand_pathname_ */ 79 dcl main_name char (168) aligned; /* "library" name of main program */ 80 dcl temp_ent char (32); /* used by expand_pathname_ */ 81 dcl system char (8) aligned; /* name of current system */ 82 dcl interrupt_names char (32) aligned; /* for create_ips_mask_ */ 83 /* external variables */ 84 85 dcl (error_table_$not_done, error_table_$name_not_found) ext fixed bin (35); 86 dcl fast_related_data_$fortran_io_initiated bit (1) aligned ext; 87 dcl fast_related_data_$chaining bit (1) aligned ext; 88 dcl fast_related_data_$fortran_buffer_p ptr ext; 89 dcl fast_related_data_$basic_area_p ptr ext; 90 dcl fast_related_data_$terminate_run entry ext variable; 91 92 /* external entries */ 93 94 dcl hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); 95 dcl ioa_ entry options (variable); 96 dcl hcs_$get_max_length_seg entry (ptr, fixed bin (19), fixed bin (35)); 97 dcl cu_$gen_call entry (ptr, ptr); 98 dcl fortran_io_$close_file entry (fixed bin, fixed bin (35)); 99 dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); 100 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 101 dcl (get_temp_segments_, release_temp_segments_) entry (char (*), (*) ptr, fixed bin (35)); 102 dcl hcs_$initiate_count entry (char (*), char (*), char (*), 103 fixed bin (24), fixed bin (2), ptr, fixed bin (35)); 104 dcl object_info_$display entry (ptr, fixed bin (24), ptr, fixed bin (35)); 105 dcl area_ entry (fixed bin (26), ptr); 106 dcl decode_definition_$full entry (ptr, ptr, ptr) returns (bit (1) aligned); 107 dcl basic_$run_unit_compiler entry 108 (ptr, ptr, fixed bin, bit (1) aligned, entry, entry, fixed bin (35)); 109 dcl fort_$compile_run entry (ptr, ptr, fixed bin, ptr, entry, entry, fixed bin (35)); 110 dcl create_ips_mask_ entry (ptr, fixed bin, bit (36) aligned); 111 dcl (hcs_$set_ips_mask, hcs_$reset_ips_mask) entry (bit (36) aligned, bit (36) aligned); 112 dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); 113 dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); 114 115 /* builtins */ 116 117 dcl (addr, addrel, baseno, baseptr, bit, bin, fixed, divide) builtin; 118 dcl (max, mod, null, ptr, rel, reverse, size, substr, unspec, verify) builtin; 119 dcl cleanup condition; 120 dcl fault_tag_3 condition; 121 122 /* arrays */ 123 124 dcl based_array (1) ptr based (array_p); /* alias for use by get/release temp segs */ 125 126 /* structures */ 127 128 dcl 1 ext_template aligned based, /* holds link info */ 129 2 type fixed bin, /* link type */ 130 2 section char (8) aligned, 131 2 ename char (32) varying, /* entry name of link target */ 132 2 init_info_p ptr; /* ptr to init info for common */ 133 134 dcl 1 arglist aligned, /* for passing file ptrs to basic */ 135 2 argcnt fixed bin (17) unaligned, /* 2 * number of args */ 136 2 alcode fixed bin (17) unaligned init (4), /* no display ptr */ 137 2 descnt fixed bin (17) unaligned, /* 2 * number of descriptors */ 138 2 mbz fixed bin (17) unaligned init (0), 139 2 argpts (16) ptr, 140 2 argdescs (16) ptr; 141 142 dcl 1 dd aligned, /* structure filled in by full entry */ 143 2 next_def ptr, /* ptr to next definition in list */ 144 2 last_def ptr, /* ptr to previous definition in list */ 145 2 block_ptr ptr, /* ptr to either defblock or segname block */ 146 2 section char (4) aligned, /* "text", "link", "symb" or "segn" */ 147 2 offset fixed bin, /* offset within class (if ^= "segn") */ 148 2 entrypoint fixed bin, /* value of entrypoint in text if ^= 0 */ 149 2 symbol char (256) aligned, /* the symbolic name of the definition */ 150 2 symbol_lng fixed bin, /* the actual length of symbol */ 151 2 flags, /* same flags as in std def */ 152 3 a_new_format bit (1) unaligned, /* def is in new format */ 153 3 a_ignore bit (1) unaligned, /* linker should ignore this def */ 154 3 a_entrypoint bit (1) unaligned, /* def is for entrypoint */ 155 3 a_retain bit (1) unaligned, 156 3 a_arg_count bit (1) unaligned, /* there is an arg count for entry */ 157 3 a_descr_sw bit (1) unaligned, /* there are valid descriptors for entry */ 158 3 a_main bit (1) unaligned, /* this is a main entry point */ 159 3 unused bit (11) unaligned, 160 2 n_args fixed bin, /* # of args entry expects */ 161 2 descr_ptr ptr; /* ptr to array of rel ptrs to descriptors for entry */ 162 163 164 dcl 1 io_vector (99) aligned based (ftn_io_p), 165 2 ip ptr unaligned, /* points to file's iocb */ 166 2 modes bit (36) aligned; 167 168 dcl 1 lib_list_node aligned based (cur_lib_node_p), 169 2 forward_thread bit (18) unaligned, /* offset of next node */ 170 2 backward_thread bit (18) unaligned, /* offset of last node */ 171 2 info aligned, /* info to determine how to terminate */ 172 3 source bit (1) unal, /* "1"b->source segment */ 173 3 has_lote bit (1) unal, /* "1"b->linkage section allocated before run unit entered */ 174 3 already_known bit (1) unal, /* "1"b->segment was initiated before run unit */ 175 3 terminate bit (1) unal, /* "1"b->terminate before leaving run unit */ 176 3 pad bit (32) unal, 177 2 segname char (168) aligned, /* pathname of library */ 178 2 segp ptr, /* points to library */ 179 2 ftn_ls_p ptr, /* ^null->points to fortran seg linkage section */ 180 2 ftn_symbol_p ptr, /* ^null->points to fortran seg symbol section */ 181 2 segbc fixed bin (24); /* bit count of library */ 182 183 184 dcl 1 rnt_node aligned based (rp), /* node in reference name table */ 185 2 entryp ptr, /* ptr to entry in program */ 186 2 threads aligned, 187 3 next_node bit (18) unaligned, /* offset of next node */ 188 3 pad bit (18) unaligned, 189 2 nchars fixed bin, /* number of characters in name */ 190 2 name char (32) aligned; /* entrypoint name */ 191 192 193 dcl 1 oi aligned like object_info; 194 1 1 /* BEGIN INCLUDE FILE ... object_info.incl.pl1 1 2*coded February 8, 1972 by Michael J. Spier */ 1 3 /* modified May 26, 1972 by M. Weaver */ 1 4 /* modified 15 April, 1975 by M. Weaver */ 1 5 1 6 declare 1 object_info aligned based, /* structure containing object info based, returned by object_info_ */ 1 7 2 version_number fixed bin, /* version number of current structure format (=2) */ 1 8 2 textp pointer, /* pointer to beginning of text section */ 1 9 2 defp pointer, /* pointer to beginning of definition section */ 1 10 2 linkp pointer, /* pointer to beginning of linkage section */ 1 11 2 statp pointer, /* pointer to beginning of static section */ 1 12 2 symbp pointer, /* pointer to beginning of symbol section */ 1 13 2 bmapp pointer, /* pointer to beginning of break map (may be null) */ 1 14 2 tlng fixed bin, /* length in words of text section */ 1 15 2 dlng fixed bin, /* length in words of definition section */ 1 16 2 llng fixed bin, /* length in words of linkage section */ 1 17 2 ilng fixed bin, /* length in words of static section */ 1 18 2 slng fixed bin, /* length in words of symbol section */ 1 19 2 blng fixed bin, /* length in words of break map */ 1 20 2 format, /* word containing bit flags about object type */ 1 21 3 old_format bit(1) unaligned, /* on if segment isn't in new format, i.e. has old style object map */ 1 22 3 bound bit(1) unaligned, /* on if segment is bound */ 1 23 3 relocatable bit(1) unaligned, /* on if seg has relocation info in its first symbol block */ 1 24 3 procedure bit(1) unaligned, /* on if segment is an executable object program */ 1 25 3 standard bit(1) unaligned, /* on if seg is in standard format (more than just standard map) */ 1 26 3 gate bit(1) unaligned, /* on if segment is a gate */ 1 27 3 separate_static bit(1) unaligned, /* on if static not in linkage */ 1 28 3 links_in_text bit(1) unaligned, /* on if there are threaded links in text */ 1 29 3 perprocess_static bit (1) unaligned, /* on if static is not to be per run unit */ 1 30 3 pad bit(27) unaligned, 1 31 2 entry_bound fixed bin, /* entry bound if segment is a gate */ 1 32 2 textlinkp pointer, /* ptr to first link in text */ 1 33 1 34 /* LIMIT OF BRIEF STRUCTURE */ 1 35 1 36 2 compiler char(8) aligned, /* name of processor which generated segment */ 1 37 2 compile_time fixed bin(71), /* clock reading of date/time object was generated */ 1 38 2 userid char(32) aligned, /* standard Multics id of creator of object segment */ 1 39 2 cvers aligned, /* generator version name in printable char string form */ 1 40 3 offset bit(18) unaligned, /* offset of name in words relative to base of symbol section */ 1 41 3 length bit(18) unaligned, /* length of name in characters */ 1 42 2 comment aligned, /* printable comment concerning generator or generation of segment */ 1 43 3 offset bit(18) unaligned, /* offset of comment in words relative to base of symbol section */ 1 44 3 length bit(18) unaligned, /* length of comment in characters */ 1 45 2 source_map fixed bin, /* offset, relative to base of symbol section, of source map structure */ 1 46 1 47 /* LIMIT OF DISPLAY STRUCTURE */ 1 48 1 49 2 rel_text pointer, /* pointer to text section relocation info */ 1 50 2 rel_def pointer, /* pointer to definition section relocation info */ 1 51 2 rel_link pointer, /* pointer to linkage section relocation info */ 1 52 2 rel_static pointer, /* pointer to static section relocation info */ 1 53 2 rel_symbol pointer, /* pointer to symbol section relocation info */ 1 54 2 text_boundary fixed bin, /* specifies mod of text section base boundary */ 1 55 2 static_boundary fixed bin, /* specifies mod of internal static base boundary */ 1 56 /* currently not used by system */ 1 57 2 default_truncate fixed bin, /* offset rel to symbp for binder to automatically trunc. symb sect. */ 1 58 2 optional_truncate fixed bin; /* offset rel to symbp for binder to optionally trunc. symb sect. */ 1 59 1 60 declare object_info_version_2 fixed bin int static init(2); 1 61 1 62 /* END INCLUDE FILE ... object_info.incl.pl1 */ 195 196 197 2 1 declare /* Structure returned by hcs_$status_long */ 2 2 2 3 1 branch_status aligned, /* automatic: hcs_$status uses a pointer */ 2 4 2 5 2 type bit(2) unaligned, /* type of entry: link, segment, dir */ 2 6 2 number_names bit(16) unaligned, /* unused by directory_status_ */ 2 7 2 names_rel_pointer bit(18) unaligned, /* unused by directory_status_ */ 2 8 2 date_time_modified bit(36) unaligned, /* date time modified */ 2 9 2 date_time_used bit(36) unaligned, /* date time entry used */ 2 10 2 mode bit(5) unaligned, /* effective access of caller */ 2 11 2 raw_mode bit(5) unaligned, 2 12 2 pad1 bit(8) unaligned, 2 13 2 records bit(18) unaligned, /* number of records in use */ 2 14 2 date_time_dumped bit(36) unaligned, /* date time last dumped */ 2 15 2 date_time_entry_modified bit(36) unaligned, /* date time entry modified */ 2 16 2 lvid bit(36) unaligned, /* logical volume id */ 2 17 2 current_length bit(12) unaligned, /* number of blocks currently allocated */ 2 18 2 bit_count bit(24) unaligned, /* bit count of entry */ 2 19 2 pad3 bit(8) unaligned, 2 20 2 copy_switch bit(1) unaligned, /* the copy switch */ 2 21 2 tpd bit(1) unaligned, /* transparent to paging device */ 2 22 2 mdir bit(1) unaligned, /* master directory switch */ 2 23 2 damaged_switch bit (1) unaligned, /* true if contents damaged */ 2 24 2 synchronized_switch bit (1) unaligned, /* true if a DM synchronized file */ 2 25 2 pad4 bit(5) unaligned, 2 26 2 ring_brackets (0:2) bit(6) unaligned, /* branch ring brackets */ 2 27 2 unique_id bit(36) unaligned, /* entry unique id */ 2 28 2 29 2 30 /* The types of each class of branch */ 2 31 segment_type bit(2) aligned internal static initial ("01"b), 2 32 directory_type bit(2) aligned internal static initial ("10"b), 2 33 msf_type bit(2) aligned internal static initial ("10"b), /* will eventually be different */ 2 34 link_type bit(2) aligned internal static initial ("00"b); 2 35 2 36 198 199 200 201 dcl 1 source_info aligned based (source_info_pt) like compiler_source_info; 202 3 1 /* BEGIN INCLUDE FILE ... compiler_source_info.incl.pl1 */ 3 2 /* coded in 1973 by B. Wolman */ 3 3 /* modified 12/75 by M. Weaver to include more source info */ 3 4 /* modified 12/76 by M. Weaver to include still more source info (version 2) */ 3 5 3 6 dcl 1 compiler_source_info aligned based, 3 7 2 version fixed bin, 3 8 2 given_ename char (32) var, 3 9 2 dirname char (168) var, 3 10 2 segname char (32) var, 3 11 2 date_time_modified fixed bin (71), 3 12 2 unique_id bit (36), 3 13 2 input_lng fixed bin (21), 3 14 2 input_pointer ptr; 3 15 3 16 dcl compiler_source_info_version_2 fixed bin static init (2) options (constant); 3 17 3 18 /* END INCLUDE FILE ... compiler_source_info.incl.pl1 */ 203 204 205 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 */ 206 207 208 5 1 /* BEGIN INCLUDE FILE -- lot.incl.pl1 S.Webber 9/74, Modified by R. Bratt 04/76, modified by M. Weaver 7/76 */ 5 2 /* modified by M. Weaver 3/77 */ 5 3 5 4 dcl lotp ptr; 5 5 5 6 dcl 1 lot based (lotp) aligned, 5 7 2 lp (0:9999) ptr unaligned; /* array of packed pointers to linkage sections */ 5 8 5 9 dcl lot_fault bit (36) aligned static options (constant) init ("111000000000000000000000000000000000"b); 5 10 /* lot fault has fault code = 0 and offset = 0 */ 5 11 5 12 dcl isotp ptr; 5 13 dcl 1 isot based (isotp) aligned, 5 14 2 isp (0:9999) ptr unaligned; 5 15 5 16 dcl 1 isot1 (0 :9999) aligned based, 5 17 2 flags unaligned, 5 18 3 fault bit (2) unaligned, 5 19 3 system bit (1) unaligned, 5 20 3 mbz bit (6) unaligned, 5 21 2 fault_code fixed bin (8) unaligned, 5 22 2 static_offset bit (18) unaligned; 5 23 5 24 5 25 /* END INCLUDE FILE lot.incl.pl1 */ 209 210 211 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 */ 212 213 214 215 /* copy arguments */ 216 system = a_system; 217 program_ptr = a_program_ptr; 218 program_lng = a_program_lng; 219 main_name = a_main_name; 220 debug_sw = a_debug_sw; 221 a_code = 0; 222 223 /* initialize automatic variables */ 224 225 arg_ptr = null; 226 ftn_io_p = null; 227 cur_lib_node_p = null; 228 last_lib_node_p = null; 229 scratch_ptr = null; 230 blank_common_ptr = null; 231 object_ptr = null; 232 rnt_p = null; 233 234 max_severity = 0; 235 nfiles = 0; 236 237 terminating = "0"b; 238 compiler_invoked = "0"b; 239 have_chained = "0"b; 240 fast_related_data_$terminate_run = terminate_run_entry; 241 fast_related_data_$fortran_io_initiated = "0"b; /* runtime must reinitialize io buffer area */ 242 243 array_p = addr (scratch_ptr); 244 call get_temp_segments_ ("dfast_run_unit_manager_", based_array, code); 245 call hcs_$get_max_length_seg (scratch_ptr, scratch_lng, code); 246 ru_area_size = scratch_lng - 300; /* save some room for lang area */ 247 cur_free_p = scratch_ptr; 248 have_chained = "0"b; 249 250 sb = ptr (addr (lotp), 0); /* get ptr to stack header */ 251 lotp = sb -> stack_header.lot_ptr; 252 isotp = sb -> stack_header.isot_ptr; 253 254 on cleanup begin; 255 256 /* get ips mask now for later use */ 257 interrupt_names = "-all"; 258 call create_ips_mask_ (addr (interrupt_names), 1, mask); 259 fast_related_data_$chaining = "0"b; 260 call terminate_run_unit_; 261 array_p = addr (scratch_ptr); 262 call release_temp_segments_ ("dfast_run_unit_manager_", based_array, code); 263 end; 264 265 call set_up_run_unit_; 266 267 /* . if a_file_info_p ^= null then call set_up_files_; /* called for execute command */ 268 269 join: if max_severity > 2 then do; 270 a_code = error_table_$not_done; 271 go to terminate; 272 end; 273 274 call find_entry_ ("main_", mainp, code); 275 276 /* if main_ename is ever given, check for it only in main program */ 277 if code ^= 0 then do; /* abort run unit */ 278 call ioa_ ("Main entry point not found."); 279 go to terminate; 280 end; 281 282 on fault_tag_3 call fault_tag_3_handler; 283 284 /* if debug_sw then call probe$init_run (mainp); */ 285 286 /* set bit count so can obtain statement map if error; need only for object but doesn't hurt source */ 287 call hcs_$set_bc_seg (program_ptr, program_lng, code); 288 289 call cu_$gen_call (mainp, arg_ptr); 290 291 terminate: 292 fast_related_data_$chaining = "0"b; /* be sur all files are closed */ 293 call terminate_run_unit_; 294 array_p = addr (scratch_ptr); 295 call release_temp_segments_ ("dfast_run_unit_manager_", based_array, code); 296 297 main_return: 298 return; 299 300 perform_chain: 301 call chain_; /* terminate old and set up neew run unit */ 302 go to join; /* now treat like ordinary run unit */ 303 304 /* end of main program */ 305 306 307 terminate_run_unit_: proc; 308 309 if terminating then return; /* don't risk loop */ 310 terminating = "1"b; 311 312 call hcs_$set_bc_seg (program_ptr, 0, code); 313 314 /* terminate all segs and clean up LOT */ 315 cp = last_lib_node_p; /* lib list is also master list */ 316 if cp ^= null then do; 317 do while (rel (cp)); 318 segptr = cp -> lib_list_node.segp; 319 if ^(cp -> lib_list_node.info.has_lote | cp -> lib_list_node.info.source) 320 & (segptr ^= null) then do; 321 k = fixed (baseno (segptr), 18); 322 lotp -> lot.lp (k), isotp -> isot.isp (k) = baseptr (0); 323 end; 324 if cp -> lib_list_node.info.terminate /* don't terminate first main seg */ 325 then call hcs_$terminate_noname (segptr, code); 326 cp = ptr (cp, cp -> lib_list_node.backward_thread); 327 end; 328 end; 329 330 /* terminate object segment */ 331 if object_ptr ^= null then do; 332 k = fixed (baseno (object_ptr), 18); 333 lotp -> lot.lp (k), isotp -> isot.isp (k) = baseptr (0); 334 call hcs_$set_bc_seg (object_ptr, 0, code); 335 array_p = addr (object_ptr); 336 call release_temp_segments_ ("dfast_run_unit_manager_", based_array, code); 337 end; 338 339 /* close all fortran files */ 340 if system = "fortran" then if ftn_io_p ^= null 341 then call fortran_io_$close_file (-1, code); 342 343 /* if necessary, close files not found during normal termination mechanisms */ 344 /* if ^fast_related_data_$chaining /* either in cleanup handler or at end */ 345 /* then call clean_up_files; */ 346 347 terminating = "0"b; 348 return; 349 350 end; /* terminate_run_unit_ */ 351 352 dfast_add_to_lib_list_: proc (a_pname, al_code); 353 354 dcl a_pname char (*); 355 dcl pname char (168); 356 dcl libp ptr; 357 dcl libbc fixed bin (24); 358 dcl al_code fixed bin (35); 359 360 361 pname = a_pname; 362 363 /* see if this name is already on the list; this may save an initiate call */ 364 cp = last_lib_node_p; 365 do while (rel (cp)); 366 if cp -> lib_list_node.segname = pname then go to already_on; 367 cp = ptr (cp, cp -> lib_list_node.backward_thread); 368 end; 369 370 /* get pointer to segment */ 371 call expand_pathname_ (pname, temp_dir, temp_ent, al_code); 372 if al_code ^= 0 then return; 373 374 on cleanup begin; /* be sure ips mask gets reset */ 375 if substr (oldmask, 36, 1) then do; /* between calls to set and reset ips mask */ 376 mask = oldmask; 377 call hcs_$reset_ips_mask (mask, oldmask); 378 end; 379 end; 380 381 interrupt_names = "-all"; 382 call create_ips_mask_ (addr (interrupt_names), 1, mask); 383 call hcs_$set_ips_mask (mask, oldmask); /* bit 36 of oldmask will be "1"b */ 384 385 386 call hcs_$initiate_count (temp_dir, temp_ent, "", libbc, 0, libp, al_code); 387 if libp = null then goto unmask; 388 389 /* see if this segment is already on the list */ 390 cp = last_lib_node_p; 391 do while (rel (cp)); 392 if cp -> lib_list_node.segp = libp then do; 393 call hcs_$terminate_noname (libp, code); 394 go to already_on; 395 end; 396 cp = ptr (cp, cp -> lib_list_node.backward_thread); 397 end; 398 399 /* allocate new node and fill in */ 400 call allocate_ (size (lib_list_node), cp); 401 last_lib_node_p -> lib_list_node.forward_thread = rel (cp); 402 cp -> lib_list_node.backward_thread = rel (last_lib_node_p); 403 cp -> lib_list_node.forward_thread = "0"b; 404 addr (cp -> lib_list_node.info) -> based_fixed = 0; 405 if code ^= 0 then cp -> lib_list_node.info.already_known = "1"b; 406 /* initiated before; may have valid lot entry */ 407 cp -> lib_list_node.info.terminate = "1"b; /* we initiated; we must terminate */ 408 cp -> lib_list_node.segname = pname; 409 cp -> lib_list_node.segp = libp; 410 cp -> lib_list_node.ftn_ls_p = null; 411 cp -> lib_list_node.ftn_symbol_p = null; 412 cp -> lib_list_node.segbc = libbc; 413 last_lib_node_p = cp; 414 415 already_on: al_code = 0; 416 unmask: mask = oldmask; /* use oldmask to bracket ips calls */ 417 call hcs_$reset_ips_mask (mask, oldmask); 418 return; 419 end; /* dfast_add_to_lib_list_ */ 420 421 init_lib_list_: proc; 422 423 /* allocate dummy node to make process_lib_list_ cleaner */ 424 425 call allocate_ (size (lib_list_node), cur_lib_node_p); 426 cur_lib_node_p -> lib_list_node.backward_thread = "0"b; 427 cur_lib_node_p -> lib_list_node.segp = null; 428 cur_lib_node_p -> lib_list_node.segname = ""; 429 cur_lib_node_p -> lib_list_node.ftn_ls_p = null; 430 cur_lib_node_p -> lib_list_node.ftn_symbol_p = null; 431 addr (cur_lib_node_p -> lib_list_node.info) -> based_fixed = 0; 432 433 434 /* allocate and initialize real first node */ 435 call allocate_ (size (lib_list_node), cp); 436 cp -> lib_list_node.backward_thread = rel (cur_lib_node_p); 437 cp -> lib_list_node.forward_thread = "0"b; 438 addr (cp -> lib_list_node.info) -> based_fixed = 0; 439 if have_chained then cp -> lib_list_node.info.terminate = "1"b; 440 cp -> lib_list_node.segname = main_name; 441 cp -> lib_list_node.segp = program_ptr; 442 cp -> lib_list_node.ftn_ls_p = null; 443 cp -> lib_list_node.ftn_symbol_p = null; 444 cp -> lib_list_node.segbc = program_lng; 445 last_lib_node_p = cp; 446 447 cur_lib_node_p -> lib_list_node.forward_thread = rel (cp); 448 449 is_main = "1"b; /* start out processing main program */ 450 return; 451 end; 452 453 chain_: proc; 454 455 /* this is just a place holder */ 456 457 return; 458 end; 459 460 461 set_up_run_unit_: proc; 462 463 dcl (blank_length, nblocks) fixed bin; 464 dcl (lsp, common_p) ptr; 465 dcl link_list (200) ptr aligned based; 466 dcl 1 common_list (100) aligned, 467 2 name char (32) aligned, /* name of labelled common block */ 468 2 block_p ptr, 469 2 block_len fixed bin; 470 471 dcl 1 ignore_source_info aligned like compiler_source_info; 472 dcl 1 ext aligned like ext_template; /* holds link info */ 473 474 dcl 1 init_info aligned based, 475 2 length fixed bin, 476 2 icode fixed bin, 477 2 template (0 refer (init_info.length)) bit (36) aligned; 478 479 dcl init_template (j) bit (36) aligned based; 480 481 call init_lib_list_; 482 compiler_invoked = "0"b; 483 484 /* compile all source and build table of object entries */ 485 call process_lib_list_ (addr (ignore_source_info)); 486 if max_severity > 2 then return; /* first release treats namedups as error */ 487 488 /* process links */ 489 if system = "fortran" then do; 490 blank_length = 0; 491 nblocks = 0; 492 cp = last_lib_node_p; 493 if cp ^= null then do while (rel (cp)); 494 call snap_ftn_links (cp -> lib_list_node.ftn_ls_p, "1"b); 495 cp = ptr (cp, cp -> lib_list_node.backward_thread); 496 end; 497 498 if object_ptr ^= null then do; /* snap links in object just compiled */ 499 lsp = lot.lp (fixed (baseno (object_ptr), 18)); /* get ptr to object's ls */ 500 call snap_ftn_links (lsp, "0"b); 501 end; 502 503 if max_severity > 2 then return; 504 call allocate_ (blank_length, blank_common_ptr); /* allocate blank common in scratch seg */ 505 506 call allocate_ (size (io_vector), ftn_io_p); 507 fast_related_data_$fortran_buffer_p = ftn_io_p; 508 end; 509 else do; /* basic */ 510 /* be sure area begins on even word boundary */ 511 if mod (fixed (rel (cur_free_p), 18), 2) = 1 then cur_free_p = addrel (cur_free_p, 1); 512 nleft = scratch_lng - fixed (rel (cur_free_p), 18); /* find # of words left in scratch seg */ 513 call area_ (nleft, cur_free_p); 514 fast_related_data_$basic_area_p = cur_free_p; 515 end; 516 517 return; 518 519 520 snap_ftn_links: proc (lp, old_object); 521 522 dcl nlinks fixed bin; /* number of links in linkage section */ 523 dcl first_link_offset fixed bin (18); 524 dcl dl_code fixed bin (35); 525 dcl (lp, link_ptr, link_list_ptr) ptr; 526 dcl old_object bit (1) aligned; 527 dcl length builtin; 528 529 if lp = null then return; 530 531 first_link_offset = fixed (lp -> header.stats.begin_links, 18); 532 link_list_ptr = addrel (lp, first_link_offset); 533 nlinks = divide (fixed (lp -> header.stats.block_length, 18) - first_link_offset + 1, 2, 17, 0); 534 do i = 1 to nlinks; 535 link_ptr = addr (link_list_ptr -> link_list (i)); 536 call decode_ftn_link_ (link_ptr, addr (ext), "1"b, dl_code); 537 if dl_code ^= 0 then do; /* illegal link */ 538 if dl_code = 1 then ; /* not a ft2 link */ 539 else link_ptr -> link.ft2 = "100111"b; /* get ft3 if reference */ 540 end; 541 else if ext.type = 5 & ext.section = "*system" then do; /* common */ 542 if ext.ename = "blnk*com" then do; 543 blank_length = max (blank_length, ext.init_info_p -> init_info.length); 544 /* keep track of max blank common length */ 545 link_ptr -> based_ptr = addr (blank_common_ptr); /* snap link indirect thru blank_common_ptr */ 546 link_ptr -> link.modifier = "010000"b; /* make pointer indirect */ 547 end; 548 else do; /* labelled common */ 549 call find_common_block_; 550 if code = 0 then link_ptr -> based_ptr = common_p; /* snap link */ 551 end; 552 end; 553 else if (ext.type = 1) & (ext.section = "*symbol") then do; 554 if old_object then link_ptr -> based_ptr = cp -> lib_list_node.ftn_symbol_p; 555 else link_ptr -> based_ptr = new_obj_symbol_p; 556 end; 557 else do; /* ordinary link */ 558 call find_entry_ ((ext.ename), ep, code); 559 if code ^= 0 then do; 560 call error (2, "Unable to satisfy reference to ^a because it is not in a library.", 561 substr (ext.ename, 1, length (ename))); 562 link_ptr -> link.ft2 = "100111"b; /* make fault tag 3 and continue */ 563 end; 564 else link_ptr -> based_ptr = ep; /* snap link */ 565 end; 566 end; 567 return; 568 569 find_common_block_: proc; 570 571 /* this procedure finds or allocates common blocks */ 572 /* global varaibles: init_info_p, 573* . ename, 574* . common_p, 575* . code, 576* . common_list. 577**/ 578 579 dcl i fixed bin; 580 581 code = 0; 582 do i = 1 to nblocks; /* see if block is already allocated */ 583 if ext.ename = common_list (i).name then do; /* found match */ 584 if common_list (i).block_len = ext.init_info_p -> init_info.length 585 then do; 586 common_p = common_list (i).block_p; /* use allocated block */ 587 if ext.init_info_p -> init_info.icode = 3 then do; /* but initialize now */ 588 j = ext.init_info_p -> init_info.length; 589 common_p -> init_template = ext.init_info_p -> init_info.template; 590 end; 591 end; 592 else do; 593 call error (3, "Different lengths specified for common block ^a", 594 substr (ext.ename, 1, length (ext.ename))); 595 code = 1; 596 end; 597 return; 598 end; 599 end; 600 601 /* no match; allocate new block in scratch seg */ 602 603 nblocks = nblocks + 1; 604 common_list (i).name = ext.ename; 605 j, common_list (i).block_len = init_info_p -> init_info.length; 606 call allocate_ (j, common_p); 607 common_list (i).block_p = common_p; 608 if ext.init_info_p -> init_info.icode = 3 609 then common_p -> init_template = ext.init_info_p -> init_info.template; 610 611 return; 612 end; /* find_common_blocks_ */ 613 end; /* snap_ftn_links */ 614 end; /* set_up_run_unit_ */ 615 616 decode_ftn_link_: proc (linkp, extp, linking, dcode); 617 618 /* This procedure returns information about legal fortran links only. 619* Do not distinguish types of errors except for missing fault tag 2. */ 620 /* This is outside set_up_run_unit_ so fault tag 3 handler can call it */ 621 622 dcl (linkp, extp) ptr; 623 dcl linking bit (1) aligned; 624 dcl dcode fixed bin (35); 625 626 dcl (head_pointer, def_pointer, exp_pointer, type_pointer, ext_pointer) ptr; 627 dcl (ntype, section_id) fixed bin (18); 628 dcl name_length fixed bin; 629 630 dcl 1 ext aligned based, /* holds link info */ 631 2 type fixed bin, /* link type */ 632 2 section char (8) aligned, 633 2 ename, 634 3 nchars fixed bin, 635 3 string char (32), 636 2 init_info_p ptr; /* ptr to init info for common */ 637 638 dcode = 1; 639 if linking then if linkp -> link.ft2 ^= "100110"b then return; 640 /* must have fault tag 2 */ 641 dcode = 2; 642 643 head_pointer = addrel (linkp, linkp -> link.head_ptr); 644 def_pointer = head_pointer -> header.def_ptr; 645 exp_pointer = addrel (def_pointer, linkp -> link.exp_ptr); 646 if exp_pointer -> exp_word.exp then return; /* must have 0 expression */ 647 648 type_pointer = addrel (def_pointer, exp_pointer -> exp_word.type_ptr); 649 ext_pointer = addrel (def_pointer, type_pointer -> type_pair.ext_ptr); 650 section_id = bin (type_pointer -> type_pair.seg_ptr, 18); 651 652 extp -> ext.type, ntype = bin (type_pointer -> type_pair.type, 18); 653 654 if (ntype = 4) | (ntype = 5) then do; 655 name_length = bin (ext_pointer -> name.nchars, 9); 656 if name_length > 32 then return; /* name too long */ 657 extp -> ext.ename.nchars = name_length; 658 substr (extp -> ext.ename.string, 1, name_length) 659 = substr (ext_pointer -> name.char_string, 1, name_length); 660 661 if ntype = 4 then do; 662 if type_pointer -> type_pair.seg_ptr ^= type_pointer -> type_pair.ext_ptr then return; 663 /* don't allow $ names in DFAST */ 664 extp -> ext.section = " "; 665 extp -> ext.init_info_p = null; 666 end; 667 else do; /* ntype = 5 */ 668 if section_id ^= 5 /* *system */ then return; 669 extp -> ext.section = "*system"; 670 if type_pointer -> type_pair.trap_ptr = "0"b then return; 671 /* must have init info */ 672 extp -> ext.init_info_p = addrel (def_pointer, type_pointer -> type_pair.trap_ptr); 673 end; 674 end; 675 676 else if ntype = 1 then do; 677 if section_id ^= 2 then return; /* must be *symbol|0 */ 678 extp -> ext.section = "*symbol"; 679 extp -> ext.ename.nchars = 0; 680 extp -> ext.init_info_p = null; 681 end; 682 683 else return; /* not a legal fortran type */ 684 685 dcode = 0; 686 return; 687 688 end; /* decode_ftn_link_ */ 689 690 find_entry_: proc (entname, entp, ecode); 691 692 /* this procedure returns a ptr to the entrypoint corresponding to a given name */ 693 694 dcl entname char (32); 695 dcl entp ptr; 696 dcl ename_length fixed bin; 697 dcl ecode fixed bin (35); 698 699 ename_length = 33 - verify (reverse (entname), " "); 700 rp = rnt_p; 701 do while (rel (rp)); 702 if ename_length = rnt_node.nchars 703 then if entname = rnt_node.name then do; 704 /* found match */ 705 entp = rnt_node.entryp; 706 ecode = 0; 707 return; 708 end; 709 rp = ptr (rp, rnt_node.next_node); 710 end; 711 712 ecode = error_table_$name_not_found; 713 return; 714 715 end; /* find_entry_ */ 716 717 718 719 find_entry_value: entry (a_entname, a_entp, a_ecode); 720 721 /* This entry is called by basic_find_proc_ */ 722 723 dcl a_entname char (32); 724 dcl a_entp ptr; 725 dcl a_ecode fixed bin (35); 726 727 call find_entry_ (a_entname, a_entp, a_ecode); 728 729 return; 730 731 732 733 process_object_: proc (old_object, has_lot_entry); 734 735 dcl (listptr, namep, linkage_section_p, program_header_pt) ptr; 736 dcl (namel, link_lng) fixed bin; 737 dcl old_object bit (1) aligned; /* "1"b->object segment is in hierarchy */ 738 dcl has_lot_entry bit (1) unal; 739 dcl based_name char (namel) based (namep); 740 dcl based_name_aligned char (namel) based (namep) aligned; 741 dcl 1 saved_lib_list aligned based, /* list found in object's text */ 742 2 nlibs fixed bin, 743 2 names (0 refer (nlibs)) aligned, 744 3 offset bit (18) unaligned, 745 3 length fixed bin (17) unaligned; 746 dcl ls (link_lng) fixed bin (35) based; 747 dcl al_code fixed bin (35); 748 7 1 dcl 1 basic_program_header aligned based(program_header_pt), 7 2 2 version_number fixed binary, 7 3 2 numeric_storage like loc_number, 7 4 2 string_storage like loc_number, 7 5 2 numeric_data like loc_number, 7 6 2 string_data like loc_number, 7 7 2 incoming_args like loc_number, 7 8 2 time_limit float bin, 7 9 2 numeric_scalars like loc_number, 7 10 2 string_scalars like loc_number, 7 11 2 numeric_arrays like loc_number, 7 12 2 string_arrays like loc_number, 7 13 2 functions like loc_number, 7 14 2 statement_map like loc_number, 7 15 2 precision_ind fixed bin(17) unaligned, 7 16 2 definitions fixed bin(17) unaligned; 7 17 7 18 dcl 1 loc_number based, 7 19 2 location bit(18) unaligned, 7 20 2 number bit(18) unaligned; 749 750 751 /* don't mix basic and fortran programs */ 752 if oi.compiler = "fortran2" then if system ^= "fortran" then go to wrong_sys; 753 if oi.compiler = "basic" then do; /* be sure precision matches */ 754 if system = "fortran" then go to wrong_sys; 755 if oi.textp -> basic_program_header.version_number = -1 then do; 756 /* double precision program */ 757 if system ^= "dbasic" then go to wrong_sys; 758 end; 759 else if system = "dbasic" then do; /* single precision program */ 760 wrong_sys: call error (3, "Program ^a belongs to another system.", cur_lib_node_p -> lib_list_node.segname); 761 return; 762 end; 763 end; 764 765 dd.next_def = oi.defp; /* initialize for loop */ 766 do while (^(decode_definition_$full (dd.next_def, addr (dd), addr (oi)))); 767 if dd.symbol = "library_list_" then do; 768 listptr = addrel (oi.textp, dd.offset); 769 do i = 1 to listptr -> saved_lib_list.nlibs; 770 namep = addrel (oi.textp, listptr -> saved_lib_list.names (i).offset); 771 namel = listptr -> saved_lib_list.names (i).length; 772 call dfast_add_to_lib_list_ (based_name, al_code); 773 if code ^= 0 then call error (3, "Library ^a could not be processed.", 774 based_name_aligned); 775 end; 776 end; 777 else if dd.section = "text" then call add_to_known_names; 778 end; 779 780 /* allocate linkage */ 781 if has_lot_entry then return; 782 if old_object then do; /* must copy linkage section */ 783 link_lng = oi.llng; 784 call allocate_ (link_lng, linkage_section_p); 785 linkage_section_p -> ls = oi.linkp -> ls; 786 if system = "fortran" then do; /* need to keep pointers for snapping links */ 787 cur_lib_node_p -> lib_list_node.ftn_ls_p = linkage_section_p; 788 /* set ptrs to linkage sections to be prelinked */ 789 cur_lib_node_p -> lib_list_node.ftn_symbol_p = oi.symbp; 790 end; 791 else cur_lib_node_p -> lib_list_node.ftn_ls_p, 792 cur_lib_node_p -> lib_list_node.ftn_symbol_p = null; 793 end; 794 else do; /* there's no lib_list_node for new object */ 795 linkage_section_p = oi.linkp; /* don't copy temp linkage section */ 796 new_obj_symbol_p = oi.symbp; 797 end; 798 799 /* update LOT, ISOT */ 800 k = fixed (baseno (oi.textp), 18); 801 lotp -> lot.lp (k) = linkage_section_p; 802 803 /* /*isotp->isot.isp(k)=linkage_section_p; */ 804 805 /* fill in linkage section header */ 806 linkage_section_p -> header.def_ptr = oi.defp; 807 linkage_section_p -> header.symbol_ptr = oi.symbp; 808 linkage_section_p -> header.original_linkage_ptr = oi.linkp; 809 linkage_section_p -> header.stats.segment_number = bit (k, 18); 810 linkage_section_p -> header.stats.static_length = bit (bin (oi.ilng, 18), 18); 811 812 return; 813 814 add_to_known_names: proc; 815 816 /* this procedure fills in the rnt */ 817 /* global variables: rnt_p, 818* ename, 819* def_ptr, 820* have_main; 821**/ 822 823 dcl ename_used char (32) var; 824 dcl ename_length fixed bin; 825 dcl saved_rp ptr; 826 827 /* copy name to be added */ 828 /* if it's the main entry point, use main__ so we can find it easily later */ 829 830 /* 831* . if dd.flags.a_main then do; 832* . if have_main then do; /* don't allow 2 main entry points ! 833* . call error (3, "Library ^a has a main entry point.", cur_lib_node_p -> lib_list_node.segname); 834* . return; 835* . end; 836* . ename_used = "main__"; 837* . ename_length = length (ename_used); 838* . have_main = "1"b; 839* . end; 840**/ 841 ename_length = dd.symbol_lng; 842 ename_used = substr (dd.symbol, 1, dd.symbol_lng); 843 if ename_used = "main_" then do; 844 if ^is_main then do; 845 call error (3, "Library ^a has a main entry point.", 846 cur_lib_node_p -> lib_list_node.segname); 847 return; 848 end; 849 end; 850 851 if rnt_p = null then do; /* rnt does not exist yet */ 852 call fill_in_rnt_node; 853 rnt_node.next_node = "0"b; 854 rnt_p = rp; 855 return; 856 end; 857 858 rp = rnt_p; 859 do while (rel (rp)); 860 if ename_length = rnt_node.nchars 861 862 then if ename_used = rnt_node.name then do; 863 call error (2, "Duplicate subroutine name ^a.", rnt_node.name); 864 return; 865 end; 866 saved_rp = rp; /* save for filling in thread */ 867 rp = ptr (rp, rnt_node.next_node); 868 end; 869 870 /* add name to rnt */ 871 call fill_in_rnt_node; 872 saved_rp -> rnt_node.next_node = rel (rp); /* thread new node to rest of list */ 873 return; 874 875 876 fill_in_rnt_node: proc; 877 878 879 call allocate_ (size (rnt_node), rp); 880 rnt_node.entryp = addrel (oi.textp, dd.offset); 881 rnt_node.pad = "0"b; 882 rnt_node.nchars = ename_length; 883 rnt_node.name = ename_used; 884 return; 885 886 end; /* fill_in_rnt_node */ 887 888 end; /* add_to_known_names_ */ 889 end; /* process_object_ */ 890 891 892 process_lib_list_: proc (source_info_pointer); 893 894 dcl source_info_pointer ptr; 895 dcl fixed_lote fixed bin (35); 896 dcl object_len fixed bin (24); 897 dcl object_length fixed bin; 898 899 dcl 1 fort_options aligned like fortran_options; 900 8 1 /* BEGIN INCLUDE FILE fort_options.incl.pl1 */ 8 2 8 3 /****^ *********************************************************** 8 4* * * 8 5* * Copyright, (C) Honeywell Information Systems Inc., 1987 * 8 6* * * 8 7* *********************************************************** */ 8 8 8 9 /****^ HISTORY COMMENTS: 8 10* 1) change(86-07-14,BWong), approve(86-07-14,MCR7382), audit(86-07-17,Ginter), 8 11* install(86-07-28,MR12.0-1105): 8 12* Fix fortran bug 473. 8 13* 2) change(87-06-23,RWaters), approve(87-06-23,MCR7703), audit(87-07-10,Huen), 8 14* install(87-08-06,MR12.1-1069): 8 15* Implemented SCP 6315: fortran error-handling argument. 8 16* END HISTORY COMMENTS */ 8 17 8 18 8 19 /* 8 20* Modified: 12 May 87 by RWaters added debug_io 8 21* Modified: 19 February 1986 by B. Wong & A. Ginter - 473.a: Correct 8 22* comments and size of pad field in fort_declared 8 23* and pad out dfast and fast bit masks to two words. 8 24* Modified: 09 October 1985 by B. Wong - 473: add VLA_auto, VLA_static, 8 25* VLA_parm, VLC, LA_auto, and LA_static. Remove VLA and LA. 8 26* Modified: 28 March 1984 by M. Mabey - Install HFP support. 8 27* Modified: 21 September 1983 by M. Mabey - correct size of pad field in fortran_declared. 8 28* Modified: 16 May 1983 by M. Mabey - add fortran_declared 8 29* Modified: 18 December 1982 by T. Oke - Add 'long_profile'. 8 30* Modified: 22 September 1982 by T. Oke - add VLA and LA 8 31* Modified: 3 May 1982 by T. Oke - add check_multiply 8 32* Modified: 06/24/81 by S. Herbst - add do_rounding & auto_zero to fast_mask and dfast_mask 8 33* Modified: 26 February 1980 by C R Davis - add fast_mask, fix dfast_mask. 8 34* Modified: 31 January 1980 by C R Davis - add stringrange. 8 35* Modified: 13 September 1979 by Paul E. Smee--add ansi_77. 8 36* Modified: 05 December 1978 by Paul E. Smee--add do_rounding, auto_zero. 8 37* Modified: 25 January 1978 by Richard A. Barnes for the loop optimizer 8 38**/ 8 39 8 40 declare 8 41 8 42 1 fortran_options aligned based, 8 43 2 use_library bit (1) unaligned, /* (1) ON if library statements will be parsed */ 8 44 2 optimize bit (1) unaligned, /* (2) ON if optimized code is to be produced */ 8 45 2 time bit (1) unaligned, /* (3) ON for compile timing */ 8 46 2 source_format unaligned, 8 47 3 has_line_numbers bit (1) unaligned, /* (4) ON if each line begins with a line number */ 8 48 3 fold bit (1) unaligned, /* (5) ON if variable names are to be folded to lowercase */ 8 49 3 card bit (1) unaligned, /* (6) ON for card format */ 8 50 3 convert bit (1) unaligned, /* (7) ON for card format to be converted */ 8 51 2 listing unaligned, 8 52 3 source bit (1) unaligned, /* (8) ON for listing of numbered source */ 8 53 3 symbol bit (1) unaligned, /* (9) ON for listing with symbol map */ 8 54 3 map bit (1) unaligned, /* (10) ON for listing with statement map */ 8 55 3 list bit (1) unaligned, /* (11) ON for listing with assembler instructions */ 8 56 2 error_messages unaligned, 8 57 3 brief bit (1) unaligned, /* (12) ON for brief error messages */ 8 58 3 severity fixed bin (3), /* (13-16) suppresses messages below this severity */ 8 59 2 debugging unaligned, 8 60 3 subscriptrange bit (1) unaligned, /* (17) ON for subscript range checking */ 8 61 3 stringrange bit (1) unaligned, /* (18) ON for string range checking */ 8 62 3 brief_table bit (1) unaligned, /* (19) ON for statement table */ 8 63 3 table bit (1) unaligned, /* (20) ON for statement and symbol table */ 8 64 3 profile bit (1) unaligned, /* (21) ON to generate code to meter statements */ 8 65 3 check bit (1) unaligned, /* (22) ON for syntactic and semantic checking only */ 8 66 2 system_debugging unaligned, 8 67 3 stop_after_cg bit (1) unaligned, /* (23) ON if debug stop after code generator */ 8 68 3 stop_after_parse bit (1) unaligned, /* (24) ON if debug stop after parse */ 8 69 2 relocatable bit (1) unaligned, /* (25) ON if relocatable object segment generated */ 8 70 2 optimizing unaligned, 8 71 3 time_optimizer bit (1) unaligned, /* (26) ON if timings for optimizer requested */ 8 72 /* (27) ON if optimizer can loosen safety constraints */ 8 73 3 ignore_articulation_blocks bit (1) unaligned, 8 74 3 consolidate bit(1) unaligned, /* (28) ON if optimizer should run consolidation phase */ 8 75 2 do_rounding bit(1) unaligned, /* (29) ON if floating point round should be used */ 8 76 2 auto_zero bit(1) unaligned, /* (30) ON if auto storage should be zeroed when allocated */ 8 77 2 ansi_77 bit (1) unaligned, /* (31) ON if ansi77 rules are to be followed */ 8 78 2 check_multiply bit (1) unaligned, /* (32) ON if check integer multiply extent */ 8 79 2 VLA_auto bit (1) unaligned, /* (33) ON if auto VLA's being done */ 8 80 2 VLA_parm bit (1) unaligned, /* (34) ON if parm VLA's being done */ 8 81 2 VLA_static bit (1) unaligned, /* (35) ON if static VLA's being done */ 8 82 2 VLC bit (1) unaligned, /* (36) ON if VLC's being done */ 8 83 2 LA_auto bit (1) unaligned, /* (1) ON if auto LA's being done */ 8 84 2 LA_static bit (1) unaligned, /* (2) ON if static LA's being done */ 8 85 2 long_profile bit (1) unaligned, /* (3) ON to generate long_profile */ 8 86 2 static_storage bit (1) unaligned, /* (4) ON if static storage */ 8 87 2 hfp bit (1) unaligned, /* (5) ON if using hex floating point math */ 8 88 2 debug_io bit (1) unaligned, /* (6) */ 8 89 2 pad bit(30) unaligned; /* (7-36) Pad bits */ 8 90 8 91 declare 8 92 8 93 1 fortran_declared aligned based, 8 94 2 ansi66 bit(1) unaligned, /* (1) First word */ 8 95 2 ansi77 bit(1) unaligned, /* (2) */ 8 96 2 auto bit(1) unaligned, /* (3) */ 8 97 2 auto_zero bit(1) unaligned, /* (4) */ 8 98 2 brief bit(1) unaligned, /* (5) */ 8 99 2 binary_floating_point bit(1) unaligned, /* (6) */ 8 100 2 brief_table bit(1) unaligned, /* (7) */ 8 101 2 card bit(1) unaligned, /* (8) */ 8 102 2 check bit(1) unaligned, /* (9) */ 8 103 2 check_multiply bit(1) unaligned, /* (10) */ 8 104 2 consolidate bit(1) unaligned, /* (11) */ 8 105 2 debug bit(1) unaligned, /* (12) */ 8 106 2 debug_cg bit(1) unaligned, /* (13) */ 8 107 2 debug_io bit(1) unaligned, /* (14) */ 8 108 2 default_full bit(1) unaligned, /* (15) */ 8 109 2 default_safe bit(1) unaligned, /* (16) */ 8 110 2 fold bit(1) unaligned, /* (17) */ 8 111 2 free bit(1) unaligned, /* (18) */ 8 112 2 full_optimize bit(1) unaligned, /* (19) */ 8 113 2 hexadecimal_floating_point bit(1) unaligned, 8 114 /* (20) */ 8 115 2 la_auto bit(1) unaligned, /* (21) */ 8 116 2 la_static bit(1) unaligned, /* (22) */ 8 117 2 large_array bit(1) unaligned, /* (23) */ 8 118 2 line_numbers bit(1) unaligned, /* (24) */ 8 119 2 list bit(1) unaligned, /* (25) */ 8 120 2 long bit(1) unaligned, /* (26) */ 8 121 2 long_profile bit(1) unaligned, /* (27) */ 8 122 2 map bit(1) unaligned, /* (28) */ 8 123 2 no_auto_zero bit(1) unaligned, /* (29) */ 8 124 2 no_check bit(1) unaligned, /* (30) */ 8 125 2 no_fold bit(1) unaligned, /* (31) */ 8 126 2 no_large_array bit(1) unaligned, /* (32) */ 8 127 2 no_line_numbers bit(1) unaligned, /* (33) */ 8 128 2 no_map bit(1) unaligned, /* (34) */ 8 129 2 no_optimize bit(1) unaligned, /* (35) */ 8 130 2 no_check_multiply bit(1) unaligned, /* (36) */ 8 131 2 no_debug_io bit(1) unal, /* (1) Second Word */ 8 132 2 no_stringrange bit(1) unaligned, /* (2) */ 8 133 2 no_subscriptrange bit(1) unaligned, /* (3) */ 8 134 2 no_table bit(1) unaligned, /* (4) */ 8 135 2 no_very_large_array bit(1) unaligned, /* (5) */ 8 136 2 no_vla_parm bit(1) unaligned, /* (6) */ 8 137 2 no_version bit(1) unaligned, /* (7) */ 8 138 2 non_relocatable bit(1) unaligned, /* (8) */ 8 139 2 optimize bit(1) unaligned, /* (9) */ 8 140 2 profile bit(1) unaligned, /* (10) */ 8 141 2 relocatable bit(1) unaligned, /* (11) */ 8 142 2 round bit(1) unaligned, /* (12) */ 8 143 2 safe_optimize bit(1) unaligned, /* (13) */ 8 144 2 severity fixed bin(3) unaligned, /* (14-16) */ 8 145 2 static bit(1) unaligned, /* (17) */ 8 146 2 stringrange bit(1) unaligned, /* (18) */ 8 147 2 subscriptrange bit(1) unaligned, /* (19) */ 8 148 2 table bit(1) unaligned, /* (20) */ 8 149 2 time bit(1) unaligned, /* (21) */ 8 150 2 time_ot bit(1) unaligned, /* (22) */ 8 151 2 top_down bit(1) unaligned, /* (23) */ 8 152 2 truncate bit(1) unaligned, /* (24) */ 8 153 2 version bit(1) unaligned, /* (25) */ 8 154 2 very_large_array bit(1) unaligned, /* (26) */ 8 155 2 very_large_common bit(1) unaligned, /* (27) */ 8 156 2 vla_auto bit(1) unaligned, /* (28) */ 8 157 2 vla_parm bit(1) unaligned, /* (29) */ 8 158 2 vla_static bit(1) unaligned, /* (30) */ 8 159 2 pad bit(6) unaligned; /* (31-36) */ 8 160 8 161 8 162 declare /* Options used by DFAST */ 8 163 8 164 dfast_mask bit (72) internal static options (constant) initial ("100110000000000010100000000011"b); 8 165 /* use_library, has_line_numbers, fold, subscriptrange, brief_table */ 8 166 8 167 8 168 declare /* Options used by FAST */ 8 169 8 170 fast_mask bit (72) internal static options (constant) initial ("000100000000000010100000000011"b); 8 171 /* has_line_numbers, subscriptrange, brief_table */ 8 172 8 173 /* END INCLUDE FILE fort_options.incl.pl1 */ 901 902 903 source_info_pt = source_info_pointer; 904 905 /* find all library segments */ 906 do while (cur_lib_node_p -> lib_list_node.forward_thread); 907 cur_lib_node_p = ptr (cur_lib_node_p, lib_list_node.forward_thread); 908 oi.version_number = object_info_version_2; 909 call object_info_$display (lib_list_node.segp, lib_list_node.segbc, addr (oi), code); 910 if code = 0 then do; /* object */ 911 fixed_lote = addr (lotp -> lot.lp (fixed (baseno (oi.textp), 18))) -> based_fixed; 912 if (fixed_lote > 0) & (lib_list_node.info.already_known) 913 then cur_lib_node_p -> lib_list_node.info.has_lote = "1"b; 914 call process_object_ ("1"b, cur_lib_node_p -> lib_list_node.info.has_lote); /* find defs, copy linkage */ 915 is_main = "0"b; 916 end; 917 else do; 918 /* source; must compile */ 919 /* set up source info */ 920 source_info.version = compiler_source_info_version_2; 921 source_info.input_pointer = cur_lib_node_p -> lib_list_node.segp; 922 source_info.input_lng = divide (cur_lib_node_p -> lib_list_node.segbc+8, 9, 17, 0); 923 call expand_pathname_ ((cur_lib_node_p -> lib_list_node.segname), temp_dir, temp_ent, code); 924 source_info.given_ename = substr (temp_ent, 1, 33 - verify (reverse (temp_ent), " ")); 925 926 call hcs_$status_long (temp_dir, temp_ent, 1, addr (branch_status), null, code); 927 /* ignore any error--not likely and doesn't matter */ 928 source_info.date_time_modified = fixed (branch_status.date_time_modified || (16)"0"b, 71); 929 source_info.unique_id = branch_status.unique_id; 930 931 call hcs_$fs_get_path_name (source_info.input_pointer, temp_dir, i, temp_ent, code); 932 source_info.dirname = substr (temp_dir, 1, i); 933 source_info.segname = substr (temp_ent, 1, 33 - verify (reverse (temp_ent), " ")); 934 935 if compiler_invoked then return; 936 /* here at most once per run unit */ 937 938 array_p = addr (object_ptr); 939 call get_temp_segments_ ("dfast_run_unit_manager_", based_array, code); 940 if code ^= 0 then do; 941 call error (4, "Unable to obtain segment for compiled code.", " "); 942 go to main_return; 943 end; 944 945 save_main = is_main; /* note if compiling maan */ 946 is_main = "0"b; /* turn off for any libraries found */ 947 compiler_invoked = "1"b; 948 949 if system = "fortran" then do; 950 unspec (fort_options) = dfast_mask; 951 call fort_$compile_run ( 952 source_info_pointer, object_ptr, object_length, addr (fort_options), 953 dfast_get_next_source_seg_, dfast_add_to_lib_list_, code); 954 end; 955 956 else call basic_$run_unit_compiler ( /* assume basic */ 957 source_info_pointer, object_ptr, object_length, debug_sw, 958 dfast_get_next_source_seg_, dfast_add_to_lib_list_, code); 959 960 if code ^= 0 then do; 961 call error (3, "errors in source. Program could not be run.", " "); 962 return; 963 end; 964 965 object_len = object_length * 36; /* convert to bit count */ 966 call hcs_$set_bc_seg (object_ptr, object_len, code); 967 call object_info_$display (object_ptr, object_len, addr (oi), code); 968 is_main = save_main; 969 970 if code ^= 0 then call error (3, "Errors in source. Program could not be run.", " "); 971 else call process_object_ ("0"b, "0"b); /* find defs; don't copy linkage */ 972 return; 973 end; 974 end; 975 976 /* found all libraries; tell compiler to finish object */ 977 if compiler_invoked then source_info.input_pointer = null; 978 979 return; 980 end; 981 982 dfast_get_next_source_seg_: proc (source_info_pointer); 983 984 dcl source_info_pointer ptr; 985 986 call process_lib_list_ (source_info_pointer); 987 988 return; 989 end; /* dfast_get_next_source_seg_ */ 990 991 992 allocate_: proc (nwords, newptr); 993 994 /* this routine allocates spece in the scratch segment; it is used when 995* the run unit is being set up */ 996 997 dcl nwords fixed bin; 998 dcl newptr ptr; 999 1000 /* always allocate on even word boundary */ 1001 if mod (fixed (rel (cur_free_p), 18), 2) = 1 then cur_free_p = addrel (cur_free_p, 1); 1002 newptr = cur_free_p; 1003 cur_free_p = addrel (cur_free_p, nwords); 1004 if fixed (rel (cur_free_p), 18) > ru_area_size then do; 1005 call error (4, "Attempt to overflow run unit scratch area.", " "); 1006 go to main_return; /* abort completely; can't continue at all */ 1007 end; 1008 1009 return; 1010 end; /* allocate_ */ 1011 1012 1013 error: proc (severity, control_string, arg_string); 1014 1015 dcl severity fixed bin; 1016 dcl (control_string, arg_string) char (*) aligned; 1017 1018 max_severity = max (max_severity, severity); 1019 call ioa_ (control_string, arg_string); 1020 1021 return; 1022 end; /* error */ 1023 1024 1025 1026 1027 terminate_run_entry: proc; 1028 1029 goto terminate; 1030 1031 end; /* terminate_run_entry */ 1032 1033 1034 1035 fault_tag_3_handler: proc; 1036 1037 /* fortran links which could not be snapped are converted to fault tag 3's */ 1038 1039 dcl link_ptr ptr; 1040 dcl dl_code fixed bin (35); 1041 dcl find_condition_info_ entry (ptr, ptr, fixed bin (35)); 1042 dcl continue_to_signal_ entry (fixed bin (35)); 1043 1044 dcl 1 ext aligned like ext_template; 1045 1046 dcl 1 cond_info aligned, 9 1 /* BEGIN INCLUDE FILE ... cond_info.incl.pl1 9 2* coded by M. Weaver 12 July 1973 */ 9 3 9 4 2 mcptr ptr, /* ptr to machine conditions at time of fault */ 9 5 2 version fixed bin, /* version of this structure (now=1) */ 9 6 2 condition_name char(32) var, /* name of condition */ 9 7 2 infoptr ptr, /* ptr to software info structure */ 9 8 2 wcptr ptr, /* ptr to wall crossing machine conditions */ 9 9 2 loc_ptr ptr, /* ptr to location where condition occurred */ 9 10 2 flags aligned, 9 11 3 crawlout bit(1) unal, /* = "1"b if condition occurred in inner ring */ 9 12 3 pad1 bit(35) unal, 9 13 2 pad_word bit(36) aligned, 9 14 2 user_loc_ptr ptr, /* ptr to last non-support loc before condition */ 9 15 2 pad (4) bit(36) aligned; 9 16 9 17 /* END INCLUDE FILE ... cond_info.incl.pl1 */ 1047 1048 10 1 /* */ 10 2 /* BEGIN INCLUDE FILE mc.incl.pl1 Created Dec 72 for 6180 - WSS. */ 10 3 /* Modified 06/07/76 by Greenberg for mc.resignal */ 10 4 /* Modified 07/07/76 by Morris for fault register data */ 10 5 /* Modified 08/28/80 by J. A. Bush for the DPS8/70M CVPU */ 10 6 /* Modified '82 to make values constant */ 10 7 10 8 /* words 0-15 pointer registers */ 10 9 10 10 dcl mcp ptr; 10 11 10 12 dcl 1 mc based (mcp) aligned, 10 13 2 prs (0:7) ptr, /* POINTER REGISTERS */ 10 14 (2 regs, /* registers */ 10 15 3 x (0:7) bit (18), /* index registers */ 10 16 3 a bit (36), /* accumulator */ 10 17 3 q bit (36), /* q-register */ 10 18 3 e bit (8), /* exponent */ 10 19 3 pad1 bit (28), 10 20 3 t bit (27), /* timer register */ 10 21 3 pad2 bit (6), 10 22 3 ralr bit (3), /* ring alarm register */ 10 23 10 24 2 scu (0:7) bit (36), 10 25 10 26 2 mask bit (72), /* mem controller mask at time of fault */ 10 27 2 ips_temp bit (36), /* Temporary storage for IPS info */ 10 28 2 errcode fixed bin (35), /* fault handler's error code */ 10 29 2 fim_temp, 10 30 3 unique_index bit (18) unal, /* unique index for restarting faults */ 10 31 3 resignal bit (1) unal, /* recompute signal name with fcode below */ 10 32 3 fcode bit (17) unal, /* fault code used as index to FIM table and SCT */ 10 33 2 fault_reg bit (36), /* fault register */ 10 34 2 pad2 bit (1), 10 35 2 cpu_type fixed bin (2) unsigned, /* L68 = 0, DPS8/70M = 1 */ 10 36 2 ext_fault_reg bit (15), /* extended fault reg for DPS8/70M CPU */ 10 37 2 fault_time bit (54), /* time of fault */ 10 38 10 39 2 eis_info (0:7) bit (36)) unaligned; 10 40 10 41 10 42 dcl (apx fixed bin init (0), 10 43 abx fixed bin init (1), 10 44 bpx fixed bin init (2), 10 45 bbx fixed bin init (3), 10 46 lpx fixed bin init (4), 10 47 lbx fixed bin init (5), 10 48 spx fixed bin init (6), 10 49 sbx fixed bin init (7)) internal static options (constant); 10 50 10 51 10 52 10 53 10 54 dcl scup ptr; 10 55 10 56 dcl 1 scu based (scup) aligned, /* SCU DATA */ 10 57 10 58 10 59 /* WORD (0) */ 10 60 10 61 (2 ppr, /* PROCEDURE POINTER REGISTER */ 10 62 3 prr bit (3), /* procedure ring register */ 10 63 3 psr bit (15), /* procedure segment register */ 10 64 3 p bit (1), /* procedure privileged bit */ 10 65 10 66 2 apu, /* APPENDING UNIT STATUS */ 10 67 3 xsf bit (1), /* ext seg flag - IT modification */ 10 68 3 sdwm bit (1), /* match in SDW Ass. Mem. */ 10 69 3 sd_on bit (1), /* SDW Ass. Mem. ON */ 10 70 3 ptwm bit (1), /* match in PTW Ass. Mem. */ 10 71 3 pt_on bit (1), /* PTW Ass. Mem. ON */ 10 72 3 pi_ap bit (1), /* Instr Fetch or Append cycle */ 10 73 3 dsptw bit (1), /* Fetch of DSPTW */ 10 74 3 sdwnp bit (1), /* Fetch of SDW non paged */ 10 75 3 sdwp bit (1), /* Fetch of SDW paged */ 10 76 3 ptw bit (1), /* Fetch of PTW */ 10 77 3 ptw2 bit (1), /* Fetch of pre-paged PTW */ 10 78 3 fap bit (1), /* Fetch of final address paged */ 10 79 3 fanp bit (1), /* Fetch of final address non-paged */ 10 80 3 fabs bit (1), /* Fetch of final address absolute */ 10 81 10 82 2 fault_cntr bit (3), /* number of retrys of EIS instructions */ 10 83 10 84 10 85 /* WORD (1) */ 10 86 10 87 2 fd, /* FAULT DATA */ 10 88 3 iro bit (1), /* illegal ring order */ 10 89 3 oeb bit (1), /* out of execute bracket */ 10 90 3 e_off bit (1), /* no execute */ 10 91 3 orb bit (1), /* out of read bracket */ 10 92 3 r_off bit (1), /* no read */ 10 93 3 owb bit (1), /* out of write bracket */ 10 94 3 w_off bit (1), /* no write */ 10 95 3 no_ga bit (1), /* not a gate */ 10 96 3 ocb bit (1), /* out of call bracket */ 10 97 3 ocall bit (1), /* outward call */ 10 98 3 boc bit (1), /* bad outward call */ 10 99 3 inret bit (1), /* inward return */ 10 100 3 crt bit (1), /* cross ring transfer */ 10 101 3 ralr bit (1), /* ring alarm register */ 10 102 3 am_er bit (1), /* associative memory fault */ 10 103 3 oosb bit (1), /* out of segment bounds */ 10 104 3 paru bit (1), /* processor parity upper */ 10 105 3 parl bit (1), /* processor parity lower */ 10 106 3 onc_1 bit (1), /* op not complete type 1 */ 10 107 3 onc_2 bit (1), /* op not complete type 2 */ 10 108 10 109 2 port_stat, /* PORT STATUS */ 10 110 3 ial bit (4), /* illegal action lines */ 10 111 3 iac bit (3), /* illegal action channel */ 10 112 3 con_chan bit (3), /* connect channel */ 10 113 10 114 2 fi_num bit (5), /* (fault/interrupt) number */ 10 115 2 fi_flag bit (1), /* 1 => fault, 0 => interrupt */ 10 116 10 117 10 118 /* WORD (2) */ 10 119 10 120 2 tpr, /* TEMPORARY POINTER REGISTER */ 10 121 3 trr bit (3), /* temporary ring register */ 10 122 3 tsr bit (15), /* temporary segment register */ 10 123 10 124 2 pad2 bit (9), 10 125 10 126 2 cpu_no bit (3), /* CPU number */ 10 127 10 128 2 delta bit (6), /* tally modification DELTA */ 10 129 10 130 10 131 /* WORD (3) */ 10 132 10 133 2 word3 bit (18), 10 134 10 135 2 tsr_stat, /* TSR STATUS for 1,2,&3 word instructions */ 10 136 3 tsna, /* Word 1 status */ 10 137 4 prn bit (3), /* Word 1 PR number */ 10 138 4 prv bit (1), /* Word 1 PR valid bit */ 10 139 3 tsnb, /* Word 2 status */ 10 140 4 prn bit (3), /* Word 2 PR number */ 10 141 4 prv bit (1), /* Word 2 PR valid bit */ 10 142 3 tsnc, /* Word 3 status */ 10 143 4 prn bit (3), /* Word 3 PR number */ 10 144 4 prv bit (1), /* Word 3 PR valid bit */ 10 145 10 146 2 tpr_tbr bit (6), /* TPR.TBR field */ 10 147 10 148 10 149 /* WORD (4) */ 10 150 10 151 2 ilc bit (18), /* INSTRUCTION COUNTER */ 10 152 10 153 2 ir, /* INDICATOR REGISTERS */ 10 154 3 zero bit (1), /* zero indicator */ 10 155 3 neg bit (1), /* negative indicator */ 10 156 3 carry bit (1), /* carryry indicator */ 10 157 3 ovfl bit (1), /* overflow indicator */ 10 158 3 eovf bit (1), /* eponent overflow */ 10 159 3 eufl bit (1), /* exponent underflow */ 10 160 3 oflm bit (1), /* overflow mask */ 10 161 3 tro bit (1), /* tally runout */ 10 162 3 par bit (1), /* parity error */ 10 163 3 parm bit (1), /* parity mask */ 10 164 3 bm bit (1), /* ^bar mode */ 10 165 3 tru bit (1), /* truncation mode */ 10 166 3 mif bit (1), /* multi-word instruction mode */ 10 167 3 abs bit (1), /* absolute mode */ 10 168 3 hex bit (1), /* hexadecimal exponent mode */ 10 169 3 pad bit (3), 10 170 10 171 10 172 /* WORD (5) */ 10 173 10 174 2 ca bit (18), /* COMPUTED ADDRESS */ 10 175 10 176 2 cu, /* CONTROL UNIT STATUS */ 10 177 3 rf bit (1), /* on first cycle of repeat instr */ 10 178 3 rpt bit (1), /* repeat instruction */ 10 179 3 rd bit (1), /* repeat double instruction */ 10 180 3 rl bit (1), /* repeat link instruciton */ 10 181 3 pot bit (1), /* IT modification */ 10 182 3 pon bit (1), /* return type instruction */ 10 183 3 xde bit (1), /* XDE from Even location */ 10 184 3 xdo bit (1), /* XDE from Odd location */ 10 185 3 poa bit (1), /* operation preparation */ 10 186 3 rfi bit (1), /* tells CPU to refetch instruction */ 10 187 3 its bit (1), /* ITS modification */ 10 188 3 if bit (1), /* fault occured during instruction fetch */ 10 189 10 190 2 cpu_tag bit (6)) unaligned, /* computed tag field */ 10 191 10 192 10 193 /* WORDS (6,7) */ 10 194 10 195 2 even_inst bit (36), /* even instruction of faulting pair */ 10 196 10 197 2 odd_inst bit (36); /* odd instruction of faulting pair */ 10 198 10 199 10 200 10 201 10 202 10 203 10 204 /* ALTERNATE SCU DECLARATION */ 10 205 10 206 10 207 dcl 1 scux based (scup) aligned, 10 208 10 209 (2 pad0 bit (36), 10 210 10 211 2 fd, /* GROUP II FAULT DATA */ 10 212 3 isn bit (1), /* illegal segment number */ 10 213 3 ioc bit (1), /* illegal op code */ 10 214 3 ia_am bit (1), /* illegal address - modifier */ 10 215 3 isp bit (1), /* illegal slave procedure */ 10 216 3 ipr bit (1), /* illegal procedure */ 10 217 3 nea bit (1), /* non existent address */ 10 218 3 oobb bit (1), /* out of bounds */ 10 219 3 pad bit (29), 10 220 10 221 2 pad2 bit (36), 10 222 10 223 2 pad3a bit (18), 10 224 10 225 2 tsr_stat (0:2), /* TSR STATUS as an ARRAY */ 10 226 3 prn bit (3), /* PR number */ 10 227 3 prv bit (1), /* PR valid bit */ 10 228 10 229 2 pad3b bit (6)) unaligned, 10 230 10 231 2 pad45 (0:1) bit (36), 10 232 10 233 2 instr (0:1) bit (36); /* Instruction ARRAY */ 10 234 10 235 10 236 10 237 /* END INCLUDE FILE mc.incl.pl1 */ 1049 1050 1051 cond_info.version = 1; 1052 call find_condition_info_ (null, addr (cond_info), dl_code); 1053 if dl_code ^= 0 then goto continue_ft3; 1054 1055 scup = addr (cond_info.mcptr -> mc.scu (0)); 1056 link_ptr = ptr (baseptr (fixed (fixed (scup -> scu.ppr.psr, 15), 18)), scup -> scu.ca); 1057 1058 call decode_ftn_link_ (link_ptr, addr (ext), "0"b, dl_code); 1059 if dl_code = 0 then call ioa_ ("Attempt to reference missing subprogram ^a.^/Program aborted.", 1060 ext.ename); 1061 else if dl_code = 2 then call ioa_ ( 1062 "Attempt to reference through invalid link.^/FORTRAN compiler error. Program aborted."); 1063 else do; /* at this writing no other codes are returned, but... */ 1064 continue_ft3: call continue_to_signal_ (code); 1065 return; 1066 end; 1067 1068 goto terminate; 1069 1070 end; /* fault_tag_3_handler */ 1071 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 08/06/87 1047.1 dfast_run_unit_manager_.pl1 >spec>install>MR12.1-1069>dfast_run_unit_manager_.pl1 195 1 08/05/77 1022.5 object_info.incl.pl1 >ldd>include>object_info.incl.pl1 198 2 11/22/82 0955.6 branch_status.incl.pl1 >ldd>include>branch_status.incl.pl1 203 3 03/10/77 1345.4 compiler_source_info.incl.pl1 >ldd>include>compiler_source_info.incl.pl1 206 4 07/27/83 0910.0 linkdcl.incl.pl1 >ldd>include>linkdcl.incl.pl1 209 5 08/05/77 1022.4 lot.incl.pl1 >ldd>include>lot.incl.pl1 212 6 11/07/86 1550.3 stack_header.incl.pl1 >ldd>include>stack_header.incl.pl1 749 7 03/27/82 0439.4 basic_program_header.incl.pl1 >ldd>include>basic_program_header.incl.pl1 901 8 08/06/87 1045.4 fort_options.incl.pl1 >spec>install>MR12.1-1069>fort_options.incl.pl1 1047 9 05/06/74 1741.0 cond_info.incl.pl1 >ldd>include>cond_info.incl.pl1 1049 10 12/15/83 1100.4 mc.incl.pl1 >ldd>include>mc.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. a_code parameter fixed bin(35,0) dcl 29 set ref 11 221* 270* a_debug_sw parameter bit(1) dcl 28 ref 11 220 a_ecode parameter fixed bin(35,0) dcl 725 set ref 719 727* a_entname parameter char(32) unaligned dcl 723 set ref 719 727* a_entp parameter pointer dcl 724 set ref 719 727* a_main_name parameter char(168) dcl 27 ref 11 219 a_pname parameter char unaligned dcl 354 ref 352 361 a_program_lng parameter fixed bin(24,0) dcl 26 ref 11 218 a_program_ptr parameter pointer dcl 25 ref 11 217 a_system parameter char(8) dcl 24 ref 11 216 addr builtin function dcl 117 ref 243 250 258 258 261 294 335 382 382 404 431 438 485 485 535 536 536 545 766 766 766 766 909 909 911 926 926 938 951 951 967 967 1052 1052 1055 1058 1058 addrel builtin function dcl 117 ref 511 532 643 645 648 649 672 768 770 880 1001 1003 al_code parameter fixed bin(35,0) dcl 358 in procedure "dfast_add_to_lib_list_" set ref 352 371* 372 386* 415* al_code 000116 automatic fixed bin(35,0) dcl 747 in procedure "process_object_" set ref 772* alcode 0(18) 000346 automatic fixed bin(17,0) initial level 2 packed unaligned dcl 134 set ref 134* already_known 1(02) based bit(1) level 3 packed unaligned dcl 168 set ref 405* 912 area_ 000056 constant entry external dcl 105 ref 513 arg_ptr 000100 automatic pointer dcl 33 set ref 225* 289* arg_string parameter char dcl 1016 set ref 1013 1019* arglist 000346 automatic structure level 1 dcl 134 array_p 000132 automatic pointer dcl 47 set ref 243* 244 261* 262 294* 295 335* 336 938* 939 backward_thread 0(18) based bit(18) level 2 packed unaligned dcl 168 set ref 326 367 396 402* 426* 436* 495 based_array based pointer array dcl 124 set ref 244* 262* 295* 336* 939* based_fixed based fixed bin(35,0) dcl 63 set ref 404* 431* 438* 911 based_name based char unaligned dcl 739 set ref 772* based_name_aligned based char dcl 740 set ref 773* based_ptr based pointer dcl 51 set ref 545* 550* 554* 555* 564* baseno builtin function dcl 117 ref 321 332 499 800 911 baseptr builtin function dcl 117 ref 322 333 1056 basic_$run_unit_compiler 000062 constant entry external dcl 107 ref 956 basic_program_header based structure level 1 dcl 7-1 begin_links 6 based bit(18) level 3 packed unaligned dcl 4-31 ref 531 bin builtin function dcl 117 ref 650 652 655 810 bit builtin function dcl 117 ref 809 810 blank_common_ptr 000116 automatic pointer dcl 40 set ref 230* 504* 545 blank_length 000716 automatic fixed bin(17,0) dcl 463 set ref 490* 504* 543* 543 block_len 12 000724 automatic fixed bin(17,0) array level 2 dcl 466 set ref 584 605* block_length 6(18) based bit(18) level 3 packed unaligned dcl 4-31 ref 533 block_p 10 000724 automatic pointer array level 2 dcl 466 set ref 586 607* branch_status 000654 automatic structure level 1 dcl 2-1 set ref 926 926 ca 5 based bit(18) level 2 packed unaligned dcl 10-56 ref 1056 char_string 0(09) based char(31) level 2 packed unaligned dcl 4-70 ref 658 cleanup 000332 stack reference condition dcl 119 ref 254 374 code 000146 automatic fixed bin(35,0) dcl 59 set ref 244* 245* 262* 274* 277 287* 295* 312* 324* 334* 336* 340* 393* 405 550 558* 559 581* 595* 773 909* 910 923* 926* 931* 939* 940 951* 956* 960 966* 967* 970 1064* common_list 000724 automatic structure array level 1 dcl 466 common_p 000722 automatic pointer dcl 464 set ref 550 586* 589 606* 607 608 compiler 30 000566 automatic char(8) level 2 dcl 193 set ref 752 753 compiler_invoked 000156 automatic bit(1) dcl 70 set ref 238* 482* 935 947* 977 compiler_source_info based structure level 1 dcl 3-6 compiler_source_info_version_2 constant fixed bin(17,0) initial dcl 3-16 ref 920 cond_info 000130 automatic structure level 1 dcl 1046 set ref 1052 1052 continue_to_signal_ 000102 constant entry external dcl 1042 ref 1064 control_string parameter char dcl 1016 set ref 1013 1019* cp 000122 automatic pointer dcl 42 set ref 315* 316 317 318 319 319 324 326* 326 326 364* 365 366 367* 367 367 390* 391 392 396* 396 396 400* 401 402 403 404 405 407 408 409 410 411 412 413 435* 436 437 438 439 440 441 442 443 444 445 447 492* 493 493 494 495* 495 495 554 create_ips_mask_ 000066 constant entry external dcl 110 ref 258 382 cu_$gen_call 000036 constant entry external dcl 97 ref 289 cur_free_p 000114 automatic pointer dcl 39 set ref 247* 511 511* 511 512 513* 514 1001 1001* 1001 1002 1003* 1003 1004 cur_lib_node_p 000106 automatic pointer dcl 36 set ref 227* 400 400 425 425 425* 426 427 428 429 430 431 435 435 436 447 760 787 789 791 791 845 906 907* 907 907 909 909 912 912 914 921 922 923 date_time_modified 76 based fixed bin(71,0) level 2 in structure "source_info" dcl 201 in procedure "dfast_run_unit_manager_" set ref 928* date_time_modified 1 000654 automatic bit(36) level 2 in structure "branch_status" packed unaligned dcl 2-1 in procedure "dfast_run_unit_manager_" set ref 928 dcode parameter fixed bin(35,0) dcl 624 set ref 616 638* 641* 685* dd 000450 automatic structure level 1 dcl 142 set ref 766 766 debug_sw 000154 automatic bit(1) dcl 68 set ref 220* 956* decode_definition_$full 000060 constant entry external dcl 106 ref 766 def_pointer 000102 automatic pointer dcl 626 set ref 644* 645 648 649 672 def_ptr based pointer level 2 dcl 4-31 set ref 644 806* defp 4 000566 automatic pointer level 2 dcl 193 set ref 765 806 dfast_mask 000000 constant bit(72) initial unaligned dcl 8-162 ref 950 dirname 12 based varying char(168) level 2 dcl 201 set ref 932* divide builtin function dcl 117 ref 533 922 dl_code 000110 automatic fixed bin(35,0) dcl 1040 in procedure "fault_tag_3_handler" set ref 1052* 1053 1058* 1059 1061 dl_code 003336 automatic fixed bin(35,0) dcl 524 in procedure "snap_ftn_links" set ref 536* 537 538 ecode parameter fixed bin(35,0) dcl 697 set ref 690 706* 712* ename 3 000112 automatic varying char(32) level 2 in structure "ext" dcl 1044 in procedure "fault_tag_3_handler" set ref 1059* ename 3 003310 automatic varying char(32) level 2 in structure "ext" dcl 472 in procedure "set_up_run_unit_" set ref 542 558 560 560 560 560 583 593 593 593 593 604 ename 3 based structure level 2 in structure "ext" dcl 630 in procedure "decode_ftn_link_" ename_length 000137 automatic fixed bin(17,0) dcl 824 in procedure "add_to_known_names" set ref 841* 860 882 ename_length 003366 automatic fixed bin(17,0) dcl 696 in procedure "find_entry_" set ref 699* 702 ename_used 000126 automatic varying char(32) dcl 823 set ref 842* 843 860 883 entname parameter char(32) unaligned dcl 694 ref 690 699 702 entp parameter pointer dcl 695 set ref 690 705* entryp based pointer level 2 dcl 184 set ref 705 880* ep 000140 automatic pointer dcl 50 set ref 558* 564 error_table_$name_not_found 000014 external static fixed bin(35,0) dcl 85 ref 712 error_table_$not_done 000012 external static fixed bin(35,0) dcl 85 ref 270 exp 0(18) based bit(18) level 2 packed unaligned dcl 4-21 ref 646 exp_pointer 000104 automatic pointer dcl 626 set ref 645* 646 648 exp_ptr 1 based bit(18) level 2 packed unaligned dcl 4-11 ref 645 exp_word based structure level 1 dcl 4-21 expand_pathname_ 000044 constant entry external dcl 100 ref 371 923 ext based structure level 1 dcl 630 in procedure "decode_ftn_link_" ext 003310 automatic structure level 1 dcl 472 in procedure "set_up_run_unit_" set ref 536 536 ext 000112 automatic structure level 1 dcl 1044 in procedure "fault_tag_3_handler" set ref 1058 1058 ext_pointer 000110 automatic pointer dcl 626 set ref 649* 655 658 ext_ptr 1(18) based bit(18) level 2 packed unaligned dcl 4-25 ref 649 662 ext_template based structure level 1 dcl 128 extp parameter pointer dcl 622 ref 616 652 657 658 664 665 669 672 678 679 680 fast_related_data_$basic_area_p 000024 external static pointer dcl 89 set ref 514* fast_related_data_$chaining 000020 external static bit(1) dcl 87 set ref 259* 291* fast_related_data_$fortran_buffer_p 000022 external static pointer dcl 88 set ref 507* fast_related_data_$fortran_io_initiated 000016 external static bit(1) dcl 86 set ref 241* fast_related_data_$terminate_run 000026 external static entry variable dcl 90 set ref 240* fault_tag_3 000340 stack reference condition dcl 120 ref 282 find_condition_info_ 000100 constant entry external dcl 1041 ref 1052 first_link_offset 003335 automatic fixed bin(18,0) dcl 523 set ref 531* 532 533 fixed builtin function dcl 117 ref 321 332 499 511 512 531 533 800 911 928 1001 1004 1056 1056 fixed_lote 000150 automatic fixed bin(35,0) dcl 895 set ref 911* 912 fort_$compile_run 000064 constant entry external dcl 109 ref 951 fort_options 000154 automatic structure level 1 dcl 899 set ref 950* 951 951 fortran_io_$close_file 000040 constant entry external dcl 98 ref 340 fortran_options based structure level 1 dcl 8-40 forward_thread based bit(18) level 2 packed unaligned dcl 168 set ref 401* 403* 437* 447* 906 907 ft2 0(30) based bit(6) level 2 packed unaligned dcl 4-11 set ref 539* 562* 639 ftn_io_p 000104 automatic pointer dcl 35 set ref 226* 340 506 506 506* 507 ftn_ls_p 56 based pointer level 2 dcl 168 set ref 410* 429* 442* 494* 787* 791* ftn_symbol_p 60 based pointer level 2 dcl 168 set ref 411* 430* 443* 554 789* 791* get_temp_segments_ 000046 constant entry external dcl 101 ref 244 939 given_ename 1 based varying char(32) level 2 dcl 201 set ref 924* has_lot_entry parameter bit(1) unaligned dcl 738 ref 733 781 has_lote 1(01) based bit(1) level 3 packed unaligned dcl 168 set ref 319 912* 914* have_chained 000157 automatic bit(1) dcl 71 set ref 239* 248* 439 hcs_$fs_get_path_name 000076 constant entry external dcl 113 ref 931 hcs_$get_max_length_seg 000034 constant entry external dcl 96 ref 245 hcs_$initiate_count 000052 constant entry external dcl 102 ref 386 hcs_$reset_ips_mask 000072 constant entry external dcl 111 ref 377 417 hcs_$set_bc_seg 000074 constant entry external dcl 112 ref 287 312 334 966 hcs_$set_ips_mask 000070 constant entry external dcl 111 ref 383 hcs_$status_long 000030 constant entry external dcl 94 ref 926 hcs_$terminate_noname 000042 constant entry external dcl 99 ref 324 393 head_pointer 000100 automatic pointer dcl 626 set ref 643* 644 head_ptr based bit(18) level 2 packed unaligned dcl 4-11 ref 643 header based structure level 1 dcl 4-31 i 000150 automatic fixed bin(17,0) dcl 61 in procedure "dfast_run_unit_manager_" set ref 534* 535* 769* 770 771* 931* 932 i 003354 automatic fixed bin(17,0) dcl 579 in procedure "find_common_block_" set ref 582* 583 584 586* 604 605 607 icode 1 based fixed bin(17,0) level 2 dcl 474 ref 587 608 ignore_source_info 003204 automatic structure level 1 dcl 471 set ref 485 485 ilng 21 000566 automatic fixed bin(17,0) level 2 dcl 193 set ref 810 info 1 based structure level 2 dcl 168 set ref 404 431 438 init_info based structure level 1 dcl 474 init_info_p 14 003310 automatic pointer level 2 in structure "ext" dcl 472 in procedure "set_up_run_unit_" set ref 543 584 587 588 589 605 608 608 init_info_p 14 based pointer level 2 in structure "ext" dcl 630 in procedure "decode_ftn_link_" set ref 665* 672* 680* init_template based bit(36) array dcl 479 set ref 589* 608* input_lng 101 based fixed bin(21,0) level 2 dcl 201 set ref 922* input_pointer 102 based pointer level 2 dcl 201 set ref 921* 931* 977* interrupt_names 000322 automatic char(32) dcl 82 set ref 257* 258 258 381* 382 382 io_vector based structure array level 1 dcl 164 ref 506 506 ioa_ 000032 constant entry external dcl 95 ref 278 1019 1059 1061 is_main 000160 automatic bit(1) dcl 72 set ref 449* 844 915* 945 946* 968* isot based structure level 1 dcl 5-13 isot_ptr 52 based pointer level 2 dcl 6-26 ref 252 isotp 000670 automatic pointer dcl 5-12 set ref 252* 322 333 isp based pointer array level 2 packed unaligned dcl 5-13 set ref 322* 333* j 000151 automatic fixed bin(17,0) dcl 61 set ref 588* 589 605* 606* 608 k 000152 automatic fixed bin(18,0) dcl 62 set ref 321* 322 322 332* 333 333 800* 801 809 last_lib_node_p 000110 automatic pointer dcl 37 set ref 228* 315 364 390 401 402 413* 445* 492 length builtin function dcl 527 in procedure "snap_ftn_links" ref 560 560 593 593 length based fixed bin(17,0) level 2 in structure "init_info" dcl 474 in procedure "set_up_run_unit_" ref 543 584 588 589 605 608 length 1(18) based fixed bin(17,0) array level 3 in structure "saved_lib_list" packed unaligned dcl 741 in procedure "process_object_" ref 771 lib_list_node based structure level 1 dcl 168 set ref 400 400 425 425 435 435 libbc 000154 automatic fixed bin(24,0) dcl 357 set ref 386* 412 libp 000152 automatic pointer dcl 356 set ref 386* 387 392 393* 409 link based structure level 1 dcl 4-11 link_list based pointer array dcl 465 set ref 535 link_list_ptr 003342 automatic pointer dcl 525 set ref 532* 535 link_lng 000115 automatic fixed bin(17,0) dcl 736 set ref 783* 784* 785 link_ptr 003340 automatic pointer dcl 525 in procedure "snap_ftn_links" set ref 535* 536* 539 545 546 550 554 555 562 564 link_ptr 000106 automatic pointer dcl 1039 in procedure "fault_tag_3_handler" set ref 1056* 1058* linkage_section_p 000112 automatic pointer dcl 735 set ref 784* 785 787 795* 801 806 807 808 809 810 linking parameter bit(1) dcl 623 ref 616 639 linkp parameter pointer dcl 622 in procedure "decode_ftn_link_" ref 616 639 643 643 645 linkp 6 000566 automatic pointer level 2 in structure "oi" dcl 193 in procedure "dfast_run_unit_manager_" set ref 785 795 808 listptr 000106 automatic pointer dcl 735 set ref 768* 769 770 771 llng 20 000566 automatic fixed bin(17,0) level 2 dcl 193 set ref 783 loc_number based structure level 1 packed unaligned dcl 7-18 lot based structure level 1 dcl 5-6 lot_ptr 26 based pointer level 2 dcl 6-26 ref 251 lotp 000666 automatic pointer dcl 5-4 set ref 250 251* 322 333 499 801 911 lp based pointer array level 2 in structure "lot" packed unaligned dcl 5-6 in procedure "dfast_run_unit_manager_" set ref 322* 333* 499 801* 911 lp parameter pointer dcl 525 in procedure "snap_ftn_links" ref 520 529 531 532 533 ls based fixed bin(35,0) array dcl 746 set ref 785* 785 lsp 000720 automatic pointer dcl 464 set ref 499* 500* main_name 000236 automatic char(168) dcl 79 set ref 219* 440 mainp 000102 automatic pointer dcl 34 set ref 274* 289* mask 000162 automatic bit(36) dcl 74 set ref 258* 376* 377* 382* 383* 416* 417* max builtin function dcl 118 ref 543 1018 max_severity 000142 automatic fixed bin(17,0) dcl 55 set ref 234* 269 486 503 1018* 1018 mbz 1(18) 000346 automatic fixed bin(17,0) initial level 2 packed unaligned dcl 134 set ref 134* mc based structure level 1 dcl 10-12 mcptr 000130 automatic pointer level 2 dcl 1046 set ref 1055 mod builtin function dcl 118 ref 511 1001 modifier 1(30) based bit(6) level 2 packed unaligned dcl 4-11 set ref 546* name 000724 automatic char(32) array level 2 in structure "common_list" dcl 466 in procedure "set_up_run_unit_" set ref 583 604* name based structure level 1 dcl 4-70 in procedure "dfast_run_unit_manager_" name 4 based char(32) level 2 in structure "rnt_node" dcl 184 in procedure "dfast_run_unit_manager_" set ref 702 860 863* 883* name_length 000114 automatic fixed bin(17,0) dcl 628 set ref 655* 656 657 658 658 namel 000114 automatic fixed bin(17,0) dcl 736 set ref 771* 772 772 773 773 namep 000110 automatic pointer dcl 735 set ref 770* 772 773 names 1 based structure array level 2 dcl 741 nblocks 000717 automatic fixed bin(17,0) dcl 463 set ref 491* 582 603* 603 nchars 3 based fixed bin(17,0) level 2 in structure "rnt_node" dcl 184 in procedure "dfast_run_unit_manager_" set ref 702 860 882* nchars based bit(9) level 2 in structure "name" packed unaligned dcl 4-70 in procedure "dfast_run_unit_manager_" ref 655 nchars 3 based fixed bin(17,0) level 3 in structure "ext" dcl 630 in procedure "decode_ftn_link_" set ref 657* 679* new_obj_symbol_p 000136 automatic pointer dcl 49 set ref 555 796* newptr parameter pointer dcl 998 set ref 992 1002* next_def 000450 automatic pointer level 2 dcl 142 set ref 765* 766* next_node 2 based bit(18) level 3 packed unaligned dcl 184 set ref 709 853* 867 872* nfiles 000143 automatic fixed bin(17,0) dcl 56 set ref 235* nleft 000147 automatic fixed bin(26,0) dcl 60 set ref 512* 513* nlibs based fixed bin(17,0) level 2 dcl 741 ref 769 nlinks 003334 automatic fixed bin(17,0) dcl 522 set ref 533* 534 ntype 000112 automatic fixed bin(18,0) dcl 627 set ref 652* 654 654 661 676 null builtin function dcl 118 ref 225 226 227 228 229 230 231 232 316 319 331 340 387 410 411 427 429 430 442 443 493 498 529 665 680 791 851 926 926 977 1052 1052 nwords parameter fixed bin(17,0) dcl 997 ref 992 1003 object_info based structure level 1 dcl 1-6 object_info_$display 000054 constant entry external dcl 104 ref 909 967 object_info_version_2 constant fixed bin(17,0) initial dcl 1-60 ref 908 object_len 000151 automatic fixed bin(24,0) dcl 896 set ref 965* 966* 967* object_length 000152 automatic fixed bin(17,0) dcl 897 set ref 951* 956* 965 object_ptr 000120 automatic pointer dcl 41 set ref 231* 331 332 334* 335 498 499 938 951* 956* 966* 967* offset 7 000450 automatic fixed bin(17,0) level 2 in structure "dd" dcl 142 in procedure "dfast_run_unit_manager_" set ref 768 880 offset 1 based bit(18) array level 3 in structure "saved_lib_list" packed unaligned dcl 741 in procedure "process_object_" ref 770 oi 000566 automatic structure level 1 dcl 193 set ref 766 766 909 909 967 967 old_object parameter bit(1) dcl 737 in procedure "process_object_" ref 733 782 old_object parameter bit(1) dcl 526 in procedure "snap_ftn_links" ref 520 554 oldmask 000163 automatic bit(36) dcl 74 set ref 375 376 377* 383* 416 417* original_linkage_ptr 3 based pointer level 2 packed unaligned dcl 4-31 set ref 808* pad 2(18) based bit(18) level 3 packed unaligned dcl 184 set ref 881* pname 000100 automatic char(168) unaligned dcl 355 set ref 361* 366 371* 408 ppr based structure level 2 packed unaligned dcl 10-56 program_lng 000153 automatic fixed bin(24,0) dcl 64 set ref 218* 287* 444 program_ptr 000130 automatic pointer dcl 46 set ref 217* 287* 312* 441 psr 0(03) based bit(15) level 3 packed unaligned dcl 10-56 ref 1056 ptr builtin function dcl 118 ref 250 326 367 396 495 709 867 907 1056 rel builtin function dcl 118 ref 317 365 391 401 402 436 447 493 511 512 701 859 872 1001 1004 release_temp_segments_ 000050 constant entry external dcl 101 ref 262 295 336 reverse builtin function dcl 118 ref 699 924 933 rnt_node based structure level 1 dcl 184 set ref 879 879 rnt_p 000010 internal static pointer dcl 44 set ref 232* 700 851 854* 858 rp 000126 automatic pointer dcl 45 set ref 700* 701 702 702 705 709* 709 709 853 854 858* 859 860 860 863 866 867* 867 867 872 879 879 879* 880 881 882 883 ru_area_size 000145 automatic fixed bin(18,0) dcl 58 set ref 246* 1004 save_main 000161 automatic bit(1) dcl 73 set ref 945* 968 saved_lib_list based structure level 1 dcl 741 saved_rp 000140 automatic pointer dcl 825 set ref 866* 872 sb 000672 automatic pointer dcl 6-24 set ref 250* 251 252 scratch_lng 000144 automatic fixed bin(19,0) dcl 57 set ref 245* 246 512 scratch_ptr 000112 automatic pointer dcl 38 set ref 229* 243 245* 247 261 294 scu 30 based bit(36) array level 2 in structure "mc" packed unaligned dcl 10-12 in procedure "fault_tag_3_handler" set ref 1055 scu based structure level 1 dcl 10-56 in procedure "fault_tag_3_handler" scup 000162 automatic pointer dcl 10-54 set ref 1055* 1056 1056 section 1 003310 automatic char(8) level 2 in structure "ext" dcl 472 in procedure "set_up_run_unit_" set ref 541 553 section 6 000450 automatic char(4) level 2 in structure "dd" dcl 142 in procedure "dfast_run_unit_manager_" set ref 777 section 1 based char(8) level 2 in structure "ext" dcl 630 in procedure "decode_ftn_link_" set ref 664* 669* 678* section_id 000113 automatic fixed bin(18,0) dcl 627 set ref 650* 668 677 seg_ptr 1 based bit(18) level 2 packed unaligned dcl 4-25 ref 650 662 segbc 62 based fixed bin(24,0) level 2 dcl 168 set ref 412* 444* 909* 922 segment_number 7 based bit(18) level 3 packed unaligned dcl 4-31 set ref 809* segname 65 based varying char(32) level 2 in structure "source_info" dcl 201 in procedure "dfast_run_unit_manager_" set ref 933* segname 2 based char(168) level 2 in structure "lib_list_node" dcl 168 in procedure "dfast_run_unit_manager_" set ref 366 408* 428* 440* 760* 845* 923 segp 54 based pointer level 2 dcl 168 set ref 318 392 409* 427* 441* 909* 921 segptr 000124 automatic pointer dcl 43 set ref 318* 319 321 324* severity parameter fixed bin(17,0) dcl 1015 ref 1013 1018 size builtin function dcl 118 ref 400 400 425 425 435 435 506 506 879 879 source 1 based bit(1) level 3 packed unaligned dcl 168 set ref 319 source_info based structure level 1 dcl 201 source_info_pointer parameter pointer dcl 984 in procedure "dfast_get_next_source_seg_" set ref 982 986* source_info_pointer parameter pointer dcl 894 in procedure "process_lib_list_" set ref 892 903 951* 956* source_info_pt 000134 automatic pointer dcl 48 set ref 903* 920 921 922 924 928 929 931 932 933 977 stack_header based structure level 1 dcl 6-26 static_length 7(18) based bit(18) level 3 packed unaligned dcl 4-31 set ref 810* stats 6 based structure level 2 dcl 4-31 string 4 based char(32) level 3 dcl 630 set ref 658* substr builtin function dcl 118 set ref 375 560 560 593 593 658* 658 842 924 932 933 symbol 11 000450 automatic char(256) level 2 dcl 142 set ref 767 842 symbol_lng 111 000450 automatic fixed bin(17,0) level 2 dcl 142 set ref 841 842 symbol_ptr 2 based pointer level 2 packed unaligned dcl 4-31 set ref 807* symbp 12 000566 automatic pointer level 2 dcl 193 set ref 789 796 807 system 000320 automatic char(8) dcl 81 set ref 216* 340 489 752 754 757 759 786 949 temp_dir 000164 automatic char(168) unaligned dcl 78 set ref 371* 386* 923* 926* 931* 932 temp_ent 000310 automatic char(32) unaligned dcl 80 set ref 371* 386* 923* 924 924 926* 931* 933 933 template 2 based bit(36) array level 2 dcl 474 ref 589 608 terminate 1(03) based bit(1) level 3 packed unaligned dcl 168 set ref 324 407* 439* terminating 000155 automatic bit(1) dcl 69 set ref 237* 309 310* 347* textp 2 000566 automatic pointer level 2 dcl 193 set ref 755 768 770 800 880 911 threads 2 based structure level 2 dcl 184 trap_ptr 0(18) based bit(18) level 2 packed unaligned dcl 4-25 ref 670 672 type based bit(18) level 2 in structure "type_pair" packed unaligned dcl 4-25 in procedure "dfast_run_unit_manager_" ref 652 type based fixed bin(17,0) level 2 in structure "ext" dcl 630 in procedure "decode_ftn_link_" set ref 652* type 003310 automatic fixed bin(17,0) level 2 in structure "ext" dcl 472 in procedure "set_up_run_unit_" set ref 541 553 type_pair based structure level 1 dcl 4-25 type_pointer 000106 automatic pointer dcl 626 set ref 648* 649 650 652 662 662 670 672 type_ptr based bit(18) level 2 packed unaligned dcl 4-21 ref 648 unique_id 11 000654 automatic bit(36) level 2 in structure "branch_status" packed unaligned dcl 2-1 in procedure "dfast_run_unit_manager_" set ref 929 unique_id 100 based bit(36) level 2 in structure "source_info" dcl 201 in procedure "dfast_run_unit_manager_" set ref 929* unspec builtin function dcl 118 set ref 950* verify builtin function dcl 118 ref 699 924 933 version 2 000130 automatic fixed bin(17,0) level 2 in structure "cond_info" dcl 1046 in procedure "fault_tag_3_handler" set ref 1051* version based fixed bin(17,0) level 2 in structure "source_info" dcl 201 in procedure "dfast_run_unit_manager_" set ref 920* version_number 000566 automatic fixed bin(17,0) level 2 in structure "oi" dcl 193 in procedure "dfast_run_unit_manager_" set ref 908* version_number based fixed bin(17,0) level 2 in structure "basic_program_header" dcl 7-1 in procedure "process_object_" ref 755 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. abx internal static fixed bin(17,0) initial dcl 10-42 apx internal static fixed bin(17,0) initial dcl 10-42 bbx internal static fixed bin(17,0) initial dcl 10-42 bpx internal static fixed bin(17,0) initial dcl 10-42 call_offset internal static fixed bin(17,0) initial dcl 6-78 directory_type internal static bit(2) initial dcl 2-1 entry_offset internal static fixed bin(17,0) initial dcl 6-78 fast_mask internal static bit(72) initial unaligned dcl 8-168 fortran_declared based structure level 1 dcl 8-91 isot1 based structure array level 1 dcl 5-16 lbx internal static fixed bin(17,0) initial dcl 10-42 link_type internal static bit(2) initial dcl 2-1 linkage_header_flags based structure level 1 dcl 4-44 lot_fault internal static bit(36) initial dcl 5-9 lpx internal static fixed bin(17,0) initial dcl 10-42 mcp automatic pointer dcl 10-10 msf_type internal static bit(2) initial dcl 2-1 program_header_pt automatic pointer dcl 735 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 sbx internal static fixed bin(17,0) initial dcl 10-42 scux based structure level 1 dcl 10-207 segment_type internal static bit(2) initial dcl 2-1 spx internal static fixed bin(17,0) initial dcl 10-42 stack_header_overlay based fixed bin(17,0) array dcl 6-94 trap_word based structure level 1 dcl 4-66 tv_offset internal static fixed bin(17,0) initial dcl 6-72 virgin_linkage_header based structure level 1 dcl 4-52 NAMES DECLARED BY EXPLICIT CONTEXT. add_to_known_names 003333 constant entry internal dcl 814 ref 777 allocate_ 004462 constant entry internal dcl 992 ref 400 425 435 504 506 606 784 879 already_on 001564 constant label dcl 415 set ref 366 394 chain_ 001706 constant entry internal dcl 453 ref 300 continue_ft3 004753 constant label dcl 1064 ref 1053 decode_ftn_link_ 002525 constant entry internal dcl 616 ref 536 1058 dfast_add_to_lib_list_ 001224 constant entry internal dcl 352 ref 772 951 951 956 956 dfast_get_next_source_seg_ 004443 constant entry internal dcl 982 ref 951 951 956 956 dfast_run_unit_manager_ 000363 constant entry external dcl 11 error 004551 constant entry internal dcl 1013 ref 560 593 760 773 845 863 941 961 970 1005 fault_tag_3_handler 004626 constant entry internal dcl 1035 ref 282 fill_in_rnt_node 003503 constant entry internal dcl 876 ref 852 871 find_common_block_ 002323 constant entry internal dcl 569 ref 549 find_entry_ 002704 constant entry internal dcl 690 ref 274 558 727 find_entry_value 000754 constant entry external dcl 719 init_lib_list_ 001603 constant entry internal dcl 421 ref 481 join 000613 constant label dcl 269 ref 302 main_return 000745 constant label dcl 297 ref 942 1006 perform_chain 000746 constant label dcl 300 process_lib_list_ 003540 constant entry internal dcl 892 ref 485 986 process_object_ 002762 constant entry internal dcl 733 ref 914 971 set_up_run_unit_ 001710 constant entry internal dcl 461 ref 265 snap_ftn_links 002072 constant entry internal dcl 520 ref 494 500 terminate 000711 constant label dcl 291 ref 271 279 1029 1068 terminate_run_entry 004616 constant entry internal dcl 1027 ref 240 terminate_run_unit_ 000777 constant entry internal dcl 307 ref 260 293 unmask 001566 constant label dcl 416 ref 387 wrong_sys 003020 constant label dcl 760 ref 752 754 757 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5556 5662 5026 5566 Length 6350 5026 104 452 527 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME dfast_run_unit_manager_ 1915 external procedure is an external procedure. on unit on line 254 90 on unit on unit on line 282 179 on unit terminate_run_unit_ 90 internal procedure is called by several nonquick procedures. dfast_add_to_lib_list_ 170 internal procedure is assigned to an entry variable, and enables or reverts conditions. on unit on line 374 70 on unit init_lib_list_ internal procedure shares stack frame of external procedure dfast_run_unit_manager_. chain_ internal procedure shares stack frame of external procedure dfast_run_unit_manager_. set_up_run_unit_ internal procedure shares stack frame of external procedure dfast_run_unit_manager_. snap_ftn_links internal procedure shares stack frame of external procedure dfast_run_unit_manager_. find_common_block_ internal procedure shares stack frame of external procedure dfast_run_unit_manager_. decode_ftn_link_ 80 internal procedure is called by several nonquick procedures. find_entry_ internal procedure shares stack frame of external procedure dfast_run_unit_manager_. process_object_ internal procedure shares stack frame of internal procedure process_lib_list_. add_to_known_names internal procedure shares stack frame of internal procedure process_lib_list_. fill_in_rnt_node internal procedure shares stack frame of internal procedure process_lib_list_. process_lib_list_ 257 internal procedure is called by several nonquick procedures. dfast_get_next_source_seg_ 70 internal procedure is assigned to an entry variable. allocate_ 94 internal procedure is called by several nonquick procedures. error 76 internal procedure is called during a stack extension. terminate_run_entry 64 internal procedure is assigned to an entry variable. fault_tag_3_handler internal procedure shares stack frame of on unit on line 282. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 rnt_p dfast_run_unit_manager_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME decode_ftn_link_ 000100 head_pointer decode_ftn_link_ 000102 def_pointer decode_ftn_link_ 000104 exp_pointer decode_ftn_link_ 000106 type_pointer decode_ftn_link_ 000110 ext_pointer decode_ftn_link_ 000112 ntype decode_ftn_link_ 000113 section_id decode_ftn_link_ 000114 name_length decode_ftn_link_ dfast_add_to_lib_list_ 000100 pname dfast_add_to_lib_list_ 000152 libp dfast_add_to_lib_list_ 000154 libbc dfast_add_to_lib_list_ dfast_run_unit_manager_ 000100 arg_ptr dfast_run_unit_manager_ 000102 mainp dfast_run_unit_manager_ 000104 ftn_io_p dfast_run_unit_manager_ 000106 cur_lib_node_p dfast_run_unit_manager_ 000110 last_lib_node_p dfast_run_unit_manager_ 000112 scratch_ptr dfast_run_unit_manager_ 000114 cur_free_p dfast_run_unit_manager_ 000116 blank_common_ptr dfast_run_unit_manager_ 000120 object_ptr dfast_run_unit_manager_ 000122 cp dfast_run_unit_manager_ 000124 segptr dfast_run_unit_manager_ 000126 rp dfast_run_unit_manager_ 000130 program_ptr dfast_run_unit_manager_ 000132 array_p dfast_run_unit_manager_ 000134 source_info_pt dfast_run_unit_manager_ 000136 new_obj_symbol_p dfast_run_unit_manager_ 000140 ep dfast_run_unit_manager_ 000142 max_severity dfast_run_unit_manager_ 000143 nfiles dfast_run_unit_manager_ 000144 scratch_lng dfast_run_unit_manager_ 000145 ru_area_size dfast_run_unit_manager_ 000146 code dfast_run_unit_manager_ 000147 nleft dfast_run_unit_manager_ 000150 i dfast_run_unit_manager_ 000151 j dfast_run_unit_manager_ 000152 k dfast_run_unit_manager_ 000153 program_lng dfast_run_unit_manager_ 000154 debug_sw dfast_run_unit_manager_ 000155 terminating dfast_run_unit_manager_ 000156 compiler_invoked dfast_run_unit_manager_ 000157 have_chained dfast_run_unit_manager_ 000160 is_main dfast_run_unit_manager_ 000161 save_main dfast_run_unit_manager_ 000162 mask dfast_run_unit_manager_ 000163 oldmask dfast_run_unit_manager_ 000164 temp_dir dfast_run_unit_manager_ 000236 main_name dfast_run_unit_manager_ 000310 temp_ent dfast_run_unit_manager_ 000320 system dfast_run_unit_manager_ 000322 interrupt_names dfast_run_unit_manager_ 000346 arglist dfast_run_unit_manager_ 000450 dd dfast_run_unit_manager_ 000566 oi dfast_run_unit_manager_ 000654 branch_status dfast_run_unit_manager_ 000666 lotp dfast_run_unit_manager_ 000670 isotp dfast_run_unit_manager_ 000672 sb dfast_run_unit_manager_ 000716 blank_length set_up_run_unit_ 000717 nblocks set_up_run_unit_ 000720 lsp set_up_run_unit_ 000722 common_p set_up_run_unit_ 000724 common_list set_up_run_unit_ 003204 ignore_source_info set_up_run_unit_ 003310 ext set_up_run_unit_ 003334 nlinks snap_ftn_links 003335 first_link_offset snap_ftn_links 003336 dl_code snap_ftn_links 003340 link_ptr snap_ftn_links 003342 link_list_ptr snap_ftn_links 003354 i find_common_block_ 003366 ename_length find_entry_ on unit on line 282 000106 link_ptr fault_tag_3_handler 000110 dl_code fault_tag_3_handler 000112 ext fault_tag_3_handler 000130 cond_info fault_tag_3_handler 000162 scup fault_tag_3_handler process_lib_list_ 000106 listptr process_object_ 000110 namep process_object_ 000112 linkage_section_p process_object_ 000114 namel process_object_ 000115 link_lng process_object_ 000116 al_code process_object_ 000126 ename_used add_to_known_names 000137 ename_length add_to_known_names 000140 saved_rp add_to_known_names 000150 fixed_lote process_lib_list_ 000151 object_len process_lib_list_ 000152 object_length process_lib_list_ 000154 fort_options process_lib_list_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return_mac move_label_var make_label_var tra_ext_1 bound_ck_signal mdfx1 enable_op shorten_stack ext_entry int_entry int_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. area_ basic_$run_unit_compiler continue_to_signal_ create_ips_mask_ cu_$gen_call decode_definition_$full expand_pathname_ find_condition_info_ fort_$compile_run fortran_io_$close_file get_temp_segments_ hcs_$fs_get_path_name hcs_$get_max_length_seg hcs_$initiate_count hcs_$reset_ips_mask hcs_$set_bc_seg hcs_$set_ips_mask hcs_$status_long hcs_$terminate_noname ioa_ object_info_$display release_temp_segments_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$name_not_found error_table_$not_done fast_related_data_$basic_area_p fast_related_data_$chaining fast_related_data_$fortran_buffer_p fast_related_data_$fortran_io_initiated fast_related_data_$terminate_run LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 134 000347 11 000355 216 000371 217 000376 218 000401 219 000403 220 000407 221 000412 225 000413 226 000415 227 000416 228 000417 229 000420 230 000421 231 000422 232 000423 234 000425 235 000426 237 000427 238 000430 239 000431 240 000432 241 000436 243 000437 244 000441 245 000464 246 000477 247 000502 248 000504 250 000505 251 000510 252 000512 254 000514 257 000530 258 000534 259 000552 260 000554 261 000561 262 000565 263 000611 265 000612 269 000613 270 000616 271 000622 274 000623 277 000630 278 000632 279 000646 282 000647 287 000665 289 000700 291 000711 293 000713 294 000717 295 000721 297 000745 300 000746 302 000747 719 000750 727 000762 729 000775 307 000776 309 001004 310 001007 312 001011 315 001024 316 001030 317 001034 318 001037 319 001042 321 001052 322 001056 324 001065 326 001101 327 001107 331 001110 332 001115 333 001121 334 001130 335 001144 336 001150 340 001174 347 001220 348 001222 352 001223 361 001237 364 001244 365 001250 366 001253 367 001260 368 001264 371 001265 372 001312 374 001315 375 001331 376 001336 377 001340 379 001350 381 001351 382 001355 383 001374 386 001406 387 001452 390 001456 391 001462 392 001465 393 001472 394 001503 396 001504 397 001510 400 001511 401 001524 402 001530 403 001534 404 001536 405 001540 407 001544 408 001546 409 001551 410 001553 411 001556 412 001560 413 001563 415 001564 416 001566 417 001571 418 001602 421 001603 425 001604 426 001616 427 001620 428 001623 429 001627 430 001630 431 001632 435 001634 436 001646 437 001652 438 001654 439 001656 440 001662 441 001665 442 001667 443 001672 444 001674 445 001677 447 001700 449 001703 450 001705 453 001706 457 001707 461 001710 481 001711 482 001712 485 001713 486 001723 489 001727 490 001733 491 001734 492 001735 493 001737 494 001746 495 001761 496 001766 498 001767 499 001773 500 002000 503 002004 504 002010 506 002020 507 002032 508 002035 511 002036 512 002047 513 002055 514 002066 517 002071 520 002072 529 002074 531 002101 532 002106 533 002111 534 002117 535 002125 536 002131 537 002151 538 002153 539 002156 540 002161 541 002162 542 002173 543 002200 545 002205 546 002207 547 002212 549 002213 550 002214 552 002220 553 002221 554 002232 555 002242 556 002244 558 002245 559 002253 560 002255 562 002311 563 002315 564 002316 566 002320 567 002322 569 002323 581 002324 582 002325 583 002335 584 002345 586 002350 587 002353 588 002357 589 002361 591 002403 593 002404 595 002440 597 002443 599 002444 603 002446 604 002447 605 002455 606 002461 607 002471 608 002475 611 002523 616 002524 638 002532 639 002535 641 002545 643 002547 644 002555 645 002557 646 002565 648 002570 649 002575 650 002602 652 002610 654 002615 655 002621 656 002624 657 002626 658 002630 661 002633 662 002636 664 002641 665 002644 666 002646 668 002647 669 002652 670 002655 672 002660 674 002663 676 002664 677 002666 678 002671 679 002675 680 002676 681 002700 683 002701 685 002702 686 002703 690 002704 699 002706 700 002724 701 002727 702 002732 705 002744 706 002746 707 002747 709 002750 710 002754 712 002755 713 002761 733 002762 752 002764 753 002774 754 003000 755 003004 757 003007 758 003013 759 003014 760 003020 761 003047 765 003050 766 003052 767 003101 768 003106 769 003112 770 003122 771 003127 772 003134 773 003152 775 003206 776 003211 777 003212 778 003216 781 003217 782 003226 783 003231 784 003234 785 003245 786 003255 787 003261 789 003263 790 003266 791 003267 793 003274 795 003275 796 003300 800 003304 801 003310 806 003312 807 003314 808 003316 809 003320 810 003325 812 003332 814 003333 841 003334 842 003337 843 003346 844 003353 845 003355 847 003404 851 003405 852 003412 853 003413 854 003417 855 003421 858 003422 859 003424 860 003427 863 003440 864 003466 866 003467 867 003470 868 003474 871 003475 872 003476 873 003502 876 003503 879 003504 880 003520 881 003525 882 003530 883 003532 884 003536 892 003537 903 003545 906 003552 907 003557 908 003562 909 003564 910 003604 911 003607 912 003615 914 003624 915 003641 916 003643 920 003644 921 003646 922 003652 923 003657 924 003707 926 003734 928 003776 929 004004 931 004006 932 004037 933 004051 935 004074 938 004076 939 004100 940 004124 941 004127 942 004157 945 004162 946 004164 947 004165 949 004167 950 004173 951 004175 954 004235 956 004236 960 004274 961 004277 962 004327 965 004330 966 004333 967 004346 968 004367 970 004372 971 004425 972 004432 974 004433 977 004434 979 004441 982 004442 986 004450 988 004460 992 004461 1001 004467 1002 004501 1003 004504 1004 004510 1005 004514 1006 004544 1009 004547 1013 004550 1018 004571 1019 004600 1021 004614 1027 004615 1029 004623 1035 004626 1051 004627 1052 004631 1053 004650 1055 004652 1056 004655 1058 004667 1059 004711 1061 004734 1064 004753 1065 004763 1068 004764 ----------------------------------------------------------- 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