COMPILATION LISTING OF SEGMENT dfast_compile_ 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 1110.1 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 dfast_compile_: proc (edit_info_ptr, code); 12 13 /* coded 12/75 by S. E. Barr */ 14 /* modified 12/76 by M. Weaver to use version 2 compiler_source_info structure */ 15 /* Modified 28 Feb 1980 by C R Davis for new fort_options include file. */ 16 17 /* This procedure executes COMPILE command for Fortran and Basic. 18* * 19* * 1. If the following conditions are met, the segment is compiled: 20* * a. The source_segment flag is on. 21* * b. The edit_done flag is off. 22* * 23* * 2. If the compilation is successful, these changes are made: 24* * a. The current_segment is replaced with the object code. 25* * b. The current_name is set: 26* * 1) Multics convention: If the source name has a language tag, then 27* * the object name drops the language tag. ("test.basic" becomes "test") 28* * 2) If the source name did not have a language suffix, the name is set to "object". 29* * ("test" becomes "object") 30**/ 31 dcl edit_info_ptr ptr; 32 dcl code fixed bin (35); 33 34 /* automatic */ 35 36 dcl 1 fort_opt aligned like fortran_options; 37 dcl i fixed bin; 38 dcl object_length fixed bin (21); 39 dcl temp_ptr ptr; 40 41 dcl (addr, fixed, length, null, substr, unspec) builtin; 42 43 /* constant */ 44 45 46 /* external */ 47 48 49 dcl basic_$compile entry (ptr, ptr, fixed bin (21), fixed bin (35)); 50 dcl fort_$compile entry (ptr, ptr, fixed bin (21), ptr, fixed bin (35)); 51 dcl basic_$precision_length fixed bin ext ; 52 dcl dfast_error_ entry (fixed bin (35), char (*), char (*)); 53 dcl dfast_merge_ entry (bit (1) unal, ptr, fixed bin (35)); 54 dcl hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); 55 dcl hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35)); 56 57 /* based */ 58 59 dcl 1 f aligned based (edit_info_ptr) like dfast_edit_info; 60 dcl 1 c aligned like compiler_source_info; 61 dcl 1 b aligned like branch_status; 62 63 /* */ 1 1 /* BEGIN INCLUDE FILE -- dfast_edit_info.incl.pl1 1 2* written 5/75 by S.E.Barr 1 3**/ 1 4 dcl 1 dfast_edit_info aligned based (edit_info_ptr), 1 5 2 flags aligned, 1 6 3 brief_mode bit (1) unal, /* ON if short messages to be used */ 1 7 3 build_mode bit (1) unal, /* On if in build mode */ 1 8 3 source_segment bit (1) unal, /* ON if segment is source */ 1 9 3 edit_done bit (1) unal, /* ON if current segment has been edited since save */ 1 10 3 basic_system bit (1) unal, /* ON if basic, OFF if fortran */ 1 11 3 caps_mode bit (1) unal, /* ON if running in CAPS mode */ 1 12 3 dbasic bit (1) unal, /* ON if double prec basic */ 1 13 3 pad bit (29) unal, 1 14 2 system_info aligned, 1 15 3 max_seg_size fixed bin (21), /* maximum segment size in characters */ 1 16 3 user_name char (32) aligned, /* person id */ 1 17 3 tty_id char (6) unal, /* terminal id of the form "ttynnn" */ 1 18 3 current_name char (256) var aligned, /* name of current segment */ 1 19 3 current_length fixed bin (21), /* length in characters of current segment */ 1 20 3 alter_length fixed bin (21), /* length in characters of the alter segment */ 1 21 3 current_ptr ptr, /* ptr to current segment */ 1 22 3 alter_ptr ptr, 1 23 3 home_dir char (168) var, /* home directory from pit */ 1 24 3 user_id char (32) var, /* login id */ 1 25 3 project_id char (32) var, /* login home directory */ 1 26 3 source_directory char (168) aligned, /* directory of where the source was. For COMPILE. */ 1 27 3 source_entryname char (32); /* name of the source. For COMPILE. */ 1 28 1 29 /* END INCLUDE FILE -- dfast_edit_info.incl.pl1 */ 64 2 1 /* BEGIN INCLUDE ... dfast_error_codes.incl.pl1 */ 2 2 2 3 dcl error_alt_empty fixed bin (35) int static init (1)options (constant); 2 4 dcl error_max_size fixed bin (35) int static init (2)options (constant); 2 5 dcl error_cur_empty fixed bin (35) int static init (3)options (constant); 2 6 dcl error_not_saved fixed bin (35) int static init (4)options (constant); 2 7 dcl error_name_dup fixed bin (35) int static init (5)options (constant); 2 8 dcl error_long_rec fixed bin (35) int static init (6)options (constant); 2 9 dcl error_unknown_arg fixed bin (35) int static init (7)options (constant); 2 10 dcl error_no_expl fixed bin (35) int static init (8)options (constant); 2 11 dcl error_bad_name fixed bin (35) int static init (9)options (constant); 2 12 dcl error_bad_req fixed bin (35) int static init (10)options (constant); 2 13 dcl error_syntax_string fixed bin (35) int static init (11)options (constant); 2 14 dcl error_name_miss fixed bin (35) int static init (12)options (constant); 2 15 dcl error_no_comp fixed bin (35) int static init (13)options (constant); 2 16 dcl error_no_main fixed bin (35) int static init (14)options (constant); 2 17 dcl error_block_spec fixed bin (35) int static init (15)options (constant); 2 18 dcl error_obj_nop fixed bin (35) int static init (16)options (constant); 2 19 dcl error_sav_cur fixed bin (35) int static init (17)options (constant); 2 20 dcl error_bad_type fixed bin (35) int static init (18)options (constant); 2 21 dcl error_unkn_sys fixed bin (35) int static init (19)options (constant); 2 22 dcl error_no_suffix fixed bin (35) int static init (20)options (constant); 2 23 dcl error_no_nl fixed bin (35) int static init (21)options (constant); 2 24 dcl error_bad_sort fixed bin (35) int static init (22)options (constant); 2 25 dcl error_no_num fixed bin (35) int static init (23)options (constant); 2 26 dcl error_line_miss fixed bin (35) int static init (24)options (constant); 2 27 dcl error_request_miss fixed bin (35) int static init (25)options (constant); 2 28 dcl error_bad_line fixed bin (35) int static init (26)options (constant); 2 29 dcl error_no_string fixed bin (35) int static init (27)options (constant); 2 30 dcl error_line_order fixed bin (35) int static init (28)options (constant); 2 31 dcl error_max_lines fixed bin (35) int static init (29)options (constant); 2 32 dcl error_bad_pathname fixed bin (35) int static init (30)options (constant); 2 33 dcl error_access_mode fixed bin (35) int static init (31)options (constant); 2 34 dcl error_delimiter_miss fixed bin (35) int static init (32)options (constant); 2 35 dcl error_size_fixed_record fixed bin (35) int static init (33)options (constant); 2 36 dcl error_bad_rec_len fixed bin (35) int static init (34)options (constant); 2 37 dcl error_string_size fixed bin (35) int static init (35)options (constant); 2 38 dcl error_max_line_number fixed bin (35) int static init (36)options (constant); 2 39 dcl error_max_args fixed bin (35) int static init (37)options (constant); 2 40 dcl error_name_sys fixed bin (35) int static init (38)options (constant); 2 41 dcl error_dprint_map fixed bin (35) int static init (39)options (constant); 2 42 dcl error_max_num fixed bin (35) int static options (constant) init (40); 2 43 dcl error_edit_max_num fixed bin (35) int static options (constant) init (41); 2 44 dcl error_un_num_text fixed bin (35) int static options (constant) init (42); 2 45 dcl error_no_new_line fixed bin (35) int static options (constant) init (43); 2 46 2 47 /* END INCLUDE ... dfast_error_codes.incl.pl1 */ 65 3 1 /* BEGIN INCLUDE FILE ... compiler_source_info.incl.pl1 */ 3 2 /* coded in 1973 by B. Wolman */ 3 3 /* modified 12/75 by M. Weaver to include more source info */ 3 4 /* modified 12/76 by M. Weaver to include still more source info (version 2) */ 3 5 3 6 dcl 1 compiler_source_info aligned based, 3 7 2 version fixed bin, 3 8 2 given_ename char (32) var, 3 9 2 dirname char (168) var, 3 10 2 segname char (32) var, 3 11 2 date_time_modified fixed bin (71), 3 12 2 unique_id bit (36), 3 13 2 input_lng fixed bin (21), 3 14 2 input_pointer ptr; 3 15 3 16 dcl compiler_source_info_version_2 fixed bin static init (2) options (constant); 3 17 3 18 /* END INCLUDE FILE ... compiler_source_info.incl.pl1 */ 66 4 1 /* BEGIN INCLUDE FILE fort_options.incl.pl1 */ 4 2 4 3 /****^ *********************************************************** 4 4* * * 4 5* * Copyright, (C) Honeywell Information Systems Inc., 1987 * 4 6* * * 4 7* *********************************************************** */ 4 8 4 9 /****^ HISTORY COMMENTS: 4 10* 1) change(86-07-14,BWong), approve(86-07-14,MCR7382), audit(86-07-17,Ginter), 4 11* install(86-07-28,MR12.0-1105): 4 12* Fix fortran bug 473. 4 13* 2) change(87-06-23,RWaters), approve(87-06-23,MCR7703), audit(87-07-10,Huen), 4 14* install(87-08-06,MR12.1-1069): 4 15* Implemented SCP 6315: fortran error-handling argument. 4 16* END HISTORY COMMENTS */ 4 17 4 18 4 19 /* 4 20* Modified: 12 May 87 by RWaters added debug_io 4 21* Modified: 19 February 1986 by B. Wong & A. Ginter - 473.a: Correct 4 22* comments and size of pad field in fort_declared 4 23* and pad out dfast and fast bit masks to two words. 4 24* Modified: 09 October 1985 by B. Wong - 473: add VLA_auto, VLA_static, 4 25* VLA_parm, VLC, LA_auto, and LA_static. Remove VLA and LA. 4 26* Modified: 28 March 1984 by M. Mabey - Install HFP support. 4 27* Modified: 21 September 1983 by M. Mabey - correct size of pad field in fortran_declared. 4 28* Modified: 16 May 1983 by M. Mabey - add fortran_declared 4 29* Modified: 18 December 1982 by T. Oke - Add 'long_profile'. 4 30* Modified: 22 September 1982 by T. Oke - add VLA and LA 4 31* Modified: 3 May 1982 by T. Oke - add check_multiply 4 32* Modified: 06/24/81 by S. Herbst - add do_rounding & auto_zero to fast_mask and dfast_mask 4 33* Modified: 26 February 1980 by C R Davis - add fast_mask, fix dfast_mask. 4 34* Modified: 31 January 1980 by C R Davis - add stringrange. 4 35* Modified: 13 September 1979 by Paul E. Smee--add ansi_77. 4 36* Modified: 05 December 1978 by Paul E. Smee--add do_rounding, auto_zero. 4 37* Modified: 25 January 1978 by Richard A. Barnes for the loop optimizer 4 38**/ 4 39 4 40 declare 4 41 4 42 1 fortran_options aligned based, 4 43 2 use_library bit (1) unaligned, /* (1) ON if library statements will be parsed */ 4 44 2 optimize bit (1) unaligned, /* (2) ON if optimized code is to be produced */ 4 45 2 time bit (1) unaligned, /* (3) ON for compile timing */ 4 46 2 source_format unaligned, 4 47 3 has_line_numbers bit (1) unaligned, /* (4) ON if each line begins with a line number */ 4 48 3 fold bit (1) unaligned, /* (5) ON if variable names are to be folded to lowercase */ 4 49 3 card bit (1) unaligned, /* (6) ON for card format */ 4 50 3 convert bit (1) unaligned, /* (7) ON for card format to be converted */ 4 51 2 listing unaligned, 4 52 3 source bit (1) unaligned, /* (8) ON for listing of numbered source */ 4 53 3 symbol bit (1) unaligned, /* (9) ON for listing with symbol map */ 4 54 3 map bit (1) unaligned, /* (10) ON for listing with statement map */ 4 55 3 list bit (1) unaligned, /* (11) ON for listing with assembler instructions */ 4 56 2 error_messages unaligned, 4 57 3 brief bit (1) unaligned, /* (12) ON for brief error messages */ 4 58 3 severity fixed bin (3), /* (13-16) suppresses messages below this severity */ 4 59 2 debugging unaligned, 4 60 3 subscriptrange bit (1) unaligned, /* (17) ON for subscript range checking */ 4 61 3 stringrange bit (1) unaligned, /* (18) ON for string range checking */ 4 62 3 brief_table bit (1) unaligned, /* (19) ON for statement table */ 4 63 3 table bit (1) unaligned, /* (20) ON for statement and symbol table */ 4 64 3 profile bit (1) unaligned, /* (21) ON to generate code to meter statements */ 4 65 3 check bit (1) unaligned, /* (22) ON for syntactic and semantic checking only */ 4 66 2 system_debugging unaligned, 4 67 3 stop_after_cg bit (1) unaligned, /* (23) ON if debug stop after code generator */ 4 68 3 stop_after_parse bit (1) unaligned, /* (24) ON if debug stop after parse */ 4 69 2 relocatable bit (1) unaligned, /* (25) ON if relocatable object segment generated */ 4 70 2 optimizing unaligned, 4 71 3 time_optimizer bit (1) unaligned, /* (26) ON if timings for optimizer requested */ 4 72 /* (27) ON if optimizer can loosen safety constraints */ 4 73 3 ignore_articulation_blocks bit (1) unaligned, 4 74 3 consolidate bit(1) unaligned, /* (28) ON if optimizer should run consolidation phase */ 4 75 2 do_rounding bit(1) unaligned, /* (29) ON if floating point round should be used */ 4 76 2 auto_zero bit(1) unaligned, /* (30) ON if auto storage should be zeroed when allocated */ 4 77 2 ansi_77 bit (1) unaligned, /* (31) ON if ansi77 rules are to be followed */ 4 78 2 check_multiply bit (1) unaligned, /* (32) ON if check integer multiply extent */ 4 79 2 VLA_auto bit (1) unaligned, /* (33) ON if auto VLA's being done */ 4 80 2 VLA_parm bit (1) unaligned, /* (34) ON if parm VLA's being done */ 4 81 2 VLA_static bit (1) unaligned, /* (35) ON if static VLA's being done */ 4 82 2 VLC bit (1) unaligned, /* (36) ON if VLC's being done */ 4 83 2 LA_auto bit (1) unaligned, /* (1) ON if auto LA's being done */ 4 84 2 LA_static bit (1) unaligned, /* (2) ON if static LA's being done */ 4 85 2 long_profile bit (1) unaligned, /* (3) ON to generate long_profile */ 4 86 2 static_storage bit (1) unaligned, /* (4) ON if static storage */ 4 87 2 hfp bit (1) unaligned, /* (5) ON if using hex floating point math */ 4 88 2 debug_io bit (1) unaligned, /* (6) */ 4 89 2 pad bit(30) unaligned; /* (7-36) Pad bits */ 4 90 4 91 declare 4 92 4 93 1 fortran_declared aligned based, 4 94 2 ansi66 bit(1) unaligned, /* (1) First word */ 4 95 2 ansi77 bit(1) unaligned, /* (2) */ 4 96 2 auto bit(1) unaligned, /* (3) */ 4 97 2 auto_zero bit(1) unaligned, /* (4) */ 4 98 2 brief bit(1) unaligned, /* (5) */ 4 99 2 binary_floating_point bit(1) unaligned, /* (6) */ 4 100 2 brief_table bit(1) unaligned, /* (7) */ 4 101 2 card bit(1) unaligned, /* (8) */ 4 102 2 check bit(1) unaligned, /* (9) */ 4 103 2 check_multiply bit(1) unaligned, /* (10) */ 4 104 2 consolidate bit(1) unaligned, /* (11) */ 4 105 2 debug bit(1) unaligned, /* (12) */ 4 106 2 debug_cg bit(1) unaligned, /* (13) */ 4 107 2 debug_io bit(1) unaligned, /* (14) */ 4 108 2 default_full bit(1) unaligned, /* (15) */ 4 109 2 default_safe bit(1) unaligned, /* (16) */ 4 110 2 fold bit(1) unaligned, /* (17) */ 4 111 2 free bit(1) unaligned, /* (18) */ 4 112 2 full_optimize bit(1) unaligned, /* (19) */ 4 113 2 hexadecimal_floating_point bit(1) unaligned, 4 114 /* (20) */ 4 115 2 la_auto bit(1) unaligned, /* (21) */ 4 116 2 la_static bit(1) unaligned, /* (22) */ 4 117 2 large_array bit(1) unaligned, /* (23) */ 4 118 2 line_numbers bit(1) unaligned, /* (24) */ 4 119 2 list bit(1) unaligned, /* (25) */ 4 120 2 long bit(1) unaligned, /* (26) */ 4 121 2 long_profile bit(1) unaligned, /* (27) */ 4 122 2 map bit(1) unaligned, /* (28) */ 4 123 2 no_auto_zero bit(1) unaligned, /* (29) */ 4 124 2 no_check bit(1) unaligned, /* (30) */ 4 125 2 no_fold bit(1) unaligned, /* (31) */ 4 126 2 no_large_array bit(1) unaligned, /* (32) */ 4 127 2 no_line_numbers bit(1) unaligned, /* (33) */ 4 128 2 no_map bit(1) unaligned, /* (34) */ 4 129 2 no_optimize bit(1) unaligned, /* (35) */ 4 130 2 no_check_multiply bit(1) unaligned, /* (36) */ 4 131 2 no_debug_io bit(1) unal, /* (1) Second Word */ 4 132 2 no_stringrange bit(1) unaligned, /* (2) */ 4 133 2 no_subscriptrange bit(1) unaligned, /* (3) */ 4 134 2 no_table bit(1) unaligned, /* (4) */ 4 135 2 no_very_large_array bit(1) unaligned, /* (5) */ 4 136 2 no_vla_parm bit(1) unaligned, /* (6) */ 4 137 2 no_version bit(1) unaligned, /* (7) */ 4 138 2 non_relocatable bit(1) unaligned, /* (8) */ 4 139 2 optimize bit(1) unaligned, /* (9) */ 4 140 2 profile bit(1) unaligned, /* (10) */ 4 141 2 relocatable bit(1) unaligned, /* (11) */ 4 142 2 round bit(1) unaligned, /* (12) */ 4 143 2 safe_optimize bit(1) unaligned, /* (13) */ 4 144 2 severity fixed bin(3) unaligned, /* (14-16) */ 4 145 2 static bit(1) unaligned, /* (17) */ 4 146 2 stringrange bit(1) unaligned, /* (18) */ 4 147 2 subscriptrange bit(1) unaligned, /* (19) */ 4 148 2 table bit(1) unaligned, /* (20) */ 4 149 2 time bit(1) unaligned, /* (21) */ 4 150 2 time_ot bit(1) unaligned, /* (22) */ 4 151 2 top_down bit(1) unaligned, /* (23) */ 4 152 2 truncate bit(1) unaligned, /* (24) */ 4 153 2 version bit(1) unaligned, /* (25) */ 4 154 2 very_large_array bit(1) unaligned, /* (26) */ 4 155 2 very_large_common bit(1) unaligned, /* (27) */ 4 156 2 vla_auto bit(1) unaligned, /* (28) */ 4 157 2 vla_parm bit(1) unaligned, /* (29) */ 4 158 2 vla_static bit(1) unaligned, /* (30) */ 4 159 2 pad bit(6) unaligned; /* (31-36) */ 4 160 4 161 4 162 declare /* Options used by DFAST */ 4 163 4 164 dfast_mask bit (72) internal static options (constant) initial ("100110000000000010100000000011"b); 4 165 /* use_library, has_line_numbers, fold, subscriptrange, brief_table */ 4 166 4 167 4 168 declare /* Options used by FAST */ 4 169 4 170 fast_mask bit (72) internal static options (constant) initial ("000100000000000010100000000011"b); 4 171 /* has_line_numbers, subscriptrange, brief_table */ 4 172 4 173 /* END INCLUDE FILE fort_options.incl.pl1 */ 67 5 1 declare /* Structure returned by hcs_$status_long */ 5 2 5 3 1 branch_status aligned, /* automatic: hcs_$status uses a pointer */ 5 4 5 5 2 type bit(2) unaligned, /* type of entry: link, segment, dir */ 5 6 2 number_names bit(16) unaligned, /* unused by directory_status_ */ 5 7 2 names_rel_pointer bit(18) unaligned, /* unused by directory_status_ */ 5 8 2 date_time_modified bit(36) unaligned, /* date time modified */ 5 9 2 date_time_used bit(36) unaligned, /* date time entry used */ 5 10 2 mode bit(5) unaligned, /* effective access of caller */ 5 11 2 raw_mode bit(5) unaligned, 5 12 2 pad1 bit(8) unaligned, 5 13 2 records bit(18) unaligned, /* number of records in use */ 5 14 2 date_time_dumped bit(36) unaligned, /* date time last dumped */ 5 15 2 date_time_entry_modified bit(36) unaligned, /* date time entry modified */ 5 16 2 lvid bit(36) unaligned, /* logical volume id */ 5 17 2 current_length bit(12) unaligned, /* number of blocks currently allocated */ 5 18 2 bit_count bit(24) unaligned, /* bit count of entry */ 5 19 2 pad3 bit(8) unaligned, 5 20 2 copy_switch bit(1) unaligned, /* the copy switch */ 5 21 2 tpd bit(1) unaligned, /* transparent to paging device */ 5 22 2 mdir bit(1) unaligned, /* master directory switch */ 5 23 2 damaged_switch bit (1) unaligned, /* true if contents damaged */ 5 24 2 synchronized_switch bit (1) unaligned, /* true if a DM synchronized file */ 5 25 2 pad4 bit(5) unaligned, 5 26 2 ring_brackets (0:2) bit(6) unaligned, /* branch ring brackets */ 5 27 2 unique_id bit(36) unaligned, /* entry unique id */ 5 28 5 29 5 30 /* The types of each class of branch */ 5 31 segment_type bit(2) aligned internal static initial ("01"b), 5 32 directory_type bit(2) aligned internal static initial ("10"b), 5 33 msf_type bit(2) aligned internal static initial ("10"b), /* will eventually be different */ 5 34 link_type bit(2) aligned internal static initial ("00"b); 5 35 5 36 68 69 70 /* */ 71 if ^f.source_segment then code = error_obj_nop; 72 else do; 73 if f.alter_length > 0 then call dfast_merge_ ("0"b, edit_info_ptr, code); 74 75 if code = 0 then do; 76 if f.edit_done then code = error_sav_cur; 77 else do; 78 call hcs_$status_long ((f.source_directory), (f.source_entryname), 1, addr (b), null, code); 79 if code = 0 then do; 80 call hcs_$truncate_seg (f.alter_ptr, 0, code); 81 if code = 0 then do; 82 c.version = compiler_source_info_version_2; 83 c.input_pointer = f.current_ptr; 84 c.input_lng = f.current_length; 85 c.dirname = f.source_directory; 86 c.segname = f.source_entryname; 87 c.given_ename = f.source_entryname; 88 c.date_time_modified = fixed (b.date_time_modified || (16) "0"b, 71); 89 c.unique_id = b.unique_id; 90 if f.basic_system then do; 91 if f.dbasic then basic_$precision_length = 2; 92 else basic_$precision_length = 1; 93 call basic_$compile (addr (c), f.alter_ptr, object_length, code); 94 call switch_buffers (".basic"); 95 end; 96 else do; 97 unspec (fort_opt) = dfast_mask; 98 call fort_$compile (addr (c), f.alter_ptr, object_length, addr( fort_opt), code); 99 call switch_buffers (".fortran"); 100 end; 101 end; 102 end; 103 end; 104 end; 105 end; 106 107 if code ^= 0 then call dfast_error_ (code, "compile", (f.current_name)); 108 109 return; 110 111 /* */ 112 switch_buffers: proc (language); 113 114 dcl language char (*); 115 116 dcl len fixed bin; /* length of language */ 117 118 if code = 0 then do; 119 temp_ptr = f.alter_ptr; 120 f.alter_ptr = f.current_ptr; 121 f.current_ptr = temp_ptr; 122 len = length (language); 123 i = length (f.current_name); 124 f.current_name = "object"; 125 if i >= len + 1 then do; 126 if substr (c.segname, i-len+1,len) = language 127 then f.current_name = substr (c.segname, 1, i-len); 128 end; 129 f.current_length = object_length * 4; 130 f.source_segment = "0"b; 131 end; 132 133 return; 134 135 end switch_buffers; 136 137 end dfast_compile_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 08/06/87 1047.0 dfast_compile_.pl1 >spec>install>MR12.1-1069>dfast_compile_.pl1 64 1 03/27/82 0439.4 dfast_edit_info.incl.pl1 >ldd>include>dfast_edit_info.incl.pl1 65 2 03/27/82 0439.4 dfast_error_codes.incl.pl1 >ldd>include>dfast_error_codes.incl.pl1 66 3 03/10/77 1345.4 compiler_source_info.incl.pl1 >ldd>include>compiler_source_info.incl.pl1 67 4 08/06/87 1045.4 fort_options.incl.pl1 >spec>install>MR12.1-1069>fort_options.incl.pl1 68 5 11/22/82 0955.6 branch_status.incl.pl1 >ldd>include>branch_status.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 41 ref 78 78 93 93 98 98 98 98 alter_length 117 based fixed bin(21,0) level 3 dcl 59 ref 73 alter_ptr 122 based pointer level 3 dcl 59 set ref 80* 93* 98* 119 120* b 000212 automatic structure level 1 dcl 61 set ref 78 78 basic_$compile 000010 constant entry external dcl 49 ref 93 basic_$precision_length 000014 external static fixed bin(17,0) dcl 51 set ref 91* 92* basic_system 0(04) based bit(1) level 3 packed unaligned dcl 59 ref 90 branch_status 000224 automatic structure level 1 dcl 5-1 c 000106 automatic structure level 1 dcl 60 set ref 93 93 98 98 code parameter fixed bin(35,0) dcl 32 set ref 11 71* 73* 75 76* 78* 79 80* 81 93* 98* 107 107* 118 compiler_source_info based structure level 1 dcl 3-6 compiler_source_info_version_2 constant fixed bin(17,0) initial dcl 3-16 ref 82 current_length 116 based fixed bin(21,0) level 3 dcl 59 set ref 84 129* current_name 15 based varying char(256) level 3 dcl 59 set ref 107 123 124* 126* current_ptr 120 based pointer level 3 dcl 59 set ref 83 120 121* date_time_modified 1 000212 automatic bit(36) level 2 in structure "b" packed unaligned dcl 61 in procedure "dfast_compile_" set ref 88 date_time_modified 76 000106 automatic fixed bin(71,0) level 2 in structure "c" dcl 60 in procedure "dfast_compile_" set ref 88* dbasic 0(06) based bit(1) level 3 packed unaligned dcl 59 ref 91 dfast_edit_info based structure level 1 dcl 1-4 dfast_error_ 000016 constant entry external dcl 52 ref 107 dfast_mask 000000 constant bit(72) initial unaligned dcl 4-162 ref 97 dfast_merge_ 000020 constant entry external dcl 53 ref 73 dirname 12 000106 automatic varying char(168) level 2 dcl 60 set ref 85* edit_done 0(03) based bit(1) level 3 packed unaligned dcl 59 ref 76 edit_info_ptr parameter pointer dcl 31 set ref 11 71 73 73* 76 78 78 80 83 84 85 86 87 90 91 93 98 107 119 120 120 121 123 124 126 129 130 error_obj_nop constant fixed bin(35,0) initial dcl 2-18 ref 71 error_sav_cur constant fixed bin(35,0) initial dcl 2-19 ref 76 f based structure level 1 dcl 59 fixed builtin function dcl 41 ref 88 flags based structure level 2 dcl 59 fort_$compile 000012 constant entry external dcl 50 ref 98 fort_opt 000100 automatic structure level 1 dcl 36 set ref 97* 98 98 fortran_options based structure level 1 dcl 4-40 given_ename 1 000106 automatic varying char(32) level 2 dcl 60 set ref 87* hcs_$status_long 000022 constant entry external dcl 54 ref 78 hcs_$truncate_seg 000024 constant entry external dcl 55 ref 80 i 000102 automatic fixed bin(17,0) dcl 37 set ref 123* 125 126 126 input_lng 101 000106 automatic fixed bin(21,0) level 2 dcl 60 set ref 84* input_pointer 102 000106 automatic pointer level 2 dcl 60 set ref 83* language parameter char unaligned dcl 114 ref 112 122 126 len 000244 automatic fixed bin(17,0) dcl 116 set ref 122* 125 126 126 126 length builtin function dcl 41 ref 122 123 null builtin function dcl 41 ref 78 78 object_length 000103 automatic fixed bin(21,0) dcl 38 set ref 93* 98* 129 segname 65 000106 automatic varying char(32) level 2 dcl 60 set ref 86* 126 126 source_directory 221 based char(168) level 3 dcl 59 ref 78 85 source_entryname 273 based char(32) level 3 dcl 59 ref 78 86 87 source_segment 0(02) based bit(1) level 3 packed unaligned dcl 59 set ref 71 130* substr builtin function dcl 41 ref 126 126 system_info 2 based structure level 2 dcl 59 temp_ptr 000104 automatic pointer dcl 39 set ref 119* 121 unique_id 100 000106 automatic bit(36) level 2 in structure "c" dcl 60 in procedure "dfast_compile_" set ref 89* unique_id 11 000212 automatic bit(36) level 2 in structure "b" packed unaligned dcl 61 in procedure "dfast_compile_" set ref 89 unspec builtin function dcl 41 set ref 97* version 000106 automatic fixed bin(17,0) level 2 dcl 60 set ref 82* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. directory_type internal static bit(2) initial dcl 5-1 error_access_mode internal static fixed bin(35,0) initial dcl 2-33 error_alt_empty internal static fixed bin(35,0) initial dcl 2-3 error_bad_line internal static fixed bin(35,0) initial dcl 2-28 error_bad_name internal static fixed bin(35,0) initial dcl 2-11 error_bad_pathname internal static fixed bin(35,0) initial dcl 2-32 error_bad_rec_len internal static fixed bin(35,0) initial dcl 2-36 error_bad_req internal static fixed bin(35,0) initial dcl 2-12 error_bad_sort internal static fixed bin(35,0) initial dcl 2-24 error_bad_type internal static fixed bin(35,0) initial dcl 2-20 error_block_spec internal static fixed bin(35,0) initial dcl 2-17 error_cur_empty internal static fixed bin(35,0) initial dcl 2-5 error_delimiter_miss internal static fixed bin(35,0) initial dcl 2-34 error_dprint_map internal static fixed bin(35,0) initial dcl 2-41 error_edit_max_num internal static fixed bin(35,0) initial dcl 2-43 error_line_miss internal static fixed bin(35,0) initial dcl 2-26 error_line_order internal static fixed bin(35,0) initial dcl 2-30 error_long_rec internal static fixed bin(35,0) initial dcl 2-8 error_max_args internal static fixed bin(35,0) initial dcl 2-39 error_max_line_number internal static fixed bin(35,0) initial dcl 2-38 error_max_lines internal static fixed bin(35,0) initial dcl 2-31 error_max_num internal static fixed bin(35,0) initial dcl 2-42 error_max_size internal static fixed bin(35,0) initial dcl 2-4 error_name_dup internal static fixed bin(35,0) initial dcl 2-7 error_name_miss internal static fixed bin(35,0) initial dcl 2-14 error_name_sys internal static fixed bin(35,0) initial dcl 2-40 error_no_comp internal static fixed bin(35,0) initial dcl 2-15 error_no_expl internal static fixed bin(35,0) initial dcl 2-10 error_no_main internal static fixed bin(35,0) initial dcl 2-16 error_no_new_line internal static fixed bin(35,0) initial dcl 2-45 error_no_nl internal static fixed bin(35,0) initial dcl 2-23 error_no_num internal static fixed bin(35,0) initial dcl 2-25 error_no_string internal static fixed bin(35,0) initial dcl 2-29 error_no_suffix internal static fixed bin(35,0) initial dcl 2-22 error_not_saved internal static fixed bin(35,0) initial dcl 2-6 error_request_miss internal static fixed bin(35,0) initial dcl 2-27 error_size_fixed_record internal static fixed bin(35,0) initial dcl 2-35 error_string_size internal static fixed bin(35,0) initial dcl 2-37 error_syntax_string internal static fixed bin(35,0) initial dcl 2-13 error_un_num_text internal static fixed bin(35,0) initial dcl 2-44 error_unkn_sys internal static fixed bin(35,0) initial dcl 2-21 error_unknown_arg internal static fixed bin(35,0) initial dcl 2-9 fast_mask internal static bit(72) initial unaligned dcl 4-168 fortran_declared based structure level 1 dcl 4-91 link_type internal static bit(2) initial dcl 5-1 msf_type internal static bit(2) initial dcl 5-1 segment_type internal static bit(2) initial dcl 5-1 NAMES DECLARED BY EXPLICIT CONTEXT. dfast_compile_ 000032 constant entry external dcl 11 switch_buffers 000370 constant entry internal dcl 112 ref 94 99 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 610 636 502 620 Length 1124 502 26 252 106 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME dfast_compile_ 248 external procedure is an external procedure. switch_buffers internal procedure shares stack frame of external procedure dfast_compile_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME dfast_compile_ 000100 fort_opt dfast_compile_ 000102 i dfast_compile_ 000103 object_length dfast_compile_ 000104 temp_ptr dfast_compile_ 000106 c dfast_compile_ 000212 b dfast_compile_ 000224 branch_status dfast_compile_ 000244 len switch_buffers THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_out_desc call_ext_out return_mac shorten_stack ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. basic_$compile dfast_error_ dfast_merge_ fort_$compile hcs_$status_long hcs_$truncate_seg THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. basic_$precision_length LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000026 71 000037 73 000047 75 000066 76 000071 78 000100 79 000151 80 000154 81 000172 82 000175 83 000177 84 000203 85 000207 86 000214 87 000221 88 000225 89 000231 90 000233 91 000236 92 000245 93 000250 94 000266 95 000273 97 000274 98 000276 99 000321 107 000326 109 000366 112 000370 118 000401 119 000404 120 000410 121 000412 122 000415 123 000417 124 000423 125 000430 126 000434 129 000456 130 000461 133 000463 ----------------------------------------------------------- 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