mikros/rust
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Better backpointer logic.

Browse Source
This commit is contained in:
Graydon Hoare 2010-10-05 18:09:49 -07:00
parent 246e72b0fb
commit cdf67b1f2e
4 changed files with 65 additions and 19 deletions

13
src/boot/be/il.ml

@ -903,9 +903,20 @@ let get_element_ptr
(string_of_cell fmt mem_cell)
;;
let ptr_cast (cell:cell) (rty:referent_ty) : cell =
let cell_cast (cell:cell) (rty:referent_ty) : cell =
match cell with
Mem (mem, _) -> Mem (mem, rty)
| Reg (reg, _) ->
begin
match rty with
ScalarTy st -> Reg (reg, st)
| _ -> bug () "expected scalar type in Il.cell_cast on register"
end
let ptr_cast (cell:cell) (rty:referent_ty) : cell =
match cell with
Mem (mem, ScalarTy (AddrTy _)) -> Mem (mem, ScalarTy (AddrTy rty))
| Reg (reg, AddrTy _) -> Reg (reg, AddrTy rty)
| _ -> bug () "expected address cell in Il.ptr_cast"
;;

6
src/boot/be/x86.ml

@ -1078,17 +1078,17 @@ let rec calculate_sz
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_box_rty in
let obj_body = Il.cell_cast obj_body obj_box_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 tydesc = Il.cell_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
let ty_params = Il.cell_cast (word_at (h eax)) ty_params_rty in
get_element_ptr ty_params i
in

39
src/boot/me/semant.ml

@ -2142,27 +2142,33 @@ and vec_sty (word_bits:Il.bits) : Il.scalar_ty =
let ptr = Il.ScalarTy (Il.AddrTy Il.OpaqueTy) in
Il.AddrTy (Il.StructTy [| word; word; word; ptr |])
and referent_type (cx:ctxt) (t:Ast.ty) : Il.referent_ty =
and referent_type
?parent_tags:parent_tags
?boxed:(boxed=false)
(cx:ctxt)
(t:Ast.ty)
: Il.referent_ty =
let s t = Il.ScalarTy t in
let v b = Il.ValTy b in
let p t = Il.AddrTy t in
let sv b = s (v b) in
let sp t = s (p t) in
let recur ty = referent_type ?parent_tags ~boxed cx ty in
let word_bits = cx.ctxt_abi.Abi.abi_word_bits in
let word = word_rty word_bits in
let ptr = sp Il.OpaqueTy in
let rc_ptr = sp (Il.StructTy [| word; Il.OpaqueTy |]) in
let tup ttup = Il.StructTy (Array.map (referent_type cx) ttup) in
let tup ttup = Il.StructTy (Array.map recur ttup) in
let tag ttag =
let n = get_n_tag_tups cx ttag in
let union =
let rty t =
match t with
Ast.TY_box (Ast.TY_tag dst_tag) when is_back_edge ttag dst_tag ->
sp (Il.StructTy [| word; Il.OpaqueTy |])
| _ -> referent_type cx t
let parent_tags =
match parent_tags with
None -> [ttag]
| Some pts -> ttag::pts
in
let rty t = referent_type ~parent_tags ~boxed cx t in
let tup ttup = Il.StructTy (Array.map rty ttup) in
Array.init n (fun i -> tup (get_nth_tag_tup cx ttag i))
in
@ -2202,7 +2208,17 @@ and referent_type (cx:ctxt) (t:Ast.ty) : Il.referent_ty =
| Ast.TY_fn _ -> fn_rty cx false
| Ast.TY_obj _ -> obj_rty word_bits
| Ast.TY_tag ttag -> tag ttag
| Ast.TY_tag ttag ->
begin
match parent_tags with
Some parent_tags
when boxed
&& parent_tags <> []
&& List.mem ttag parent_tags
&& is_back_edge ttag (List.hd parent_tags) ->
Il.StructTy [| word; Il.OpaqueTy |]
| _ -> tag ttag
end
| Ast.TY_chan _
| Ast.TY_port _
@ -2213,14 +2229,15 @@ and referent_type (cx:ctxt) (t:Ast.ty) : Il.referent_ty =
| Ast.TY_native _ -> ptr
| Ast.TY_box t ->
sp (Il.StructTy [| word; referent_type cx t |])
sp (Il.StructTy
[| word; referent_type ?parent_tags ~boxed:true cx t |])
| Ast.TY_mutable t -> referent_type cx t
| Ast.TY_mutable t -> recur t
| Ast.TY_param (i, _) -> Il.ParamTy i
| Ast.TY_named _ -> bug () "named type in referent_type"
| Ast.TY_constrained (t, _) -> referent_type cx t
| Ast.TY_constrained (t, _) -> recur t
and slot_referent_type (cx:ctxt) (sl:Ast.slot) : Il.referent_ty =
let s t = Il.ScalarTy t in

26
src/boot/me/trans.ml

@ -337,6 +337,8 @@ let trans_visitor
let rec ptr_cast = Il.ptr_cast
and cell_cast = Il.cell_cast
and curr_crate_ptr _ : Il.cell =
word_at (fp_imm frame_crate_ptr)
@ -465,7 +467,7 @@ let trans_visitor
let indirect_args =
get_element_ptr args_cell Abi.calltup_elt_indirect_args
in
deref (ptr_cast
deref (cell_cast
(get_element_ptr indirect_args Abi.indirect_args_elt_closure)
(Il.ScalarTy (Il.AddrTy (obj_box_rty word_bits))))
in
@ -508,7 +510,7 @@ let trans_visitor
get_element_ptr (deref tydesc) Abi.tydesc_field_first_param
in
let ty_params =
ptr_cast ty_params (Il.ScalarTy (Il.AddrTy ty_params_rty))
cell_cast ty_params (Il.ScalarTy (Il.AddrTy ty_params_rty))
in
deref ty_params
else
@ -550,7 +552,7 @@ let trans_visitor
let blk_fn = get_element_ptr self_iterator_args
Abi.iterator_args_elt_block_fn
in
ptr_cast blk_fn
cell_cast blk_fn
(Il.ScalarTy (Il.AddrTy Il.CodeTy))
in
@ -3223,6 +3225,18 @@ let trans_visitor
iter_ty_parts_full ty_params dst src ty
(clone_ty ty_params clone_task)
and unfold_opaque_cell (c:Il.cell) (ty:Ast.ty) : Il.cell =
match Il.cell_referent_ty c with
Il.ScalarTy (Il.AddrTy _) ->
begin
match strip_mutable_or_constrained_ty ty with
Ast.TY_box boxed ->
Il.ptr_cast c
(Il.StructTy [| word_rty; referent_type cx boxed |])
| _ -> c
end
| _ -> c
and free_ty
(is_gc:bool)
(ty_params:Il.cell)
@ -3230,6 +3244,8 @@ let trans_visitor
(cell:Il.cell)
: unit =
check_box_rty cell;
let cell = unfold_opaque_cell cell ty in
check_box_rty cell;
note_drop_step ty "in free-ty";
begin
match strip_mutable_or_constrained_ty ty with
@ -3463,6 +3479,8 @@ let trans_visitor
| (Ast.TY_box ty', DEREF_one_box)
| (Ast.TY_box ty', DEREF_all_boxes) ->
check_box_rty cell;
let cell = unfold_opaque_cell cell ty in
check_box_rty cell;
if initializing
then init_box cell ty;
@ -4092,7 +4110,7 @@ let trans_visitor
in
let pair_code_cell = get_element_ptr dst_cell Abi.fn_field_code in
let pair_box_cell =
ptr_cast
cell_cast
(get_element_ptr dst_cell Abi.fn_field_box)
(Il.ScalarTy (Il.AddrTy (closure_box_rty)))
in