diff options
Diffstat (limited to 'src/boot/be')
| -rw-r--r-- | src/boot/be/abi.ml | 5 | ||||
| -rw-r--r-- | src/boot/be/elf.ml | 142 | ||||
| -rw-r--r-- | src/boot/be/il.ml | 7 | ||||
| -rw-r--r-- | src/boot/be/pe.ml | 30 | ||||
| -rw-r--r-- | src/boot/be/x86.ml | 109 |
5 files changed, 165 insertions, 128 deletions
diff --git a/src/boot/be/abi.ml b/src/boot/be/abi.ml index 347d49fc..5bdf21fa 100644 --- a/src/boot/be/abi.ml +++ b/src/boot/be/abi.ml @@ -41,7 +41,7 @@ let box_gc_header_size = 4;; let box_gc_malloc_return_adjustment = 3;; -let stk_field_valgrind_id = 0 + 1;; +let stk_field_valgrind_id = 0;; let stk_field_limit = stk_field_valgrind_id + 1;; let stk_field_data = stk_field_limit + 1;; @@ -121,7 +121,8 @@ type abi = -> Common.size (* callsz *) -> Common.nabi -> Common.fixup (* grow_task *) - -> unit); + -> bool (* is_obj_fn *) + -> unit); abi_emit_fn_epilogue: (Il.emitter -> unit); diff --git a/src/boot/be/elf.ml b/src/boot/be/elf.ml index 3d25657b..406508e4 100644 --- a/src/boot/be/elf.ml +++ b/src/boot/be/elf.ml @@ -169,14 +169,16 @@ type sh_flags = let section_header + ?(sh_link:int64 option=None) + ?(sh_info:int64 option=None) + ?(zero_sh_addr:bool=false) + ?(sh_flags:sh_flags list=[]) + ?(section_fixup:fixup option=None) + ?(sh_addralign:int64=1L) + ?(sh_entsize:int64=0L) ~(shstring_table_fixup:fixup) ~(shname_string_fixup:fixup) - ~(sh_type:sh_type) - ~(sh_flags:sh_flags list) - ~(section_fixup:fixup option) - ~(sh_addralign:int64) - ~(sh_entsize:int64) - ~(sh_link:int64 option) + (sh_type:sh_type) : frag = SEQ [| @@ -201,9 +203,12 @@ let section_header SHF_WRITE -> 0x1L | SHF_ALLOC -> 0x2L | SHF_EXECINSTR -> 0x4L) sh_flags))); - WORD (TY_u32, (match section_fixup with - None -> (IMM 0L) - | Some s -> (M_POS s))); + WORD (TY_u32, + if zero_sh_addr + then IMM 0L + else (match section_fixup with + None -> (IMM 0L) + | Some s -> (M_POS s))); WORD (TY_u32, (match section_fixup with None -> (IMM 0L) | Some s -> (F_POS s))); @@ -213,7 +218,9 @@ let section_header WORD (TY_u32, (IMM (match sh_link with None -> 0L | Some i -> i))); - WORD (TY_u32, (IMM 0L)); (* sh_info *) + WORD (TY_u32, (IMM (match sh_info with + None -> 0L + | Some i -> i))); WORD (TY_u32, (IMM sh_addralign)); WORD (TY_u32, (IMM sh_entsize)); |] @@ -633,7 +640,7 @@ let elf32_linux_x86_file let dynsymndx = 4L in (* Section index of .dynsym *) let dynstrndx = 5L in (* Section index of .dynstr *) (* let hashndx = 6L in *) (* Section index of .hash *) - (* let pltndx = 7L in *) (* Section index of .plt *) + let pltndx = 7L in (* Section index of .plt *) (* let gotpltndx = 8L in *) (* Section index of .got.plt *) (* let relapltndx = 9L in *) (* Section index of .rela.plt *) let datandx = 10L in (* Section index of .data *) @@ -690,155 +697,129 @@ let elf32_linux_x86_file (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: null_section_name_fixup - ~sh_type: SHT_NULL - ~sh_flags: [] ~section_fixup: None ~sh_addralign: 0L - ~sh_entsize: 0L - ~sh_link: None); + SHT_NULL); (* .interp *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: interp_section_name_fixup - ~sh_type: SHT_PROGBITS ~sh_flags: [ SHF_ALLOC ] ~section_fixup: (Some interp_section_fixup) - ~sh_addralign: 1L - ~sh_entsize: 0L - ~sh_link: None); + SHT_PROGBITS); (* .text *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: text_section_name_fixup - ~sh_type: SHT_PROGBITS ~sh_flags: [ SHF_ALLOC; SHF_EXECINSTR ] ~section_fixup: (Some text_section_fixup) ~sh_addralign: 32L - ~sh_entsize: 0L - ~sh_link: None); + SHT_PROGBITS); (* .rodata *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: rodata_section_name_fixup - ~sh_type: SHT_PROGBITS ~sh_flags: [ SHF_ALLOC ] ~section_fixup: (Some rodata_section_fixup) ~sh_addralign: 32L - ~sh_entsize: 0L - ~sh_link: None); + SHT_PROGBITS); (* .dynsym *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: dynsym_section_name_fixup - ~sh_type: SHT_DYNSYM ~sh_flags: [ SHF_ALLOC ] ~section_fixup: (Some dynsym_section_fixup) - ~sh_addralign: 8L + ~sh_addralign: 4L ~sh_entsize: elf32_symsize - ~sh_link: (Some dynstrndx) ); + ~sh_link: (Some dynstrndx) + SHT_DYNSYM); (* .dynstr *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: dynstr_section_name_fixup - ~sh_type: SHT_STRTAB ~sh_flags: [ SHF_ALLOC ] ~section_fixup: (Some dynstr_section_fixup) - ~sh_addralign: 1L - ~sh_entsize: 0L - ~sh_link: None); + SHT_STRTAB); (* .hash *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: hash_section_name_fixup - ~sh_type: SHT_PROGBITS ~sh_flags: [ SHF_ALLOC ] ~section_fixup: (Some hash_section_fixup) ~sh_addralign: 4L ~sh_entsize: 4L - ~sh_link: (Some dynsymndx)); + SHT_PROGBITS); (* .plt *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: plt_section_name_fixup - ~sh_type: SHT_PROGBITS ~sh_flags: [ SHF_ALLOC; SHF_EXECINSTR ] ~section_fixup: (Some plt_section_fixup) ~sh_addralign: 4L - ~sh_entsize: 0L - ~sh_link: None); + SHT_PROGBITS); (* .got.plt *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: got_plt_section_name_fixup - ~sh_type: SHT_PROGBITS ~sh_flags: [ SHF_ALLOC; SHF_WRITE ] ~section_fixup: (Some got_plt_section_fixup) ~sh_addralign: 4L - ~sh_entsize: 0L - ~sh_link: None); + SHT_PROGBITS); (* .rela.plt *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: rela_plt_section_name_fixup - ~sh_type: SHT_RELA ~sh_flags: [ SHF_ALLOC ] ~section_fixup: (Some rela_plt_section_fixup) ~sh_addralign: 4L ~sh_entsize: elf32_rela_entsz - ~sh_link: (Some dynsymndx)); + ~sh_link: (Some dynsymndx) + ~sh_info: (Some pltndx) + SHT_RELA); (* .data *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: data_section_name_fixup - ~sh_type: SHT_PROGBITS ~sh_flags: [ SHF_ALLOC; SHF_WRITE ] ~section_fixup: (Some data_section_fixup) ~sh_addralign: 32L - ~sh_entsize: 0L - ~sh_link: None); + SHT_PROGBITS); (* .bss *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: bss_section_name_fixup - ~sh_type: SHT_NOBITS ~sh_flags: [ SHF_ALLOC; SHF_WRITE ] ~section_fixup: (Some bss_section_fixup) ~sh_addralign: 32L - ~sh_entsize: 0L - ~sh_link: None); + SHT_NOBITS); (* .dynamic *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: dynamic_section_name_fixup - ~sh_type: SHT_DYNAMIC ~sh_flags: [ SHF_ALLOC; SHF_WRITE ] ~section_fixup: (Some dynamic_section_fixup) ~sh_addralign: 8L - ~sh_entsize: 0L - ~sh_link: None); + ~sh_link: (Some dynstrndx) + SHT_DYNAMIC); (* .shstrtab *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: shstrtab_section_name_fixup - ~sh_type: SHT_STRTAB - ~sh_flags: [] ~section_fixup: (Some shstrtab_section_fixup) - ~sh_addralign: 1L - ~sh_entsize: 0L - ~sh_link: None); + SHT_STRTAB); (* FIXME: uncomment the dwarf section headers as you make use of them; @@ -852,58 +833,45 @@ let elf32_linux_x86_file (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: debug_aranges_section_name_fixup - ~sh_type: SHT_PROGBITS - ~sh_flags: [] ~section_fixup: (Some sem.Semant.ctxt_debug_aranges_fixup) ~sh_addralign: 8L - ~sh_entsize: 0L - ~sh_link: None); + ~zero_sh_addr: true + SHT_PROGBITS); *) (* .debug_pubnames *) (* (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: debug_pubnames_section_name_fixup - ~sh_type: SHT_PROGBITS - ~sh_flags: [] ~section_fixup: (Some sem.Semant.ctxt_debug_pubnames_fixup) - ~sh_addralign: 1L - ~sh_entsize: 0L - ~sh_link: None); + ~zero_sh_addr: true + SHT_PROGBITS); *) (* .debug_info *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: debug_info_section_name_fixup - ~sh_type: SHT_PROGBITS - ~sh_flags: [] ~section_fixup: (Some sem.Semant.ctxt_debug_info_fixup) - ~sh_addralign: 1L - ~sh_entsize: 0L - ~sh_link: None); + ~zero_sh_addr: true + SHT_PROGBITS); (* .debug_abbrev *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: debug_abbrev_section_name_fixup - ~sh_type: SHT_PROGBITS - ~sh_flags: [] ~section_fixup: (Some sem.Semant.ctxt_debug_abbrev_fixup) - ~sh_addralign: 1L - ~sh_entsize: 0L - ~sh_link: None); + ~zero_sh_addr: true + SHT_PROGBITS); + (* .debug_line *) (* (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: debug_line_section_name_fixup - ~sh_type: SHT_PROGBITS - ~sh_flags: [] ~section_fixup: (Some sem.Semant.ctxt_debug_line_fixup) - ~sh_addralign: 1L - ~sh_entsize: 0L - ~sh_link: None); + ~zero_sh_addr: true + SHT_PROGBITS); *) (* .debug_frame *) @@ -911,24 +879,18 @@ let elf32_linux_x86_file (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: debug_frame_section_name_fixup - ~sh_type: SHT_PROGBITS - ~sh_flags: [] ~section_fixup: (Some sem.Semant.ctxt_debug_frame_fixup) ~sh_addralign: 4L - ~sh_entsize: 0L - ~sh_link: None); + ~zero_sh_addr: true + SHT_PROGBITS); *) (* .note.rust *) (section_header ~shstring_table_fixup: shstrtab_section_fixup ~shname_string_fixup: note_rust_section_name_fixup - ~sh_type: SHT_NOTE - ~sh_flags: [] ~section_fixup: (Some note_rust_section_fixup) - ~sh_addralign: 1L - ~sh_entsize: 0L - ~sh_link: None); + SHT_NOTE); |] in @@ -999,7 +961,7 @@ let elf32_linux_x86_file elf32_header ~sess ~ei_data: ELFDATA2LSB - ~e_type: ET_DYN + ~e_type: (if sess.Session.sess_library_mode then ET_DYN else ET_EXEC) ~e_machine: EM_386 ~e_version: EV_CURRENT diff --git a/src/boot/be/il.ml b/src/boot/be/il.ml index 172d8661..2a5b643a 100644 --- a/src/boot/be/il.ml +++ b/src/boot/be/il.ml @@ -901,6 +901,13 @@ let get_element_ptr (string_of_cell fmt mem_cell) ;; +let ptr_cast (cell:cell) (rty:referent_ty) : cell = + match cell with + Mem (mem, _) -> Mem (mem, rty) + | Reg (reg, AddrTy _) -> Reg (reg, AddrTy rty) + | _ -> bug () "expected address cell in Il.ptr_cast" +;; + (* * Local Variables: * fill-column: 78; diff --git a/src/boot/be/pe.ml b/src/boot/be/pe.ml index d360ddf5..b85cb1a9 100644 --- a/src/boot/be/pe.ml +++ b/src/boot/be/pe.ml @@ -783,9 +783,35 @@ let crate_exports (sem:Semant.ctxt) : pe_export array = let export_seg (_, tab) = Array.of_list (List.map export_sym (htab_pairs tab)) in + + (* Make some fake symbol table entries to aid in debugging. *) + let export_stab name fixup = + { + pe_export_name_fixup = new_fixup "export name fixup"; + pe_export_name = "rust$" ^ name; + pe_export_address_fixup = fixup + } + in + let export_stab_of_item (node_id, code) = + let name = Hashtbl.find sem.Semant.ctxt_all_item_names node_id in + let name' = "item$" ^ (Semant.string_of_name name) in + export_stab name' code.Semant.code_fixup + in + let export_stab_of_glue (glue, code) = + export_stab (Semant.glue_str sem glue) code.Semant.code_fixup + in + + let stabs = + Array.of_list (List.concat [ + (List.map export_stab_of_item + (htab_pairs sem.Semant.ctxt_all_item_code)); + (List.map export_stab_of_glue (htab_pairs sem.Semant.ctxt_glue_code)) + ]) + in + Array.concat - (List.map export_seg - (htab_pairs sem.Semant.ctxt_native_provided)) + (stabs::(List.map export_seg + (htab_pairs sem.Semant.ctxt_native_provided))) ;; diff --git a/src/boot/be/x86.ml b/src/boot/be/x86.ml index 55b101bb..f879027b 100644 --- a/src/boot/be/x86.ml +++ b/src/boot/be/x86.ml @@ -303,7 +303,7 @@ let emit_target_specific let dst_eax = hr_like_cell eax dst in let lhs_eax = hr_like_op eax lhs in let rhs_ecx = hr_like_op ecx rhs in - (* Horrible: we bounce complex mul inputs off spill slots + (* Horrible: we bounce mul/div/mod inputs off spill slots * to ensure non-interference between the temporaries used * during mem-base-reg reloads and the registers we're * preparing. *) @@ -311,32 +311,26 @@ let emit_target_specific Il.Mem (Il.next_spill_slot e (Il.ScalarTy (Il.operand_scalar_ty op))) in - let is_mem op = - match op with - Il.Cell (Il.Mem _) -> true + let is_eax cell = + match cell with + Il.Cell (Il.Reg (Il.Hreg hr, _)) -> hr = eax | _ -> false - in - let bounce_lhs = is_mem lhs in - let bounce_rhs = is_mem rhs in - let lhs_spill = next_spill_like lhs in - let rhs_spill = next_spill_like rhs in - - if bounce_lhs - then mov lhs_spill lhs; - - if bounce_rhs - then mov rhs_spill rhs; - - mov lhs_eax - (if bounce_lhs - then (Il.Cell lhs_spill) - else lhs); - - mov rhs_ecx - (if bounce_rhs - then (Il.Cell rhs_spill) - else rhs); - + in + if is_eax lhs + then + mov rhs_ecx rhs + else + begin + let lhs_spill = next_spill_like lhs in + let rhs_spill = next_spill_like rhs in + + mov lhs_spill lhs; + mov rhs_spill rhs; + + mov lhs_eax (Il.Cell lhs_spill); + mov rhs_ecx (Il.Cell rhs_spill); + end; + put (Il.Binary { b with Il.binary_lhs = (Il.Cell lhs_eax); @@ -344,7 +338,7 @@ let emit_target_specific Il.binary_dst = dst_eax; }); if dst <> dst_eax then mov dst (Il.Cell dst_eax); - + | _ when (Il.Cell dst) <> lhs -> mov dst lhs; put (Il.Binary @@ -593,6 +587,7 @@ let restore_frame_base (e:Il.emitter) (base:Il.reg) (retpc:Il.reg) : unit = * * *ebp+20+(4*N) = [argN ] * ... + * *ebp+28 = [arg2 ] = obj/closure ptr * *ebp+24 = [arg1 ] = task ptr * *ebp+20 = [arg0 ] = out ptr * *ebp+16 = [retpc ] @@ -1033,7 +1028,7 @@ let unwind_glue (* Puts result in eax; clobbers ecx, edx in the process. *) -let rec calculate_sz (e:Il.emitter) (size:size) : unit = +let rec calculate_sz (e:Il.emitter) (size:size) (in_obj:bool) : unit = let emit = Il.emit e in let mov dst src = emit (Il.umov dst src) in let push x = emit (Il.Push x) in @@ -1045,11 +1040,48 @@ let rec calculate_sz (e:Il.emitter) (size:size) : unit = let mul x y = emit (Il.binary Il.UMUL (rc x) (ro x) (ro y)) in let subi x y = emit (Il.binary Il.SUB (rc x) (ro x) (immi y)) in let eax_gets_a_and_ecx_gets_b a b = - calculate_sz e b; + calculate_sz e b in_obj; push (ro eax); - calculate_sz e a; + calculate_sz e a in_obj; pop (rc ecx); in + + let ty_param_n_in_obj_fn i = + (* + * Here we are trying to immitate the obj-fn branch of + * Trans.get_ty_params_of_current_frame while using + * eax as our only register. + *) + + (* Bind all the referent types we'll need... *) + + let obj_body_rty = Semant.obj_closure_rty word_bits in + let tydesc_rty = Semant.tydesc_rty word_bits in + (* Note that we cheat here and pretend only to have i+1 tydescs (because + we GEP to the i'th while still in this function, so no one outside + finds out about the lie. *) + let tydesc_tys = Array.init (i + 1) (fun _ -> Ast.TY_type) in + let ty_params_ty = Ast.TY_tup tydesc_tys in + let ty_params_rty = Semant.referent_type word_bits ty_params_ty in + + (* ... and fetch! *) + + mov (rc eax) (Il.Cell closure_ptr); + let obj_body = word_n (h eax) Abi.box_rc_field_body in + let obj_body = Il.ptr_cast obj_body obj_body_rty in + let tydesc_ptr = get_element_ptr obj_body Abi.obj_body_elt_tydesc in + + mov (rc eax) (Il.Cell tydesc_ptr); + let tydesc = Il.ptr_cast (word_at (h eax)) tydesc_rty in + let ty_params_ptr = + get_element_ptr tydesc Abi.tydesc_field_first_param + in + + mov (rc eax) (Il.Cell ty_params_ptr); + let ty_params = Il.ptr_cast (word_at (h eax)) ty_params_rty in + get_element_ptr ty_params i + in + match size with SIZE_fixed i -> mov (rc eax) (immi i) @@ -1061,15 +1093,23 @@ let rec calculate_sz (e:Il.emitter) (size:size) : unit = mov (rc eax) (imm (Asm.M_POS f)) | SIZE_param_size i -> - mov (rc eax) (Il.Cell (ty_param_n i)); + if in_obj + then + mov (rc eax) (Il.Cell (ty_param_n_in_obj_fn i)) + else + mov (rc eax) (Il.Cell (ty_param_n i)); mov (rc eax) (Il.Cell (word_n (h eax) Abi.tydesc_field_size)) | SIZE_param_align i -> - mov (rc eax) (Il.Cell (ty_param_n i)); + if in_obj + then + mov (rc eax) (Il.Cell (ty_param_n_in_obj_fn i)) + else + mov (rc eax) (Il.Cell (ty_param_n i)); mov (rc eax) (Il.Cell (word_n (h eax) Abi.tydesc_field_align)) | SIZE_rt_neg a -> - calculate_sz e a; + calculate_sz e a in_obj; neg eax | SIZE_rt_add (a, b) -> @@ -1185,6 +1225,7 @@ let fn_prologue (callsz:size) (nabi:nabi) (grow_task_fixup:fixup) + (is_obj_fn:bool) : unit = let esi_n = word_n (h esi) in @@ -1314,7 +1355,7 @@ let fn_prologue emit (Il.jmp Il.JA Il.CodeNone); (* Calculate dynamic frame size. *) - calculate_sz e call_and_frame_sz; + calculate_sz e call_and_frame_sz is_obj_fn; ((ro eax), Some primordial_underflow_jmp_pc) end | Some e -> ((imm e), None) |