diff options
Diffstat (limited to 'src/boot/me/trans.ml')
| -rw-r--r-- | src/boot/me/trans.ml | 199 |
1 files changed, 129 insertions, 70 deletions
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml index f77386a9..46329a10 100644 --- a/src/boot/me/trans.ml +++ b/src/boot/me/trans.ml @@ -225,7 +225,7 @@ let trans_visitor let epilogue_jumps = Stack.create() in let path_name (_:unit) : string = - string_of_name (Walk.path_to_name path) + string_of_name (path_to_name path) in let based (reg:Il.reg) : Il.mem = @@ -1228,8 +1228,8 @@ let trans_visitor (sorted_htab_keys fns)) end - and trans_init_str (dst:Ast.lval) (s:string) : unit = - (* Include null byte. *) + and trans_init_str (dst:Ast.lval) (s:string) : unit = + (* Include null byte. *) let init_sz = Int64.of_int ((String.length s) + 1) in let static = trans_static_string s in let (dst, _) = trans_lval_init dst in @@ -1715,49 +1715,63 @@ let trans_visitor (code:Il.code) (dst:Il.cell option) (args:Il.cell array) + (clo:Il.cell option) : unit = - let inner dst = + let inner dst cloptr = let scratch = next_vreg_cell Il.voidptr_t in let pop _ = emit (Il.Pop scratch) in for i = ((Array.length args) - 1) downto 0 do emit (Il.Push (Il.Cell args.(i))) done; + emit (Il.Push cloptr); emit (Il.Push (Il.Cell abi.Abi.abi_tp_cell)); emit (Il.Push dst); call_code code; pop (); pop (); + pop (); Array.iter (fun _ -> pop()) args; in + let cloptr = + match clo with + None -> zero + | Some cloptr -> Il.Cell cloptr + in match dst with - None -> inner zero - | Some dst -> aliasing true dst (fun dst -> inner (Il.Cell dst)) + None -> inner zero cloptr + | Some dst -> + aliasing true dst (fun dst -> inner (Il.Cell dst) cloptr) and trans_call_static_glue (callee:Il.operand) (dst:Il.cell option) (args:Il.cell array) + (clo:Il.cell option) : unit = - trans_call_glue (code_of_operand callee) dst args + trans_call_glue (code_of_operand callee) dst args clo and trans_call_dynamic_glue (tydesc:Il.cell) (idx:int) (dst:Il.cell option) (args:Il.cell array) + (clo:Il.cell option) : unit = let fptr = get_vtbl_entry_idx tydesc idx in - trans_call_glue (code_of_operand (Il.Cell fptr)) dst args + trans_call_glue (code_of_operand (Il.Cell fptr)) dst args clo and trans_call_simple_static_glue (fix:fixup) (ty_params:Il.cell) - (arg:Il.cell) + (args:Il.cell array) + (clo:Il.cell option) : unit = trans_call_static_glue (code_fixup_to_ptr_operand fix) - None [| alias ty_params; arg |] + None + (Array.append [| alias ty_params |] args) + clo and get_tydesc_params (outer_ty_params:Il.cell) @@ -1779,7 +1793,8 @@ let trans_visitor (ty_param:int) (vtbl_idx:int) (ty_params:Il.cell) - (arg:Il.cell) + (args:Il.cell array) + (clo:Il.cell option) : unit = iflog (fun _ -> annotate (Printf.sprintf "calling tydesc[%d].glue[%d]" @@ -1787,8 +1802,11 @@ let trans_visitor let td = get_ty_param ty_params ty_param in let ty_params_ptr = get_tydesc_params ty_params td in trans_call_dynamic_glue - td vtbl_idx - None [| ty_params_ptr; arg; |] + td + vtbl_idx + None + (Array.append [| ty_params_ptr |] args) + clo (* trans_compare returns a quad number of the cjmp, which the caller patches to the cjmp destination. *) @@ -2453,36 +2471,41 @@ let trans_visitor note_drop_step ty "drop_ty: obj path"; let binding = get_element_ptr cell Abi.binding_field_binding in let null_jmp = null_check binding in + let rc_jmp = drop_refcount_and_cmp binding in let obj = deref binding in - let rc = get_element_ptr obj 0 in - let rc_jmp = drop_refcount_and_cmp rc in let tydesc = get_element_ptr obj 1 in let body = get_element_ptr obj 2 in - let ty_params = - get_element_ptr (deref tydesc) Abi.tydesc_field_first_param - in + let ty_params = get_tydesc_params ty_params tydesc in let dtor = get_element_ptr (deref tydesc) Abi.tydesc_field_obj_drop_glue in let null_dtor_jmp = null_check dtor in (* Call any dtor, if present. *) - note_drop_step ty "drop_ty: calling obj dtor"; - trans_call_dynamic_glue tydesc - Abi.tydesc_field_obj_drop_glue None [| binding |]; - patch null_dtor_jmp; - (* Drop the body. *) - note_drop_step ty "drop_ty: dropping obj body"; - trans_call_dynamic_glue tydesc - Abi.tydesc_field_drop_glue None [| ty_params; alias body |]; - (* FIXME: this will fail if the user has lied about the - * state-ness of their obj. We need to store state-ness in the - * captured tydesc, and use that. *) - note_drop_step ty "drop_ty: freeing obj body"; - trans_free binding (type_has_state ty); - mov binding zero; - patch rc_jmp; - patch null_jmp; - note_drop_step ty "drop_ty: done obj path"; + note_drop_step ty "drop_ty: calling obj dtor"; + trans_call_dynamic_glue + tydesc + Abi.tydesc_field_obj_drop_glue + None + [| binding |] + (Some binding); + patch null_dtor_jmp; + (* Drop the body. *) + note_drop_step ty "drop_ty: dropping obj body"; + trans_call_dynamic_glue + tydesc + Abi.tydesc_field_drop_glue + None + [| ty_params; alias body |] + None; + (* FIXME: this will fail if the user has lied about the + * state-ness of their obj. We need to store state-ness in the + * captured tydesc, and use that. *) + note_drop_step ty "drop_ty: freeing obj body"; + trans_free binding (type_has_state ty); + mov binding zero; + patch rc_jmp; + patch null_jmp; + note_drop_step ty "drop_ty: done obj path"; | Ast.TY_param (i, _) -> @@ -2491,7 +2514,11 @@ let trans_visitor begin fun cell -> trans_call_simple_dynamic_glue - i Abi.tydesc_field_drop_glue ty_params cell + i + Abi.tydesc_field_drop_glue + ty_params + [| cell |] + None end; note_drop_step ty "drop_ty: done parametric-ty path"; @@ -2505,8 +2532,7 @@ let trans_visitor let _ = check_box_rty cell in let null_jmp = null_check cell in - let rc = box_rc_cell cell in - let j = drop_refcount_and_cmp rc in + let j = drop_refcount_and_cmp cell in (* FIXME (issue #25): check to see that the box has * further box members; if it doesn't we can elide the @@ -2514,7 +2540,9 @@ let trans_visitor trans_call_simple_static_glue (get_free_glue ty (mctrl = MEM_gc) curr_iso) - ty_params cell; + ty_params + [| cell |] + None; (* Null the slot out to prevent double-free if the frame * unwinds. @@ -2525,7 +2553,7 @@ let trans_visitor note_drop_step ty "drop_ty: done box-drop path"; | MEM_interior when type_is_structured ty -> - note_drop_step ty "drop:ty structured-interior path"; + note_drop_step ty "drop_ty structured-interior path"; iter_ty_parts ty_params cell ty (drop_ty ty_params) curr_iso; note_drop_step ty "drop_ty: done structured-interior path"; @@ -2603,7 +2631,7 @@ let trans_visitor trans_call_static_glue (code_fixup_to_ptr_operand glue_fix) (Some dst) - [| alias ty_params; src; clone_task |] + [| alias ty_params; src; clone_task |] None | _ -> iter_ty_parts_full ty_params dst src ty (clone_ty ty_params clone_task) curr_iso @@ -2640,7 +2668,10 @@ let trans_visitor lea vr body_mem; trace_word cx.ctxt_sess.Session.sess_trace_drop vr; trans_call_simple_static_glue - (get_drop_glue body_ty curr_iso) ty_params vr; + (get_drop_glue body_ty curr_iso) + ty_params + [| vr |] + None; note_drop_step ty "in free-ty, calling free"; trans_free cell is_gc; end; @@ -2700,7 +2731,9 @@ let trans_visitor lea tmp body_mem; trans_call_simple_static_glue (get_mark_glue ty curr_iso) - ty_params tmp; + ty_params + [| tmp |] + None; List.iter patch marked_jump; | MEM_interior when type_is_structured ty -> @@ -2714,7 +2747,9 @@ let trans_visitor lea tmp mem; trans_call_simple_static_glue (get_mark_glue ty curr_iso) - ty_params tmp + ty_params + [| tmp |] + None | _ -> () @@ -2740,14 +2775,35 @@ let trans_visitor emit (Il.jmp Il.JE Il.CodeNone); j - and drop_refcount_and_cmp (rc:Il.cell) : quad_idx = + and drop_refcount_and_cmp (boxed:Il.cell) : quad_idx = iflog (fun _ -> annotate "drop refcount and maybe free"); + let rc = box_rc_cell boxed in + if cx.ctxt_sess.Session.sess_trace_gc || + cx.ctxt_sess.Session.sess_trace_drop + then + begin + trace_str true "refcount--"; + trace_word true boxed; + trace_word true rc + end; emit (Il.binary Il.SUB rc (Il.Cell rc) one); emit (Il.cmp (Il.Cell rc) zero); let j = mark () in emit (Il.jmp Il.JNE Il.CodeNone); j + and incr_refcount (boxed:Il.cell) : unit = + let rc = box_rc_cell boxed in + if cx.ctxt_sess.Session.sess_trace_gc || + cx.ctxt_sess.Session.sess_trace_drop + then + begin + trace_str true "refcount++"; + trace_word true boxed; + trace_word true rc + end; + add_to rc one + and drop_slot (ty_params:Il.cell) (cell:Il.cell) @@ -2917,7 +2973,7 @@ let trans_visitor | (MEM_rc_struct, MEM_rc_struct) -> (* Lightweight copy: twiddle refcounts, move pointer. *) anno "refcounted light"; - add_to (box_rc_cell src) one; + incr_refcount src; if not initializing then drop_ty ty_params dst dst_ty None; @@ -3012,7 +3068,9 @@ let trans_visitor let ty_params_ptr = get_tydesc_params ty_params td in trans_call_dynamic_glue td Abi.tydesc_field_copy_glue - (Some dst) [| ty_params_ptr; src; |] + (Some dst) + [| ty_params_ptr; src; |] + None end | Ast.TY_fn _ @@ -3186,13 +3244,13 @@ let trans_visitor (dst:Il.cell) (dst_tys:Ast.ty array) (trec:Ast.ty_rec) - (atab:(Ast.ident * Ast.atom) array) + (atab:(Ast.ident * Ast.mutability * Ast.atom) array) (base:Ast.lval) : unit = Array.iteri begin fun i (fml_ident, _) -> - let fml_entry _ (act_ident, atom) = + let fml_entry _ (act_ident, _, atom) = if act_ident = fml_ident then Some atom else None in let dst_ty = dst_tys.(i) in @@ -3537,6 +3595,9 @@ let trans_visitor let callee_task_cell = get_element_ptr all_callee_args_cell Abi.calltup_elt_task_ptr in + let callee_indirect_args = + get_element_ptr all_callee_args_cell Abi.calltup_elt_indirect_args + in let callee_ty_params = get_element_ptr all_callee_args_cell Abi.calltup_elt_ty_params in @@ -3548,10 +3609,6 @@ let trans_visitor get_element_ptr_dyn_in_current_frame all_callee_args_cell Abi.calltup_elt_iterator_args in - let callee_indirect_args = - get_element_ptr_dyn_in_current_frame - all_callee_args_cell Abi.calltup_elt_indirect_args - in let n_args = Array.length call.call_args in let n_iterators = Array.length call.call_iterator_args in @@ -3611,9 +3668,9 @@ let trans_visitor end call.call_callee_ty_params; - trans_arg1 callee_task_cell; + trans_arg1 callee_task_cell; - trans_arg0 callee_output_cell initializing_arg0 call + trans_arg0 callee_output_cell initializing_arg0 call @@ -4002,10 +4059,9 @@ let trans_visitor let dst_slot_id = (fst (fo.Ast.for_slot)).id in let dst_slot = get_slot cx dst_slot_id in let dst_cell = cell_of_block_slot dst_slot_id in - let (head_stmts, seq) = fo.Ast.for_seq in + let seq = fo.Ast.for_seq in let (seq_cell, seq_ty) = trans_lval seq in let unit_ty = seq_unit_ty seq_ty in - Array.iter trans_stmt head_stmts; iter_seq_parts ty_params seq_cell seq_cell unit_ty begin fun _ src_cell unit_ty _ -> @@ -4070,7 +4126,11 @@ let trans_visitor let fp = get_iter_outer_frame_ptr_for_current_frame () in let vr = next_vreg_cell Il.voidptr_t in mov vr zero; - trans_call_glue (code_of_operand block_fptr) None [| vr; fp |] + trans_call_glue + (code_of_operand block_fptr) + None + [| vr; fp |] + None and trans_vec_append dst_cell dst_ty src_oper src_ty = let elt_ty = seq_unit_ty dst_ty in @@ -4255,7 +4315,7 @@ let trans_visitor begin match base with None -> - let atoms = Array.map snd atab in + let atoms = Array.map (fun (_, _, atom) -> atom) atab in trans_init_structural_from_atoms dst_cell dst_tys atoms | Some base_lval -> @@ -4263,7 +4323,7 @@ let trans_visitor dst_cell dst_tys trec atab base_lval end - | Ast.STMT_init_tup (dst, atoms) -> + | Ast.STMT_init_tup (dst, elems) -> let (slot_cell, ty) = trans_lval_init dst in let dst_tys = match ty with @@ -4272,6 +4332,7 @@ let trans_visitor bugi cx stmt.id "non-tup destination type in stmt_init_tup" in + let atoms = Array.map snd elems in let (dst_cell, _) = deref_ty DEREF_none true slot_cell ty in trans_init_structural_from_atoms dst_cell dst_tys atoms @@ -4279,7 +4340,7 @@ let trans_visitor | Ast.STMT_init_str (dst, s) -> trans_init_str dst s - | Ast.STMT_init_vec (dst, atoms) -> + | Ast.STMT_init_vec (dst, _, atoms) -> trans_init_vec dst atoms | Ast.STMT_init_port dst -> @@ -4297,7 +4358,7 @@ let trans_visitor trans_init_chan dst p end - | Ast.STMT_init_box (dst, src) -> + | Ast.STMT_init_box (dst, _, src) -> trans_init_box dst src | Ast.STMT_block block -> @@ -4614,7 +4675,7 @@ let trans_visitor trans_crate_rel_static_string_frag (string_of_name_component nc) in trans_crate_rel_data_operand - (DATA_name (Walk.name_of ncs)) + (DATA_name (name_of ncs)) (fun _ -> Asm.SEQ (Array.append (Array.map f (Array.of_list ncs)) [| Asm.WORD (word_ty_mach, Asm.IMM 0L) |])) @@ -5012,7 +5073,7 @@ let fixup_assigning_visitor : Walk.visitor = let path_name (_:unit) : string = - Fmt.fmt_to_str Ast.fmt_name (Walk.path_to_name path) + Fmt.fmt_to_str Ast.fmt_name (path_to_name path) in let enter_file_for id = @@ -5110,11 +5171,8 @@ let process_crate (fixup_assigning_visitor cx path Walk.empty_visitor)); (unreferenced_required_item_ignoring_visitor cx - (Walk.mod_item_logging_visitor - (log cx "translation pass: %s") - path - (trans_visitor cx path - Walk.empty_visitor))) + (trans_visitor cx path + Walk.empty_visitor)) |]; in log cx "translating crate"; @@ -5123,7 +5181,8 @@ let process_crate None -> () | Some m -> log cx "with main fn %s" m end; - run_passes cx "trans" path passes (log cx "%s") crate; + run_passes cx "trans" path passes + cx.ctxt_sess.Session.sess_log_trans log crate; ;; (* |