COMPILATION LISTING OF SEGMENT fast_run_unit_manager_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 01/19/88 1503.4 mst Tue Options: optimize map 1 /****^ ****************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* ****************************************************** */ 9 10 11 12 /****^ HISTORY COMMENTS: 13* 1) change(87-12-02,TLNguyen), approve(87-12-02,MCR7806), 14* audit(87-12-10,Lippard), install(88-01-19,MR12.2-1015): 15* - Fixed size condition raised when calculate the length of the allocated 16* variable named dump in the set_up_run_unit internal procedure. 17* - Remove based_bit75, i, index, link_ptr, original_linkp, and size 18* from the source because they are referenced anywhere within it. 19* END HISTORY COMMENTS */ 20 21 22 fast_run_unit_manager_: proc (program_ptr, program_lng, arg_flags, main_ename, a_code); 23 24 /* coded March 1976 by M. Weaver */ 25 /* modified October 1976 by M. Weaver to use new get_definition_ calling sequence */ 26 /* modified December 1976 by M. Weaver to again look for main_ */ 27 /* modified January 1977 to restore fortran_io_initiated */ 28 29 dcl program_ptr ptr; /* ptr to main program for run unit */ 30 dcl program_lng fixed bin (24); /* bit count of main program */ 31 dcl 1 arg_flags aligned, 32 2 just_compiled bit (1) unaligned, /* ON if main prog compiled by run command */ 33 2 brief bit (1) unaligned, /* ON if warning messages to be inhibited */ 34 2 probe bit (1) unaligned, /* ON if program to be run under debugger */ 35 2 mbz bit (33) unaligned; 36 dcl main_ename char (32) varying; /* name of main program */ 37 dcl a_code fixed bin (35); 38 39 /* pointers */ 40 dcl blank_common_ptr ptr; 41 dcl seg_ptr ptr; 42 dcl rp ptr; 43 dcl definition_p ptr; 44 dcl main_ptr ptr; 45 dcl ftn_io_p ptr; 46 dcl scratch_ptr (1) ptr static; 47 dcl rnt_p ptr static; 48 dcl clp ptr static; 49 dcl segment_table_ptr ptr static; 50 dcl static_lotp ptr static; 51 dcl static_isotp ptr static; 52 dcl eio_ptr ptr static; 53 dcl entry_ptr ptr static; 54 dcl saved_ftn_buffer_p ptr; 55 dcl n_ptr ptr static; 56 57 /* fixed bin */ 58 dcl max_severity fixed bin; 59 dcl i fixed bin; 60 dcl blank_length fixed bin; 61 dcl scratch_lng fixed bin (19); 62 dcl code fixed bin (35); 63 dcl dlng fixed bin; 64 dcl ecount fixed bin static; 65 dcl total_names fixed bin static; 66 67 /* bit strings */ 68 dcl terminating bit (1) aligned; 69 dcl dir_empty bit (1) aligned static; 70 dcl saved_fortran_io_initiated bit (1) aligned; 71 72 /* character strings */ 73 dcl language char (8) aligned static; 74 dcl dirname char (168) static; 75 dcl entname char (32); 76 77 /* area */ 78 dcl scratch_area area (255000) based (scratch_ptr (1)); 79 80 /* external */ 81 dcl (error_table_$not_done, error_table_$name_not_found) fixed bin (35) external; 82 dcl fast_related_data_$fortran_io_initiated bit (1) aligned ext; 83 dcl fast_related_data_$fortran_buffer_p ptr ext; 84 dcl fast_related_data_$terminate_run entry variable ext; 85 dcl fast_related_data_$basic_area_p ptr ext; 86 87 /* external entries */ 88 89 dcl ioa_ entry options (variable); 90 dcl hcs_$get_max_length_seg entry (ptr, fixed bin (19), fixed bin (35)); 91 dcl cu_$gen_call entry (ptr, ptr); 92 dcl fortran_io_$close_file entry (fixed bin, fixed bin (35)); 93 dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); 94 dcl (get_temp_segments_, release_temp_segments_) entry (char (*), (*) ptr, fixed bin (35)); 95 dcl hcs_$initiate_count entry (char (*), char (*), char (*), 96 fixed bin (24), fixed bin (2), ptr, fixed bin (35)); 97 dcl object_info_$display entry (ptr, fixed bin (24), ptr, fixed bin (35)); 98 dcl area_ entry (fixed bin (19), ptr); 99 dcl decode_definition_$init entry (ptr, fixed bin (24)); 100 dcl decode_definition_ entry (ptr, ptr) returns (bit (1) aligned); 101 dcl hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35)); 102 dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); 103 dcl hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35)); 104 dcl get_definition_ entry (ptr, char (*), char (*), ptr, fixed bin (35)); 105 dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); 106 dcl get_wdir_ entry () returns (char (168) aligned); 107 dcl find_command_$clear entry (); 108 109 /* builtins and conditions */ 110 111 dcl (addr, addrel, baseno, baseptr, bit, bin, fixed, length, max) builtin; 112 dcl (null, ptr, rel, reverse, substr, verify) builtin; 113 dcl cleanup condition; 114 dcl fault_tag_3 condition; 115 116 /* structures */ 117 118 dcl 1 ext_template aligned based, /* holds link info */ 119 2 type fixed bin, /* link type */ 120 2 section char (8) aligned, 121 2 ename char (32) varying, /* entry name of link target */ 122 2 init_info_p ptr; /* ptr to init info for common */ 123 124 dcl 1 dd aligned, /* structure filled in by decode_definition_ */ 125 2 next_def ptr, /* ptr to next definition in list */ 126 2 last_def ptr, /* ptr to previous definition in list */ 127 2 block_ptr ptr, /* ptr to either defblock or segname block */ 128 2 section char (4) aligned, /* "text", "link", "symb" or "segn" */ 129 2 offset fixed bin, /* offset within class (if ^= "segn") */ 130 2 entrypoint fixed bin, /* value of entrypoint in text if ^= 0 */ 131 2 symbol char (32) aligned; /* the symbolic name of the definition */ 132 133 134 dcl 1 static_st (0:1) aligned static like st; /* used before hcs_$star is called */ 135 136 dcl 1 st (0:ecount+1) aligned based (segment_table_ptr), 137 2 segno bit (18) unaligned, 138 2 flags unaligned, 139 3 links_snapped bit (1) unaligned, 140 3 temp_lote bit (1) unaligned, 141 3 wrong_language bit (1) unaligned, 142 3 nonobject bit (1) unaligned, 143 3 cant_initiate bit (1) unaligned, 144 3 pad bit (13) unaligned, 145 2 defptr ptr, 146 2 ftn_ls_p ptr unaligned, 147 2 ftn_symbol_p ptr unaligned, 148 2 language char (8) aligned; 149 150 dcl 1 rnt_node aligned based (rp), 151 2 entryp ptr, 152 2 back_thread bit (18) unaligned, 153 2 seg_table_offset fixed bin (17) unaligned, 154 2 nchars fixed bin (17), 155 2 name char (32) aligned; 156 157 158 dcl 1 oi aligned like object_info; 159 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 */ 160 161 162 2 1 /* BEGIN INCLUDE FILE linkdcl.incl.pl1 --- last modified 15 Nov 1971 by C Garman */ 2 2 2 3 /* Last Modified (Date and Reason): 2 4* 6/75 by M.Weaver to add virgin_linkage_header declaration 2 5* 6/75 by S.Webber to comment existing structures better 2 6* 9/77 by M. Weaver to add run_depth to link 2 7* 2/83 by M. Weaver to add linkage header flags and change run_depth precision 2 8**/ 2 9 2 10 /* format: style3 */ 2 11 dcl 1 link based aligned, /* link pair in linkage section */ 2 12 2 head_ptr bit (18) unal, /* rel pointer to beginning of linkage section */ 2 13 2 ringno bit (3) unal, 2 14 2 mbz bit (6) unal, 2 15 2 run_depth fixed bin (2) unal, /* run unit depth, filled when link is snapped */ 2 16 2 ft2 bit (6) unal, /* fault tag. 46(8) if not snapped, 43(8) if snapped */ 2 17 2 exp_ptr bit (18) unal, /* pointer (rel to defs) of expression word */ 2 18 2 mbz2 bit (12) unal, 2 19 2 modifier bit (6) unal; /* modifier to be left in snapped link */ 2 20 2 21 dcl 1 exp_word based aligned, /* expression word in link definition */ 2 22 2 type_ptr bit (18) unal, /* pointer (rel to defs) of type pair structure */ 2 23 2 exp bit (18) unal; /* constant expression to be added in when snapping link */ 2 24 2 25 dcl 1 type_pair based aligned, /* type pair in link definition */ 2 26 2 type bit (18) unal, /* type of link. may be 1,2,3,4,5, or 6 */ 2 27 2 trap_ptr bit (18) unal, /* pointer (rel to defs) to the trap word */ 2 28 2 seg_ptr bit (18) unal, /* pointer to ACC reference name for segment referenced */ 2 29 2 ext_ptr bit (18) unal; /* pointer (rel to defs) of ACC segdef name */ 2 30 2 31 dcl 1 header based aligned, /* linkage block header */ 2 32 2 def_ptr ptr, /* pointer to definition section */ 2 33 2 symbol_ptr ptr unal, /* pointer to symbol section in object segment */ 2 34 2 original_linkage_ptr 2 35 ptr unal, /* pointer to linkage section in object segment */ 2 36 2 unused bit (72), 2 37 2 stats, 2 38 3 begin_links bit (18) unal, /* offset (rel to this section) of first link */ 2 39 3 block_length bit (18) unal, /* number of words in this linkage section */ 2 40 3 segment_number 2 41 bit (18) unal, /* text segment number associated with this section */ 2 42 3 static_length bit (18) unal; /* number of words of static for this segment */ 2 43 2 44 dcl 1 linkage_header_flags 2 45 aligned based, /* overlay of def_ptr for flags */ 2 46 2 pad1 bit (28) unaligned, /* flags are in first word */ 2 47 2 static_vlas bit (1) unaligned, /* static section "owns" some LA/VLA segments */ 2 48 2 perprocess_static 2 49 bit (1) unaligned, /* 1 copy of static section is used by all tasks/run units */ 2 50 2 pad2 bit (6) unaligned; 2 51 2 52 dcl 1 virgin_linkage_header 2 53 aligned based, /* template for linkage header in object segment */ 2 54 2 pad bit (30) unaligned, /* is filled in by linker */ 2 55 2 defs_in_link bit (6) unaligned, /* =o20 if defs in linkage (nonstandard) */ 2 56 2 def_offset bit (18) unaligned, /* offset of definition section */ 2 57 2 first_ref_relp bit (18) unaligned, /* offset of trap-at-first-reference offset array */ 2 58 2 filled_in_later bit (144), 2 59 2 link_begin bit (18) unaligned, /* offset of first link */ 2 60 2 linkage_section_lng 2 61 bit (18) unaligned, /* length of linkage section */ 2 62 2 segno_pad bit (18) unaligned, /* will be segment number of copied linkage */ 2 63 2 static_length bit (18) unaligned; /* length of static section */ 2 64 2 65 2 66 dcl 1 trap_word based aligned, /* trap word in link definition */ 2 67 2 call_ptr bit (18) unal, /* pointer (rel to link) of link to trap procedure */ 2 68 2 arg_ptr bit (18) unal; /* pointer (rel to link) of link to arg info for trap proc */ 2 69 2 70 dcl 1 name based aligned, /* storage of ASCII names in definitions */ 2 71 2 nchars bit (9) unaligned, /* number of characters in name */ 2 72 2 char_string char (31) unaligned; /* 31-character name */ 2 73 2 74 /* END INCLUDE FILE linkdcl.incl.pl1 */ 163 164 165 3 1 /* BEGIN INCLUDE FILE definition.incl.pl1 */ 3 2 3 3 3 4 3 5 /****^ HISTORY COMMENTS: 3 6* 1) change(86-05-02,Elhard), approve(86-05-02,MCR7391), 3 7* audit(86-07-18,DGHowe), install(86-11-20,MR12.0-1222): 3 8* Modified to add indirect bit to definition flags. 3 9* END HISTORY COMMENTS */ 3 10 3 11 3 12 dcl 1 definition aligned based, 3 13 2 forward unal bit(18), /* offset of next def */ 3 14 2 backward unal bit(18), /* offset of previous def */ 3 15 2 value unal bit(18), 3 16 2 flags unal, 3 17 3 new bit(1), 3 18 3 ignore bit(1), 3 19 3 entry bit(1), 3 20 3 retain bit(1), 3 21 3 argcount bit(1), 3 22 3 descriptors bit(1), 3 23 3 indirect bit(1), 3 24 3 unused bit(8), 3 25 2 class unal bit(3), 3 26 2 symbol unal bit(18), /* offset of ACC for symbol */ 3 27 2 segname unal bit(18); /* offset of segname def */ 3 28 3 29 /* END INCLUDE FILE definition.incl.pl1 */ 166 167 168 4 1 /* BEGIN INCLUDE FILE -- lot.incl.pl1 S.Webber 9/74, Modified by R. Bratt 04/76, modified by M. Weaver 7/76 */ 4 2 /* modified by M. Weaver 3/77 */ 4 3 4 4 dcl lotp ptr; 4 5 4 6 dcl 1 lot based (lotp) aligned, 4 7 2 lp (0:9999) ptr unaligned; /* array of packed pointers to linkage sections */ 4 8 4 9 dcl lot_fault bit (36) aligned static options (constant) init ("111000000000000000000000000000000000"b); 4 10 /* lot fault has fault code = 0 and offset = 0 */ 4 11 4 12 dcl isotp ptr; 4 13 dcl 1 isot based (isotp) aligned, 4 14 2 isp (0:9999) ptr unaligned; 4 15 4 16 dcl 1 isot1 (0 :9999) aligned based, 4 17 2 flags unaligned, 4 18 3 fault bit (2) unaligned, 4 19 3 system bit (1) unaligned, 4 20 3 mbz bit (6) unaligned, 4 21 2 fault_code fixed bin (8) unaligned, 4 22 2 static_offset bit (18) unaligned; 4 23 4 24 4 25 /* END INCLUDE FILE lot.incl.pl1 */ 169 170 171 5 1 /* BEGIN INCLUDE FILE ... stack_header.incl.pl1 .. 3/72 Bill Silver */ 5 2 /* modified 7/76 by M. Weaver for *system links and more system use of areas */ 5 3 /* modified 3/77 by M. Weaver to add rnt_ptr */ 5 4 /* Modified April 1983 by C. Hornig for tasking */ 5 5 5 6 /****^ HISTORY COMMENTS: 5 7* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396), 5 8* audit(86-08-05,Schroth), install(86-11-03,MR12.0-1206): 5 9* added the heap_header_ptr definition. 5 10* 2) change(86-08-12,Kissel), approve(86-08-12,MCR7473), 5 11* audit(86-10-10,Fawcett), install(86-11-03,MR12.0-1206): 5 12* Modified to support control point management. These changes were actually 5 13* made in February 1985 by G. Palter. 5 14* 3) change(86-10-22,Fawcett), approve(86-10-22,MCR7473), 5 15* audit(86-10-22,Farley), install(86-11-03,MR12.0-1206): 5 16* Remove the old_lot pointer and replace it with cpm_data_ptr. Use the 18 5 17* bit pad after cur_lot_size for the cpm_enabled. This was done to save some 5 18* space int the stack header and change the cpd_ptr unal to cpm_data_ptr 5 19* (ITS pair). 5 20* END HISTORY COMMENTS */ 5 21 5 22 /* format: style2 */ 5 23 5 24 dcl sb ptr; /* the main pointer to the stack header */ 5 25 5 26 dcl 1 stack_header based (sb) aligned, 5 27 2 pad1 (4) fixed bin, /* (0) also used as arg list by outward_call_handler */ 5 28 2 cpm_data_ptr ptr, /* (4) pointer to control point which owns this stack */ 5 29 2 combined_stat_ptr ptr, /* (6) pointer to area containing separate static */ 5 30 2 clr_ptr ptr, /* (8) pointer to area containing linkage sections */ 5 31 2 max_lot_size fixed bin (17) unal, /* (10) DU number of words allowed in lot */ 5 32 2 main_proc_invoked fixed bin (11) unal, /* (10) DL nonzero if main procedure invoked in run unit */ 5 33 2 have_static_vlas bit (1) unal, /* (10) DL "1"b if (very) large arrays are being used in static */ 5 34 2 pad4 bit (2) unal, 5 35 2 run_unit_depth fixed bin (2) unal, /* (10) DL number of active run units stacked */ 5 36 2 cur_lot_size fixed bin (17) unal, /* (11) DU number of words (entries) in lot */ 5 37 2 cpm_enabled bit (18) unal, /* (11) DL non-zero if control point management is enabled */ 5 38 2 system_free_ptr ptr, /* (12) pointer to system storage area */ 5 39 2 user_free_ptr ptr, /* (14) pointer to user storage area */ 5 40 2 null_ptr ptr, /* (16) */ 5 41 2 stack_begin_ptr ptr, /* (18) pointer to first stack frame on the stack */ 5 42 2 stack_end_ptr ptr, /* (20) pointer to next useable stack frame */ 5 43 2 lot_ptr ptr, /* (22) pointer to the lot for the current ring */ 5 44 2 signal_ptr ptr, /* (24) pointer to signal procedure for current ring */ 5 45 2 bar_mode_sp ptr, /* (26) value of sp before entering bar mode */ 5 46 2 pl1_operators_ptr ptr, /* (28) pointer to pl1_operators_$operator_table */ 5 47 2 call_op_ptr ptr, /* (30) pointer to standard call operator */ 5 48 2 push_op_ptr ptr, /* (32) pointer to standard push operator */ 5 49 2 return_op_ptr ptr, /* (34) pointer to standard return operator */ 5 50 2 return_no_pop_op_ptr 5 51 ptr, /* (36) pointer to standard return / no pop operator */ 5 52 2 entry_op_ptr ptr, /* (38) pointer to standard entry operator */ 5 53 2 trans_op_tv_ptr ptr, /* (40) pointer to translator operator ptrs */ 5 54 2 isot_ptr ptr, /* (42) pointer to ISOT */ 5 55 2 sct_ptr ptr, /* (44) pointer to System Condition Table */ 5 56 2 unwinder_ptr ptr, /* (46) pointer to unwinder for current ring */ 5 57 2 sys_link_info_ptr ptr, /* (48) pointer to *system link name table */ 5 58 2 rnt_ptr ptr, /* (50) pointer to Reference Name Table */ 5 59 2 ect_ptr ptr, /* (52) pointer to event channel table */ 5 60 2 assign_linkage_ptr ptr, /* (54) pointer to storage for (obsolete) hcs_$assign_linkage */ 5 61 2 heap_header_ptr ptr, /* (56) pointer to the heap header for this ring */ 5 62 2 trace, 5 63 3 frames, 5 64 4 count fixed bin, /* (58) number of trace frames */ 5 65 4 top_ptr ptr unal, /* (59) pointer to last trace frame */ 5 66 3 in_trace bit (36) aligned, /* (60) trace antirecursion flag */ 5 67 2 pad2 bit (36), /* (61) */ 5 68 2 pad5 pointer; /* (62) pointer to future stuff */ 5 69 5 70 /* The following offset refers to a table within the pl1 operator table. */ 5 71 5 72 dcl tv_offset fixed bin init (361) internal static; 5 73 /* (551) octal */ 5 74 5 75 5 76 /* The following constants are offsets within this transfer vector table. */ 5 77 5 78 dcl ( 5 79 call_offset fixed bin init (271), 5 80 push_offset fixed bin init (272), 5 81 return_offset fixed bin init (273), 5 82 return_no_pop_offset fixed bin init (274), 5 83 entry_offset fixed bin init (275) 5 84 ) internal static; 5 85 5 86 5 87 5 88 5 89 5 90 /* The following declaration is an overlay of the whole stack header. Procedures which 5 91* move the whole stack header should use this overlay. 5 92**/ 5 93 5 94 dcl stack_header_overlay (size (stack_header)) fixed bin based (sb); 5 95 5 96 5 97 5 98 /* END INCLUDE FILE ... stack_header.incl.pl1 */ 172 173 174 175 /* initialize variables */ 176 177 a_code = 0; 178 scratch_ptr (1) = null; 179 blank_common_ptr = null; 180 ftn_io_p = null; 181 rnt_p = null; 182 clp = null; 183 segment_table_ptr = addr (static_st); 184 eio_ptr = null; 185 entry_ptr = null; 186 n_ptr = null; 187 188 max_severity = 0; 189 ecount = 0; 190 static_st (0).segno, static_st (1).segno = "0"b; 191 192 terminating = "0"b; 193 dir_empty = "0"b; 194 195 /* get info about main program */ 196 197 oi.version_number = object_info_version_2; 198 call object_info_$display (program_ptr, program_lng, addr (oi), code); 199 if code ^= 0 then do; 200 call ioa_ ("Specified main program cannot be executed."); 201 a_code = code; 202 return; 203 end; 204 205 /* initialize more stuff needed by cleanup handler */ 206 207 saved_ftn_buffer_p = fast_related_data_$fortran_buffer_p; 208 saved_fortran_io_initiated = fast_related_data_$fortran_io_initiated; 209 /* will restore for debugging purposes */ 210 fast_related_data_$fortran_io_initiated = "0"b; 211 fast_related_data_$terminate_run = terminate_run_entry; 212 213 sb = ptr (addr (rp), 0); /* get ptr to stack header */ 214 static_lotp = sb -> stack_header.lot_ptr; 215 static_isotp = sb -> stack_header.isot_ptr; 216 217 on cleanup call Clean_up; 218 219 /* obtain scratch area if necessary */ 220 221 if (oi.compiler = "basic") | (oi.compiler = "fortran2") then do; 222 language = oi.compiler; 223 call get_temp_segments_ ("fast_run_unit_manager_", scratch_ptr, code); 224 call hcs_$get_max_length_seg (scratch_ptr (1), scratch_lng, code); 225 call area_ (scratch_lng, scratch_ptr (1)); 226 end; 227 else language = "other"; /* all linking done by standard system */ 228 229 230 /* set up run unit */ 231 232 dirname = get_wdir_ (); 233 call set_up_run_unit; 234 235 if max_severity > 2 then do; 236 incomplete_set_up: 237 a_code = error_table_$not_done; 238 call Clean_up; 239 return; 240 end; 241 242 if main_ptr = null then do; 243 call ioa_ ("Could not find main entry point."); 244 goto incomplete_set_up; 245 end; 246 247 on fault_tag_3 call fault_tag_3_handler; 248 249 call cu_$gen_call (main_ptr, null); 250 terminate: 251 call Clean_up; 252 return; /* end of main program */ 253 254 255 Clean_up: proc; 256 257 if scratch_ptr (1) ^= null then do; 258 call terminate_run_unit; 259 call release_temp_segments_ ("fast_run_unit_manager_", scratch_ptr, code); 260 end; 261 call find_command_$clear; /* have cleared LOT entries; make cp use hcs_$make_ptr */ 262 263 /* reset fast_related_data_ pointers in case basic or fortran 264* programs are called by a pl1 program in another run unit or are run outside of FAST. */ 265 266 fast_related_data_$fortran_buffer_p = saved_ftn_buffer_p; 267 fast_related_data_$fortran_io_initiated = saved_fortran_io_initiated; 268 fast_related_data_$basic_area_p = null; 269 270 return; 271 272 273 274 terminate_run_unit: proc; 275 276 /* This code is a separate procedure to facilitate error loop checking */ 277 278 dcl m fixed bin (18); 279 280 if terminating then return; /* don't risk loop */ 281 terminating = "1"b; 282 283 /* terminate all segments and clean up LOT and ISOT; 284* If language = "other", no st entries are filled in */ 285 286 do i = 0 to ecount + 1; 287 if st (i).segno then do; 288 if st (i).flags.temp_lote then do; 289 m = fixed (st (i).segno, 18); 290 static_lotp -> lot.lp (m) = baseptr (0); 291 static_isotp -> lot.lp (m) = baseptr (0); 292 end; 293 if i > 0 then /* caller initiated main program */ 294 call hcs_$terminate_noname (baseptr (st (i).segno), code); 295 end; 296 end; 297 298 if language = "fortran2" then if ftn_io_p ^= null 299 then call fortran_io_$close_file (-1, code); 300 301 terminating = "0"b; 302 303 return; 304 end; /* of terminate_run_unit */ 305 306 end; /* of Clean_up */ 307 308 set_up_run_unit: proc; 309 310 /* This procedure gets a pointer to the main entry point, prelinks all fortran programs 311* in the run unit, alllocates blank common and sets the pointers in fast_related_data_. */ 312 313 dcl dummy_length fixed bin (19); 314 dcl bit18_based bit (18) unaligned based; 315 dcl dummy_ptr ptr; 316 dcl main_dir char (168); 317 dcl dummy (dummy_length) fixed bin (35) based; 318 dcl blank_common (blank_length) fixed bin (35) based (blank_common_ptr); 319 dcl main_ename_c32 char (32); 320 321 322 main_ptr = null; 323 main_ename_c32 = main_ename; /* need nonvarying string */ 324 325 if language = "other" then do; /* won't need RNT or anything 326* else in scratch seg */ 327 call hcs_$fs_get_path_name (program_ptr, main_dir, dlng, entname, code); 328 /* get pathname of main program */ 329 if code ^= 0 then do; 330 other_not_found: 331 call error (3, "Could not find main program.", " "); 332 return; 333 end; 334 call hcs_$initiate (main_dir, entname, main_ename_c32, 0, 1, seg_ptr, code); 335 /* associate reference name with main prog */ 336 if seg_ptr = null then goto other_not_found; 337 call hcs_$make_ptr (null, main_ename_c32, main_ename_c32, main_ptr, code); 338 if main_ptr = null 339 then call hcs_$make_ptr (null, main_ename_c32, "main_", main_ptr, code); 340 return; 341 end; 342 343 st (0).defptr = oi.defp; 344 st (0).segno = baseno (program_ptr); 345 st (0).language = language; 346 addr (st (0).flags) -> bit18_based = "0"b; /* array still in stack at this point */ 347 348 if arg_flags.just_compiled then do; 349 call process_just_compiled_entries; 350 if main_ptr = null then return; 351 call allocate_linkage ("1"b, 0); 352 end; 353 354 else do; 355 call get_definition_ (oi.defp, main_ename_c32, main_ename_c32, definition_p, code); 356 if definition_p = null then do; /* look for main_ */ 357 call get_definition_ (oi.defp, main_ename_c32, "main_", definition_p, code); 358 if definition_p = null then return; 359 if definition_p -> definition.class then return; /* entry must be in text */ 360 end; 361 362 main_ptr = addrel (oi.textp, definition_p -> definition.value); 363 call add_to_rnt (main_ename_c32, main_ptr, 0); 364 call allocate_linkage ("0"b, 0); 365 end; 366 367 if language = "basic" then fast_related_data_$basic_area_p = scratch_ptr (1); 368 /* use scratch seg area */ 369 else do; /* main program is fortran; ppelink */ 370 blank_length = 0; 371 call snap_ftn_links (0); /* recursive; when it returns all is prelinked */ 372 if max_severity > 2 then return; 373 if blank_length > 0 374 then allocate blank_common in (scratch_area) set (blank_common_ptr); 375 376 /* The rest of scratch segment will be used for fortran I/O. We must calculate the 377* size and allocate it to get a good pointer; In order to find out where we 378* are now, a dummy variable will be allocated. */ 379 380 dummy_length = 1; 381 allocate dummy in (scratch_area) set (dummy_ptr); 382 dummy_length = scratch_lng - bin (rel (dummy_ptr), 18) - 20; 383 /* alllow room for area header, etc. */ 384 allocate dummy in (scratch_area) set (fast_related_data_$fortran_buffer_p); 385 ftn_io_p = fast_related_data_$fortran_buffer_p; 386 end; 387 388 return; 389 390 end; /* set_up_run_unit */ 391 392 393 snap_ftn_links: proc (st_offset_2); 394 395 /* This procedure snaps all links in fortran programs. It is called 396* recursively; for example, if while snapping program a's links a 397* link is snapped to program b, and none of program b's links have 398* been snapped yet, snap_ftn_links is called to snap b's links before 399* proceeding further with program a's links. */ 400 401 dcl 1 common_list_node aligned based (cl_node_ptr), 402 2 back_thread bit (18) unaligned, 403 2 block_lng fixed bin (17) unaligned, 404 2 name char (32) aligned, 405 2 block_p ptr unaligned; 406 407 dcl (link_ptr, lp, ep, cl_node_ptr, common_p) ptr; 408 dcl (dl_code, st_offset_2, target_st_offset, j) fixed bin; 409 dcl last_rel bit (18) aligned; 410 dcl FT3 bit (6) aligned init ("100111"b); 411 dcl based_ptr ptr based; 412 413 dcl init_template (j) bit (36) aligned based; 414 415 dcl 1 ext aligned like ext_template; 416 417 dcl 1 init_info aligned based, 418 2 lng fixed bin, 419 2 icode fixed bin, 420 2 template (0 refer (init_info.lng)) bit (36) aligned; 421 422 423 st (st_offset_2).flags.links_snapped = "1"b; /* so won't get called again for this program */ 424 lp = st (st_offset_2).ftn_ls_p; /* get ptr to active linkage section */ 425 last_rel = rel (addrel (lp, bin (lp -> header.stats.block_length, 18))); 426 /* get offset of end of linkage section for optimization */ 427 428 do link_ptr = addrel (lp, lp -> header.stats.begin_links) repeat (addrel (link_ptr, 2)) 429 while (rel (link_ptr) < last_rel); 430 call decode_ftn_link (link_ptr, addr (ext), "1"b, dl_code); 431 if dl_code ^= 0 then do; 432 if dl_code ^= 1 then link_ptr -> link.ft2 = FT3; 433 /* get fault tag 3 if reference */ 434 end; 435 else if (ext.type = 5) & (ext.section = "*system") then do; /* common */ 436 if ext.ename = "blnk*com" then do; /* blank common */ 437 blank_length = max (blank_length, ext.init_info_p -> init_info.lng); 438 link_ptr -> based_ptr = addr (blank_common_ptr); 439 /* snap link indirect thru blank_common_ptr */ 440 link_ptr -> link.modifier = "010000"b; /* make pointer indirect */ 441 end; 442 443 else do; /* labelled common */ 444 call find_common_block; 445 if code = 0 then link_ptr -> based_ptr = common_p; /* snap link */ 446 end; 447 end; 448 449 else if (ext.type = 1) & (ext.section = "*sybmol") 450 then link_ptr -> based_ptr = st (st_offset_2).ftn_symbol_p; 451 452 else do; /* ordinary link */ 453 call find_entry ((ext.ename), ep, target_st_offset); 454 if ep = null then link_ptr -> link.ft2 = FT3; /* message already printed */ 455 else do; /* found entry */ 456 link_ptr -> based_ptr = ep; /* snap link */ 457 if ^st (target_st_offset).flags.links_snapped 458 then if st (target_st_offset).ftn_ls_p ^= null 459 then call snap_ftn_links (target_st_offset); 460 end; 461 end; 462 end; 463 464 return; 465 466 467 find_common_block: proc; 468 469 code = 0; 470 if clp ^= null 471 then do cl_node_ptr = clp repeat (ptr (cl_node_ptr, cl_node_ptr -> common_list_node.back_thread)) 472 while (rel (cl_node_ptr)); 473 474 if rel (cl_node_ptr) then do; 475 if ext.ename = common_list_node.name then do; /* found match */ 476 if common_list_node.block_lng = ext.init_info_p -> init_info.lng then do; 477 common_p = common_list_node.block_p; /* use allocated block */ 478 if ext.init_info_p -> init_info.icode = 3 479 then do; /* but initialize now */ 480 j = ext.init_info_p -> init_info.lng; 481 common_p -> init_template = ext.init_info_p -> init_info.template; 482 end; 483 end; 484 else do; 485 call error (3, "Different lengths specified for common block ^a", 486 substr (ext.ename, 1, length (ext.ename))); 487 code = 1; 488 end; 489 return; 490 end; 491 end; 492 end; 493 494 /* no match; allocate new node and new block in scratch seg */ 495 496 cl_node_ptr = clp; 497 allocate common_list_node in (scratch_area) set (clp); 498 if cl_node_ptr = null then clp -> common_list_node.back_thread = "0"b; 499 else clp -> common_list_node.back_thread = rel (cl_node_ptr); 500 clp -> common_list_node.name = ext.ename; 501 j, clp -> common_list_node.block_lng = ext.init_info_p -> init_info.lng; 502 allocate init_template in (scratch_area) set (common_p); 503 clp -> common_list_node.block_p = common_p; 504 if ext.init_info_p -> init_info.icode = 3 505 then common_p -> init_template = ext.init_info_p -> init_info.template; 506 507 return; 508 end; /* find_common_block */ 509 510 511 end; /* snap_ftn_links */ 512 513 decode_ftn_link: proc (linkp, extp, linking, dcode); 514 515 /* This procedure returns information about legal fortran links only. 516* Do not distinguish types of errors except for missing fault tag 2. */ 517 /* This is outside set_up_run_unit_ so fault tag 3 handler can ca 518* l it */ 519 520 dcl (linkp, extp) ptr; 521 dcl linking bit (1) aligned; 522 dcl dcode fixed bin; 523 524 dcl (head_pointer, def_pointer, exp_pointer, type_pointer, ext_pointer) ptr; 525 dcl (ntype, section_id) fixed bin (18); 526 dcl name_length fixed bin; 527 528 dcl 1 ext aligned based, /* holds link info */ 529 2 type fixed bin, /* link type */ 530 2 section char (8) aligned, 531 2 ename, 532 3 nchars fixed bin, 533 3 string char (32), 534 2 init_info_p ptr; /* ptr to init info for common */ 535 536 dcode = 1; 537 if linking then if linkp -> link.ft2 ^= "100110"b then return; 538 /* must have fault tag 2 */ 539 dcode = 2; 540 541 head_pointer = addrel (linkp, linkp -> link.head_ptr); 542 def_pointer = head_pointer -> header.def_ptr; 543 exp_pointer = addrel (def_pointer, linkp -> link.exp_ptr); 544 if exp_pointer -> exp_word.exp then return; /* must have 0 expression */ 545 546 type_pointer = addrel (def_pointer, exp_pointer -> exp_word.type_ptr); 547 ext_pointer = addrel (def_pointer, type_pointer -> type_pair.ext_ptr); 548 section_id = bin (type_pointer -> type_pair.seg_ptr, 18); 549 550 extp -> ext.type, ntype = bin (type_pointer -> type_pair.type, 18); 551 552 if (ntype = 4) | (ntype = 5) then do; 553 name_length = bin (ext_pointer -> name.nchars, 9); 554 if name_length > 32 then return; /* name too long */ 555 extp -> ext.ename.nchars = name_length; 556 substr (extp -> ext.ename.string, 1, name_length) 557 = substr (ext_pointer -> name.char_string, 1, name_length); 558 559 if ntype = 4 then do; 560 if type_pointer -> type_pair.seg_ptr ^= type_pointer -> type_pair.ext_ptr then return; 561 /* don't allow $ names in DFAST */ 562 extp -> ext.section = " "; 563 extp -> ext.init_info_p = null; 564 end; 565 else do; /* ntype = 5 */ 566 if section_id ^= 5 /* *system */ then return; 567 extp -> ext.section = "*system"; 568 if type_pointer -> type_pair.trap_ptr = "0"b then return; 569 /* must have init info */ 570 extp -> ext.init_info_p = addrel (def_pointer, type_pointer -> type_pair.trap_ptr); 571 end; 572 end; 573 574 else if ntype = 1 then do; 575 if section_id ^= 2 then return; /* must be *symbol|0 */ 576 extp -> ext.section = "*symbol"; 577 extp -> ext.ename.nchars = 0; 578 extp -> ext.init_info_p = null; 579 end; 580 581 else return; /* not a legal fortran type */ 582 583 dcode = 0; 584 return; 585 586 end; /* decode_ftn_link */ 587 588 find_entry: proc (ename, ep, st_offset_3); 589 590 /* This procedure returns a pointer to the entrypoint corresponding to ename. 591* If there is anything wrong with the segment that ename refers to, the ep 592* returned is null and the caller should not do anything more with that name. 593* In this case, find_entry prints a error message the first 594* time that ename is referenced. 595* find_entry first searches the RNT; if the name is not foune there, the working directory 596* is searched (via output from hcs_$star_). If the segment was not previously 597* referenced by a different name, it is initiated and the segment's st entry is 598* filled in. To simplify error handling, the rnt node is filled in 599* with a null entry pointer until the real entry pointer is found. */ 600 601 dcl ename char (32); 602 dcl ep ptr; 603 dcl st_offset_3 fixed bin; 604 dcl (i, j, k, ename_length) fixed bin; 605 dcl seg_bc fixed bin (24); 606 607 dcl 1 entries (ecount) aligned based (entry_ptr), 608 (2 type bit (2), 609 2 nnames fixed bin (15), 610 2 nindex fixed bin (17)) unaligned; 611 612 dcl e_info_offset (total_names) fixed bin based (eio_ptr); 613 614 dcl names (total_names) char (32) aligned based (n_ptr); 615 616 617 ep = null; 618 st_offset_3 = 0; 619 ename_length = 33 - verify (reverse (ename), " "); 620 621 /* search RNT for ename */ 622 623 if rnt_p ^= null 624 then do rp = rnt_p repeat (ptr (rp, rp -> rnt_node.back_thread)) 625 while (rp -> rnt_node.back_thread); 626 if ename_length = rnt_node.nchars 627 then if ename = rnt_node.name then do; /* found match */ 628 ep = rnt_node.entryp; 629 st_offset_3 = rnt_node.seg_table_offset; 630 return; 631 end; 632 end; 633 634 if dir_empty then return; /* can't do any more */ 635 636 if ecount = 0 then do; /* get contents of working dir */ 637 call hcs_$star_ (dirname, "**", 3, scratch_ptr (1), ecount, entry_ptr, n_ptr, code); 638 if code ^= 0 then do; 639 dir_empty = "1"b; 640 call error (3, "Home directory is empty. Referenced programs cannot be found.", " "); 641 return; 642 end; 643 allocate st in (scratch_area) set (segment_table_ptr); 644 st (0) = static_st (0); /* copy maiin program's entry */ 645 total_names = 0; 646 do i = 1 to ecount; /* find number of names returned */ 647 total_names = total_names + entries (i).nnames; 648 end; 649 650 /* fill in array relating names with the appropriate entry info. */ 651 652 allocate e_info_offset in (scratch_area) set (eio_ptr); 653 k = 0; 654 do i = 1 to ecount; 655 do j = 1 to entries (i).nnames; 656 k = k + 1; 657 e_info_offset (k) = i; 658 end; 659 end; 660 end; 661 662 do i = 1 to total_names while (ename ^= names (i)); end; 663 664 if i = total_names + 1 then do; 665 st_offset_3 = ecount + 1; /* dummy entry for names not found */ 666 call add_to_rnt (ename, null, st_offset_3); 667 call error (2, "Referenced segment ^a cannot be found.", ename); 668 return; 669 end; 670 671 k, st_offset_3 = e_info_offset (i); 672 call add_to_rnt (ename, null, st_offset_3); 673 674 if entries (k).type = "10"b then do; 675 st (k).flags.nonobject = "1"b; 676 call error (2, "Illegal reference to directory ^a.", ename); 677 return; 678 end; 679 680 if st (k).flags.cant_initiate then goto bad_access; 681 682 if st (k).segno = "0"b then do; 683 call hcs_$initiate_count (dirname, ename, "", seg_bc, 1, seg_ptr, code); 684 if seg_ptr = null then do; 685 st (k).flags.cant_initiate = "1"b; 686 bad_access: call error (2, "Insufficient access to ^a.", ename); 687 return; 688 end; 689 690 if (^arg_flags.just_compiled) & (baseno (seg_ptr) = st (0).segno) then st (k) = st (0); 691 else do; /* collect info about seg */ 692 st (k).segno = baseno (seg_ptr); 693 oi.version_number = object_info_version_2; 694 call object_info_$display (seg_ptr, seg_bc, addr (oi), code); 695 if code ^= 0 then do; 696 st (k).flags.nonobject = "1"b; 697 bad_object: call error (2, "^a cannot be called because it is not a program.", ename); 698 return; 699 end; 700 701 st (k).defptr = oi.defp; 702 if (oi.compiler = "fortran2") | (oi.compiler = "basic") then do; 703 st (k).language = oi.compiler; 704 if oi.compiler ^= language then do; 705 st (k).flags.wrong_language = "1"b; 706 wrong_lang: call error (2, "Subprogram ^a is in an incompatible language.", ename); 707 return; 708 end; 709 call allocate_linkage ("0"b, st_offset_3); 710 end; 711 else do; 712 st (k).language = "other"; 713 st (k).ftn_ls_p, st (k).ftn_symbol_p = null; 714 end; 715 end; 716 end; /* done filling in info about new seg */ 717 718 else do; /* check flags of known seg */ 719 /* different name, so print message agaiin */ 720 if st (k).flags.wrong_language then goto wrong_lang; 721 if st (k).flags.nonobject then goto bad_object; 722 end; 723 724 /* finally get the pointer to the entrypoint */ 725 726 if st (k).language = "other" then call hcs_$make_ptr (seg_ptr, ename, ename, ep, code); 727 else do; 728 call get_definition_ (st (k).defptr, ename, ename, definition_p, code); 729 if definition_p ^= null 730 then if definition_p -> definition.class = "0"b 731 then ep = addrel (seg_ptr, definition_p -> definition.value); 732 end; 733 734 if ep = null then call error (2, "Cannot find subprogram ^a in segment.", ename); 735 rnt_p -> rnt_node.entryp = ep; /* fill in final value of entry pointer */ 736 737 return; 738 end; /* of find_entry */ 739 740 741 allocate_linkage: proc (temp_object, st_offset_4); 742 743 /* This procedure is called only for fortran and basic programs. For these we always 744* allocate linkage and fill in the LOT entry. */ 745 746 dcl temp_object bit (1) aligned; 747 dcl st_offset_4 fixed bin; 748 dcl (k, link_lng) fixed bin; 749 dcl linkage_section_p ptr; 750 dcl linkage_section (link_lng) fixed bin (35) based; 751 752 753 st (st_offset_4).flags.temp_lote = "1"b; /* so terminate will zap LOT entry */ 754 if temp_object then linkage_section_p = oi.linkp; /* use linkage section in place */ 755 else do; /* copy into scratch seg */ 756 link_lng = oi.llng; 757 allocate linkage_section in (scratch_area) set (linkage_section_p); 758 linkage_section_p -> linkage_section = oi.linkp -> linkage_section; 759 end; 760 761 if st (st_offset_4).language = "fortran2" then do; 762 st (st_offset_4).ftn_ls_p = linkage_section_p; 763 st (st_offset_4).ftn_symbol_p = oi.symbp; 764 end; 765 766 else st (st_offset_4).ftn_ls_p, st (st_offset_4).ftn_symbol_p = null; 767 768 /* fill in LOT, ISOT */ 769 770 k = bin (baseno (oi.textp), 18); 771 static_lotp -> lot.lp (k), 772 static_isotp -> lot.lp (k) = linkage_section_p; 773 774 /* fill in linkage section header */ 775 776 linkage_section_p -> header.def_ptr = oi.defp; 777 linkage_section_p -> header.symbol_ptr = oi.symbp; 778 linkage_section_p -> header.original_linkage_ptr = oi.linkp; 779 linkage_section_p -> header.stats.segment_number = bit (k, 18); 780 linkage_section_p -> header.stats.static_length = bit (bin (oi.ilng, 18), 18); 781 782 return; 783 784 end; /* of allocate_linkage */ 785 786 787 add_to_rnt: proc (ename, ep, st_offset_5); 788 789 /* This procedure simply adds a node to the RNT; searching is done in find_entry. */ 790 791 dcl ename char (32); 792 dcl ep ptr; 793 dcl st_offset_5 fixed bin; 794 795 796 rp = rnt_p; 797 allocate rnt_node in (scratch_area) set (rnt_p); 798 799 rnt_p -> rnt_node.entryp = ep; 800 rnt_p -> rnt_node.name = ename; 801 rnt_p -> rnt_node.nchars = 33 - verify (reverse (ename), " "); 802 rnt_p -> rnt_node.seg_table_offset = st_offset_5; 803 804 if rp = null then rnt_p -> rnt_node.back_thread = "0"b; /* first node */ 805 else rnt_p -> rnt_node.back_thread = rel (rp); 806 807 return; 808 end; /* of add_to_rnt */ 809 810 811 process_just_compiled_entries: proc; 812 813 /* This procedure adds the names of all the entrypoints in a just compiled 814* program to the RNT. */ 815 816 dcl defptr ptr; 817 818 main_ptr = null; 819 call decode_definition_$init (program_ptr, program_lng); 820 821 do defptr = oi.defp repeat (dd.next_def) while (^decode_definition_ (defptr, addr (dd))); 822 if dd.section = "text" then do; 823 if dd.symbol = "main_" then main_ptr = addrel (oi.textp, dd.offset); 824 else call add_to_rnt ((dd.symbol), addrel (oi.textp, dd.offset), 0); 825 end; 826 end; 827 828 return; 829 830 end; /* of process_just_compiled entries */ 831 832 find_entry_value: entry (a_entname, a_ep, ecode); 833 834 /* This entry is called by basic_find_proc_. 835* Because it is an external entry, the procedures it calls must use 836* static pointers and counts. */ 837 838 dcl a_entname char (32); 839 dcl a_ep ptr; 840 dcl ecode fixed bin (35); 841 dcl st_offset_5 fixed bin; 842 843 call find_entry (a_entname, a_ep, st_offset_5); 844 if a_ep = null then ecode = error_table_$name_not_found; 845 else ecode = 0; 846 return; 847 848 849 850 851 terminate_run_entry: proc; 852 853 /* This procedure is called by fortran stop */ 854 855 goto terminate; 856 857 end; /* of terminate_run_entry */ 858 859 860 861 error: proc (severity, control_string, arg_string); 862 863 dcl severity fixed bin; 864 dcl (control_string, arg_string) char (*); 865 dcl new_control_string char (200) varying; 866 867 max_severity = max (max_severity, severity); 868 if severity <= 2 then do; /* warning only */ 869 if arg_flags.brief then return; /* don't print any message */ 870 new_control_string = "Warning: " || control_string; 871 end; 872 else new_control_string = control_string; 873 call ioa_ (new_control_string, arg_string); 874 875 return; 876 end; /* error */ 877 878 fault_tag_3_handler: proc; 879 880 /* fortran links which could not be snapped are converted to fault tag 3's */ 881 882 dcl link_ptr ptr; 883 dcl dl_code fixed bin; 884 dcl find_condition_info_ entry (ptr, ptr, fixed bin (35)); 885 dcl continue_to_signal_ entry (fixed bin (35)); 886 887 dcl 1 ext aligned like ext_template; 888 889 dcl 1 cond_info aligned, 6 1 /* BEGIN INCLUDE FILE ... cond_info.incl.pl1 6 2* coded by M. Weaver 12 July 1973 */ 6 3 6 4 2 mcptr ptr, /* ptr to machine conditions at time of fault */ 6 5 2 version fixed bin, /* version of this structure (now=1) */ 6 6 2 condition_name char(32) var, /* name of condition */ 6 7 2 infoptr ptr, /* ptr to software info structure */ 6 8 2 wcptr ptr, /* ptr to wall crossing machine conditions */ 6 9 2 loc_ptr ptr, /* ptr to location where condition occurred */ 6 10 2 flags aligned, 6 11 3 crawlout bit(1) unal, /* = "1"b if condition occurred in inner ring */ 6 12 3 pad1 bit(35) unal, 6 13 2 pad_word bit(36) aligned, 6 14 2 user_loc_ptr ptr, /* ptr to last non-support loc before condition */ 6 15 2 pad (4) bit(36) aligned; 6 16 6 17 /* END INCLUDE FILE ... cond_info.incl.pl1 */ 890 891 7 1 /* */ 7 2 /* BEGIN INCLUDE FILE mc.incl.pl1 Created Dec 72 for 6180 - WSS. */ 7 3 /* Modified 06/07/76 by Greenberg for mc.resignal */ 7 4 /* Modified 07/07/76 by Morris for fault register data */ 7 5 /* Modified 08/28/80 by J. A. Bush for the DPS8/70M CVPU */ 7 6 /* Modified '82 to make values constant */ 7 7 7 8 /* words 0-15 pointer registers */ 7 9 7 10 dcl mcp ptr; 7 11 7 12 dcl 1 mc based (mcp) aligned, 7 13 2 prs (0:7) ptr, /* POINTER REGISTERS */ 7 14 (2 regs, /* registers */ 7 15 3 x (0:7) bit (18), /* index registers */ 7 16 3 a bit (36), /* accumulator */ 7 17 3 q bit (36), /* q-register */ 7 18 3 e bit (8), /* exponent */ 7 19 3 pad1 bit (28), 7 20 3 t bit (27), /* timer register */ 7 21 3 pad2 bit (6), 7 22 3 ralr bit (3), /* ring alarm register */ 7 23 7 24 2 scu (0:7) bit (36), 7 25 7 26 2 mask bit (72), /* mem controller mask at time of fault */ 7 27 2 ips_temp bit (36), /* Temporary storage for IPS info */ 7 28 2 errcode fixed bin (35), /* fault handler's error code */ 7 29 2 fim_temp, 7 30 3 unique_index bit (18) unal, /* unique index for restarting faults */ 7 31 3 resignal bit (1) unal, /* recompute signal name with fcode below */ 7 32 3 fcode bit (17) unal, /* fault code used as index to FIM table and SCT */ 7 33 2 fault_reg bit (36), /* fault register */ 7 34 2 pad2 bit (1), 7 35 2 cpu_type fixed bin (2) unsigned, /* L68 = 0, DPS8/70M = 1 */ 7 36 2 ext_fault_reg bit (15), /* extended fault reg for DPS8/70M CPU */ 7 37 2 fault_time bit (54), /* time of fault */ 7 38 7 39 2 eis_info (0:7) bit (36)) unaligned; 7 40 7 41 7 42 dcl (apx fixed bin init (0), 7 43 abx fixed bin init (1), 7 44 bpx fixed bin init (2), 7 45 bbx fixed bin init (3), 7 46 lpx fixed bin init (4), 7 47 lbx fixed bin init (5), 7 48 spx fixed bin init (6), 7 49 sbx fixed bin init (7)) internal static options (constant); 7 50 7 51 7 52 7 53 7 54 dcl scup ptr; 7 55 7 56 dcl 1 scu based (scup) aligned, /* SCU DATA */ 7 57 7 58 7 59 /* WORD (0) */ 7 60 7 61 (2 ppr, /* PROCEDURE POINTER REGISTER */ 7 62 3 prr bit (3), /* procedure ring register */ 7 63 3 psr bit (15), /* procedure segment register */ 7 64 3 p bit (1), /* procedure privileged bit */ 7 65 7 66 2 apu, /* APPENDING UNIT STATUS */ 7 67 3 xsf bit (1), /* ext seg flag - IT modification */ 7 68 3 sdwm bit (1), /* match in SDW Ass. Mem. */ 7 69 3 sd_on bit (1), /* SDW Ass. Mem. ON */ 7 70 3 ptwm bit (1), /* match in PTW Ass. Mem. */ 7 71 3 pt_on bit (1), /* PTW Ass. Mem. ON */ 7 72 3 pi_ap bit (1), /* Instr Fetch or Append cycle */ 7 73 3 dsptw bit (1), /* Fetch of DSPTW */ 7 74 3 sdwnp bit (1), /* Fetch of SDW non paged */ 7 75 3 sdwp bit (1), /* Fetch of SDW paged */ 7 76 3 ptw bit (1), /* Fetch of PTW */ 7 77 3 ptw2 bit (1), /* Fetch of pre-paged PTW */ 7 78 3 fap bit (1), /* Fetch of final address paged */ 7 79 3 fanp bit (1), /* Fetch of final address non-paged */ 7 80 3 fabs bit (1), /* Fetch of final address absolute */ 7 81 7 82 2 fault_cntr bit (3), /* number of retrys of EIS instructions */ 7 83 7 84 7 85 /* WORD (1) */ 7 86 7 87 2 fd, /* FAULT DATA */ 7 88 3 iro bit (1), /* illegal ring order */ 7 89 3 oeb bit (1), /* out of execute bracket */ 7 90 3 e_off bit (1), /* no execute */ 7 91 3 orb bit (1), /* out of read bracket */ 7 92 3 r_off bit (1), /* no read */ 7 93 3 owb bit (1), /* out of write bracket */ 7 94 3 w_off bit (1), /* no write */ 7 95 3 no_ga bit (1), /* not a gate */ 7 96 3 ocb bit (1), /* out of call bracket */ 7 97 3 ocall bit (1), /* outward call */ 7 98 3 boc bit (1), /* bad outward call */ 7 99 3 inret bit (1), /* inward return */ 7 100 3 crt bit (1), /* cross ring transfer */ 7 101 3 ralr bit (1), /* ring alarm register */ 7 102 3 am_er bit (1), /* associative memory fault */ 7 103 3 oosb bit (1), /* out of segment bounds */ 7 104 3 paru bit (1), /* processor parity upper */ 7 105 3 parl bit (1), /* processor parity lower */ 7 106 3 onc_1 bit (1), /* op not complete type 1 */ 7 107 3 onc_2 bit (1), /* op not complete type 2 */ 7 108 7 109 2 port_stat, /* PORT STATUS */ 7 110 3 ial bit (4), /* illegal action lines */ 7 111 3 iac bit (3), /* illegal action channel */ 7 112 3 con_chan bit (3), /* connect channel */ 7 113 7 114 2 fi_num bit (5), /* (fault/interrupt) number */ 7 115 2 fi_flag bit (1), /* 1 => fault, 0 => interrupt */ 7 116 7 117 7 118 /* WORD (2) */ 7 119 7 120 2 tpr, /* TEMPORARY POINTER REGISTER */ 7 121 3 trr bit (3), /* temporary ring register */ 7 122 3 tsr bit (15), /* temporary segment register */ 7 123 7 124 2 pad2 bit (9), 7 125 7 126 2 cpu_no bit (3), /* CPU number */ 7 127 7 128 2 delta bit (6), /* tally modification DELTA */ 7 129 7 130 7 131 /* WORD (3) */ 7 132 7 133 2 word3 bit (18), 7 134 7 135 2 tsr_stat, /* TSR STATUS for 1,2,&3 word instructions */ 7 136 3 tsna, /* Word 1 status */ 7 137 4 prn bit (3), /* Word 1 PR number */ 7 138 4 prv bit (1), /* Word 1 PR valid bit */ 7 139 3 tsnb, /* Word 2 status */ 7 140 4 prn bit (3), /* Word 2 PR number */ 7 141 4 prv bit (1), /* Word 2 PR valid bit */ 7 142 3 tsnc, /* Word 3 status */ 7 143 4 prn bit (3), /* Word 3 PR number */ 7 144 4 prv bit (1), /* Word 3 PR valid bit */ 7 145 7 146 2 tpr_tbr bit (6), /* TPR.TBR field */ 7 147 7 148 7 149 /* WORD (4) */ 7 150 7 151 2 ilc bit (18), /* INSTRUCTION COUNTER */ 7 152 7 153 2 ir, /* INDICATOR REGISTERS */ 7 154 3 zero bit (1), /* zero indicator */ 7 155 3 neg bit (1), /* negative indicator */ 7 156 3 carry bit (1), /* carryry indicator */ 7 157 3 ovfl bit (1), /* overflow indicator */ 7 158 3 eovf bit (1), /* eponent overflow */ 7 159 3 eufl bit (1), /* exponent underflow */ 7 160 3 oflm bit (1), /* overflow mask */ 7 161 3 tro bit (1), /* tally runout */ 7 162 3 par bit (1), /* parity error */ 7 163 3 parm bit (1), /* parity mask */ 7 164 3 bm bit (1), /* ^bar mode */ 7 165 3 tru bit (1), /* truncation mode */ 7 166 3 mif bit (1), /* multi-word instruction mode */ 7 167 3 abs bit (1), /* absolute mode */ 7 168 3 hex bit (1), /* hexadecimal exponent mode */ 7 169 3 pad bit (3), 7 170 7 171 7 172 /* WORD (5) */ 7 173 7 174 2 ca bit (18), /* COMPUTED ADDRESS */ 7 175 7 176 2 cu, /* CONTROL UNIT STATUS */ 7 177 3 rf bit (1), /* on first cycle of repeat instr */ 7 178 3 rpt bit (1), /* repeat instruction */ 7 179 3 rd bit (1), /* repeat double instruction */ 7 180 3 rl bit (1), /* repeat link instruciton */ 7 181 3 pot bit (1), /* IT modification */ 7 182 3 pon bit (1), /* return type instruction */ 7 183 3 xde bit (1), /* XDE from Even location */ 7 184 3 xdo bit (1), /* XDE from Odd location */ 7 185 3 poa bit (1), /* operation preparation */ 7 186 3 rfi bit (1), /* tells CPU to refetch instruction */ 7 187 3 its bit (1), /* ITS modification */ 7 188 3 if bit (1), /* fault occured during instruction fetch */ 7 189 7 190 2 cpu_tag bit (6)) unaligned, /* computed tag field */ 7 191 7 192 7 193 /* WORDS (6,7) */ 7 194 7 195 2 even_inst bit (36), /* even instruction of faulting pair */ 7 196 7 197 2 odd_inst bit (36); /* odd instruction of faulting pair */ 7 198 7 199 7 200 7 201 7 202 7 203 7 204 /* ALTERNATE SCU DECLARATION */ 7 205 7 206 7 207 dcl 1 scux based (scup) aligned, 7 208 7 209 (2 pad0 bit (36), 7 210 7 211 2 fd, /* GROUP II FAULT DATA */ 7 212 3 isn bit (1), /* illegal segment number */ 7 213 3 ioc bit (1), /* illegal op code */ 7 214 3 ia_am bit (1), /* illegal address - modifier */ 7 215 3 isp bit (1), /* illegal slave procedure */ 7 216 3 ipr bit (1), /* illegal procedure */ 7 217 3 nea bit (1), /* non existent address */ 7 218 3 oobb bit (1), /* out of bounds */ 7 219 3 pad bit (29), 7 220 7 221 2 pad2 bit (36), 7 222 7 223 2 pad3a bit (18), 7 224 7 225 2 tsr_stat (0:2), /* TSR STATUS as an ARRAY */ 7 226 3 prn bit (3), /* PR number */ 7 227 3 prv bit (1), /* PR valid bit */ 7 228 7 229 2 pad3b bit (6)) unaligned, 7 230 7 231 2 pad45 (0:1) bit (36), 7 232 7 233 2 instr (0:1) bit (36); /* Instruction ARRAY */ 7 234 7 235 7 236 7 237 /* END INCLUDE FILE mc.incl.pl1 */ 892 893 894 cond_info.version = 1; 895 call find_condition_info_ (null, addr (cond_info), code); 896 if code ^= 0 then goto continue_ft3; 897 898 scup = addr (cond_info.mcptr -> mc.scu (0)); 899 link_ptr = ptr (baseptr (fixed (fixed (scup -> scu.tpr.tsr, 15), 18)), scup -> scu.ca); 900 901 call decode_ftn_link (link_ptr, addr (ext), "0"b, dl_code); 902 if dl_code = 0 then call ioa_ ("Attempt to reference missing subprogram ^a.^/Program aborted.", 903 ext.ename); 904 else if dl_code = 2 then call ioa_ ( 905 "Attempt to reference through invalid link.^/FORTRAN compiler error. Program aborted."); 906 else do; /* at this writing no other codes are returned, but... */ 907 continue_ft3: call continue_to_signal_ (code); 908 return; 909 end; 910 911 goto terminate; 912 913 end; /* fault_tag_3_handler */ 914 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/19/88 1500.1 fast_run_unit_manager_.pl1 >spec>install>MR12.2-1015>fast_run_unit_manager_.pl1 160 1 08/05/77 1022.5 object_info.incl.pl1 >ldd>include>object_info.incl.pl1 163 2 07/27/83 0910.0 linkdcl.incl.pl1 >ldd>include>linkdcl.incl.pl1 166 3 11/24/86 1226.9 definition.incl.pl1 >ldd>include>definition.incl.pl1 169 4 08/05/77 1022.4 lot.incl.pl1 >ldd>include>lot.incl.pl1 172 5 11/07/86 1550.3 stack_header.incl.pl1 >ldd>include>stack_header.incl.pl1 890 6 05/06/74 1741.0 cond_info.incl.pl1 >ldd>include>cond_info.incl.pl1 892 7 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. FT3 000116 automatic bit(6) initial dcl 410 set ref 410* 432 454 a_code parameter fixed bin(35,0) dcl 37 set ref 22 177* 201* 236* a_entname parameter char(32) unaligned dcl 838 set ref 832 843* a_ep parameter pointer dcl 839 set ref 832 843* 844 addr builtin function dcl 111 ref 183 198 198 213 346 430 430 438 694 694 821 821 895 895 898 901 901 addrel builtin function dcl 111 ref 362 425 428 462 541 543 546 547 570 729 823 824 824 area_ 000170 constant entry external dcl 98 ref 225 arg_flags parameter structure level 1 dcl 31 ref 22 arg_string parameter char unaligned dcl 864 set ref 861 873* back_thread based bit(18) level 2 in structure "common_list_node" packed unaligned dcl 401 in procedure "snap_ftn_links" set ref 492 498* 499* back_thread 2 based bit(18) level 2 in structure "rnt_node" packed unaligned dcl 150 in procedure "fast_run_unit_manager_" set ref 623 632 804* 805* based_ptr based pointer dcl 411 set ref 438* 445* 449* 456* baseno builtin function dcl 111 ref 344 690 692 770 baseptr builtin function dcl 111 ref 290 291 293 293 899 begin_links 6 based bit(18) level 3 packed unaligned dcl 2-31 ref 428 bin builtin function dcl 111 ref 382 425 548 550 553 770 780 bit builtin function dcl 111 ref 779 780 bit18_based based bit(18) unaligned dcl 314 set ref 346* blank_common based fixed bin(35,0) array dcl 318 ref 373 blank_common_ptr 000100 automatic pointer dcl 40 set ref 179* 373* 438 blank_length 000120 automatic fixed bin(17,0) dcl 60 set ref 370* 373 373 437* 437 block_length 6(18) based bit(18) level 3 packed unaligned dcl 2-31 ref 425 block_lng 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 401 set ref 476 501* block_p 11 based pointer level 2 packed unaligned dcl 401 set ref 477 503* brief 0(01) parameter bit(1) level 2 packed unaligned dcl 31 ref 869 ca 5 based bit(18) level 2 packed unaligned dcl 7-56 ref 899 cant_initiate 0(22) based bit(1) array level 3 packed unaligned dcl 136 set ref 680 685* char_string 0(09) based char(31) level 2 packed unaligned dcl 2-70 ref 556 cl_node_ptr 000106 automatic pointer dcl 407 set ref 470* 470* 474 475 476 477* 492 492 496* 498 499 class 1(33) based bit(3) level 2 packed unaligned dcl 3-12 ref 359 729 cleanup 000136 stack reference condition dcl 113 ref 217 clp 000014 internal static pointer dcl 48 set ref 182* 470 470 496 497* 498 499 500 501 503 code 000122 automatic fixed bin(35,0) dcl 62 set ref 198* 199 201 223* 224* 259* 293* 298* 327* 329 334* 337* 338* 355* 357* 445 469* 487* 637* 638 683* 694* 695 726* 728* 895* 896 907* common_list_node based structure level 1 dcl 401 set ref 497 common_p 000110 automatic pointer dcl 407 set ref 445 477* 481 502* 503 504 compiler 30 000174 automatic char(8) level 2 dcl 158 set ref 221 221 222 702 702 703 704 cond_info 000130 automatic structure level 1 dcl 889 set ref 895 895 continue_to_signal_ 000216 constant entry external dcl 885 ref 907 control_string parameter char unaligned dcl 864 ref 861 870 872 cu_$gen_call 000152 constant entry external dcl 91 ref 249 dcode parameter fixed bin(17,0) dcl 522 set ref 513 536* 539* 583* dd 000152 automatic structure level 1 dcl 124 set ref 821 821 decode_definition_ 000174 constant entry external dcl 100 ref 821 decode_definition_$init 000172 constant entry external dcl 99 ref 819 def_pointer 000102 automatic pointer dcl 524 set ref 542* 543 546 547 570 def_ptr based pointer level 2 dcl 2-31 set ref 542 776* definition based structure level 1 dcl 3-12 definition_p 000106 automatic pointer dcl 43 set ref 355* 356 357* 358 359 362 728* 729 729 729 defp 4 000174 automatic pointer level 2 dcl 158 set ref 343 355* 357* 701 776 821 defptr 000370 automatic pointer dcl 816 in procedure "process_just_compiled_entries" set ref 821* 821* defptr 2 based pointer array level 2 in structure "st" dcl 136 in procedure "fast_run_unit_manager_" set ref 343* 701* 728* dir_empty 000034 internal static bit(1) dcl 69 set ref 193* 634 639* dirname 000040 internal static char(168) unaligned dcl 74 set ref 232* 637* 683* dl_code 000112 automatic fixed bin(17,0) dcl 408 in procedure "snap_ftn_links" set ref 430* 431 432 dl_code 000110 automatic fixed bin(17,0) dcl 883 in procedure "fault_tag_3_handler" set ref 901* 902 904 dlng 000123 automatic fixed bin(17,0) dcl 63 set ref 327* dummy based fixed bin(35,0) array dcl 317 ref 381 384 dummy_length 000274 automatic fixed bin(19,0) dcl 313 set ref 380* 381 382* 384 dummy_ptr 000276 automatic pointer dcl 315 set ref 381* 382 e_info_offset based fixed bin(17,0) array dcl 612 set ref 652 657* 671 ecode parameter fixed bin(35,0) dcl 840 set ref 832 844* 845* ecount 000032 internal static fixed bin(17,0) dcl 64 set ref 189* 286 636 637* 643 646 654 665 eio_ptr 000024 internal static pointer dcl 52 set ref 184* 652* 657 671 ename 3 000120 automatic varying char(32) level 2 in structure "ext" dcl 415 in procedure "snap_ftn_links" set ref 436 453 475 485 485 485 485 500 ename parameter char(32) unaligned dcl 791 in procedure "add_to_rnt" ref 787 800 801 ename 3 based structure level 2 in structure "ext" dcl 528 in procedure "decode_ftn_link" ename parameter char(32) unaligned dcl 601 in procedure "find_entry" set ref 588 619 626 662 666* 667* 672* 676* 683* 686* 697* 706* 726* 726* 728* 728* 734* ename 3 000112 automatic varying char(32) level 2 in structure "ext" dcl 887 in procedure "fault_tag_3_handler" set ref 902* ename_length 000103 automatic fixed bin(17,0) dcl 604 set ref 619* 626 entname 000126 automatic char(32) unaligned dcl 75 set ref 327* 334* entries based structure array level 1 dcl 607 entry_ptr 000026 internal static pointer dcl 53 set ref 185* 637* 647 655 674 entryp based pointer level 2 dcl 150 set ref 628 735* 799* ep parameter pointer dcl 602 in procedure "find_entry" set ref 588 617* 628* 726* 729* 734 735 ep 000104 automatic pointer dcl 407 in procedure "snap_ftn_links" set ref 453* 454 456 ep parameter pointer dcl 792 in procedure "add_to_rnt" ref 787 799 error_table_$name_not_found 000134 external static fixed bin(35,0) dcl 81 ref 844 error_table_$not_done 000132 external static fixed bin(35,0) dcl 81 ref 236 exp 0(18) based bit(18) level 2 packed unaligned dcl 2-21 ref 544 exp_pointer 000104 automatic pointer dcl 524 set ref 543* 544 546 exp_ptr 1 based bit(18) level 2 packed unaligned dcl 2-11 ref 543 exp_word based structure level 1 dcl 2-21 ext 000112 automatic structure level 1 dcl 887 in procedure "fault_tag_3_handler" set ref 901 901 ext 000120 automatic structure level 1 dcl 415 in procedure "snap_ftn_links" set ref 430 430 ext based structure level 1 dcl 528 in procedure "decode_ftn_link" ext_pointer 000110 automatic pointer dcl 524 set ref 547* 553 556 ext_ptr 1(18) based bit(18) level 2 packed unaligned dcl 2-25 ref 547 560 ext_template based structure level 1 dcl 118 extp parameter pointer dcl 520 ref 513 550 555 556 562 563 567 570 576 577 578 fast_related_data_$basic_area_p 000144 external static pointer dcl 85 set ref 268* 367* fast_related_data_$fortran_buffer_p 000140 external static pointer dcl 83 set ref 207 266* 384* 385 fast_related_data_$fortran_io_initiated 000136 external static bit(1) dcl 82 set ref 208 210* 267* fast_related_data_$terminate_run 000142 external static entry variable dcl 84 set ref 211* fault_tag_3 000144 stack reference condition dcl 114 ref 247 find_command_$clear 000212 constant entry external dcl 107 ref 261 find_condition_info_ 000214 constant entry external dcl 884 ref 895 fixed builtin function dcl 111 ref 289 899 899 flags 0(18) based structure array level 2 packed unaligned dcl 136 set ref 346 fortran_io_$close_file 000154 constant entry external dcl 92 ref 298 ft2 0(30) based bit(6) level 2 packed unaligned dcl 2-11 set ref 432* 454* 537 ftn_io_p 000112 automatic pointer dcl 45 set ref 180* 298 385* ftn_ls_p 4 based pointer array level 2 packed unaligned dcl 136 set ref 424 457 713* 762* 766* ftn_symbol_p 5 based pointer array level 2 packed unaligned dcl 136 set ref 449 713* 763* 766* get_definition_ 000204 constant entry external dcl 104 ref 355 357 728 get_temp_segments_ 000160 constant entry external dcl 94 ref 223 get_wdir_ 000210 constant entry external dcl 106 ref 232 hcs_$fs_get_path_name 000206 constant entry external dcl 105 ref 327 hcs_$get_max_length_seg 000150 constant entry external dcl 90 ref 224 hcs_$initiate 000200 constant entry external dcl 102 ref 334 hcs_$initiate_count 000164 constant entry external dcl 95 ref 683 hcs_$make_ptr 000202 constant entry external dcl 103 ref 337 338 726 hcs_$star_ 000176 constant entry external dcl 101 ref 637 hcs_$terminate_noname 000156 constant entry external dcl 93 ref 293 head_pointer 000100 automatic pointer dcl 524 set ref 541* 542 head_ptr based bit(18) level 2 packed unaligned dcl 2-11 ref 541 header based structure level 1 dcl 2-31 i 000117 automatic fixed bin(17,0) dcl 59 in procedure "fast_run_unit_manager_" set ref 286* 287 288 289 293 293 293* i 000100 automatic fixed bin(17,0) dcl 604 in procedure "find_entry" set ref 646* 647* 654* 655 657* 662* 662* 664 671 icode 1 based fixed bin(17,0) level 2 dcl 417 ref 478 504 ilng 21 000174 automatic fixed bin(17,0) level 2 dcl 158 set ref 780 init_info based structure level 1 dcl 417 init_info_p 14 000120 automatic pointer level 2 in structure "ext" dcl 415 in procedure "snap_ftn_links" set ref 437 476 478 480 481 501 504 504 init_info_p 14 based pointer level 2 in structure "ext" dcl 528 in procedure "decode_ftn_link" set ref 563* 570* 578* init_template based bit(36) array dcl 413 set ref 481* 502 504* ioa_ 000146 constant entry external dcl 89 ref 200 243 873 902 904 isot_ptr 52 based pointer level 2 dcl 5-26 ref 215 j 000114 automatic fixed bin(17,0) dcl 408 in procedure "snap_ftn_links" set ref 480* 481 501* 502 504 j 000101 automatic fixed bin(17,0) dcl 604 in procedure "find_entry" set ref 655* just_compiled parameter bit(1) level 2 packed unaligned dcl 31 ref 348 690 k 000102 automatic fixed bin(17,0) dcl 604 in procedure "find_entry" set ref 653* 656* 656 657 671* 674 675 680 682 685 690 692 696 701 703 705 712 713 713 720 721 726 728 k 000100 automatic fixed bin(17,0) dcl 748 in procedure "allocate_linkage" set ref 770* 771 771 779 language 6 based char(8) array level 2 in structure "st" dcl 136 in procedure "fast_run_unit_manager_" set ref 345* 703* 712* 726 761 language 000036 internal static char(8) dcl 73 in procedure "fast_run_unit_manager_" set ref 222* 227* 298 325 345 367 704 last_rel 000115 automatic bit(18) dcl 409 set ref 425* 428 length builtin function dcl 111 ref 485 485 link based structure level 1 dcl 2-11 link_lng 000101 automatic fixed bin(17,0) dcl 748 set ref 756* 757 758 link_ptr 000100 automatic pointer dcl 407 in procedure "snap_ftn_links" set ref 428* 428* 430* 432 438 440 445 449 454 456* 462 link_ptr 000106 automatic pointer dcl 882 in procedure "fault_tag_3_handler" set ref 899* 901* linkage_section based fixed bin(35,0) array dcl 750 set ref 757 758* 758 linkage_section_p 000102 automatic pointer dcl 749 set ref 754* 757* 758 762 771 776 777 778 779 780 linking parameter bit(1) dcl 521 ref 513 537 linkp parameter pointer dcl 520 in procedure "decode_ftn_link" ref 513 537 541 541 543 linkp 6 000174 automatic pointer level 2 in structure "oi" dcl 158 in procedure "fast_run_unit_manager_" set ref 754 758 778 links_snapped 0(18) based bit(1) array level 3 packed unaligned dcl 136 set ref 423* 457 llng 20 000174 automatic fixed bin(17,0) level 2 dcl 158 set ref 756 lng based fixed bin(17,0) level 2 dcl 417 ref 437 476 480 481 501 504 lot based structure level 1 dcl 4-6 lot_ptr 26 based pointer level 2 dcl 5-26 ref 214 lp based pointer array level 2 in structure "lot" packed unaligned dcl 4-6 in procedure "fast_run_unit_manager_" set ref 290* 291* 771* 771* lp 000102 automatic pointer dcl 407 in procedure "snap_ftn_links" set ref 424* 425 425 428 428 m 000106 automatic fixed bin(18,0) dcl 278 set ref 289* 290 291 main_dir 000300 automatic char(168) unaligned dcl 316 set ref 327* 334* main_ename parameter varying char(32) dcl 36 ref 22 323 main_ename_c32 000352 automatic char(32) unaligned dcl 319 set ref 323* 334* 337* 337* 338* 355* 355* 357* 363* main_ptr 000110 automatic pointer dcl 44 set ref 242 249* 322* 337* 338 338* 350 362* 363* 818* 823* max builtin function dcl 111 ref 437 867 max_severity 000116 automatic fixed bin(17,0) dcl 58 set ref 188* 235 372 867* 867 mc based structure level 1 dcl 7-12 mcptr 000130 automatic pointer level 2 dcl 889 set ref 898 modifier 1(30) based bit(6) level 2 packed unaligned dcl 2-11 set ref 440* n_ptr 000030 internal static pointer dcl 55 set ref 186* 637* 662 name based structure level 1 dcl 2-70 in procedure "fast_run_unit_manager_" name 4 based char(32) level 2 in structure "rnt_node" dcl 150 in procedure "fast_run_unit_manager_" set ref 626 800* name 1 based char(32) level 2 in structure "common_list_node" dcl 401 in procedure "snap_ftn_links" set ref 475 500* name_length 000114 automatic fixed bin(17,0) dcl 526 set ref 553* 554 555 556 556 names based char(32) array dcl 614 ref 662 nchars 3 based fixed bin(17,0) level 2 in structure "rnt_node" dcl 150 in procedure "fast_run_unit_manager_" set ref 626 801* nchars based bit(9) level 2 in structure "name" packed unaligned dcl 2-70 in procedure "fast_run_unit_manager_" ref 553 nchars 3 based fixed bin(17,0) level 3 in structure "ext" dcl 528 in procedure "decode_ftn_link" set ref 555* 577* new_control_string 000100 automatic varying char(200) dcl 865 set ref 870* 872* 873* next_def 000152 automatic pointer level 2 dcl 124 set ref 826 nnames 0(02) based fixed bin(15,0) array level 2 packed unaligned dcl 607 ref 647 655 nonobject 0(21) based bit(1) array level 3 packed unaligned dcl 136 set ref 675* 696* 721 ntype 000112 automatic fixed bin(18,0) dcl 525 set ref 550* 552 552 559 574 null builtin function dcl 112 ref 178 179 180 181 182 184 185 186 242 249 249 257 268 298 322 336 337 337 338 338 338 350 356 358 454 457 470 498 563 578 617 623 666 666 672 672 684 713 729 734 766 804 818 844 895 895 object_info based structure level 1 dcl 1-6 object_info_$display 000166 constant entry external dcl 97 ref 198 694 object_info_version_2 constant fixed bin(17,0) initial dcl 1-60 ref 197 693 offset 7 000152 automatic fixed bin(17,0) level 2 dcl 124 set ref 823 824 824 oi 000174 automatic structure level 1 dcl 158 set ref 198 198 694 694 original_linkage_ptr 3 based pointer level 2 packed unaligned dcl 2-31 set ref 778* program_lng parameter fixed bin(24,0) dcl 30 set ref 22 198* 819* program_ptr parameter pointer dcl 29 set ref 22 198* 327* 344 819* ptr builtin function dcl 112 ref 213 492 632 899 rel builtin function dcl 112 ref 382 425 428 470 474 499 805 release_temp_segments_ 000162 constant entry external dcl 94 ref 259 reverse builtin function dcl 112 ref 619 801 rnt_node based structure level 1 dcl 150 set ref 797 rnt_p 000012 internal static pointer dcl 47 set ref 181* 623 623 735 796 797* 799 800 801 802 804 805 rp 000104 automatic pointer dcl 42 set ref 213 623* 623* 626 626 628 629* 632 632 796* 804 805 saved_fortran_io_initiated 000125 automatic bit(1) dcl 70 set ref 208* 267 saved_ftn_buffer_p 000114 automatic pointer dcl 54 set ref 207* 266 sb 000262 automatic pointer dcl 5-24 set ref 213* 214 215 scratch_area based area(255000) dcl 78 ref 373 381 384 497 502 643 652 757 797 scratch_lng 000121 automatic fixed bin(19,0) dcl 61 set ref 224* 225* 382 scratch_ptr 000010 internal static pointer array dcl 46 set ref 178* 223* 224* 225* 257 259* 367 373 381 384 497 502 637* 643 652 757 797 scu based structure level 1 dcl 7-56 in procedure "fault_tag_3_handler" scu 30 based bit(36) array level 2 in structure "mc" packed unaligned dcl 7-12 in procedure "fault_tag_3_handler" set ref 898 scup 000162 automatic pointer dcl 7-54 set ref 898* 899 899 section 1 000120 automatic char(8) level 2 in structure "ext" dcl 415 in procedure "snap_ftn_links" set ref 435 449 section 1 based char(8) level 2 in structure "ext" dcl 528 in procedure "decode_ftn_link" set ref 562* 567* 576* section 6 000152 automatic char(4) level 2 in structure "dd" dcl 124 in procedure "fast_run_unit_manager_" set ref 822 section_id 000113 automatic fixed bin(18,0) dcl 525 set ref 548* 566 575 seg_bc 000104 automatic fixed bin(24,0) dcl 605 set ref 683* 694* seg_ptr 000102 automatic pointer dcl 41 in procedure "fast_run_unit_manager_" set ref 334* 336 683* 684 690 692 694* 726* 729 seg_ptr 1 based bit(18) level 2 in structure "type_pair" packed unaligned dcl 2-25 in procedure "fast_run_unit_manager_" ref 548 560 seg_table_offset 2(18) based fixed bin(17,0) level 2 packed unaligned dcl 150 set ref 629 802* segment_number 7 based bit(18) level 3 packed unaligned dcl 2-31 set ref 779* segment_table_ptr 000016 internal static pointer dcl 49 set ref 183* 287 288 289 293 293 343 344 345 346 423 424 449 457 457 643* 644 675 680 682 685 690 690 690 692 696 701 703 705 712 713 713 720 721 726 728 753 761 762 763 766 766 segno 000112 internal static bit(18) array level 2 in structure "static_st" packed unaligned dcl 134 in procedure "fast_run_unit_manager_" set ref 190* 190* segno based bit(18) array level 2 in structure "st" packed unaligned dcl 136 in procedure "fast_run_unit_manager_" set ref 287 289 293 293 344* 682 690 692* severity parameter fixed bin(17,0) dcl 863 ref 861 867 868 st based structure array level 1 dcl 136 set ref 643 644* 690* 690 st_offset_2 parameter fixed bin(17,0) dcl 408 ref 393 423 424 449 st_offset_3 parameter fixed bin(17,0) dcl 603 set ref 588 618* 629* 665* 666* 671* 672* 709* st_offset_4 parameter fixed bin(17,0) dcl 747 ref 741 753 761 762 763 766 766 st_offset_5 parameter fixed bin(17,0) dcl 793 in procedure "add_to_rnt" ref 787 802 st_offset_5 000264 automatic fixed bin(17,0) dcl 841 in procedure "fast_run_unit_manager_" set ref 843* stack_header based structure level 1 dcl 5-26 static_isotp 000022 internal static pointer dcl 51 set ref 215* 291 771 static_length 7(18) based bit(18) level 3 packed unaligned dcl 2-31 set ref 780* static_lotp 000020 internal static pointer dcl 50 set ref 214* 290 771 static_st 000112 internal static structure array level 1 dcl 134 set ref 183 644 stats 6 based structure level 2 dcl 2-31 string 4 based char(32) level 3 dcl 528 set ref 556* substr builtin function dcl 112 set ref 485 485 556* 556 symbol 11 000152 automatic char(32) level 2 dcl 124 set ref 823 824 symbol_ptr 2 based pointer level 2 packed unaligned dcl 2-31 set ref 777* symbp 12 000174 automatic pointer level 2 dcl 158 set ref 763 777 target_st_offset 000113 automatic fixed bin(17,0) dcl 408 set ref 453* 457 457 457* temp_lote 0(19) based bit(1) array level 3 packed unaligned dcl 136 set ref 288 753* temp_object parameter bit(1) dcl 746 ref 741 754 template 2 based bit(36) array level 2 dcl 417 ref 481 504 terminating 000124 automatic bit(1) dcl 68 set ref 192* 280 281* 301* textp 2 000174 automatic pointer level 2 dcl 158 set ref 362 770 823 824 824 total_names 000033 internal static fixed bin(17,0) dcl 65 set ref 645* 647* 647 652 662 664 tpr 2 based structure level 2 packed unaligned dcl 7-56 trap_ptr 0(18) based bit(18) level 2 packed unaligned dcl 2-25 ref 568 570 tsr 2(03) based bit(15) level 3 packed unaligned dcl 7-56 ref 899 type based fixed bin(17,0) level 2 in structure "ext" dcl 528 in procedure "decode_ftn_link" set ref 550* type based bit(2) array level 2 in structure "entries" packed unaligned dcl 607 in procedure "find_entry" ref 674 type 000120 automatic fixed bin(17,0) level 2 in structure "ext" dcl 415 in procedure "snap_ftn_links" set ref 435 449 type based bit(18) level 2 in structure "type_pair" packed unaligned dcl 2-25 in procedure "fast_run_unit_manager_" ref 550 type_pair based structure level 1 dcl 2-25 type_pointer 000106 automatic pointer dcl 524 set ref 546* 547 548 550 560 560 568 570 type_ptr based bit(18) level 2 packed unaligned dcl 2-21 ref 546 value 1 based bit(18) level 2 packed unaligned dcl 3-12 ref 362 729 verify builtin function dcl 112 ref 619 801 version 2 000130 automatic fixed bin(17,0) level 2 dcl 889 set ref 894* version_number 000174 automatic fixed bin(17,0) level 2 dcl 158 set ref 197* 693* wrong_language 0(20) based bit(1) array level 3 packed unaligned dcl 136 set ref 705* 720 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. abx internal static fixed bin(17,0) initial dcl 7-42 apx internal static fixed bin(17,0) initial dcl 7-42 bbx internal static fixed bin(17,0) initial dcl 7-42 bpx internal static fixed bin(17,0) initial dcl 7-42 call_offset internal static fixed bin(17,0) initial dcl 5-78 entry_offset internal static fixed bin(17,0) initial dcl 5-78 isot based structure level 1 dcl 4-13 isot1 based structure array level 1 dcl 4-16 isotp automatic pointer dcl 4-12 lbx internal static fixed bin(17,0) initial dcl 7-42 linkage_header_flags based structure level 1 dcl 2-44 lot_fault internal static bit(36) initial dcl 4-9 lotp automatic pointer dcl 4-4 lpx internal static fixed bin(17,0) initial dcl 7-42 mcp automatic pointer dcl 7-10 push_offset internal static fixed bin(17,0) initial dcl 5-78 return_no_pop_offset internal static fixed bin(17,0) initial dcl 5-78 return_offset internal static fixed bin(17,0) initial dcl 5-78 sbx internal static fixed bin(17,0) initial dcl 7-42 scux based structure level 1 dcl 7-207 spx internal static fixed bin(17,0) initial dcl 7-42 stack_header_overlay based fixed bin(17,0) array dcl 5-94 trap_word based structure level 1 dcl 2-66 tv_offset internal static fixed bin(17,0) initial dcl 5-72 virgin_linkage_header based structure level 1 dcl 2-52 NAMES DECLARED BY EXPLICIT CONTEXT. Clean_up 000744 constant entry internal dcl 255 ref 217 238 250 add_to_rnt 004051 constant entry internal dcl 787 ref 363 666 672 824 allocate_linkage 003730 constant entry internal dcl 741 ref 351 364 709 bad_access 003301 constant label dcl 686 ref 680 bad_object 003411 constant label dcl 697 ref 721 continue_ft3 004506 constant label dcl 907 ref 896 decode_ftn_link 002335 constant entry internal dcl 513 ref 430 901 error 004246 constant entry internal dcl 861 ref 330 485 640 667 676 686 697 706 734 fast_run_unit_manager_ 000351 constant entry external dcl 22 fault_tag_3_handler 004357 constant entry internal dcl 878 ref 247 find_common_block 002106 constant entry internal dcl 467 ref 444 find_entry 002515 constant entry internal dcl 588 ref 453 843 find_entry_value 000710 constant entry external dcl 832 incomplete_set_up 000614 constant label dcl 236 ref 244 other_not_found 001204 constant label dcl 330 ref 336 process_just_compiled_entries 004132 constant entry internal dcl 811 ref 349 set_up_run_unit 001134 constant entry internal dcl 308 ref 233 snap_ftn_links 001654 constant entry internal dcl 393 ref 371 457 terminate 000677 constant label dcl 250 ref 855 911 terminate_run_entry 004235 constant entry internal dcl 851 ref 211 terminate_run_unit 001022 constant entry internal dcl 274 ref 258 wrong_lang 003465 constant label dcl 706 ref 720 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5204 5424 4523 5214 Length 6070 4523 220 430 460 122 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME fast_run_unit_manager_ 432 external procedure is an external procedure. on unit on line 217 64 on unit on unit on line 247 179 on unit Clean_up 102 internal procedure is called by several nonquick procedures. terminate_run_unit internal procedure shares stack frame of internal procedure Clean_up. set_up_run_unit internal procedure shares stack frame of external procedure fast_run_unit_manager_. snap_ftn_links 160 internal procedure calls itself recursively. find_common_block internal procedure shares stack frame of internal procedure snap_ftn_links. decode_ftn_link 80 internal procedure is called by several nonquick procedures. find_entry 143 internal procedure is called by several nonquick procedures. allocate_linkage 72 internal procedure is called by several nonquick procedures. add_to_rnt 65 internal procedure is called by several nonquick procedures. process_just_compiled_entries internal procedure shares stack frame of external procedure fast_run_unit_manager_. terminate_run_entry 64 internal procedure is assigned to an entry variable. error 128 internal procedure is called during a stack extension. fault_tag_3_handler internal procedure shares stack frame of on unit on line 247. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 scratch_ptr fast_run_unit_manager_ 000012 rnt_p fast_run_unit_manager_ 000014 clp fast_run_unit_manager_ 000016 segment_table_ptr fast_run_unit_manager_ 000020 static_lotp fast_run_unit_manager_ 000022 static_isotp fast_run_unit_manager_ 000024 eio_ptr fast_run_unit_manager_ 000026 entry_ptr fast_run_unit_manager_ 000030 n_ptr fast_run_unit_manager_ 000032 ecount fast_run_unit_manager_ 000033 total_names fast_run_unit_manager_ 000034 dir_empty fast_run_unit_manager_ 000036 language fast_run_unit_manager_ 000040 dirname fast_run_unit_manager_ 000112 static_st fast_run_unit_manager_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME Clean_up 000106 m terminate_run_unit allocate_linkage 000100 k allocate_linkage 000101 link_lng allocate_linkage 000102 linkage_section_p allocate_linkage 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 error 000100 new_control_string error fast_run_unit_manager_ 000100 blank_common_ptr fast_run_unit_manager_ 000102 seg_ptr fast_run_unit_manager_ 000104 rp fast_run_unit_manager_ 000106 definition_p fast_run_unit_manager_ 000110 main_ptr fast_run_unit_manager_ 000112 ftn_io_p fast_run_unit_manager_ 000114 saved_ftn_buffer_p fast_run_unit_manager_ 000116 max_severity fast_run_unit_manager_ 000117 i fast_run_unit_manager_ 000120 blank_length fast_run_unit_manager_ 000121 scratch_lng fast_run_unit_manager_ 000122 code fast_run_unit_manager_ 000123 dlng fast_run_unit_manager_ 000124 terminating fast_run_unit_manager_ 000125 saved_fortran_io_initiated fast_run_unit_manager_ 000126 entname fast_run_unit_manager_ 000152 dd fast_run_unit_manager_ 000174 oi fast_run_unit_manager_ 000262 sb fast_run_unit_manager_ 000264 st_offset_5 fast_run_unit_manager_ 000274 dummy_length set_up_run_unit 000276 dummy_ptr set_up_run_unit 000300 main_dir set_up_run_unit 000352 main_ename_c32 set_up_run_unit 000370 defptr process_just_compiled_entries find_entry 000100 i find_entry 000101 j find_entry 000102 k find_entry 000103 ename_length find_entry 000104 seg_bc find_entry on unit on line 247 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 snap_ftn_links 000100 link_ptr snap_ftn_links 000102 lp snap_ftn_links 000104 ep snap_ftn_links 000106 cl_node_ptr snap_ftn_links 000110 common_p snap_ftn_links 000112 dl_code snap_ftn_links 000113 target_st_offset snap_ftn_links 000114 j snap_ftn_links 000115 last_rel snap_ftn_links 000116 FT3 snap_ftn_links 000120 ext snap_ftn_links 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 tra_ext_1 bound_ck_signal enable_op shorten_stack ext_entry int_entry int_entry_desc op_alloc_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. area_ continue_to_signal_ cu_$gen_call decode_definition_ decode_definition_$init find_command_$clear find_condition_info_ fortran_io_$close_file get_definition_ get_temp_segments_ get_wdir_ hcs_$fs_get_path_name hcs_$get_max_length_seg hcs_$initiate hcs_$initiate_count hcs_$make_ptr hcs_$star_ 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_$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 22 000344 177 000356 178 000360 179 000362 180 000363 181 000364 182 000365 183 000366 184 000370 185 000371 186 000372 188 000373 189 000374 190 000375 192 000400 193 000401 197 000402 198 000404 199 000422 200 000424 201 000440 202 000443 207 000444 208 000450 210 000452 211 000453 213 000457 214 000462 215 000464 217 000466 221 000510 222 000517 223 000522 224 000545 225 000560 226 000571 227 000572 232 000575 233 000610 235 000611 236 000614 238 000620 239 000624 242 000625 243 000631 244 000645 247 000646 249 000664 250 000677 252 000703 832 000704 843 000715 844 000730 845 000741 846 000742 255 000743 257 000751 258 000755 259 000756 261 001003 266 001010 267 001014 268 001017 270 001021 274 001022 280 001023 281 001027 286 001031 287 001042 288 001050 289 001055 290 001060 291 001065 293 001066 296 001104 298 001107 301 001131 303 001133 308 001134 322 001135 323 001137 325 001145 327 001152 329 001202 330 001204 332 001233 334 001234 336 001277 337 001303 338 001333 340 001373 343 001374 344 001377 345 001404 346 001407 348 001411 349 001414 350 001415 351 001422 352 001435 355 001436 356 001463 357 001467 358 001521 359 001526 362 001533 363 001541 364 001554 367 001567 370 001577 371 001600 372 001607 373 001613 380 001623 381 001625 382 001633 384 001642 385 001651 388 001652 393 001653 410 001661 423 001663 424 001670 425 001673 428 001701 430 001712 431 001733 432 001735 434 001743 435 001744 436 001755 437 001762 438 001770 440 001772 441 001775 444 001776 445 001777 447 002004 449 002005 453 002026 454 002045 456 002056 457 002060 462 002101 464 002105 467 002106 469 002107 470 002111 474 002123 475 002124 476 002132 477 002137 478 002141 480 002145 481 002147 483 002171 485 002172 487 002227 489 002233 492 002234 496 002242 497 002245 498 002254 499 002263 500 002265 501 002271 502 002274 503 002302 504 002305 507 002333 513 002334 536 002342 537 002345 539 002355 541 002357 542 002365 543 002367 544 002375 546 002400 547 002405 548 002412 550 002420 552 002425 553 002431 554 002434 555 002436 556 002440 559 002443 560 002446 562 002451 563 002454 564 002456 566 002457 567 002462 568 002465 570 002470 572 002473 574 002474 575 002476 576 002501 577 002505 578 002506 579 002510 581 002511 583 002512 584 002513 588 002514 617 002522 618 002525 619 002526 623 002544 626 002562 628 002573 629 002575 630 002602 632 002603 634 002606 636 002611 637 002613 638 002662 639 002665 640 002670 641 002720 643 002721 644 002732 645 002735 646 002736 647 002745 648 002753 652 002755 653 002764 654 002765 655 002775 656 003011 657 003012 658 003017 659 003021 662 003023 662 003045 664 003047 665 003054 666 003060 667 003075 668 003124 671 003125 672 003133 674 003150 675 003157 676 003163 677 003212 680 003213 682 003221 683 003224 684 003270 685 003275 686 003301 687 003330 690 003331 692 003354 693 003362 694 003364 695 003402 696 003405 697 003411 698 003440 701 003441 702 003446 703 003455 704 003460 705 003463 706 003465 707 003514 709 003515 710 003531 712 003532 713 003535 716 003540 720 003541 721 003544 726 003547 728 003614 729 003647 734 003666 735 003721 737 003726 741 003727 753 003735 754 003742 756 003751 757 003754 758 003762 761 003771 762 004003 763 004006 764 004011 766 004012 770 004016 771 004023 776 004026 777 004030 778 004033 779 004035 780 004042 782 004047 787 004050 796 004056 797 004061 799 004070 800 004074 801 004100 802 004115 804 004117 805 004127 807 004131 811 004132 818 004133 819 004135 821 004147 822 004172 823 004175 824 004206 826 004230 828 004233 851 004234 855 004242 861 004245 867 004266 868 004275 869 004300 870 004304 871 004326 872 004330 873 004341 875 004356 878 004357 894 004360 895 004362 896 004402 898 004405 899 004410 901 004422 902 004444 904 004467 907 004506 908 004516 911 004517 ----------------------------------------------------------- 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