diff options
| -rw-r--r-- | asmcomp/cmmgen.ml | 9 | ||||
| -rw-r--r-- | bytecomp/bytegen.ml | 31 |
2 files changed, 24 insertions, 16 deletions
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 0d08f8766..3647c985c 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -1421,12 +1421,17 @@ and transl_switch arg index cases = match Array.length cases with and transl_letrec bindings cont = let bsz = List.map (fun (id, exp) -> (id, exp, expr_size exp)) bindings in let rec init_blocks = function - | [] -> fill_blocks bsz + | [] -> fill_nonrec bsz | (id, exp, RHS_block sz) :: rem -> Clet(id, Cop(Cextcall("alloc_dummy", typ_addr, true), [int_const sz]), init_blocks rem) | (id, exp, RHS_nonrec) :: rem -> - Clet (id, transl exp, init_blocks rem) + Clet (id, Cconst_int 0, init_blocks rem) + and fill_nonrec = function + | [] -> fill_blocks bsz + | (id, exp, RHS_block sz) :: rem -> fill_nonrec rem + | (id, exp, RHS_nonrec) :: rem -> + Clet (id, transl exp, fill_nonrec rem) and fill_blocks = function | [] -> cont | (id, exp, RHS_block _) :: rem -> diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml index 9b93783e6..18651b3dd 100644 --- a/bytecomp/bytegen.ml +++ b/bytecomp/bytegen.ml @@ -463,27 +463,30 @@ let rec comp_expr env exp sz cont = end else begin let decl_size = List.map (fun (id, exp) -> (id, exp, size_of_lambda exp)) decl in - let rec comp_decl new_env sz i = function - | [] -> - comp_expr new_env body sz (add_pop ndecl cont) - | (id, exp, RHS_block blocksize) :: rem -> - comp_expr new_env exp sz - (Kpush :: Kacc i :: Kccall("update_dummy", 2) :: - comp_decl new_env sz (i-1) rem) - | (id, exp, RHS_nonrec) :: rem -> - comp_decl new_env sz (i-1) rem - in let rec comp_init new_env sz = function - | [] -> - comp_decl new_env sz ndecl decl_size + | [] -> comp_nonrec new_env sz ndecl decl_size | (id, exp, RHS_block blocksize) :: rem -> Kconst(Const_base(Const_int blocksize)) :: Kccall("alloc_dummy", 1) :: 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 blocksize) :: 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 blocksize) :: rem -> comp_expr new_env exp sz - (Kpush :: - comp_init (add_var id (sz+1) new_env) (sz+1) rem) + (Kpush :: Kacc i :: Kccall("update_dummy", 2) :: + comp_rec new_env sz (i-1) rem) + | (id, exp, RHS_nonrec) :: rem -> + comp_rec new_env sz (i-1) rem in comp_init env sz decl_size end |