COMPILATION LISTING OF SEGMENT fst_run_ 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.3 mst Thu Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright (c) 1972 by Massachusetts Institute of * 5* * Technology and Honeywell Information Systems, Inc. * 6* * * 7* * * 8* ****************************************************** */ 9 10 fst_run_: proc (edit_ptr, arg_path); 11 12 /* * This procedure implements the run command. 13* * 14* * 1. If arg_path = null, the temporary text is used. 15* * 2. Otherwise the segment specified by arg_path is used. 16* * 17* * If the segment is not an object segment, it is compiled. The language suffix determines the compiler. If the 18* * compilation is successful, the object code is run. 19* * 20* * Written 3/76 by S.E. Barr 21* * Modified 12/76 by M. Weaver to use version 2 compiler_source_info 22* * Modified 02/80 by C R Davis to move fast_mask to include file. 23* * Modified 10/25/83 by C Spitzer. remove call to basic_$precision_length. 24**/ 25 dcl edit_ptr ptr; 26 dcl arg_path char (*) var; 27 28 /* automatic */ 29 30 dcl bit_count fixed bin (24); 31 dcl code fixed bin (35); 32 dcl directory char (168); 33 dcl directory_length fixed bin aligned; 34 dcl entry char (32); 35 dcl 1 f aligned like fst_edit_info based (edit_ptr); 36 dcl 1 fort_opt aligned like fortran_options; 37 dcl i fixed bin; 38 dcl main_ename char (32) var; /* main_ for FORTRAN or BASIC */ 39 dcl path char (168); 40 dcl 1 oi aligned like object_info; 41 dcl object_length fixed bin; /* word length from compilers */ 42 dcl object_bc fixed bin (24); /* bit cound for run unit */ 43 dcl object_ptr ptr; 44 dcl 1 run_flags aligned, 45 2 just_compiled bit (1) unal, 46 2 brief bit (1) unal init ("0"b), 47 2 probe bit (1) unal init ("0"b), 48 2 pad bit (33) unal init ("0"b); 49 dcl 1 s aligned like compiler_source_info; 50 dcl seg_ptr ptr; 51 52 dcl (addr, divide, fixed, index, length, null, reverse, substr, unspec, verify) builtin; 53 54 dcl cleanup condition; 55 56 /* external */ 57 58 dcl basic_$compile entry (ptr, ptr, fixed bin, fixed bin (35)); 59 dcl dfast_error_ entry (fixed bin (35), char (*), char (*)); 60 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 61 dcl fast_run_unit_manager_ entry (ptr, fixed bin (24), 1 aligned, 2 bit (1) unal, 2 bit (1) unal, 2 bit (1) unal, 2 bit (33) unal, char (*) var, fixed bin (35)); 62 dcl fort_$compile entry (ptr, ptr, fixed bin, ptr, fixed bin (35)); 63 dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); 64 dcl hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35)); 65 dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); 66 dcl hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); 67 dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); 68 dcl hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35)); 69 dcl object_info_$brief entry (ptr, fixed bin (24), ptr, fixed bin (35)); 70 1 1 /* BEGIN INCLUDE FILE ... fst_edit_info.incl.pl1 */ 1 2 1 3 dcl 1 fst_edit_info aligned based (edit_ptr), 1 4 2 pathname char (168) var, /* path last used with new, old, save command */ 1 5 2 text_ptr ptr, /* ptr to text being edited */ 1 6 2 alt_ptr ptr, /* ptr to text additions not yet included */ 1 7 2 text_length fixed bin (21), /* number of characters in text */ 1 8 2 alt_length fixed bin (21), /* number of characters in pending changes */ 1 9 2 max_seg_size fixed bin (21), /* max. number of characters per segment */ 1 10 2 working_dir char (168) var, /* path of the working directory */ 1 11 2 end_line_number fixed bin, /* value of line number of the last line */ 1 12 2 flags aligned, 1 13 3 subsystem bit (1) unal, /* ON if entered as subsystem, OFF if command */ 1 14 3 text_modified bit (1) unal, /* ON if changes since last save */ 1 15 3 basic_source bit (1) unal, /* ON if name ends with .basic */ 1 16 3 prompt bit (1) unal, /* ON if should prompt after commands */ 1 17 3 pad bit (32) unal; 1 18 1 19 /* END INCLUDE FILE ... fst_edit_info.incl.pl1 */ 71 2 1 /* BEGIN INCLUDE FILE fort_options.incl.pl1 */ 2 2 2 3 /****^ *********************************************************** 2 4* * * 2 5* * Copyright, (C) Honeywell Information Systems Inc., 1987 * 2 6* * * 2 7* *********************************************************** */ 2 8 2 9 /****^ HISTORY COMMENTS: 2 10* 1) change(86-07-14,BWong), approve(86-07-14,MCR7382), audit(86-07-17,Ginter), 2 11* install(86-07-28,MR12.0-1105): 2 12* Fix fortran bug 473. 2 13* 2) change(87-06-23,RWaters), approve(87-06-23,MCR7703), audit(87-07-10,Huen), 2 14* install(87-08-06,MR12.1-1069): 2 15* Implemented SCP 6315: fortran error-handling argument. 2 16* END HISTORY COMMENTS */ 2 17 2 18 2 19 /* 2 20* Modified: 12 May 87 by RWaters added debug_io 2 21* Modified: 19 February 1986 by B. Wong & A. Ginter - 473.a: Correct 2 22* comments and size of pad field in fort_declared 2 23* and pad out dfast and fast bit masks to two words. 2 24* Modified: 09 October 1985 by B. Wong - 473: add VLA_auto, VLA_static, 2 25* VLA_parm, VLC, LA_auto, and LA_static. Remove VLA and LA. 2 26* Modified: 28 March 1984 by M. Mabey - Install HFP support. 2 27* Modified: 21 September 1983 by M. Mabey - correct size of pad field in fortran_declared. 2 28* Modified: 16 May 1983 by M. Mabey - add fortran_declared 2 29* Modified: 18 December 1982 by T. Oke - Add 'long_profile'. 2 30* Modified: 22 September 1982 by T. Oke - add VLA and LA 2 31* Modified: 3 May 1982 by T. Oke - add check_multiply 2 32* Modified: 06/24/81 by S. Herbst - add do_rounding & auto_zero to fast_mask and dfast_mask 2 33* Modified: 26 February 1980 by C R Davis - add fast_mask, fix dfast_mask. 2 34* Modified: 31 January 1980 by C R Davis - add stringrange. 2 35* Modified: 13 September 1979 by Paul E. Smee--add ansi_77. 2 36* Modified: 05 December 1978 by Paul E. Smee--add do_rounding, auto_zero. 2 37* Modified: 25 January 1978 by Richard A. Barnes for the loop optimizer 2 38**/ 2 39 2 40 declare 2 41 2 42 1 fortran_options aligned based, 2 43 2 use_library bit (1) unaligned, /* (1) ON if library statements will be parsed */ 2 44 2 optimize bit (1) unaligned, /* (2) ON if optimized code is to be produced */ 2 45 2 time bit (1) unaligned, /* (3) ON for compile timing */ 2 46 2 source_format unaligned, 2 47 3 has_line_numbers bit (1) unaligned, /* (4) ON if each line begins with a line number */ 2 48 3 fold bit (1) unaligned, /* (5) ON if variable names are to be folded to lowercase */ 2 49 3 card bit (1) unaligned, /* (6) ON for card format */ 2 50 3 convert bit (1) unaligned, /* (7) ON for card format to be converted */ 2 51 2 listing unaligned, 2 52 3 source bit (1) unaligned, /* (8) ON for listing of numbered source */ 2 53 3 symbol bit (1) unaligned, /* (9) ON for listing with symbol map */ 2 54 3 map bit (1) unaligned, /* (10) ON for listing with statement map */ 2 55 3 list bit (1) unaligned, /* (11) ON for listing with assembler instructions */ 2 56 2 error_messages unaligned, 2 57 3 brief bit (1) unaligned, /* (12) ON for brief error messages */ 2 58 3 severity fixed bin (3), /* (13-16) suppresses messages below this severity */ 2 59 2 debugging unaligned, 2 60 3 subscriptrange bit (1) unaligned, /* (17) ON for subscript range checking */ 2 61 3 stringrange bit (1) unaligned, /* (18) ON for string range checking */ 2 62 3 brief_table bit (1) unaligned, /* (19) ON for statement table */ 2 63 3 table bit (1) unaligned, /* (20) ON for statement and symbol table */ 2 64 3 profile bit (1) unaligned, /* (21) ON to generate code to meter statements */ 2 65 3 check bit (1) unaligned, /* (22) ON for syntactic and semantic checking only */ 2 66 2 system_debugging unaligned, 2 67 3 stop_after_cg bit (1) unaligned, /* (23) ON if debug stop after code generator */ 2 68 3 stop_after_parse bit (1) unaligned, /* (24) ON if debug stop after parse */ 2 69 2 relocatable bit (1) unaligned, /* (25) ON if relocatable object segment generated */ 2 70 2 optimizing unaligned, 2 71 3 time_optimizer bit (1) unaligned, /* (26) ON if timings for optimizer requested */ 2 72 /* (27) ON if optimizer can loosen safety constraints */ 2 73 3 ignore_articulation_blocks bit (1) unaligned, 2 74 3 consolidate bit(1) unaligned, /* (28) ON if optimizer should run consolidation phase */ 2 75 2 do_rounding bit(1) unaligned, /* (29) ON if floating point round should be used */ 2 76 2 auto_zero bit(1) unaligned, /* (30) ON if auto storage should be zeroed when allocated */ 2 77 2 ansi_77 bit (1) unaligned, /* (31) ON if ansi77 rules are to be followed */ 2 78 2 check_multiply bit (1) unaligned, /* (32) ON if check integer multiply extent */ 2 79 2 VLA_auto bit (1) unaligned, /* (33) ON if auto VLA's being done */ 2 80 2 VLA_parm bit (1) unaligned, /* (34) ON if parm VLA's being done */ 2 81 2 VLA_static bit (1) unaligned, /* (35) ON if static VLA's being done */ 2 82 2 VLC bit (1) unaligned, /* (36) ON if VLC's being done */ 2 83 2 LA_auto bit (1) unaligned, /* (1) ON if auto LA's being done */ 2 84 2 LA_static bit (1) unaligned, /* (2) ON if static LA's being done */ 2 85 2 long_profile bit (1) unaligned, /* (3) ON to generate long_profile */ 2 86 2 static_storage bit (1) unaligned, /* (4) ON if static storage */ 2 87 2 hfp bit (1) unaligned, /* (5) ON if using hex floating point math */ 2 88 2 debug_io bit (1) unaligned, /* (6) */ 2 89 2 pad bit(30) unaligned; /* (7-36) Pad bits */ 2 90 2 91 declare 2 92 2 93 1 fortran_declared aligned based, 2 94 2 ansi66 bit(1) unaligned, /* (1) First word */ 2 95 2 ansi77 bit(1) unaligned, /* (2) */ 2 96 2 auto bit(1) unaligned, /* (3) */ 2 97 2 auto_zero bit(1) unaligned, /* (4) */ 2 98 2 brief bit(1) unaligned, /* (5) */ 2 99 2 binary_floating_point bit(1) unaligned, /* (6) */ 2 100 2 brief_table bit(1) unaligned, /* (7) */ 2 101 2 card bit(1) unaligned, /* (8) */ 2 102 2 check bit(1) unaligned, /* (9) */ 2 103 2 check_multiply bit(1) unaligned, /* (10) */ 2 104 2 consolidate bit(1) unaligned, /* (11) */ 2 105 2 debug bit(1) unaligned, /* (12) */ 2 106 2 debug_cg bit(1) unaligned, /* (13) */ 2 107 2 debug_io bit(1) unaligned, /* (14) */ 2 108 2 default_full bit(1) unaligned, /* (15) */ 2 109 2 default_safe bit(1) unaligned, /* (16) */ 2 110 2 fold bit(1) unaligned, /* (17) */ 2 111 2 free bit(1) unaligned, /* (18) */ 2 112 2 full_optimize bit(1) unaligned, /* (19) */ 2 113 2 hexadecimal_floating_point bit(1) unaligned, 2 114 /* (20) */ 2 115 2 la_auto bit(1) unaligned, /* (21) */ 2 116 2 la_static bit(1) unaligned, /* (22) */ 2 117 2 large_array bit(1) unaligned, /* (23) */ 2 118 2 line_numbers bit(1) unaligned, /* (24) */ 2 119 2 list bit(1) unaligned, /* (25) */ 2 120 2 long bit(1) unaligned, /* (26) */ 2 121 2 long_profile bit(1) unaligned, /* (27) */ 2 122 2 map bit(1) unaligned, /* (28) */ 2 123 2 no_auto_zero bit(1) unaligned, /* (29) */ 2 124 2 no_check bit(1) unaligned, /* (30) */ 2 125 2 no_fold bit(1) unaligned, /* (31) */ 2 126 2 no_large_array bit(1) unaligned, /* (32) */ 2 127 2 no_line_numbers bit(1) unaligned, /* (33) */ 2 128 2 no_map bit(1) unaligned, /* (34) */ 2 129 2 no_optimize bit(1) unaligned, /* (35) */ 2 130 2 no_check_multiply bit(1) unaligned, /* (36) */ 2 131 2 no_debug_io bit(1) unal, /* (1) Second Word */ 2 132 2 no_stringrange bit(1) unaligned, /* (2) */ 2 133 2 no_subscriptrange bit(1) unaligned, /* (3) */ 2 134 2 no_table bit(1) unaligned, /* (4) */ 2 135 2 no_very_large_array bit(1) unaligned, /* (5) */ 2 136 2 no_vla_parm bit(1) unaligned, /* (6) */ 2 137 2 no_version bit(1) unaligned, /* (7) */ 2 138 2 non_relocatable bit(1) unaligned, /* (8) */ 2 139 2 optimize bit(1) unaligned, /* (9) */ 2 140 2 profile bit(1) unaligned, /* (10) */ 2 141 2 relocatable bit(1) unaligned, /* (11) */ 2 142 2 round bit(1) unaligned, /* (12) */ 2 143 2 safe_optimize bit(1) unaligned, /* (13) */ 2 144 2 severity fixed bin(3) unaligned, /* (14-16) */ 2 145 2 static bit(1) unaligned, /* (17) */ 2 146 2 stringrange bit(1) unaligned, /* (18) */ 2 147 2 subscriptrange bit(1) unaligned, /* (19) */ 2 148 2 table bit(1) unaligned, /* (20) */ 2 149 2 time bit(1) unaligned, /* (21) */ 2 150 2 time_ot bit(1) unaligned, /* (22) */ 2 151 2 top_down bit(1) unaligned, /* (23) */ 2 152 2 truncate bit(1) unaligned, /* (24) */ 2 153 2 version bit(1) unaligned, /* (25) */ 2 154 2 very_large_array bit(1) unaligned, /* (26) */ 2 155 2 very_large_common bit(1) unaligned, /* (27) */ 2 156 2 vla_auto bit(1) unaligned, /* (28) */ 2 157 2 vla_parm bit(1) unaligned, /* (29) */ 2 158 2 vla_static bit(1) unaligned, /* (30) */ 2 159 2 pad bit(6) unaligned; /* (31-36) */ 2 160 2 161 2 162 declare /* Options used by DFAST */ 2 163 2 164 dfast_mask bit (72) internal static options (constant) initial ("100110000000000010100000000011"b); 2 165 /* use_library, has_line_numbers, fold, subscriptrange, brief_table */ 2 166 2 167 2 168 declare /* Options used by FAST */ 2 169 2 170 fast_mask bit (72) internal static options (constant) initial ("000100000000000010100000000011"b); 2 171 /* has_line_numbers, subscriptrange, brief_table */ 2 172 2 173 /* END INCLUDE FILE fort_options.incl.pl1 */ 72 3 1 /* BEGIN INCLUDE FILE ... object_info.incl.pl1 3 2*coded February 8, 1972 by Michael J. Spier */ 3 3 /* modified May 26, 1972 by M. Weaver */ 3 4 /* modified 15 April, 1975 by M. Weaver */ 3 5 3 6 declare 1 object_info aligned based, /* structure containing object info based, returned by object_info_ */ 3 7 2 version_number fixed bin, /* version number of current structure format (=2) */ 3 8 2 textp pointer, /* pointer to beginning of text section */ 3 9 2 defp pointer, /* pointer to beginning of definition section */ 3 10 2 linkp pointer, /* pointer to beginning of linkage section */ 3 11 2 statp pointer, /* pointer to beginning of static section */ 3 12 2 symbp pointer, /* pointer to beginning of symbol section */ 3 13 2 bmapp pointer, /* pointer to beginning of break map (may be null) */ 3 14 2 tlng fixed bin, /* length in words of text section */ 3 15 2 dlng fixed bin, /* length in words of definition section */ 3 16 2 llng fixed bin, /* length in words of linkage section */ 3 17 2 ilng fixed bin, /* length in words of static section */ 3 18 2 slng fixed bin, /* length in words of symbol section */ 3 19 2 blng fixed bin, /* length in words of break map */ 3 20 2 format, /* word containing bit flags about object type */ 3 21 3 old_format bit(1) unaligned, /* on if segment isn't in new format, i.e. has old style object map */ 3 22 3 bound bit(1) unaligned, /* on if segment is bound */ 3 23 3 relocatable bit(1) unaligned, /* on if seg has relocation info in its first symbol block */ 3 24 3 procedure bit(1) unaligned, /* on if segment is an executable object program */ 3 25 3 standard bit(1) unaligned, /* on if seg is in standard format (more than just standard map) */ 3 26 3 gate bit(1) unaligned, /* on if segment is a gate */ 3 27 3 separate_static bit(1) unaligned, /* on if static not in linkage */ 3 28 3 links_in_text bit(1) unaligned, /* on if there are threaded links in text */ 3 29 3 perprocess_static bit (1) unaligned, /* on if static is not to be per run unit */ 3 30 3 pad bit(27) unaligned, 3 31 2 entry_bound fixed bin, /* entry bound if segment is a gate */ 3 32 2 textlinkp pointer, /* ptr to first link in text */ 3 33 3 34 /* LIMIT OF BRIEF STRUCTURE */ 3 35 3 36 2 compiler char(8) aligned, /* name of processor which generated segment */ 3 37 2 compile_time fixed bin(71), /* clock reading of date/time object was generated */ 3 38 2 userid char(32) aligned, /* standard Multics id of creator of object segment */ 3 39 2 cvers aligned, /* generator version name in printable char string form */ 3 40 3 offset bit(18) unaligned, /* offset of name in words relative to base of symbol section */ 3 41 3 length bit(18) unaligned, /* length of name in characters */ 3 42 2 comment aligned, /* printable comment concerning generator or generation of segment */ 3 43 3 offset bit(18) unaligned, /* offset of comment in words relative to base of symbol section */ 3 44 3 length bit(18) unaligned, /* length of comment in characters */ 3 45 2 source_map fixed bin, /* offset, relative to base of symbol section, of source map structure */ 3 46 3 47 /* LIMIT OF DISPLAY STRUCTURE */ 3 48 3 49 2 rel_text pointer, /* pointer to text section relocation info */ 3 50 2 rel_def pointer, /* pointer to definition section relocation info */ 3 51 2 rel_link pointer, /* pointer to linkage section relocation info */ 3 52 2 rel_static pointer, /* pointer to static section relocation info */ 3 53 2 rel_symbol pointer, /* pointer to symbol section relocation info */ 3 54 2 text_boundary fixed bin, /* specifies mod of text section base boundary */ 3 55 2 static_boundary fixed bin, /* specifies mod of internal static base boundary */ 3 56 /* currently not used by system */ 3 57 2 default_truncate fixed bin, /* offset rel to symbp for binder to automatically trunc. symb sect. */ 3 58 2 optional_truncate fixed bin; /* offset rel to symbp for binder to optionally trunc. symb sect. */ 3 59 3 60 declare object_info_version_2 fixed bin int static init(2); 3 61 3 62 /* END INCLUDE FILE ... object_info.incl.pl1 */ 73 74 4 1 declare /* Structure returned by hcs_$status_long */ 4 2 4 3 1 branch_status aligned, /* automatic: hcs_$status uses a pointer */ 4 4 4 5 2 type bit(2) unaligned, /* type of entry: link, segment, dir */ 4 6 2 number_names bit(16) unaligned, /* unused by directory_status_ */ 4 7 2 names_rel_pointer bit(18) unaligned, /* unused by directory_status_ */ 4 8 2 date_time_modified bit(36) unaligned, /* date time modified */ 4 9 2 date_time_used bit(36) unaligned, /* date time entry used */ 4 10 2 mode bit(5) unaligned, /* effective access of caller */ 4 11 2 raw_mode bit(5) unaligned, 4 12 2 pad1 bit(8) unaligned, 4 13 2 records bit(18) unaligned, /* number of records in use */ 4 14 2 date_time_dumped bit(36) unaligned, /* date time last dumped */ 4 15 2 date_time_entry_modified bit(36) unaligned, /* date time entry modified */ 4 16 2 lvid bit(36) unaligned, /* logical volume id */ 4 17 2 current_length bit(12) unaligned, /* number of blocks currently allocated */ 4 18 2 bit_count bit(24) unaligned, /* bit count of entry */ 4 19 2 pad3 bit(8) unaligned, 4 20 2 copy_switch bit(1) unaligned, /* the copy switch */ 4 21 2 tpd bit(1) unaligned, /* transparent to paging device */ 4 22 2 mdir bit(1) unaligned, /* master directory switch */ 4 23 2 damaged_switch bit (1) unaligned, /* true if contents damaged */ 4 24 2 synchronized_switch bit (1) unaligned, /* true if a DM synchronized file */ 4 25 2 pad4 bit(5) unaligned, 4 26 2 ring_brackets (0:2) bit(6) unaligned, /* branch ring brackets */ 4 27 2 unique_id bit(36) unaligned, /* entry unique id */ 4 28 4 29 4 30 /* The types of each class of branch */ 4 31 segment_type bit(2) aligned internal static initial ("01"b), 4 32 directory_type bit(2) aligned internal static initial ("10"b), 4 33 msf_type bit(2) aligned internal static initial ("10"b), /* will eventually be different */ 4 34 link_type bit(2) aligned internal static initial ("00"b); 4 35 4 36 75 76 5 1 /* BEGIN INCLUDE FILE ... compiler_source_info.incl.pl1 */ 5 2 /* coded in 1973 by B. Wolman */ 5 3 /* modified 12/75 by M. Weaver to include more source info */ 5 4 /* modified 12/76 by M. Weaver to include still more source info (version 2) */ 5 5 5 6 dcl 1 compiler_source_info aligned based, 5 7 2 version fixed bin, 5 8 2 given_ename char (32) var, 5 9 2 dirname char (168) var, 5 10 2 segname char (32) var, 5 11 2 date_time_modified fixed bin (71), 5 12 2 unique_id bit (36), 5 13 2 input_lng fixed bin (21), 5 14 2 input_pointer ptr; 5 15 5 16 dcl compiler_source_info_version_2 fixed bin static init (2) options (constant); 5 17 5 18 /* END INCLUDE FILE ... compiler_source_info.incl.pl1 */ 77 78 79 80 /* */ 81 seg_ptr = null; 82 83 on cleanup begin; 84 if seg_ptr ^= null then call hcs_$terminate_noname (seg_ptr, code); 85 end; 86 87 if arg_path = "" then do; 88 path = f.pathname; 89 s.input_pointer = f.text_ptr; 90 s.input_lng = f.text_length; 91 i = index (reverse (f.pathname), ">"); 92 if i = 0 then i = 1; 93 else i = length (f.pathname) - i+ 2; 94 call compile (substr (f.pathname, i)); 95 object_bc = 36*object_length; 96 end; 97 else do; 98 path = arg_path; 99 call expand_pathname_ (path, directory, entry, code); 100 if code ^= 0 then call abort (""); 101 call hcs_$initiate_count (directory, entry, "", bit_count, 1, seg_ptr, code); 102 if seg_ptr ^= null then do; 103 oi.version_number = object_info_version_2; 104 call object_info_$brief (seg_ptr, bit_count, addr (oi), code); 105 if code = 0 then do; 106 main_ename = substr (entry, 1, length (entry) + 1 - verify (reverse (entry), " ")); 107 object_bc = bit_count; 108 run_flags.just_compiled = "0"b; 109 object_ptr = seg_ptr; 110 end; 111 else do; 112 s.input_pointer = seg_ptr; 113 s.input_lng = divide (bit_count, 9, 21, 0); 114 i = length (entry) + 1 - verify (reverse (entry), " "); 115 call compile (substr (entry, 1, i)); 116 object_bc = 36*object_length; 117 end; 118 end; 119 else do; 120 i = index (directory, " ") -1; 121 if i = -1 then i = length (directory); 122 if directory = ">" then path = ">" || entry; 123 else path = substr (directory, 1, i) || ">" || entry; 124 call dfast_error_ (code, "run", path); 125 end; 126 end; 127 128 if code = 0 then call fast_run_unit_manager_ (object_ptr, object_bc, run_flags, main_ename, code); 129 130 RETURN: 131 if seg_ptr ^= null then call hcs_$terminate_noname (seg_ptr, code); 132 return; 133 134 /* */ 135 abort: proc (message); 136 137 dcl message char (*); 138 139 140 i = index (path, " ") -1; 141 if i = -1 then i = length (path); 142 call dfast_error_ (code, "run", message || " """|| substr (path, 1, i) || """"); 143 144 goto RETURN; 145 146 end abort; 147 /* */ 148 compile: proc (name); 149 150 dcl name char (*); 151 152 code = 0; 153 s.version = compiler_source_info_version_2; 154 s.given_ename = name; 155 call hcs_$fs_get_path_name (s.input_pointer, directory, directory_length, entry, code); 156 s.dirname = substr (directory, 1, directory_length); 157 s.segname = substr (entry, 1, length (entry) + 1 - verify (reverse (entry), " ")); 158 call hcs_$status_long (directory, entry, 1, addr (branch_status), null, code); 159 s.date_time_modified = fixed (branch_status.date_time_modified || (16) "0"b, 71); 160 s.unique_id = branch_status.unique_id; 161 run_flags.just_compiled = "1"b; 162 main_ename = "main_"; 163 object_ptr = f.alt_ptr; 164 call hcs_$truncate_seg (object_ptr, 0, code); 165 166 if length (name) > 6 then do; 167 if substr (name, length (name) - 5, 6) = ".basic" then do; 168 call basic_$compile (addr (s), object_ptr, object_length, code); 169 return; 170 end; 171 else do; 172 if length (name) > 8 & substr (name, length (name) -7, 8) = ".fortran" then do; 173 unspec (fort_opt) = fast_mask; 174 call fort_$compile (addr (s), object_ptr, object_length, addr (fort_opt), code); 175 if code = 0 then call hcs_$set_bc_seg (object_ptr, object_length * 36, code); 176 return; 177 end; 178 end; 179 end; 180 181 call abort ("name must have a suffix of .basic or .fortran"); 182 183 end compile; 184 185 end fst_run_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 08/06/87 1047.1 fst_run_.pl1 >spec>install>MR12.1-1069>fst_run_.pl1 71 1 12/03/76 1658.6 fst_edit_info.incl.pl1 >ldd>include>fst_edit_info.incl.pl1 72 2 08/06/87 1045.4 fort_options.incl.pl1 >spec>install>MR12.1-1069>fort_options.incl.pl1 73 3 08/05/77 1022.5 object_info.incl.pl1 >ldd>include>object_info.incl.pl1 75 4 11/22/82 0955.6 branch_status.incl.pl1 >ldd>include>branch_status.incl.pl1 77 5 03/10/77 1345.4 compiler_source_info.incl.pl1 >ldd>include>compiler_source_info.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. addr builtin function dcl 52 ref 104 104 158 158 168 168 174 174 174 174 alt_ptr 56 based pointer level 2 dcl 35 ref 163 arg_path parameter varying char dcl 26 ref 10 87 98 basic_$compile 000010 constant entry external dcl 58 ref 168 bit_count 000100 automatic fixed bin(24,0) dcl 30 set ref 101* 104* 107 113 branch_status 000464 automatic structure level 1 dcl 4-1 set ref 158 158 brief 0(01) 000346 automatic bit(1) initial level 2 packed unaligned dcl 44 set ref 44* cleanup 000456 stack reference condition dcl 54 ref 83 code 000101 automatic fixed bin(35,0) dcl 31 set ref 84* 99* 100 101* 104* 105 124* 128 128* 130* 142* 152* 155* 158* 164* 168* 174* 175 175* compiler_source_info based structure level 1 dcl 5-6 compiler_source_info_version_2 constant fixed bin(17,0) initial dcl 5-16 ref 153 date_time_modified 76 000350 automatic fixed bin(71,0) level 2 in structure "s" dcl 49 in procedure "fst_run_" set ref 159* date_time_modified 1 000464 automatic bit(36) level 2 in structure "branch_status" packed unaligned dcl 4-1 in procedure "fst_run_" set ref 159 dfast_error_ 000012 constant entry external dcl 59 ref 124 142 directory 000102 automatic char(168) unaligned dcl 32 set ref 99* 101* 120 121 122 123 155* 156 158* directory_length 000154 automatic fixed bin(17,0) dcl 33 set ref 155* 156 dirname 12 000350 automatic varying char(168) level 2 dcl 49 set ref 156* divide builtin function dcl 52 ref 113 edit_ptr parameter pointer dcl 25 ref 10 88 89 90 91 93 94 94 163 entry 000155 automatic char(32) unaligned dcl 34 set ref 99* 101* 106 106 106 114 114 115 115 122 123 155* 157 157 157 158* expand_pathname_ 000014 constant entry external dcl 60 ref 99 f based structure level 1 dcl 35 fast_mask 000000 constant bit(72) initial unaligned dcl 2-168 ref 173 fast_run_unit_manager_ 000016 constant entry external dcl 61 ref 128 fixed builtin function dcl 52 ref 159 fort_$compile 000020 constant entry external dcl 62 ref 174 fort_opt 000166 automatic structure level 1 dcl 36 set ref 173* 174 174 fortran_options based structure level 1 dcl 2-40 fst_edit_info based structure level 1 dcl 1-3 given_ename 1 000350 automatic varying char(32) level 2 dcl 49 set ref 154* hcs_$fs_get_path_name 000022 constant entry external dcl 63 ref 155 hcs_$initiate_count 000024 constant entry external dcl 64 ref 101 hcs_$set_bc_seg 000026 constant entry external dcl 65 ref 175 hcs_$status_long 000030 constant entry external dcl 66 ref 158 hcs_$terminate_noname 000032 constant entry external dcl 67 ref 84 130 hcs_$truncate_seg 000034 constant entry external dcl 68 ref 164 i 000170 automatic fixed bin(17,0) dcl 37 set ref 91* 92 92* 93* 93 94 94 114* 115 115 120* 121 121* 123 140* 141 141* 142 index builtin function dcl 52 ref 91 120 140 input_lng 101 000350 automatic fixed bin(21,0) level 2 dcl 49 set ref 90* 113* input_pointer 102 000350 automatic pointer level 2 dcl 49 set ref 89* 112* 155* just_compiled 000346 automatic bit(1) level 2 packed unaligned dcl 44 set ref 108* 161* length builtin function dcl 52 ref 93 106 114 121 141 157 166 167 172 172 main_ename 000171 automatic varying char(32) dcl 38 set ref 106* 128* 162* message parameter char unaligned dcl 137 ref 135 142 name parameter char unaligned dcl 150 ref 148 154 166 167 167 172 172 172 null builtin function dcl 52 ref 81 84 102 130 158 158 object_bc 000343 automatic fixed bin(24,0) dcl 42 set ref 95* 107* 116* 128* object_info based structure level 1 dcl 3-6 object_info_$brief 000036 constant entry external dcl 69 ref 104 object_info_version_2 constant fixed bin(17,0) initial dcl 3-60 ref 103 object_length 000342 automatic fixed bin(17,0) dcl 41 set ref 95 116 168* 174* 175 object_ptr 000344 automatic pointer dcl 43 set ref 109* 128* 163* 164* 168* 174* 175* oi 000254 automatic structure level 1 dcl 40 set ref 104 104 pad 0(03) 000346 automatic bit(33) initial level 2 packed unaligned dcl 44 set ref 44* path 000202 automatic char(168) unaligned dcl 39 set ref 88* 98* 99* 122* 123* 124* 140 141 142 pathname based varying char(168) level 2 dcl 35 ref 88 91 93 94 94 probe 0(02) 000346 automatic bit(1) initial level 2 packed unaligned dcl 44 set ref 44* reverse builtin function dcl 52 ref 91 106 114 157 run_flags 000346 automatic structure level 1 dcl 44 set ref 128* s 000350 automatic structure level 1 dcl 49 set ref 168 168 174 174 seg_ptr 000454 automatic pointer dcl 50 set ref 81* 84 84* 101* 102 104* 109 112 130 130* segname 65 000350 automatic varying char(32) level 2 dcl 49 set ref 157* substr builtin function dcl 52 ref 94 94 106 115 115 123 142 156 157 167 172 text_length 60 based fixed bin(21,0) level 2 dcl 35 ref 90 text_ptr 54 based pointer level 2 dcl 35 ref 89 unique_id 11 000464 automatic bit(36) level 2 in structure "branch_status" packed unaligned dcl 4-1 in procedure "fst_run_" set ref 160 unique_id 100 000350 automatic bit(36) level 2 in structure "s" dcl 49 in procedure "fst_run_" set ref 160* unspec builtin function dcl 52 set ref 173* verify builtin function dcl 52 ref 106 114 157 version 000350 automatic fixed bin(17,0) level 2 dcl 49 set ref 153* version_number 000254 automatic fixed bin(17,0) level 2 dcl 40 set ref 103* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. dfast_mask internal static bit(72) initial unaligned dcl 2-162 directory_type internal static bit(2) initial dcl 4-1 fortran_declared based structure level 1 dcl 2-91 link_type internal static bit(2) initial dcl 4-1 msf_type internal static bit(2) initial dcl 4-1 segment_type internal static bit(2) initial dcl 4-1 NAMES DECLARED BY EXPLICIT CONTEXT. RETURN 000630 constant label dcl 130 ref 144 abort 000647 constant entry internal dcl 135 ref 100 181 compile 000766 constant entry internal dcl 148 ref 94 115 fst_run_ 000061 constant entry external dcl 10 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1532 1572 1337 1542 Length 2070 1337 40 262 173 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME fst_run_ 380 external procedure is an external procedure. on unit on line 83 70 on unit abort 86 internal procedure is called by several nonquick procedures. compile 118 internal procedure is called during a stack extension. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME fst_run_ 000100 bit_count fst_run_ 000101 code fst_run_ 000102 directory fst_run_ 000154 directory_length fst_run_ 000155 entry fst_run_ 000166 fort_opt fst_run_ 000170 i fst_run_ 000171 main_ename fst_run_ 000202 path fst_run_ 000254 oi fst_run_ 000342 object_length fst_run_ 000343 object_bc fst_run_ 000344 object_ptr fst_run_ 000346 run_flags fst_run_ 000350 s fst_run_ 000454 seg_ptr fst_run_ 000464 branch_status fst_run_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this_desc call_int_other_desc return_mac tra_ext_1 enable_op shorten_stack ext_entry_desc int_entry int_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. basic_$compile dfast_error_ expand_pathname_ fast_run_unit_manager_ fort_$compile hcs_$fs_get_path_name hcs_$initiate_count hcs_$set_bc_seg hcs_$status_long hcs_$terminate_noname hcs_$truncate_seg object_info_$brief NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 10 000055 44 000074 81 000102 83 000104 84 000120 85 000135 87 000136 88 000145 89 000153 90 000155 91 000161 92 000173 93 000177 94 000203 95 000227 96 000233 98 000234 99 000240 100 000264 101 000276 102 000341 103 000345 104 000347 105 000366 106 000370 107 000413 108 000415 109 000417 110 000421 112 000422 113 000424 114 000427 115 000444 116 000462 118 000466 120 000467 121 000477 122 000503 123 000523 124 000551 128 000575 130 000630 132 000645 135 000646 140 000662 141 000673 142 000677 144 000761 148 000765 152 001001 153 001003 154 001005 155 001017 156 001047 157 001060 158 001103 159 001145 160 001152 161 001154 162 001156 163 001162 164 001167 166 001203 167 001206 168 001214 169 001235 172 001236 173 001244 174 001247 175 001272 176 001313 181 001314 183 001330 ----------------------------------------------------------- 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