Explicitly provide an optional closure/obj pointer to trans_call_glue so that it can push one in the right position when calling glue, instead of always pushing a null. As far as I can tell this only affects calls to obj drop glue, since only that makes use of an object binding passed as closure/obj, so pass the binding there as needed.
This commit is contained in:
Roy Frostig
parent
df75165cf4
commit
373f904c92
@ -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,15 +1715,16 @@ 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 zero);
|
||||
emit (Il.Push cloptr);
|
||||
emit (Il.Push (Il.Cell abi.Abi.abi_tp_cell));
|
||||
emit (Il.Push dst);
|
||||
call_code code;
|
||||
@ -1731,35 +1732,46 @@ let trans_visitor
|
||||
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)
|
||||
@ -1781,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]"
|
||||
@ -1789,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. *)
|
||||
@ -2467,23 +2483,31 @@ let trans_visitor
|
||||
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, _) ->
|
||||
@ -2492,7 +2516,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";
|
||||
|
||||
@ -2514,7 +2542,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.
|
||||
@ -2603,7 +2633,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 +2670,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 +2733,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 +2749,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
|
||||
|
||||
| _ -> ()
|
||||
|
||||
@ -3033,7 +3070,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 _
|
||||
@ -4090,7 +4129,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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user