Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Code review fixes

master
Stephen Dolan 2019-06-04 11:42:49 +01:00
parent d946686ffc
commit 3607562fd2
3 changed files with 16 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
asmcomp/cmmgen.ml
View File

@ -899,7 +899,7 @@ let fundecls_size fundecls =
type rhs_kind =
| RHS_block of int
| RHS_blockoffset of int * int
| RHS_infix of { blocksize : int; offset : int }
| RHS_floatblock of int
| RHS_nonrec
;;
@ -941,9 +941,9 @@ let rec expr_size env = function
expr_size env closure
| Usequence(_exp, exp') ->
expr_size env exp'
| Uoffset (exp, ofs) ->
| Uoffset (exp, offset) ->
(match expr_size env exp with
| RHS_block sz -> RHS_blockoffset (sz, ofs)
| RHS_block blocksize -> RHS_infix { blocksize; offset }
| _ -> assert false)
| _ -> RHS_nonrec
@ -3206,9 +3206,9 @@ and transl_letrec env bindings cont =
| (id, _exp, RHS_block sz) :: rem ->
Clet(id, op_alloc "caml_alloc_dummy" [int_const dbg sz],
init_blocks rem)
| (id, _exp, RHS_blockoffset(sz, ofs)) :: rem ->
| (id, _exp, RHS_infix { blocksize; offset}) :: rem ->
Clet(id, op_alloc "caml_alloc_dummy_infix"
[int_const dbg sz; int_const dbg ofs],
[int_const dbg blocksize; int_const dbg offset],
init_blocks rem)
| (id, _exp, RHS_floatblock sz) :: rem ->
Clet(id, op_alloc "caml_alloc_dummy_float" [int_const dbg sz],
@ -3218,13 +3218,13 @@ and transl_letrec env bindings cont =
and fill_nonrec = function
| [] -> fill_blocks bsz
| (_id, _exp,
(RHS_block _ | RHS_blockoffset _ | RHS_floatblock _)) :: rem ->
(RHS_block _ | RHS_infix _ | RHS_floatblock _)) :: rem ->
fill_nonrec rem
| (id, exp, RHS_nonrec) :: rem ->
Clet(id, transl env exp, fill_nonrec rem)
and fill_blocks = function
| [] -> cont
| (id, exp, (RHS_block _ | RHS_blockoffset _ | RHS_floatblock _)) :: rem ->
| (id, exp, (RHS_block _ | RHS_infix _ | RHS_floatblock _)) :: rem ->
let op =
Cop(Cextcall("caml_update_dummy", typ_void, false, None),
[Cvar (VP.var id); transl env exp], dbg) in

16
bytecomp/bytegen.ml
View File

@ -129,7 +129,7 @@ let rec push_dummies n k = match n with
type rhs_kind =
| RHS_block of int
| RHS_blockoffset of int * int
| RHS_infix of { blocksize : int; offset : int }
| RHS_floatblock of int
| RHS_nonrec
| RHS_function of int * int
@ -166,10 +166,10 @@ let rec size_of_lambda env = function
let fv =
Ident.Set.elements (free_variables (Lletrec(bindings, lambda_unit))) in
(* See Instruct(CLOSUREREC) in interp.c *)
let sz = List.length bindings * 2 - 1 + List.length fv in
let blocksize = List.length bindings * 2 - 1 + List.length fv in
let offsets = List.mapi (fun i (id, _e) -> (id, i * 2)) bindings in
let env = List.fold_right (fun (id, ofs) env ->
Ident.add id (RHS_blockoffset (sz, ofs)) env) offsets env in
let env = List.fold_right (fun (id, offset) env ->
Ident.add id (RHS_infix { blocksize; offset }) env) offsets env in
size_of_lambda env body
| Lletrec(bindings, body) ->
let env = List.fold_right
@ -580,8 +580,8 @@ let rec comp_expr env exp sz cont =
Kconst(Const_base(Const_int blocksize)) ::
Kccall("caml_alloc_dummy", 1) :: Kpush ::
comp_init (add_var id (sz+1) new_env) (sz+1) rem
| (id, _exp, RHS_blockoffset (blocksize, ofs)) :: rem ->
Kconst(Const_base(Const_int ofs)) ::
| (id, _exp, RHS_infix { blocksize; offset }) :: rem ->
Kconst(Const_base(Const_int offset)) ::
Kpush ::
Kconst(Const_base(Const_int blocksize)) ::
Kccall("caml_alloc_dummy_infix", 2) :: Kpush ::
@ -597,7 +597,7 @@ let rec comp_expr env exp sz cont =
comp_init (add_var id (sz+1) new_env) (sz+1) rem
and comp_nonrec new_env sz i = function
| [] -> comp_rec new_env sz ndecl decl_size
| (_id, _exp, (RHS_block _ | RHS_blockoffset _ |
| (_id, _exp, (RHS_block _ | RHS_infix _ |
RHS_floatblock _ | RHS_function _))
:: rem ->
comp_nonrec new_env sz (i-1) rem
@ -606,7 +606,7 @@ let rec comp_expr env exp sz cont =
(Kassign (i-1) :: comp_nonrec new_env sz (i-1) rem)
and comp_rec new_env sz i = function
| [] -> comp_expr new_env body sz (add_pop ndecl cont)
| (_id, exp, (RHS_block _ | RHS_blockoffset _ |
| (_id, exp, (RHS_block _ | RHS_infix _ |
RHS_floatblock _ | RHS_function _))
:: rem ->
comp_expr new_env exp sz

3
runtime/alloc.c
View File

@ -242,7 +242,6 @@ CAMLprim value caml_update_dummy(value dummy, value newval)
if (tag == Double_array_tag){
CAMLassert (Wosize_val(newval) == Wosize_val(dummy));
CAMLassert (tag < No_scan_tag || tag == Double_array_tag);
Tag_val(dummy) = tag;
size = Wosize_val (newval) / Double_wosize;
for (i = 0; i < size; i++) {
@ -260,7 +259,7 @@ CAMLprim value caml_update_dummy(value dummy, value newval)
caml_modify (&Field(dummy, i), Field(clos, i));
}
} else {
CAMLassert (tag < No_scan_tag || tag == Double_array_tag);
CAMLassert (tag < No_scan_tag);
Tag_val(dummy) = tag;
size = Wosize_val(newval);
CAMLassert (size == Wosize_val(dummy));