9 files changed, 11 insertions, 14 deletions
diff --git a/bytecomp/codegen.ml b/bytecomp/codegen.ml
index 0dadbbe50..0f2a88f1b 100644
--- a/bytecomp/codegen.ml
+++ b/bytecomp/codegen.ml
@@ -169,7 +169,8 @@ let rec comp_expr env exp sz cont =
             comp_expr new_env body sz (add_pop ndecl cont)
         | (id, exp, blocksize) :: rem ->
             comp_expr new_env exp sz
-              (Kpush :: Kacc i :: Kupdate :: comp_decl new_env sz (i-1) rem) in
+              (Kpush :: Kacc i :: Kupdate blocksize ::
+               comp_decl new_env sz (i-1) rem) in
       let rec comp_init new_env sz = function
           [] ->
             comp_decl new_env sz ndecl decl
@@ -225,7 +226,6 @@ let rec comp_expr env exp sz cont =
         match p with
           Pgetglobal id -> Kgetglobal id
         | Psetglobal id -> Ksetglobal id
-        | Pupdate -> Kupdate
         | Pintcomp cmp -> Kintcomp cmp
         | Pmakeblock tag -> Kmakeblock(List.length args, tag)
         | Pfield n -> Kgetfield n
diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml
index fe81650f8..1fa60e649 100644
--- a/bytecomp/emitcode.ml
+++ b/bytecomp/emitcode.ml
@@ -132,7 +132,7 @@ let emit_instr = function
   | Kacc n ->
       if n < 8 then out(opACC0 + n) else (out opACC; out_int n)
   | Kenvacc n ->
-      if n < 4 then out(opENVACC0 + n) else (out opENVACC; out_int n)
+      if n < 4 then out(opENVACC1 + n) else (out opENVACC; out_int (n+1))
   | Kpush ->
       out opPUSH
   | Kpop n ->
@@ -175,7 +175,7 @@ let emit_instr = function
   | Ksetfield n ->
       if n < 4 then out(opSETFIELD0 + n) else (out opSETFIELD; out_int n)
   | Kdummy n -> out opDUMMY; out_int n
-  | Kupdate -> out opUPDATE
+  | Kupdate n -> out opUPDATE
   | Kvectlength -> out opVECTLENGTH
   | Kgetvectitem -> out opGETVECTITEM
   | Ksetvectitem -> out opSETVECTITEM
@@ -228,7 +228,8 @@ let rec emit = function
       if n < 8 then out(opPUSHACC0 + n) else (out opPUSHACC; out_int n);
       emit c
   | Kpush :: Kenvacc n :: c ->
-      if n < 4 then out(opPUSHENVACC0 + n) else (out opPUSHENVACC; out_int n);
+      if n < 4 then out(opPUSHENVACC1 + n)
+               else (out opPUSHENVACC; out_int (n+1));
       emit c
   | Kpush :: Kgetglobal id :: Kgetfield n :: c ->
       out opPUSHGETGLOBALFIELD; slot_for_getglobal id; out n; emit c
diff --git a/bytecomp/instruct.ml b/bytecomp/instruct.ml
index 1ba36990b..1c91c03e9 100644
--- a/bytecomp/instruct.ml
+++ b/bytecomp/instruct.ml
@@ -24,7 +24,7 @@ type instruction =
   | Kgetfield of int
   | Ksetfield of int
   | Kdummy of int
-  | Kupdate
+  | Kupdate of int
   | Kvectlength
   | Kgetvectitem
   | Ksetvectitem
diff --git a/bytecomp/instruct.mli b/bytecomp/instruct.mli
index 55fee05bb..4279e0c71 100644
--- a/bytecomp/instruct.mli
+++ b/bytecomp/instruct.mli
@@ -25,8 +25,8 @@ type instruction =
   | Kmakeblock of int * int             (* size, tag *)
   | Kgetfield of int
   | Ksetfield of int
-  | Kdummy of int
-  | Kupdate
+  | Kdummy of int                       (* block size *)
+  | Kupdate of int                      (* block size *)
   | Kvectlength
   | Kgetvectitem
   | Ksetvectitem
diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml
index c390826a8..99243aa9a 100644
--- a/bytecomp/lambda.ml
+++ b/bytecomp/lambda.ml
@@ -10,7 +10,6 @@ type primitive =
   | Pfield of int
   | Psetfield of int
   | Pccall of string * int
-  | Pupdate
   | Praise
   | Psequand | Psequor | Pnot
   | Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint
diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli
index f61bd2f00..93c73e4c7 100644
--- a/bytecomp/lambda.mli
+++ b/bytecomp/lambda.mli
@@ -10,7 +10,6 @@ type primitive =
   | Pfield of int
   | Psetfield of int
   | Pccall of string * int
-  | Pupdate
   | Praise
   | Psequand | Psequor | Pnot
   | Pnegint | Paddint | Psubint | Pmulint | Pdivint | Pmodint
diff --git a/bytecomp/printinstr.ml b/bytecomp/printinstr.ml
index c160d10cb..0693b6a9e 100644
--- a/bytecomp/printinstr.ml
+++ b/bytecomp/printinstr.ml
@@ -34,7 +34,7 @@ let instruction = function
   | Kgetfield n -> print_string "\tgetfield "; print_int n
   | Ksetfield n -> print_string "\tsetfield "; print_int n
   | Kdummy n -> print_string "\tdummy "; print_int n
-  | Kupdate -> print_string "\tupdate"
+  | Kupdate n -> print_string "\tupdate"; print_int n
   | Kvectlength -> print_string "\tvectlength"
   | Kgetvectitem -> print_string "\tgetvectitem"
   | Ksetvectitem -> print_string "\tsetvectitem"
diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml
index 92c4a61fc..538926812 100644
--- a/bytecomp/printlambda.ml
+++ b/bytecomp/printlambda.ml
@@ -32,7 +32,6 @@ let primitive = function
   | Pfield n -> print_string "field "; print_int n
   | Psetfield n -> print_string "setfield "; print_int n
   | Pccall(name, arity) -> print_string name
-  | Pupdate -> print_string "update"
   | Praise -> print_string "raise"
   | Psequand -> print_string "&&"
   | Psequor -> print_string "||"
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index c588845ff..b403b8772 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -91,7 +91,6 @@ let primitives_table = create_hashtable 31 [
   "%field1", Pfield 1;
   "%setfield0", Psetfield 0;
   "%makeblock", Pmakeblock 0;
-  "%update", Pupdate;
   "%raise", Praise;
   "%sequand", Psequand;
   "%sequor", Psequor;
@@ -164,7 +163,7 @@ exception Unknown
 
 let size_of_lambda id lam =
   let rec size = function
-      Lfunction(param, body) -> 2
+      Lfunction(param, body) as funct -> 1 + List.length(free_variables funct)
     | Lprim(Pmakeblock tag, args) -> List.iter check args; List.length args
     | Llet(id, arg, body) -> check arg; size body
     | _ -> raise Unknown