COMPILATION LISTING OF SEGMENT compile_block Compiled by: Multics PL/I Compiler, Release 28d, of September 14, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 10/03/83 1625.5 mst Mon 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 /* program to compile a block 12* 13* Initial Version: 16 April 1971 by BLW for Version II 14* Modified: 15 December 1972 by BLW 15* Modified: 5 October 1975 by RAB to fix 1427 16* Modified: 27 September 1976 by RAB to fix 1523 17* Modified: 15 August 1977 by RAB to fix 1654 18* Modified: 30 November 1978 by RAB to fix 1789 19* (bad storage allocation in quick begin blocks 20* contained within quick procedures) */ 21 22 compile_block: proc(pt); 23 24 dcl pt ptr; /* points at a block node */ 25 26 dcl (cg_stat$cur_block,cg_stat$text_base,cg_stat$sym_base, 27 cg_stat$prol_ent,cg_stat$root,cg_stat$cur_entry, 28 cg_stat$sym_reloc_base,cg_stat$m_s_p,cg_stat$cur_statement, 29 cg_stat$link_base,cg_stat$link_reloc_base,cg_stat$agg_temps, 30 cg_stat$profile_base) ptr ext static, 31 (cg_stat$text_pos,cg_stat$sym_pos,cg_stat$cur_level,cg_stat$profile_pos,cg_stat$map_start) fixed bin(18) ext, 32 (cg_stat$table_option,cg_stat$in_prologue,cg_stat$skip_to_label, 33 cg_stat$generate_map,cg_stat$old_id,cg_stat$profile_option,cg_stat$extended_stack) bit(1) ext; 34 35 dcl 1 cg_stat$statement_map unaligned ext, 36 2 first bit(18), 37 2 last bit(18); 38 39 dcl (bp,fp,sp,p,q,prol_save,entry_save,pl) ptr, 40 n fixed bin, 41 sym_pos fixed bin(18), 42 bt bit(9), 43 unused bit(1) aligned; 44 45 dcl (addrel,fixed,max,null,size,string) builtin; 46 47 dcl create_list entry(fixed bin) returns(ptr), 48 create_label entry(ptr,ptr,bit(3) aligned) returns(ptr), 49 (compile_block,compile_statement) entry(ptr), 50 c_a entry(fixed bin,fixed bin) returns(ptr), 51 (state_man$flush,io_op$init_ps) entry, 52 state_man$create_ms entry returns(ptr), 53 make_mod entry(fixed bin(17),fixed bin) returns(fixed bin(18)), 54 prepare_operand entry(ptr,fixed bin,bit(1) aligned) returns(ptr), 55 expmac$fill_usage entry(fixed bin(18),fixed bin(17)), 56 expmac$zero entry(fixed bin(15)), 57 expmac entry(fixed bin(15),ptr), 58 stack_temp$free_aggregates entry; 59 60 dcl ( enter_prologue init(202), 61 leave_prologue init(203), 62 tra init(169)) fixed bin(15) int static; 63 64 dcl 1 eax_ins aligned based, 65 2 offset unal bit(18); 66 67 dcl relocation bit(36) aligned based; 68 1 1 /* BEGIN INCLUDE FILE ... block.incl.pl1 */ 1 2 /* Modified 22 Ocober 1980 by M. N. Davidoff to increase max block.number to 511 */ 1 3 /* format: style3,idind30 */ 1 4 1 5 declare 1 block aligned based, 1 6 2 node_type bit (9) unaligned, 1 7 2 source_id structure unaligned, 1 8 3 file_number bit (8), 1 9 3 line_number bit (14), 1 10 3 statement_number bit (5), 1 11 2 father ptr unaligned, 1 12 2 brother ptr unaligned, 1 13 2 son ptr unaligned, 1 14 2 declaration ptr unaligned, 1 15 2 end_declaration ptr unaligned, 1 16 2 default ptr unaligned, 1 17 2 end_default ptr unaligned, 1 18 2 context ptr unaligned, 1 19 2 prologue ptr unaligned, 1 20 2 end_prologue ptr unaligned, 1 21 2 main ptr unaligned, 1 22 2 end_main ptr unaligned, 1 23 2 return_values ptr unaligned, 1 24 2 return_count ptr unaligned, 1 25 2 plio_ps ptr unaligned, 1 26 2 plio_fa ptr unaligned, 1 27 2 plio_ffsb ptr unaligned, 1 28 2 plio_ssl ptr unaligned, 1 29 2 plio_fab2 ptr unaligned, 1 30 2 block_type bit (9) unaligned, 1 31 2 prefix bit (12) unaligned, 1 32 2 like_attribute bit (1) unaligned, 1 33 2 no_stack bit (1) unaligned, 1 34 2 get_data bit (1) unaligned, 1 35 2 flush_at_call bit (1) unaligned, 1 36 2 processed bit (1) unaligned, 1 37 2 text_displayed bit (1) unaligned, 1 38 2 number fixed bin (9) unsigned unaligned, 1 39 2 free_temps dimension (3) ptr, /* these fields are used by the code generator */ 1 40 2 temp_list ptr, 1 41 2 entry_list ptr, 1 42 2 o_and_s ptr, 1 43 2 why_nonquick aligned, 1 44 3 auto_adjustable_storage bit (1) unaligned, 1 45 3 returns_star_extents bit (1) unaligned, 1 46 3 stack_extended_by_args bit (1) unaligned, 1 47 3 invoked_by_format bit (1) unaligned, 1 48 3 format_statement bit (1) unaligned, 1 49 3 io_statements bit (1) unaligned, 1 50 3 assigned_to_entry_var bit (1) unaligned, 1 51 3 condition_statements bit (1) unaligned, 1 52 3 no_owner bit (1) unaligned, 1 53 3 recursive_call bit (1) unaligned, 1 54 3 options_non_quick bit (1) unaligned, 1 55 3 options_variable bit (1) unaligned, 1 56 3 never_referenced bit (1) unaligned, 1 57 3 pad_nonquick bit (5) unaligned, 1 58 2 prologue_flag bit (1) unaligned, 1 59 2 options_main bit (1) unaligned, 1 60 2 pad bit (16) unaligned, 1 61 2 number_of_entries fixed bin (17), 1 62 2 level fixed bin (17), 1 63 2 last_auto_loc fixed bin (17), 1 64 2 symbol_block fixed bin (17), 1 65 2 entry_info fixed bin (18), 1 66 2 enter structure unaligned, 1 67 3 start fixed bin (17), 1 68 3 end fixed bin (17), 1 69 2 leave structure unaligned, 1 70 3 start fixed bin (17), 1 71 3 end fixed bin (17), 1 72 2 owner ptr; 1 73 1 74 declare max_block_number fixed bin internal static options (constant) initial (511); 1 75 1 76 /* END INCLUDE FILE ... block.incl.pl1 */ 69 2 1 /* BEGIN INCLUDE FILE ... reference.incl.pl1 */ 2 2 2 3 dcl 1 reference based aligned, 2 4 2 node_type bit(9) unaligned, 2 5 2 array_ref bit(1) unaligned, 2 6 2 varying_ref bit(1) unaligned, 2 7 2 shared bit(1) unaligned, 2 8 2 put_data_sw bit(1) unaligned, 2 9 2 processed bit(1) unaligned, 2 10 2 units fixed(3) unaligned, 2 11 2 ref_count fixed(17) unaligned, 2 12 2 c_offset fixed(24), 2 13 2 c_length fixed(24), 2 14 2 symbol ptr unaligned, 2 15 2 qualifier ptr unaligned, 2 16 2 offset ptr unaligned, 2 17 2 length ptr unaligned, 2 18 2 subscript_list ptr unaligned, 2 19 /* these fields are used by the 645 code generator */ 2 20 2 address structure unaligned, 2 21 3 base bit(3), 2 22 3 offset bit(15), 2 23 3 op bit(9), 2 24 3 no_address bit(1), 2 25 3 inhibit bit(1), 2 26 3 ext_base bit(1), 2 27 3 tag bit(6), 2 28 2 info structure unaligned, 2 29 3 address_in structure, 2 30 4 b dimension(0:7) bit(1), 2 31 4 storage bit(1), 2 32 3 value_in structure, 2 33 4 a bit(1), 2 34 4 q bit(1), 2 35 4 aq bit(1), 2 36 4 string_aq bit(1), 2 37 4 complex_aq bit(1), 2 38 4 decimal_aq bit(1), 2 39 4 b dimension(0:7) bit(1), 2 40 4 storage bit(1), 2 41 4 indicators bit(1), 2 42 4 x dimension(0:7) bit(1), 2 43 3 other structure, 2 44 4 big_offset bit(1), 2 45 4 big_length bit(1), 2 46 4 modword_in_offset bit(1), 2 47 2 data_type fixed(5) unaligned, 2 48 2 bits structure unaligned, 2 49 3 padded_ref bit(1), 2 50 3 aligned_ref bit(1), 2 51 3 long_ref bit(1), 2 52 3 forward_ref bit(1), 2 53 3 ic_ref bit(1), 2 54 3 temp_ref bit(1), 2 55 3 defined_ref bit(1), 2 56 3 evaluated bit(1), 2 57 3 allocate bit(1), 2 58 3 allocated bit(1), 2 59 3 aliasable bit(1), 2 60 3 even bit(1), 2 61 3 perm_address bit(1), 2 62 3 aggregate bit(1), 2 63 3 hit_zero bit(1), 2 64 3 dont_save bit(1), 2 65 3 fo_in_qual bit(1), 2 66 3 hard_to_load bit(1), 2 67 2 relocation bit(12) unaligned, 2 68 2 more_bits structure unaligned, 2 69 3 substr bit(1), 2 70 3 padded_for_store_ref bit(1), 2 71 3 aligned_for_store_ref bit(1), 2 72 3 mbz bit(15), 2 73 2 store_ins bit(18) unaligned; 2 74 2 75 /* END INCLUDE FILE ... reference.incl.pl1 */ 70 3 1 /* *********************************************************** 3 2* * * 3 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 3 4* * * 3 5* *********************************************************** */ 3 6 /* BEGIN INCLUDE FILE ... statement.incl.pl1 */ 3 7 /* Internal interface of the PL/I compiler */ 3 8 3 9 dcl 1 statement based aligned, 3 10 2 node_type bit(9) unaligned, 3 11 2 source_id structure unaligned, 3 12 3 file_number bit(8), 3 13 3 line_number bit(14), 3 14 3 statement_number bit(5), 3 15 2 next ptr unaligned, 3 16 2 back ptr unaligned, 3 17 2 root ptr unaligned, 3 18 2 labels ptr unaligned, 3 19 2 reference_list ptr unaligned, 3 20 2 state_list ptr unaligned, 3 21 2 reference_count fixed(17) unaligned, 3 22 2 ref_count_copy fixed(17) unaligned, 3 23 2 object structure unaligned, 3 24 3 start fixed(17), 3 25 3 finish fixed(17), 3 26 2 source structure unaligned, 3 27 3 segment fixed(11), 3 28 3 start fixed(23), 3 29 3 length fixed(11), 3 30 2 prefix bit(12) unaligned, 3 31 2 optimized bit(1) unaligned, 3 32 2 free_temps bit(1) unaligned, 3 33 2 LHS_in_RHS bit(1) unaligned, 3 34 2 statement_type bit(9) unaligned, 3 35 2 bits structure unaligned, 3 36 3 processed bit(1) unaligned, 3 37 3 put_in_profile bit(1) unaligned, 3 38 3 generated bit(1) unaligned, 3 39 3 snap bit(1) unaligned, 3 40 3 system bit(1) unaligned, 3 41 3 irreducible bit(1) unaligned, 3 42 3 checked bit(1) unaligned, 3 43 3 save_temps bit(1) unaligned, 3 44 3 suppress_warnings bit(1) unaligned, 3 45 3 force_nonquick bit(1) unaligned, 3 46 3 expanded_by_name bit(1) unaligned, 3 47 3 begins_loop bit(1) unaligned, 3 48 3 pad bit(24) unaligned; 3 49 3 50 /* END INCLUDE FILE ... statement.incl.pl1 */ 71 4 1 /* BEGIN INCLUDE FILE ... list.incl.pl1 */ 4 2 4 3 /* Modified 26 June 81 by EBush to add max_list_elements */ 4 4 4 5 4 6 dcl 1 list based aligned, 4 7 2 node_type bit(9) unaligned, 4 8 2 reserved bit(12) unaligned, 4 9 2 number fixed(14) unaligned, 4 10 2 element dimension(n refer(list.number)) ptr unaligned; 4 11 4 12 dcl max_list_elements fixed bin(17) internal static options (constant) 4 13 init(16383); 4 14 4 15 /* END INCLUDE FILE ... list.incl.pl1 */ 72 5 1 dcl 1 label based aligned, 5 2 2 node_type bit(9) unaligned, 5 3 2 source_id structure unaligned, 5 4 3 file_number bit(8), 5 5 3 line_number bit(14), 5 6 3 statement_number bit(5), 5 7 2 location fixed(17) unaligned, 5 8 2 allocated bit(1) unaligned, 5 9 2 dcl_type bit(3) unaligned, 5 10 2 reserved bit(29) unaligned, 5 11 2 array bit(1) unaligned, 5 12 2 used_as_format bit(1) unaligned, 5 13 2 used_in_goto bit(1) unaligned, 5 14 2 symbol_table bit(18) unaligned, 5 15 2 low_bound fixed(17) unaligned, 5 16 2 high_bound fixed(17) unaligned, 5 17 2 block_node ptr unaligned, 5 18 2 token ptr unaligned, 5 19 2 next ptr unaligned, 5 20 2 multi_use ptr unaligned, 5 21 2 cross_reference ptr unaligned, 5 22 2 statement ptr unaligned; 73 6 1 /* BEGIN INCLUDE FILE ... runtime_symbol.incl.pl1 ... Modified 07/79 */ 6 2 6 3 dcl 1 runtime_symbol aligned based, 6 4 2 flag unal bit(1), /* always "1"b for Version II */ 6 5 2 use_digit unal bit(1), /* if "1"b and units are half words units are really digits */ 6 6 2 array_units unal bit(2), 6 7 2 units unal bit(2), /* addressing units */ 6 8 2 type unal bit(6), /* data type */ 6 9 2 level unal bit(6), /* structure level */ 6 10 2 ndims unal bit(6), /* number of dimensions */ 6 11 2 bits unal, 6 12 3 aligned bit(1), 6 13 3 packed bit(1), 6 14 3 simple bit(1), 6 15 2 skip unal bit(1), 6 16 2 scale unal bit(8), /* arithmetic scale factor */ 6 17 2 name unal bit(18), /* rel ptr to acc name */ 6 18 2 brother unal bit(18), /* rel ptr to brother entry */ 6 19 2 father unal bit(18), /* rel ptr to father entry */ 6 20 2 son unal bit(18), /* rel ptr to son entry */ 6 21 2 address unal, 6 22 3 location bit(18), /* location in storage class */ 6 23 3 class bit(4), /* storage class */ 6 24 3 next bit(14), /* rel ptr to next of same class */ 6 25 2 size fixed bin(35), /* encoded string|arith size */ 6 26 2 offset fixed bin(35), /* encoded offset from address */ 6 27 2 virtual_org fixed bin(35), 6 28 2 bounds(1), 6 29 3 lower fixed bin(35), /* encoded lower bound */ 6 30 3 upper fixed bin(35), /* encoded upper bound */ 6 31 3 multiplier fixed bin(35); /* encoded multiplier */ 6 32 6 33 dcl 1 runtime_bound based, 6 34 2 lower fixed bin(35), 6 35 2 upper fixed bin(35), 6 36 2 multiplier fixed bin(35); 6 37 6 38 dcl 1 runtime_block aligned based, 6 39 2 flag unal bit(1), /* always "1"b for Version II */ 6 40 2 quick unal bit(1), /* "1"b if quick block */ 6 41 2 fortran unal bit(1), /* "1"b if fortran program */ 6 42 2 standard unal bit(1), /* "1"b if program has std obj segment */ 6 43 2 owner_flag unal bit(1), /* "1"b if block has valid owner field */ 6 44 2 skip unal bit(1), 6 45 2 type unal bit(6), /* = 0 for a block node */ 6 46 2 number unal bit(6), /* begin block number */ 6 47 2 start unal bit(18), /* rel ptr to start of symbols */ 6 48 2 name unal bit(18), /* rel ptr to name of proc */ 6 49 2 brother unal bit(18), /* rel ptr to brother block */ 6 50 2 father unal bit(18), /* rel ptr to father block */ 6 51 2 son unal bit(18), /* rel ptr to son block */ 6 52 2 map unal, 6 53 3 first bit(18), /* rel ptr to first word of map */ 6 54 3 last bit(18), /* rel ptr to last word of map */ 6 55 2 entry_info unal bit(18), /* info about entry of quick block */ 6 56 2 header unal bit(18), /* rel ptr to symbol header */ 6 57 2 chain(4) unal bit(18), /* chain(i) is rel ptr to first symbol 6 58* on start list with length >= 2**i */ 6 59 2 token(0:5) unal bit(18), /* token(i) is rel ptr to first token 6 60* on list with length >= 2 ** i */ 6 61 2 owner unal bit(18); /* rel ptr to owner block */ 6 62 6 63 dcl 1 runtime_token aligned based, 6 64 2 next unal bit(18), /* rel ptr to next token */ 6 65 2 dcl unal bit(18), /* rel ptr to first dcl of this token */ 6 66 2 name, /* ACC */ 6 67 3 size unal unsigned fixed bin (9), /* number of chars in token */ 6 68 3 string unal char(n refer(runtime_token.size)); 6 69 6 70 dcl 1 encoded_value aligned based, 6 71 2 flag bit (2) unal, 6 72 2 code bit (4) unal, 6 73 2 n1 bit (6) unal, 6 74 2 n2 bit (6) unal, 6 75 2 n3 bit (18) unal; 6 76 6 77 /* END INCLUDE FILE ... runtime_symbol.incl.pl1 */ 74 7 1 dcl 1 statement_map aligned based, 7 2 2 location bit(18) unaligned, 7 3 2 source_id unaligned, 7 4 3 file bit(8), 7 5 3 line bit(14), 7 6 3 statement bit(5), 7 7 2 source_info unaligned, 7 8 3 start bit(18), 7 9 3 length bit(9); 75 8 1 /* BEGIN INCLUDE FILE profile_entry.incl.pl1 */ 8 2 8 3 dcl 1 profile_entry aligned based, 8 4 2 map bit(18) unaligned, 8 5 2 skip bit(18) unaligned, 8 6 2 count fixed bin; 8 7 8 8 /* END INCLUDE FILE profile_entry.incl.pl1 */ 76 9 1 /* BEGIN INCLUDE FILE ... declare_type.incl.pl1 */ 9 2 9 3 /* Modified: 25 Apr 1979 by PCK to implement 4-bit decimal */ 9 4 9 5 dcl ( by_declare initial("001"b), 9 6 by_explicit_context initial("010"b), 9 7 by_context initial("011"b), 9 8 by_implication initial("100"b), 9 9 by_compiler initial("101"b)) int static bit(3) aligned options(constant); 9 10 9 11 /* END INCLUDE FILE ... declare_type.incl.pl1 */ 77 10 1 dcl ( root_block initial("000000001"b), 10 2 external_procedure initial("000000010"b), 10 3 internal_procedure initial("000000011"b), 10 4 begin_block initial("000000100"b), 10 5 on_unit initial("000000101"b)) internal static bit(9) aligned options(constant); 78 11 1 /* BEGIN INCLUDE FILE relbts.incl.pl1 */ 11 2 11 3 /* This include file defines the relocation bits as bit (18) entities. See 11 4* also relocation_bits.incl.pl1 and reloc_lower.incl.pl1. */ 11 5 11 6 dcl ( rc_a initial("0"b), /* absolute */ 11 7 rc_t initial("000000000000010000"b), /* text */ 11 8 rc_nt initial("000000000000010001"b), /* negative text */ 11 9 rc_lp18 initial("000000000000010010"b), /* linkage, 18 bit */ 11 10 rc_nlp18 initial("000000000000010011"b), /* negative link, 18 bit */ 11 11 rc_lp15 initial("000000000000010100"b), /* linkage, 15 bit */ 11 12 rc_dp initial("000000000000010101"b), /* def section */ 11 13 rc_s initial("000000000000010110"b), /* symbol segment */ 11 14 rc_ns initial("000000000000010111"b), /* negative symbol */ 11 15 rc_is18 initial("000000000000011000"b), /* internal static 18 */ 11 16 rc_is15 initial("000000000000011001"b), /* internal static 15 */ 11 17 rc_lb initial("000000000000011000"b), /* link block */ 11 18 rc_nlb initial("000000000000011001"b), /* negative link block */ 11 19 rc_sr initial("000000000000011010"b), /* self relative */ 11 20 rc_e initial("000000000000011111"b)) /* escape */ 11 21 bit(18) internal static options(constant); 11 22 11 23 dcl ( rc_dp_dp initial("000000000000010101000000000000010101"b), /* def section, def section */ 11 24 rc_a_dp initial("000000000000000000000000000000010101"b)) /* absolute, def section */ 11 25 bit(36) internal static options(constant); 11 26 11 27 /* END INCLUDE FILE relbts.incl.pl1 */ 79 80 81 bp = pt; 82 if bp = null then return; 83 84 bt = bp -> block.block_type; 85 if bt = begin_block 86 then do; 87 db: call compile_block((bp -> block.brother)); 88 return; 89 end; 90 91 if bt = on_unit then goto db; 92 93 goto l1; 94 95 compile_block$begin_block: entry(pt); 96 97 bp = pt; 98 bt = bp -> block.block_type; 99 100 /* since we are doing a transition from one block to another, 101* block.last_auto_loc must be up to date (fixes 1789) */ 102 103 if bp -> block.no_stack & cg_stat$cur_block -> block.no_stack 104 then do; 105 fp = cg_stat$cur_block; 106 107 do while(fp -> block.no_stack); 108 if fp -> block.owner = null 109 then fp = fp -> block.father; 110 else fp = fp -> block.owner; 111 end; 112 113 fp -> block.last_auto_loc = max(fp -> block.last_auto_loc, cg_stat$cur_block -> block.last_auto_loc); 114 end; 115 116 l1: cg_stat$cur_block, fp = bp; 117 118 if bp -> block.no_stack 119 then do; 120 121 /* get ptr to block in which storage should be allocated */ 122 123 do while(fp -> block.no_stack); 124 if fp -> block.owner = null then fp = fp -> block.father; 125 else fp = fp -> block.owner; 126 end; 127 128 bp -> block.last_auto_loc = fp -> block.last_auto_loc; 129 end; 130 131 cg_stat$cur_level = bp -> block.level; 132 133 if cg_stat$m_s_p = null then cg_stat$m_s_p = state_man$create_ms(); else call state_man$flush; 134 135 bp -> block.free_temps(1), 136 bp -> block.free_temps(2), 137 bp -> block.free_temps(3) = null; 138 139 entry_save = cg_stat$cur_entry; 140 cg_stat$cur_entry = null; 141 142 prol_save = cg_stat$prol_ent; 143 144 /* if there is only one entry to this block, we don't compile the prologue 145* sequence; the entire prologue sequence will be inserted into the 146* main sequence by compile_tree when it sees the ex_prologue operator. 147* if there is more than one entry, we must compile prologue as a closed 148* subroutine, in this case cg_stat$prol_ent will point to a dummy 149* label used to identify start of prologue. There is a different 150* label for each procedure | begin block */ 151 152 cg_stat$prol_ent = null; 153 154 p = bp -> block.prologue; 155 if p = null 156 then if bp -> block.plio_ps = null 157 then goto do_main; 158 159 if bp -> block.number_of_entries = 1 then goto do_main; 160 161 cg_stat$in_prologue = "1"b; 162 cg_stat$skip_to_label = "0"b; 163 164 if bt ^= begin_block 165 then do; 166 cg_stat$prol_ent = create_label((bp),null,by_compiler); 167 cg_stat$prol_ent -> label.location = cg_stat$text_pos; 168 cg_stat$prol_ent -> label.allocated = "1"b; 169 170 bp -> block.enter.start = cg_stat$text_pos; 171 172 n = bp -> block.last_auto_loc; 173 bp -> block.last_auto_loc = n + 1; 174 175 call expmac((enter_prologue),c_a(n,4)); 176 bp -> block.enter.end = cg_stat$text_pos; 177 end; 178 179 if bp -> block.plio_ps ^= null 180 then do; 181 if bt = begin_block then bp -> block.enter.start = cg_stat$text_pos; 182 call io_op$init_ps; 183 bp -> block.enter.end = cg_stat$text_pos; 184 end; 185 186 do while(p ^= null); 187 call compile_statement(p); 188 p = p -> statement.next; 189 end; 190 191 if bt ^= begin_block 192 then do; 193 bp -> block.leave.start = cg_stat$text_pos; 194 call expmac((leave_prologue),c_a(n,4)); 195 bp -> block.leave.end = cg_stat$text_pos; 196 call state_man$flush; 197 end; 198 199 /* initialize object map if we're generating a symbol table */ 200 201 do_main: if cg_stat$generate_map 202 then do; 203 sp = addrel(cg_stat$sym_base,bp -> block.symbol_block); 204 sp -> runtime_block.map.first = bit(fixed(cg_stat$sym_pos - 205 bp -> block.symbol_block,18),18); 206 cg_stat$old_id = "0"b; 207 end; 208 209 cg_stat$in_prologue = "0"b; 210 211 /* compile main sequence */ 212 213 p = bp -> block.main; 214 do while(p ^= null); 215 call compile_statement(p); 216 p = p -> statement.next; 217 end; 218 219 cg_stat$extended_stack = "0"b; /* fixes 1654 */ 220 221 if bp -> block.no_stack then fp -> block.last_auto_loc = 222 max(fp -> block.last_auto_loc,bp -> block.last_auto_loc); 223 224 /* free any aggregate temps that have not already been freed */ 225 226 if cg_stat$agg_temps ^= null 227 then call stack_temp$free_aggregates; 228 229 /* do son block */ 230 231 p = bp -> block.son; 232 if p ^= null 233 then do; 234 235 /* if this is a begin block, we must generate a transfer around 236* the code for internal procedures */ 237 238 if bt = begin_block 239 then do; 240 241 q = p; 242 do while(q ^= null); 243 244 if q -> block.block_type = internal_procedure 245 then do; 246 247 q = create_label((bp),null,by_compiler); 248 call expmac((tra),prepare_operand(q,1,unused)); 249 cg_stat$cur_statement -> statement.object.finish = 250 cg_stat$cur_statement -> statement.object.finish + 1; 251 goto l2; 252 end; 253 254 q = q -> block.brother; 255 end; 256 end; 257 258 l2: call compile_block(p); 259 260 if bt = begin_block 261 then if q ^= null 262 then call expmac$fill_usage(cg_stat$text_pos,(q -> label.location)); 263 264 end; 265 266 if bp -> block.no_stack 267 then do; 268 269 /* update total automatic storage used in block holding allocations 270* for this quick block. if that block is a brother, it may have 271* already been completely compiled, so we may have to fill in the 272* stack size again */ 273 274 fp -> block.last_auto_loc = max(fp -> block.last_auto_loc,bp -> block.last_auto_loc); 275 if fp -> block.processed then call fill_stack(fp); 276 end; 277 else call fill_stack(bp); 278 279 bp -> block.processed = "1"b; 280 281 chk_st: if ^ cg_stat$generate_map then goto chk_pf; 282 283 if bp = cg_stat$root 284 then do; 285 286 /* just finished root block, put dummy at end of map */ 287 288 sym_pos = cg_stat$sym_pos; 289 q = addrel(cg_stat$sym_base,sym_pos); 290 q -> statement_map.location = bit(cg_stat$text_pos,18); 291 string(q -> statement_map.source_id) = (27)"1"b; 292 addrel(cg_stat$sym_reloc_base,sym_pos) -> relocation = rc_t; 293 cg_stat$sym_pos = cg_stat$sym_pos + size(q -> statement_map); 294 cg_stat$statement_map.last = bit(cg_stat$sym_pos,18); 295 end; 296 297 sp -> runtime_block.map.last = bit(fixed(cg_stat$sym_pos - bp -> block.symbol_block,18),18); 298 299 chk_pf: if ^ cg_stat$profile_option then goto do_bro; 300 301 if bp ^= cg_stat$root then goto do_bro; 302 303 /* put dummy entry at end of profile */ 304 305 addrel(cg_stat$profile_base,cg_stat$profile_pos) -> profile_entry.map = bit(fixed(sym_pos - cg_stat$map_start,18),18); 306 307 do_bro: if bt ^= begin_block 308 then if bt ^= on_unit 309 then if bp -> block.brother ^= null 310 then call compile_block((bp -> block.brother)); 311 312 cg_stat$prol_ent = prol_save; 313 cg_stat$cur_entry = entry_save; 314 315 fill_stack: proc(blk); 316 317 dcl blk ptr; 318 319 dcl stack_size bit(18), 320 (p,q) ptr; 321 322 /* fill stack size into first instruction (eaxy) of each entry 323* in this block */ 324 325 stack_size = bit(make_mod(blk -> block.last_auto_loc,16),18); 326 p = blk -> block.entry_list; 327 328 if blk -> block_type = begin_block 329 then do; 330 p -> eax_ins.offset = stack_size; 331 return; 332 end; 333 334 do while(p ^= null); 335 q = p -> element(2) -> statement.labels -> element(2) -> reference.symbol; 336 addrel(cg_stat$text_base,q -> label.location) -> eax_ins.offset = stack_size; 337 p = p -> element(1); 338 end; 339 340 end; 341 342 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/03/83 1008.0 compile_block.pl1 >spec>on>pl128d>compile_block.pl1 69 1 08/13/81 2043.5 block.incl.pl1 >ldd>include>block.incl.pl1 70 2 07/21/80 1546.3 reference.incl.pl1 >ldd>include>reference.incl.pl1 71 3 04/07/83 1635.0 statement.incl.pl1 >ldd>include>statement.incl.pl1 72 4 08/13/81 2211.5 list.incl.pl1 >ldd>include>list.incl.pl1 73 5 05/06/74 1742.1 label.incl.pl1 >ldd>include>label.incl.pl1 74 6 11/26/79 1320.6 runtime_symbol.incl.pl1 >ldd>include>runtime_symbol.incl.pl1 75 7 05/06/74 1751.6 statement_map.incl.pl1 >ldd>include>statement_map.incl.pl1 76 8 10/30/80 1648.7 profile_entry.incl.pl1 >ldd>include>profile_entry.incl.pl1 77 9 10/25/79 1645.8 declare_type.incl.pl1 >ldd>include>declare_type.incl.pl1 78 10 05/03/76 1320.8 block_types.incl.pl1 >ldd>include>block_types.incl.pl1 79 11 10/30/80 1648.7 relbts.incl.pl1 >ldd>include>relbts.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. addrel builtin function dcl 45 ref 203 289 292 305 336 allocated 1(18) based bit(1) level 2 packed unaligned dcl 5-1 set ref 168* begin_block constant bit(9) initial dcl 10-1 ref 85 164 181 191 238 260 307 328 blk parameter pointer dcl 317 ref 315 325 326 328 block based structure level 1 dcl 1-5 block_type 24 based bit(9) level 2 packed unaligned dcl 1-5 ref 84 98 244 328 bp 000100 automatic pointer dcl 39 set ref 81* 82 84 87 97* 98 103 116 118 128 131 135 135 135 154 155 159 166 170 172 173 176 179 181 183 193 195 203 204 213 221 221 231 247 266 274 277* 279 283 297 301 307 307 brother 2 based pointer level 2 packed unaligned dcl 1-5 ref 87 254 307 307 bt 000120 automatic bit(9) unaligned dcl 39 set ref 84* 85 91 98* 164 181 191 238 260 307 307 by_compiler 000000 constant bit(3) initial dcl 9-5 set ref 166* 247* c_a 000074 constant entry external dcl 47 ref 175 175 194 194 cg_stat$agg_temps 000032 external static pointer dcl 26 ref 226 cg_stat$cur_block 000010 external static pointer dcl 26 set ref 103 105 113 116* cg_stat$cur_entry 000022 external static pointer dcl 26 set ref 139 140* 313* cg_stat$cur_level 000042 external static fixed bin(18,0) dcl 26 set ref 131* cg_stat$cur_statement 000030 external static pointer dcl 26 ref 249 249 cg_stat$extended_stack 000062 external static bit(1) unaligned dcl 26 set ref 219* cg_stat$generate_map 000054 external static bit(1) unaligned dcl 26 ref 201 281 cg_stat$in_prologue 000050 external static bit(1) unaligned dcl 26 set ref 161* 209* cg_stat$m_s_p 000026 external static pointer dcl 26 set ref 133 133* cg_stat$map_start 000046 external static fixed bin(18,0) dcl 26 ref 305 cg_stat$old_id 000056 external static bit(1) unaligned dcl 26 set ref 206* cg_stat$profile_base 000034 external static pointer dcl 26 ref 305 cg_stat$profile_option 000060 external static bit(1) unaligned dcl 26 ref 299 cg_stat$profile_pos 000044 external static fixed bin(18,0) dcl 26 ref 305 cg_stat$prol_ent 000016 external static pointer dcl 26 set ref 142 152* 166* 167 168 312* cg_stat$root 000020 external static pointer dcl 26 ref 283 301 cg_stat$skip_to_label 000052 external static bit(1) unaligned dcl 26 set ref 162* cg_stat$statement_map 000064 external static structure level 1 packed unaligned dcl 35 cg_stat$sym_base 000014 external static pointer dcl 26 ref 203 289 cg_stat$sym_pos 000040 external static fixed bin(18,0) dcl 26 set ref 204 288 293* 293 294 297 cg_stat$sym_reloc_base 000024 external static pointer dcl 26 ref 292 cg_stat$text_base 000012 external static pointer dcl 26 ref 336 cg_stat$text_pos 000036 external static fixed bin(18,0) dcl 26 set ref 167 170 176 181 183 193 195 260* 290 compile_block 000070 constant entry external dcl 47 ref 87 258 307 compile_statement 000072 constant entry external dcl 47 ref 187 215 create_label 000066 constant entry external dcl 47 ref 166 247 eax_ins based structure level 1 dcl 64 element 1 based pointer array level 2 packed unaligned dcl 4-6 ref 335 335 337 end 52(18) based fixed bin(17,0) level 3 in structure "block" packed unaligned dcl 1-5 in procedure "compile_block" set ref 195* end 51(18) based fixed bin(17,0) level 3 in structure "block" packed unaligned dcl 1-5 in procedure "compile_block" set ref 176* 183* enter 51 based structure level 2 packed unaligned dcl 1-5 enter_prologue constant fixed bin(15,0) initial dcl 60 ref 175 entry_list 36 based pointer level 2 dcl 1-5 ref 326 entry_save 000114 automatic pointer dcl 39 set ref 139* 313 expmac 000112 constant entry external dcl 47 ref 175 194 248 expmac$fill_usage 000110 constant entry external dcl 47 ref 260 father 1 based pointer level 2 packed unaligned dcl 1-5 ref 108 124 finish 10(18) based fixed bin(17,0) level 3 packed unaligned dcl 3-9 set ref 249* 249 first 3 based bit(18) level 3 packed unaligned dcl 6-38 set ref 204* fixed builtin function dcl 45 ref 204 297 305 fp 000102 automatic pointer dcl 39 set ref 105* 107 108 108* 108 110* 110 113 113 116* 123 124 124* 124 125* 125 128 221 221 274 274 275 275* free_temps 26 based pointer array level 2 dcl 1-5 set ref 135* 135* 135* internal_procedure constant bit(9) initial dcl 10-1 ref 244 io_op$init_ps 000100 constant entry external dcl 47 ref 182 label based structure level 1 dcl 5-1 labels 4 based pointer level 2 packed unaligned dcl 3-9 ref 335 last 0(18) 000064 external static bit(18) level 2 in structure "cg_stat$statement_map" packed unaligned dcl 35 in procedure "compile_block" set ref 294* last 3(18) based bit(18) level 3 in structure "runtime_block" packed unaligned dcl 6-38 in procedure "compile_block" set ref 297* last_auto_loc 46 based fixed bin(17,0) level 2 dcl 1-5 set ref 113* 113 113 128* 128 172 173* 221* 221 221 274* 274 274 325* leave 52 based structure level 2 packed unaligned dcl 1-5 leave_prologue constant fixed bin(15,0) initial dcl 60 ref 194 level 45 based fixed bin(17,0) level 2 dcl 1-5 ref 131 list based structure level 1 dcl 4-6 location 1 based fixed bin(17,0) level 2 in structure "label" packed unaligned dcl 5-1 in procedure "compile_block" set ref 167* 260 336 location based bit(18) level 2 in structure "statement_map" packed unaligned dcl 7-1 in procedure "compile_block" set ref 290* main 13 based pointer level 2 packed unaligned dcl 1-5 ref 213 make_mod 000104 constant entry external dcl 47 ref 325 map 3 based structure level 2 in structure "runtime_block" packed unaligned dcl 6-38 in procedure "compile_block" map based bit(18) level 2 in structure "profile_entry" packed unaligned dcl 8-3 in procedure "compile_block" set ref 305* max builtin function dcl 45 ref 113 221 274 n 000116 automatic fixed bin(17,0) dcl 39 set ref 172* 173 175* 175* 194* 194* next 1 based pointer level 2 packed unaligned dcl 3-9 ref 188 216 no_stack 24(22) based bit(1) level 2 packed unaligned dcl 1-5 ref 103 103 107 118 123 221 266 null builtin function dcl 45 ref 82 108 124 133 135 140 152 155 155 166 166 179 186 214 226 232 242 247 247 260 307 334 number_of_entries 44 based fixed bin(17,0) level 2 dcl 1-5 ref 159 object 10 based structure level 2 packed unaligned dcl 3-9 offset based bit(18) level 2 packed unaligned dcl 64 set ref 330* 336* on_unit constant bit(9) initial dcl 10-1 ref 91 307 owner 54 based pointer level 2 dcl 1-5 ref 108 110 124 125 p 000132 automatic pointer dcl 319 in procedure "fill_stack" set ref 326* 330 334 335 337* 337 p 000106 automatic pointer dcl 39 in procedure "compile_block" set ref 154* 155 186 187* 188* 188 213* 214 215* 216* 216 231* 232 241 258* plio_ps 17 based pointer level 2 packed unaligned dcl 1-5 ref 155 179 prepare_operand 000106 constant entry external dcl 47 ref 248 248 processed 24(25) based bit(1) level 2 packed unaligned dcl 1-5 set ref 275 279* profile_entry based structure level 1 dcl 8-3 prol_save 000112 automatic pointer dcl 39 set ref 142* 312 prologue 11 based pointer level 2 packed unaligned dcl 1-5 ref 154 pt parameter pointer dcl 24 ref 22 81 95 97 q 000110 automatic pointer dcl 39 in procedure "compile_block" set ref 241* 242 244 247* 248* 248* 254* 254 260 260 289* 290 291 293 q 000134 automatic pointer dcl 319 in procedure "fill_stack" set ref 335* 336 rc_t constant bit(18) initial unaligned dcl 11-6 ref 292 reference based structure level 1 dcl 2-3 relocation based bit(36) dcl 67 set ref 292* runtime_block based structure level 1 dcl 6-38 size builtin function dcl 45 ref 293 son 3 based pointer level 2 packed unaligned dcl 1-5 ref 231 source_id 0(18) based structure level 2 packed unaligned dcl 7-1 set ref 291* sp 000104 automatic pointer dcl 39 set ref 203* 204 297 stack_size 000130 automatic bit(18) unaligned dcl 319 set ref 325* 330 336 stack_temp$free_aggregates 000114 constant entry external dcl 47 ref 226 start 52 based fixed bin(17,0) level 3 in structure "block" packed unaligned dcl 1-5 in procedure "compile_block" set ref 193* start 51 based fixed bin(17,0) level 3 in structure "block" packed unaligned dcl 1-5 in procedure "compile_block" set ref 170* 181* state_man$create_ms 000102 constant entry external dcl 47 ref 133 state_man$flush 000076 constant entry external dcl 47 ref 133 196 statement based structure level 1 dcl 3-9 statement_map based structure level 1 dcl 7-1 set ref 293 string builtin function dcl 45 set ref 291* sym_pos 000117 automatic fixed bin(18,0) dcl 39 set ref 288* 289 292 305 symbol 3 based pointer level 2 packed unaligned dcl 2-3 ref 335 symbol_block 47 based fixed bin(17,0) level 2 dcl 1-5 ref 203 204 297 tra constant fixed bin(15,0) initial dcl 60 ref 248 unused 000121 automatic bit(1) dcl 39 set ref 248* 248* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. by_context internal static bit(3) initial dcl 9-5 by_declare internal static bit(3) initial dcl 9-5 by_explicit_context internal static bit(3) initial dcl 9-5 by_implication internal static bit(3) initial dcl 9-5 cg_stat$link_base external static pointer dcl 26 cg_stat$link_reloc_base external static pointer dcl 26 cg_stat$table_option external static bit(1) unaligned dcl 26 create_list 000000 constant entry external dcl 47 encoded_value based structure level 1 dcl 6-70 expmac$zero 000000 constant entry external dcl 47 external_procedure internal static bit(9) initial dcl 10-1 max_block_number internal static fixed bin(17,0) initial dcl 1-74 max_list_elements internal static fixed bin(17,0) initial dcl 4-12 pl automatic pointer dcl 39 rc_a internal static bit(18) initial unaligned dcl 11-6 rc_a_dp internal static bit(36) initial unaligned dcl 11-23 rc_dp internal static bit(18) initial unaligned dcl 11-6 rc_dp_dp internal static bit(36) initial unaligned dcl 11-23 rc_e internal static bit(18) initial unaligned dcl 11-6 rc_is15 internal static bit(18) initial unaligned dcl 11-6 rc_is18 internal static bit(18) initial unaligned dcl 11-6 rc_lb internal static bit(18) initial unaligned dcl 11-6 rc_lp15 internal static bit(18) initial unaligned dcl 11-6 rc_lp18 internal static bit(18) initial unaligned dcl 11-6 rc_nlb internal static bit(18) initial unaligned dcl 11-6 rc_nlp18 internal static bit(18) initial unaligned dcl 11-6 rc_ns internal static bit(18) initial unaligned dcl 11-6 rc_nt internal static bit(18) initial unaligned dcl 11-6 rc_s internal static bit(18) initial unaligned dcl 11-6 rc_sr internal static bit(18) initial unaligned dcl 11-6 root_block internal static bit(9) initial dcl 10-1 runtime_bound based structure level 1 unaligned dcl 6-33 runtime_symbol based structure level 1 dcl 6-3 runtime_token based structure level 1 dcl 6-63 NAMES DECLARED BY EXPLICIT CONTEXT. chk_pf 001006 constant label dcl 299 ref 281 chk_st 000732 constant label dcl 281 compile_block 000011 constant entry external dcl 22 compile_block$begin_block 000053 constant entry external dcl 95 db 000033 constant label dcl 87 ref 91 do_bro 001027 constant label dcl 307 ref 299 301 do_main 000446 constant label dcl 201 ref 155 159 fill_stack 001055 constant entry internal dcl 315 ref 275 277 l1 000130 constant label dcl 116 ref 93 l2 000652 constant label dcl 258 ref 251 NAME DECLARED BY CONTEXT OR IMPLICATION. bit builtin function ref 204 290 294 297 305 325 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1566 1704 1163 1576 Length 2356 1163 116 435 402 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME compile_block 124 external procedure is an external procedure. fill_stack internal procedure shares stack frame of external procedure compile_block. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME compile_block 000100 bp compile_block 000102 fp compile_block 000104 sp compile_block 000106 p compile_block 000110 q compile_block 000112 prol_save compile_block 000114 entry_save compile_block 000116 n compile_block 000117 sym_pos compile_block 000120 bt compile_block 000121 unused compile_block 000130 stack_size fill_stack 000132 p fill_stack 000134 q fill_stack THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. c_a compile_block compile_statement create_label expmac expmac$fill_usage io_op$init_ps make_mod prepare_operand stack_temp$free_aggregates state_man$create_ms state_man$flush THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cg_stat$agg_temps cg_stat$cur_block cg_stat$cur_entry cg_stat$cur_level cg_stat$cur_statement cg_stat$extended_stack cg_stat$generate_map cg_stat$in_prologue cg_stat$m_s_p cg_stat$map_start cg_stat$old_id cg_stat$profile_base cg_stat$profile_option cg_stat$profile_pos cg_stat$prol_ent cg_stat$root cg_stat$skip_to_label cg_stat$statement_map cg_stat$sym_base cg_stat$sym_pos cg_stat$sym_reloc_base cg_stat$text_base cg_stat$text_pos LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 22 000006 81 000016 82 000022 84 000026 85 000031 87 000033 88 000045 91 000046 93 000050 95 000051 97 000060 98 000064 103 000067 105 000100 107 000101 108 000106 110 000115 111 000117 113 000120 116 000130 118 000134 123 000140 124 000144 125 000153 126 000155 128 000156 131 000161 133 000164 133 000177 135 000203 139 000210 140 000214 142 000216 152 000221 154 000222 155 000224 159 000232 161 000235 162 000237 164 000240 166 000243 167 000262 168 000270 170 000272 172 000276 173 000300 175 000302 176 000331 179 000335 181 000341 182 000347 183 000353 186 000357 187 000364 188 000373 189 000376 191 000377 193 000402 194 000407 195 000436 196 000442 201 000446 203 000451 204 000457 206 000466 209 000467 213 000470 214 000473 215 000500 216 000507 217 000512 219 000513 221 000515 226 000527 231 000537 232 000542 238 000546 241 000551 242 000552 244 000556 247 000563 248 000604 249 000636 251 000646 254 000647 255 000651 258 000652 260 000661 266 000705 274 000711 275 000717 276 000724 277 000725 279 000727 281 000732 283 000735 288 000741 289 000743 290 000747 291 000754 292 000757 293 000765 294 000767 297 000775 299 001006 301 001010 305 001014 307 001027 312 001047 313 001052 342 001054 315 001055 325 001057 326 001103 328 001110 330 001114 331 001116 334 001117 335 001124 336 001132 337 001142 338 001145 340 001146 ----------------------------------------------------------- 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