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

New primitive: caml_alloc_dummy_function ... caml_alloc_dummy_function takes the function arity as a second argument. This new information can be used by js_of_ocaml to perform better optimization. 

From: Hugo Heuzard <hugo.heuzard@gmail.com>

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15592 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Gabriel Scherer 2014-11-17 12:21:49 +00:00
parent b0b1922aac
commit 2922831951
2 changed files with 16 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
bytecomp/bytegen.ml
View File

@ -128,6 +128,7 @@ type rhs_kind =
| RHS_block of int
| RHS_floatblock of int
| RHS_nonrec
| RHS_function of int * int
;;
let rec check_recordwith_updates id e =
@ -140,7 +141,7 @@ let rec check_recordwith_updates id e =
let rec size_of_lambda = function
| Lfunction(kind, params, body) as funct ->
RHS_block (1 + IdentSet.cardinal(free_variables funct))
RHS_function (1 + IdentSet.cardinal(free_variables funct), List.length params)
| Llet (Strict, id, Lprim (Pduprecord (kind, size), _), body)
when check_recordwith_updates id body ->
begin match kind with
@ -540,19 +541,25 @@ 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_function (blocksize,arity)) :: rem ->
Kconst(Const_base(Const_int arity)) ::
Kpush ::
Kconst(Const_base(Const_int blocksize)) ::
Kccall("caml_alloc_dummy_function", 2) :: Kpush ::
comp_init (add_var id (sz+1) new_env) (sz+1) rem
| (id, exp, RHS_nonrec) :: rem ->
Kconst(Const_base(Const_int 0)) :: Kpush ::
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_floatblock _)) :: rem ->
| (id, exp, (RHS_block _ | RHS_floatblock _ | RHS_function _)) :: rem ->
comp_nonrec new_env sz (i-1) rem
| (id, exp, RHS_nonrec) :: rem ->
comp_expr new_env exp sz
(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_floatblock _)) :: rem ->
| (id, exp, (RHS_block _ | RHS_floatblock _ | RHS_function _)) :: rem ->
comp_expr new_env exp sz
(Kpush :: Kacc i :: Kccall("caml_update_dummy", 2) ::
comp_rec new_env sz (i-1) rem)

6
byterun/alloc.c
View File

@ -153,6 +153,12 @@ CAMLprim value caml_alloc_dummy(value size)
return caml_alloc (wosize, 0);
}
CAMLprim value caml_alloc_dummy_function(value size,value arity)
{
/* the arity argument is used by the js_of_ocaml runtime */
return caml_alloc_dummy(size);
}
CAMLprim value caml_alloc_dummy_float (value size)
{
mlsize_t wosize = Int_val(size) * Double_wosize;