camlspotter avatar camlspotter committed 4eace9a

4.00.1+dev3_2012-09-08 rev12923

Comments (0)

Files changed (331)

0scripts/0CHECKOUT-SVN

 
 set -e
 
-REV=12779
-VERSION=4.00.0
+REV=12923
+VERSION=4.00
 
 # Move to the ocaml-svn-copy head
-hg update -C ocaml-svn-copy
+# hg update -C ocaml-svn-copy
 /bin/rm -rf [A-z]* \#*
 
-svn co http://caml.inria.fr/svn/ocaml/release/$VERSION/
+# svn co http://caml.inria.fr/svn/ocaml/release/$VERSION/
+svn co http://caml.inria.fr/svn/ocaml/version/$VERSION/
+
 # tar zxvf ../ocaml-$VERSION.tgz
 (cd $VERSION; tar cf - .) | tar xf -
 /bin/rm -rf $VERSION
+OCaml 4.00.1:
+-------------
+
+Bug fixes:
+- PR#4019: better documentation of Str.matched_string
+- PR#5700: crash with native-code stack backtraces under MacOS 10.8 x86-64
+- PR#5707: AMD64 code generator: do not use r10 and r11 for parameter passing,
+  as these registers can be destroyed by the dynamic loader
+- PR#5712: some documentation problems
+- PR#5718: false positive on 'unused constructor' warning
+- PR#5719: ocamlyacc generates code that is not warning 33-compliant
+- PR#5731: instruction scheduling forgot to account for destroyed registers
+- PR#5735: %apply and %revapply not first class citizens
+- PR#5738: first class module patterns not handled by ocamldep
+- PR#5742: missing bound checks in Array.sub
+- PR#5757: GC compaction bug (crash)
+
+
 OCaml 4.00.0:
 -------------
 
 - The official name of the language is now OCaml.
 
 Language features:
-- Added Generalized Abstract Data Types (GADTs) to the language.
+- Added Generalized Algebraic Data Types (GADTs) to the language.
   See chapter "Language extensions" of the reference manual for documentation.
 - It is now possible to omit type annotations when packing and unpacking
   first-class modules. The type-checker attempts to infer it from the context.
 - PR#5261, PR#5497: Ocaml source-code examples are not "copy-paste-able"
 * PR#5279: executable name is not initialized properly in caml_startup_code
 - PR#5290: added hash functions for channels, nats, mutexes, conditions
+- PR#5291: undetected loop in class initialization
 - PR#5295: OS threads: problem with caml_c_thread_unregister()
 - PR#5301: camlp4r and exception equal to another one with parameters
 - PR#5305: prevent ocamlbuild from complaining about links to _build/
 - PR#5518: segfault with lazy empty array
 - PR#5531: Allow ocamlbuild to add ocamldoc flags through -docflag
   and -docflags switches
+- PR#5538: combining -i and -annot in ocamlc
 - PR#5543: in Bigarray.map_file, try to avoid using lseek() when growing file
-- PR#5538: combining -i and -annot in ocamlc
 - PR#5648: (probably fixed) test failures in tests/lib-threads
 - PR#5551: repeated calls to find_in_path degrade performance
 - PR#5552: Mac OS X: unrecognized gcc option "-no-cpp-precomp"
 #                                                                       #
 #########################################################################
 
-# $Id: Makefile 12750 2012-07-20 08:06:01Z doligez $
+# $Id: Makefile 12873 2012-08-23 06:49:17Z garrigue $
 
 # The main Makefile
 
 world.opt:
 	$(MAKE) coldstart
 	$(MAKE) opt.opt
-	$(MAKE) ocamltoolsopt
 
 # Hard bootstrap how-to:
 # (only necessary in some cases, for example if you remove some primitive)
 # Native-code versions of the tools
 opt.opt: checkstack runtime core ocaml opt-core ocamlc.opt otherlibraries \
 	 $(DEBUGGER) ocamldoc ocamlbuild.byte $(CAMLP4OUT) \
-	 ocamlopt.opt otherlibrariesopt ocamllex.opt ocamltoolsopt.opt \
-	 ocamldoc.opt ocamlbuild.native $(CAMLP4OPT)
+	 ocamlopt.opt otherlibrariesopt ocamllex.opt \
+	 ocamltoolsopt ocamltoolsopt.opt ocamldoc.opt ocamlbuild.native \
+	 $(CAMLP4OPT)
 
 base.opt: checkstack runtime core ocaml opt-core ocamlc.opt otherlibraries \
 	 ocamlbuild.byte $(CAMLP4OUT) $(DEBUGGER) ocamldoc ocamlopt.opt \
-4.00.0
+4.00.1+dev3_2012-09-08
 
 # The version string is the first line of this file.
 # It must be in the format described in stdlib/sys.mli
 
-# $Id: VERSION 12779 2012-07-26 09:34:15Z doligez $
+# $Id: VERSION 12910 2012-09-10 09:52:09Z doligez $

asmcomp/amd64/emit.mlp

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: emit.mlp 12664 2012-07-09 08:35:23Z lefessan $ *)
+(* $Id: emit.mlp 12907 2012-09-08 16:51:03Z xleroy $ *)
 
 (* Emission of x86-64 (AMD 64) assembly code *)
 
 
 let reg_low_8_name =
   [| "%al"; "%bl"; "%dil"; "%sil"; "%dl"; "%cl"; "%r8b"; "%r9b";
-     "%r10b"; "%r11b"; "%bpl"; "%r12b"; "%r13b" |]
+     "%r12b"; "%r13b"; "%bpl"; "%r10b"; "%r11b" |]
 let reg_low_16_name =
   [| "%ax"; "%bx"; "%di"; "%si"; "%dx"; "%cx"; "%r8w"; "%r9w";
-     "%r10w"; "%r11w"; "%bp"; "%r12w"; "%r13w" |]
+     "%r12w"; "%r13w"; "%bp"; "%r10w"; "%r11w" |]
 let reg_low_32_name =
   [| "%eax"; "%ebx"; "%edi"; "%esi"; "%edx"; "%ecx"; "%r8d"; "%r9d";
-     "%r10d"; "%r11d"; "%ebp"; "%r12d"; "%r13d" |]
+     "%r12d"; "%r13d"; "%ebp"; "%r10d"; "%r11d" |]
 
 let emit_subreg tbl r =
   match r.loc with
   match Config.system with
   | "linux" | "gnu" ->
       (* mcount preserves rax, rcx, rdx, rsi, rdi, r8, r9 explicitly
-         and rbx, rbp, r12-r15 like all C functions.
-         We need to preserve r10 and r11 ourselves, since OCaml can
-         use them for argument passing. *)
+         and rbx, rbp, r12-r15 like all C functions.  This includes
+         all the registers used for argument passing, so we don't
+         need to preserve other regs.  We do need to initialize rbp
+         like mcount expects it, though. *)
       `	pushq	%r10\n`;
       `	movq	%rsp, %rbp\n`;
-      `	pushq	%r11\n`;
       `	{emit_call "mcount"}\n`;
-      `	popq	%r11\n`;
       `	popq	%r10\n`
   | _ ->
       () (*unsupported yet*)

asmcomp/amd64/emit_nt.mlp

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: emit_nt.mlp 11887 2011-12-18 10:00:56Z xleroy $ *)
+(* $Id: emit_nt.mlp 12907 2012-09-08 16:51:03Z xleroy $ *)
 
 (* Emission of x86-64 (AMD 64) assembly code, MASM syntax *)
 
 
 let reg_low_8_name =
   [| "al"; "bl"; "dil"; "sil"; "dl"; "cl"; "r8b"; "r9b";
-     "r10b"; "r11b"; "bpl"; "r12b"; "r13b" |]
+     "r12b"; "r13b"; "bpl"; "r10b"; "r11b" |]
 let reg_low_16_name =
   [| "ax"; "bx"; "di"; "si"; "dx"; "cx"; "r8w"; "r9w";
-     "r10w"; "r11w"; "bp"; "r12w"; "r13w" |]
+     "r12w"; "r13w"; "bp"; "r10w"; "r11w" |]
 let reg_low_32_name =
   [| "eax"; "ebx"; "edi"; "esi"; "edx"; "ecx"; "r8d"; "r9d";
-     "r10d"; "r11d"; "ebp"; "r12d"; "r13d" |]
+     "r12d"; "r13d"; "ebp"; "r10d"; "r11d" |]
 
 let emit_subreg tbl pref r =
   match r.loc with

asmcomp/amd64/proc.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: proc.ml 12149 2012-02-10 16:15:24Z doligez $ *)
+(* $Id: proc.ml 12907 2012-09-08 16:51:03Z xleroy $ *)
 
 (* Description of the AMD64 processor *)
 
     rcx         5
     r8          6
     r9          7
-    r10         8
-    r11         9
+    r12         8
+    r13         9
     rbp         10
-    r12         11
-    r13         12
+    r10         11
+    r11         12
     r14         trap pointer
     r15         allocation pointer
 
   xmm0 - xmm15  100 - 115  *)
 
 (* Conventions:
-     rax - r11: OCaml function arguments
+     rax - r13: OCaml function arguments
      rax: OCaml and C function results
      xmm0 - xmm9: OCaml function arguments
      xmm0: OCaml and C function results
      xmm0 - xmm3: C function arguments
      rbx, rbp, rsi, rdi r12-r15 are preserved by C
      xmm6-xmm15 are preserved by C
+   Note (PR#5707): r11 should not be used for parameter passing, as it
+     can be destroyed by the dynamic loader according to SVR4 ABI.
+     Linux's dynamic loader also destroys r10.
 *)
 
 let int_reg_name =
   match Config.ccomp_type with
   | "msvc" ->
       [| "rax"; "rbx"; "rdi"; "rsi"; "rdx"; "rcx"; "r8"; "r9";
-         "r10"; "r11"; "rbp"; "r12"; "r13" |]
+         "r12"; "r13"; "rbp"; "r10"; "r11" |]
   | _ ->
       [| "%rax"; "%rbx"; "%rdi"; "%rsi"; "%rdx"; "%rcx"; "%r8"; "%r9";
-         "%r10"; "%r11"; "%rbp"; "%r12"; "%r13" |]
+         "%r12"; "%r13"; "%rbp"; "%r10"; "%r11" |]
 
 let float_reg_name =
   match Config.ccomp_type with
      return value in rax or xmm0.
   C calling conventions under Win64:
      first integer args in rcx, rdx, r8, r9
-     first float args in xmm0 ... xmm3     
+     first float args in xmm0 ... xmm3
      each integer arg consumes a float reg, and conversely
      remaining args on stack
      always 32 bytes reserved at bottom of stack.
   if win64 then
     (* Win64: rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 preserved *)
     Array.of_list(List.map phys_reg
-      [0;4;5;6;7;8;9;
+      [0;4;5;6;7;11;12;
        100;101;102;103;104;105])
   else
     (* Unix: rbp, rbx, r12-r15 preserved *)
     Array.of_list(List.map phys_reg
-      [0;2;3;4;5;6;7;8;9;
+      [0;2;3;4;5;6;7;11;12;
        100;101;102;103;104;105;106;107;
        108;109;110;111;112;113;114;115])
 

asmcomp/arm/emit.mlp

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: emit.mlp 12547 2012-06-02 18:00:43Z bmeurer $ *)
+(* $Id: emit.mlp 12800 2012-07-30 18:59:07Z doligez $ *)
 
 (* Emission of ARM assembly code *)
 

asmcomp/closure.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: closure.ml 12179 2012-02-21 17:41:02Z xleroy $ *)
+(* $Id: closure.ml 12800 2012-07-30 18:59:07Z doligez $ *)
 
 (* Introduction of closures, uncurrying, recognition of direct calls *)
 
     match lam with
       Uvar v -> ()
     | Uconst(
-	(Const_base(Const_int _ | Const_char _ | Const_float _ |
+        (Const_base(Const_int _ | Const_char _ | Const_float _ |
                         Const_int32 _ | Const_int64 _ | Const_nativeint _) |
              Const_pointer _), _) -> incr size
 (* Structured Constants are now emitted during closure conversion. *)
   | Lfunction(kind, params, body) as funct ->
       close_one_function fenv cenv (Ident.create "fun") funct
 
-    (* We convert [f a] to [let a' = a in fun b c -> f a' b c] 
+    (* We convert [f a] to [let a' = a in fun b c -> f a' b c]
        when fun_arity > nargs *)
   | Lapply(funct, args, loc) ->
       let nargs = List.length args in
 
       | ((ufunct, Value_closure(fundesc, approx_res)), uargs)
           when nargs < fundesc.fun_arity ->
-	let first_args = List.map (fun arg ->
-	  (Ident.create "arg", arg) ) uargs in
-	let final_args = Array.to_list (Array.init (fundesc.fun_arity - nargs) (fun _ ->
-	  Ident.create "arg")) in
-	let rec iter args body =
-	  match args with
-	      [] -> body
-	    | (arg1, arg2) :: args ->
-	      iter args
-		(Ulet ( arg1, arg2, body))
-	in
-	let internal_args =
-	  (List.map (fun (arg1, arg2) -> Lvar arg1) first_args)
-	  @ (List.map (fun arg -> Lvar arg ) final_args)
-	in
-	let (new_fun, approx) = close fenv cenv
-	  (Lfunction(
-	    Curried, final_args, Lapply(funct, internal_args, loc)))
-	in
-	let new_fun = iter first_args new_fun in
-	(new_fun, approx)
+        let first_args = List.map (fun arg ->
+          (Ident.create "arg", arg) ) uargs in
+        let final_args = Array.to_list (Array.init (fundesc.fun_arity - nargs) (fun _ ->
+          Ident.create "arg")) in
+        let rec iter args body =
+          match args with
+              [] -> body
+            | (arg1, arg2) :: args ->
+              iter args
+                (Ulet ( arg1, arg2, body))
+        in
+        let internal_args =
+          (List.map (fun (arg1, arg2) -> Lvar arg1) first_args)
+          @ (List.map (fun arg -> Lvar arg ) final_args)
+        in
+        let (new_fun, approx) = close fenv cenv
+          (Lfunction(
+            Curried, final_args, Lapply(funct, internal_args, loc)))
+        in
+        let new_fun = iter first_args new_fun in
+        (new_fun, approx)
 
       | ((ufunct, Value_closure(fundesc, approx_res)), uargs)
         when fundesc.fun_arity > 0 && nargs > fundesc.fun_arity ->

asmcomp/cmmgen.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: cmmgen.ml 12237 2012-03-14 09:26:54Z xleroy $ *)
+(* $Id: cmmgen.ml 12800 2012-07-30 18:59:07Z doligez $ *)
 
 (* Translation from closed lambda to C-- *)
 
           bind "header" (header arr) (fun hdr ->
             if wordsize_shift = numfloat_shift then
               Csequence(make_checkbound dbg [addr_array_length hdr; idx],
-                        Cifthenelse(is_addr_array_hdr hdr, 
+                        Cifthenelse(is_addr_array_hdr hdr,
                                     addr_array_ref arr idx,
                                     float_array_ref arr idx))
             else
           bind "header" (header arr) (fun hdr ->
             if wordsize_shift = numfloat_shift then
               Csequence(make_checkbound dbg [addr_array_length hdr; idx],
-                        Cifthenelse(is_addr_array_hdr hdr, 
+                        Cifthenelse(is_addr_array_hdr hdr,
                                     addr_array_set arr idx newval,
                                     float_array_set arr idx
                                                     (unbox_float newval)))
 let emit_all_constants cont =
   let c = ref cont in
   List.iter
-    (fun (lbl, global, cst) -> 
+    (fun (lbl, global, cst) ->
        let cst = emit_constant lbl cst [] in
-       let cst = if global then 
-	 Cglobal_symbol lbl :: cst
+       let cst = if global then
+         Cglobal_symbol lbl :: cst
        else cst in
-	 c:= Cdata(cst):: !c)
+         c:= Cdata(cst):: !c)
     (Compilenv.structured_constants());
 (*  structured_constants := []; done in Compilenv.reset() *)
   Hashtbl.clear immstrings;   (* PR#3979 *)
           args @ [Cvar last_arg; Cvar clos])
     else
       if n = arity - 1 then
-	begin
+        begin
       let newclos = Ident.create "clos" in
       Clet(newclos,
            get_field (Cvar clos) 3,
            curry_fun (get_field (Cvar clos) 2 :: args) newclos (n-1))
-	end else
-	begin
-	  let newclos = Ident.create "clos" in
-	  Clet(newclos,
+        end else
+        begin
+          let newclos = Ident.create "clos" in
+          Clet(newclos,
                get_field (Cvar clos) 4,
                curry_fun (get_field (Cvar clos) 3 :: args) newclos (n-1))
     end in
      {fun_name = name2;
       fun_args = [arg, typ_addr; clos, typ_addr];
       fun_body =
-	 if arity - num > 2 then
-	   Cop(Calloc,
+         if arity - num > 2 then
+           Cop(Calloc,
                [alloc_closure_header 5;
                 Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1));
                 int_const (arity - num - 1);
                 Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1) ^ "_app");
-		Cvar arg; Cvar clos])
-	 else
-	   Cop(Calloc,
+                Cvar arg; Cvar clos])
+         else
+           Cop(Calloc,
                      [alloc_closure_header 4;
                       Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1));
                       int_const 1; Cvar arg; Cvar clos]);
       fun_dbg  = Debuginfo.none }
     ::
       (if arity - num > 2 then
-	  let rec iter i =
-	    if i <= arity then
-	      let arg = Ident.create (Printf.sprintf "arg%d" i) in
-	      (arg, typ_addr) :: iter (i+1)
-	    else []
-	  in
-	  let direct_args = iter (num+2) in
-	  let rec iter i args clos =
-	    if i = 0 then
-	      Cop(Capply(typ_addr, Debuginfo.none),
-		  (get_field (Cvar clos) 2) :: args @ [Cvar clos])
-	    else
-	      let newclos = Ident.create "clos" in
-	      Clet(newclos,
-		   get_field (Cvar clos) 4,
-		   iter (i-1) (get_field (Cvar clos) 3 :: args) newclos)
-	  in
-	  let cf =
-	    Cfunction
-	      {fun_name = name1 ^ "_" ^ string_of_int (num+1) ^ "_app";
-	       fun_args = direct_args @ [clos, typ_addr];
-	       fun_body = iter (num+1)
-		  (List.map (fun (arg,_) -> Cvar arg) direct_args) clos;
-	       fun_fast = true;
+          let rec iter i =
+            if i <= arity then
+              let arg = Ident.create (Printf.sprintf "arg%d" i) in
+              (arg, typ_addr) :: iter (i+1)
+            else []
+          in
+          let direct_args = iter (num+2) in
+          let rec iter i args clos =
+            if i = 0 then
+              Cop(Capply(typ_addr, Debuginfo.none),
+                  (get_field (Cvar clos) 2) :: args @ [Cvar clos])
+            else
+              let newclos = Ident.create "clos" in
+              Clet(newclos,
+                   get_field (Cvar clos) 4,
+                   iter (i-1) (get_field (Cvar clos) 3 :: args) newclos)
+          in
+          let cf =
+            Cfunction
+              {fun_name = name1 ^ "_" ^ string_of_int (num+1) ^ "_app";
+               fun_args = direct_args @ [clos, typ_addr];
+               fun_body = iter (num+1)
+                  (List.map (fun (arg,_) -> Cvar arg) direct_args) clos;
+               fun_fast = true;
                fun_dbg = Debuginfo.none }
-	  in
-	  cf :: intermediate_curry_functions arity (num+1)
+          in
+          cf :: intermediate_curry_functions arity (num+1)
        else
-	  intermediate_curry_functions arity (num+1))
+          intermediate_curry_functions arity (num+1))
   end
 
 let curry_function arity =

asmcomp/cmx_format.mli

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: cmx_format.mli 12210 2012-03-08 19:52:03Z doligez $ *)
+(* $Id: cmx_format.mli 12800 2012-07-30 18:59:07Z doligez $ *)
 
 (* Format of .cmx, .cmxa and .cmxs files *)
 
   dynu_magic: string;
   dynu_units: dynunit list;
 }
-

asmcomp/debuginfo.ml

 
 let from_call ev = from_location Dinfo_call ev.Lambda.lev_loc
 let from_raise ev = from_location Dinfo_raise ev.Lambda.lev_loc
-

asmcomp/emitaux.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: emitaux.ml 12699 2012-07-11 15:26:15Z lefessan $ *)
+(* $Id: emitaux.ml 12800 2012-07-30 18:59:07Z doligez $ *)
 
 (* Common functions for emitting assembly code *)
 
 
 let cfi_startproc () =
   if is_cfi_enabled () then
-    emit_string "	.cfi_startproc\n"
+    emit_string "\t.cfi_startproc\n"
 
 let cfi_endproc () =
   if is_cfi_enabled () then
-    emit_string "	.cfi_endproc\n"
+    emit_string "\t.cfi_endproc\n"
 
 let cfi_adjust_cfa_offset n =
   if is_cfi_enabled () then
   begin
-    emit_string "	.cfi_adjust_cfa_offset	"; emit_int n; emit_string "\n";
+    emit_string "\t.cfi_adjust_cfa_offset\t"; emit_int n; emit_string "\n";
   end
 
 (* Emit debug information *)
       with Not_found ->
         let file_num = !file_pos_num_cnt in
         incr file_pos_num_cnt;
-        emit_string "	.file	";
-        emit_int file_num; emit_char '	';
+        emit_string "\t.file\t";
+        emit_int file_num; emit_char '\t';
         emit_string_literal file_name; emit_char '\n';
         file_pos_nums := (file_name,file_num) :: !file_pos_nums;
         file_num in
-    emit_string "	.loc	";
-    emit_int file_num; emit_char '	';
+    emit_string "\t.loc\t";
+    emit_int file_num; emit_char '\t';
     emit_int line; emit_char '\n'
   end

asmcomp/i386/emit.mlp

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: emit.mlp 12448 2012-05-12 09:49:40Z xleroy $ *)
+(* $Id: emit.mlp 12800 2012-07-30 18:59:07Z doligez $ *)
 
 (* Emission of Intel 386 assembly code *)
 

asmcomp/i386/emit_nt.mlp

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: emit_nt.mlp 12166 2012-02-18 16:56:29Z xleroy $ *)
+(* $Id: emit_nt.mlp 12800 2012-07-30 18:59:07Z doligez $ *)
 
 (* Emission of Intel 386 assembly code, MASM syntax. *)
 

asmcomp/power/emit.mlp

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: emit.mlp 11887 2011-12-18 10:00:56Z xleroy $ *)
+(* $Id: emit.mlp 12800 2012-07-30 18:59:07Z doligez $ *)
 
 (* Emission of PowerPC assembly code *)
 

asmcomp/schedgen.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: schedgen.ml 12179 2012-02-21 17:41:02Z xleroy $ *)
+(* $Id: schedgen.ml 12876 2012-08-24 08:14:30Z xleroy $ *)
 
 (* Instruction scheduling *)
 
 
 let add_edge_after son ancestor = add_edge ancestor son 0
 
+(* Add edges from all instructions that define a pseudoregister [arg] being used
+   as argument to node [node] (RAW dependencies *)
+
+let add_RAW_dependencies node arg =
+  try
+    let ancestor = Hashtbl.find code_results arg.loc in
+    add_edge ancestor node ancestor.delay
+  with Not_found ->
+    ()
+
+(* Add edges from all instructions that use a pseudoregister [res] that is
+   defined by node [node] (WAR dependencies). *)
+
+let add_WAR_dependencies node res =
+  let ancestors = Hashtbl.find_all code_uses res.loc in
+  List.iter (add_edge_after node) ancestors
+
+(* Add edges from all instructions that have already defined a pseudoregister
+   [res] that is defined by node [node] (WAW dependencies). *)
+
+let add_WAW_dependencies node res =
+  try
+    let ancestor = Hashtbl.find code_results res.loc in
+    add_edge ancestor node 0
+  with Not_found ->
+    ()
+
 (* Compute length of longest path to a result.
    For leafs of the DAG, see whether their result is used in the instruction
    immediately following the basic block (a "critical" output). *)
   | Lreloadretaddr -> self#reload_retaddr_issue_cycles
   | _ -> assert false
 
+(* Pseudoregisters destroyed by an instruction *)
+
+method private destroyed_by_instr instr =
+  match instr.desc with
+  | Lop op -> Proc.destroyed_at_oper (Iop op)
+  | Lreloadretaddr -> [||]
+  | _ -> assert false
+
 (* Add an instruction to the code dag *)
 
 method private add_instruction ready_queue instr =
   let delay = self#instr_latency instr in
+  let destroyed = self#destroyed_by_instr instr in
   let node =
     { instr = instr;
       delay = delay;
       emitted_ancestors = 0 } in
   (* Add edges from all instructions that define one of the registers used
      (RAW dependencies) *)
-  for i = 0 to Array.length instr.arg - 1 do
-    try
-      let ancestor = Hashtbl.find code_results instr.arg.(i).loc in
-      add_edge ancestor node ancestor.delay
-    with Not_found ->
-      ()
-  done;
+  Array.iter (add_RAW_dependencies node) instr.arg;
   (* Also add edges from all instructions that use one of the result regs
-     of this instruction (WAR dependencies). *)
-  for i = 0 to Array.length instr.res - 1 do
-    let ancestors = Hashtbl.find_all code_uses instr.res.(i).loc in
-    List.iter (add_edge_after node) ancestors
-  done;
+     of this instruction, or a reg destroyed by this instruction
+     (WAR dependencies). *)
+  Array.iter (add_WAR_dependencies node) instr.res;
+  Array.iter (add_WAR_dependencies node) destroyed;   (* PR#5731 *)
   (* Also add edges from all instructions that have already defined one
-     of the results of this instruction (WAW dependencies). *)
-  for i = 0 to Array.length instr.res - 1 do
-    try
-      let ancestor = Hashtbl.find code_results instr.res.(i).loc in
-      add_edge ancestor node 0
-    with Not_found ->
-      ()
-  done;
+     of the results of this instruction, or a reg destroyed by
+     this instruction (WAW dependencies). *)
+  Array.iter (add_WAW_dependencies node) instr.res;
+  Array.iter (add_WAW_dependencies node) destroyed;   (* PR#5731 *)
   (* If this is a load, add edges from the most recent store viewed so
      far (if any) and remember the load.  Also add edges from the most
      recent checkbound and forget that checkbound. *)
   for i = 0 to Array.length instr.res - 1 do
     Hashtbl.add code_results instr.res.(i).loc node
   done;
+  for i = 0 to Array.length destroyed - 1 do
+    Hashtbl.add code_results destroyed.(i).loc node  (* PR#5731 *)
+  done;
   for i = 0 to Array.length instr.arg - 1 do
     Hashtbl.add code_uses instr.arg.(i).loc node
   done;

asmcomp/sparc/emit.mlp

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: emit.mlp 11887 2011-12-18 10:00:56Z xleroy $ *)
+(* $Id: emit.mlp 12800 2012-07-30 18:59:07Z doligez $ *)
 
 (* Emission of Sparc assembly code *)
 
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: amd64.S 12664 2012-07-09 08:35:23Z lefessan $ */
+/* $Id: amd64.S 12907 2012-09-08 16:51:03Z xleroy $ */
 
 /* Asm part of the runtime system, AMD64 processor */
 /* Must be preprocessed by cpp */
 
 /* Record lowest stack address and return address.  Clobbers %rax. */
 #define RECORD_STACK_FRAME(OFFSET) \
-	pushq   %r11 ; \
+        pushq   %r11 ; \
         movq    8+OFFSET(%rsp), %rax ; \
-	STORE_VAR(%rax,caml_last_return_address) ; \
+        STORE_VAR(%rax,caml_last_return_address) ; \
         leaq    16+OFFSET(%rsp), %rax ; \
-	STORE_VAR(%rax,caml_bottom_of_stack) ; \
-	popq    %r11
+        STORE_VAR(%rax,caml_bottom_of_stack) ; \
+        popq    %r11
 
 #else
 
 
 #define RECORD_STACK_FRAME(OFFSET) \
         movq    OFFSET(%rsp), %rax ; \
-	STORE_VAR(%rax,caml_last_return_address) ; \
+        STORE_VAR(%rax,caml_last_return_address) ; \
         leaq    8+OFFSET(%rsp), %rax ; \
-	STORE_VAR(%rax,caml_bottom_of_stack)
+        STORE_VAR(%rax,caml_bottom_of_stack)
 
 #endif
 
         pushq   %r13; \
         pushq   %r14; \
         pushq   %r15; \
-	subq	$(8+10*16), %rsp; \
-	movupd  %xmm6, 0*16(%rsp); \
+        subq    $(8+10*16), %rsp; \
+        movupd  %xmm6, 0*16(%rsp); \
         movupd  %xmm7, 1*16(%rsp); \
         movupd  %xmm8, 2*16(%rsp); \
         movupd  %xmm9, 3*16(%rsp); \
         pushq   %r13; \
         pushq   %r14; \
         pushq   %r15; \
-	subq	$8, %rsp
+        subq    $8, %rsp
 
 #define POP_CALLEE_SAVE_REGS \
-	addq	$8, %rsp; \
+        addq    $8, %rsp; \
         popq    %r15; \
         popq    %r14; \
         popq    %r13; \
         addq    $32768, %rsp
 #endif
     /* Build array of registers, save it into caml_gc_regs */
+        pushq   %r11
+        pushq   %r10
+        pushq   %rbp
         pushq   %r13
         pushq   %r12
-        pushq   %rbp
-        pushq   %r11
-        pushq   %r10
         pushq   %r9
         pushq   %r8
         pushq   %rcx
         pushq   %rax
         STORE_VAR(%rsp, caml_gc_regs)
     /* Save caml_young_ptr, caml_exception_pointer */
-	STORE_VAR(%r15, caml_young_ptr)
-	STORE_VAR(%r14, caml_exception_pointer)
+        STORE_VAR(%r15, caml_young_ptr)
+        STORE_VAR(%r14, caml_exception_pointer)
     /* Save floating-point registers */
         subq    $(16*8), %rsp
         CFI_ADJUST(232)
         movsd   %xmm14, 14*8(%rsp)
         movsd   %xmm15, 15*8(%rsp)
     /* Call the garbage collector */
-	PREPARE_FOR_C_CALL
+        PREPARE_FOR_C_CALL
         call    GCALL(caml_garbage_collection)
-	CLEANUP_AFTER_C_CALL
+        CLEANUP_AFTER_C_CALL
     /* Restore caml_young_ptr, caml_exception_pointer */
-	LOAD_VAR(caml_young_ptr, %r15)
-	LOAD_VAR(caml_exception_pointer, %r14)
+        LOAD_VAR(caml_young_ptr, %r15)
+        LOAD_VAR(caml_exception_pointer, %r14)
     /* Restore all regs used by the code generator */
         movsd   0*8(%rsp), %xmm0
         movsd   1*8(%rsp), %xmm1
         popq    %rcx
         popq    %r8
         popq    %r9
+        popq    %r12
+        popq    %r13
+        popq    %rbp
         popq    %r10
         popq    %r11
-        popq    %rbp
-        popq    %r12
-        popq    %r13
         CFI_ADJUST(-232)
     /* Return to caller */
         ret
         ret
 LBL(100):
         RECORD_STACK_FRAME(0)
-	subq	$8, %rsp
+        subq    $8, %rsp
         call    LBL(caml_call_gc)
-	addq	$8, %rsp
+        addq    $8, %rsp
         jmp     LBL(caml_alloc1)
 
 FUNCTION(G(caml_alloc2))
         ret
 LBL(101):
         RECORD_STACK_FRAME(0)
-	subq	$8, %rsp
+        subq    $8, %rsp
         call    LBL(caml_call_gc)
-	addq	$8, %rsp
+        addq    $8, %rsp
         jmp     LBL(caml_alloc2)
 
 FUNCTION(G(caml_alloc3))
         ret
 LBL(102):
         RECORD_STACK_FRAME(0)
-	subq	$8, %rsp
+        subq    $8, %rsp
         call    LBL(caml_call_gc)
-	addq	$8, %rsp
+        addq    $8, %rsp
         jmp     LBL(caml_alloc3)
 
 FUNCTION(G(caml_allocN))
         addq    $32768, %rsp
 #endif
     /* Make the exception handler and alloc ptr available to the C code */
-	STORE_VAR(%r15, caml_young_ptr)
-	STORE_VAR(%r14, caml_exception_pointer)
+        STORE_VAR(%r15, caml_young_ptr)
+        STORE_VAR(%r14, caml_exception_pointer)
     /* Call the function (address in %rax) */
     /* No need to PREPARE_FOR_C_CALL since the caller already
        reserved the stack space if needed (cf. amd64/proc.ml) */
     /* Common code for caml_start_program and caml_callback* */
 LBL(caml_start_program):
     /* Build a callback link */
-	subq	$8, %rsp	/* stack 16-aligned */
+        subq    $8, %rsp        /* stack 16-aligned */
         PUSH_VAR(caml_gc_regs)
         PUSH_VAR(caml_last_return_address)
         PUSH_VAR(caml_bottom_of_stack)
         CFI_ADJUST(32)
     /* Setup alloc ptr and exception ptr */
-	LOAD_VAR(caml_young_ptr, %r15)
-	LOAD_VAR(caml_exception_pointer, %r14)
+        LOAD_VAR(caml_young_ptr, %r15)
+        LOAD_VAR(caml_exception_pointer, %r14)
     /* Build an exception handler */
         lea     LBL(108)(%rip), %r13
         pushq   %r13
         CFI_ADJUST(-16)
 LBL(109):
     /* Update alloc ptr and exception ptr */
-	STORE_VAR(%r15,caml_young_ptr)
-	STORE_VAR(%r14,caml_exception_pointer)
+        STORE_VAR(%r15,caml_young_ptr)
+        STORE_VAR(%r14,caml_exception_pointer)
     /* Pop the callback link, restoring the global variables */
-	POP_VAR(caml_bottom_of_stack)
+        POP_VAR(caml_bottom_of_stack)
         POP_VAR(caml_last_return_address)
         POP_VAR(caml_gc_regs)
-	addq	$8, %rsp
+        addq    $8, %rsp
     /* Restore callee-save registers. */
         POP_CALLEE_SAVE_REGS
     /* Return to caller. */
 LBL(110):
         movq    %rax, %r12            /* Save exception bucket */
         movq    %rax, C_ARG_1         /* arg 1: exception bucket */
-        movq    0(%rsp), C_ARG_2      /* arg 2: pc of raise */
-        leaq    8(%rsp), C_ARG_3      /* arg 3: sp of raise */
+        popq    C_ARG_2               /* arg 2: pc of raise */
+        movq    %rsp, C_ARG_3         /* arg 3: sp at raise */
         movq    %r14, C_ARG_4         /* arg 4: sp of handler */
-	PREPARE_FOR_C_CALL            /* no need to cleanup after */
+	/* PR#5700: thanks to popq above, stack is now 16-aligned */
+        PREPARE_FOR_C_CALL            /* no need to cleanup after */
         call    GCALL(caml_stash_backtrace)
         movq    %r12, %rax            /* Recover exception bucket */
         movq    %r14, %rsp
 LBL(111):
         movq    C_ARG_1, %r12            /* Save exception bucket */
                                       /* arg 1: exception bucket */
-	LOAD_VAR(caml_last_return_address,C_ARG_2)   /* arg 2: pc of raise */
+        LOAD_VAR(caml_last_return_address,C_ARG_2)   /* arg 2: pc of raise */
         LOAD_VAR(caml_bottom_of_stack,C_ARG_3)       /* arg 3: sp of raise */
         LOAD_VAR(caml_exception_pointer,C_ARG_4)     /* arg 4: sp of handler */
-	PREPARE_FOR_C_CALL            /* no need to cleanup after */
+        subq    $8, %rsp              /* PR#5700: maintain stack alignment */
+        PREPARE_FOR_C_CALL            /* no need to cleanup after */
         call    GCALL(caml_stash_backtrace)
         movq    %r12, %rax            /* Recover exception bucket */
-	LOAD_VAR(caml_exception_pointer,%rsp)
+        LOAD_VAR(caml_exception_pointer,%rsp)
         popq    %r14                  /* Recover previous exception handler */
-	LOAD_VAR(caml_young_ptr,%r15)  /* Reload alloc ptr */
+        LOAD_VAR(caml_young_ptr,%r15)  /* Reload alloc ptr */
         ret
 
 /* Callback from C to OCaml */
         .align  EIGHT_ALIGN
 
 #if defined(SYS_macosx)
-	.literal16
+        .literal16
 #elif defined(SYS_mingw64)
-	.section .rdata,"dr"
+        .section .rdata,"dr"
 #else
-	.section    .rodata.cst8,"a",@progbits
+        .section    .rodata.cst8,"a",@progbits
 #endif
         .globl  G(caml_negf_mask)
         .align  SIXTEEN_ALIGN
 G(caml_negf_mask):
-	.quad	0x8000000000000000, 0
+        .quad   0x8000000000000000, 0
         .globl  G(caml_absf_mask)
         .align  SIXTEEN_ALIGN
 G(caml_absf_mask):
-	.quad	0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF
+        .quad   0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF
 
 #if defined(SYS_linux)
     /* Mark stack as non-executable, PR#4564 */

asmrun/amd64nt.asm

 ;*                                                                     *
 ;***********************************************************************
 
-; $Id: amd64nt.asm 12149 2012-02-10 16:15:24Z doligez $
+; $Id: amd64nt.asm 12907 2012-09-08 16:51:03Z xleroy $
 
 ; Asm part of the runtime system, AMD64 processor, Intel syntax
 
         EXTRN  caml_bottom_of_stack: QWORD
         EXTRN  caml_last_return_address: QWORD
         EXTRN  caml_gc_regs: QWORD
-	EXTRN  caml_exception_pointer: QWORD
+        EXTRN  caml_exception_pointer: QWORD
         EXTRN  caml_backtrace_active: DWORD
         EXTRN  caml_stash_backtrace: NEAR
 
         mov     caml_bottom_of_stack, rax
 L105:
     ; Save caml_young_ptr, caml_exception_pointer
-	mov	caml_young_ptr, r15
-	mov	caml_exception_pointer, r14
+        mov     caml_young_ptr, r15
+        mov     caml_exception_pointer, r14
     ; Build array of registers, save it into caml_gc_regs
+        push    r11
+        push    r10
+        push    rbp
         push    r13
         push    r12
-        push    rbp
-        push    r11
-        push    r10
         push    r9
         push    r8
         push    rcx
         pop     rcx
         pop     r8
         pop     r9
+        pop     r12
+        pop     r13
+        pop     rbp
         pop     r10
         pop     r11
-        pop     rbp
-        pop     r12
-        pop     r13
     ; Restore caml_young_ptr, caml_exception_pointer
-	mov	r15, caml_young_ptr
-	mov	r14, caml_exception_pointer
+        mov     r15, caml_young_ptr
+        mov     r14, caml_exception_pointer
     ; Return to caller
         ret
 
         mov     caml_last_return_address, rax
         lea     rax, [rsp + 8]
         mov     caml_bottom_of_stack, rax
-	sub	rsp, 8
+        sub     rsp, 8
         call    L105
-	add	rsp, 8
+        add     rsp, 8
         jmp     caml_alloc1
 
         PUBLIC  caml_alloc2
         mov     caml_last_return_address, rax
         lea     rax, [rsp + 8]
         mov     caml_bottom_of_stack, rax
-	sub	rsp, 8
+        sub     rsp, 8
         call    L105
-	add	rsp, 8
+        add     rsp, 8
         jmp     caml_alloc2
 
         PUBLIC  caml_alloc3
         mov     caml_last_return_address, rax
         lea     rax, [rsp + 8]
         mov     caml_bottom_of_stack, rax
-	sub	rsp, 8
+        sub     rsp, 8
         call    L105
-	add	rsp, 8
+        add     rsp, 8
         jmp     caml_alloc3
 
         PUBLIC  caml_allocN
         mov     caml_last_return_address, r12
         mov     caml_bottom_of_stack, rsp
     ; Make the exception handler and alloc ptr available to the C code
-	mov	caml_young_ptr, r15
-	mov	caml_exception_pointer, r14
+        mov     caml_young_ptr, r15
+        mov     caml_exception_pointer, r14
     ; Call the function (address in rax)
         call    rax
     ; Reload alloc ptr
-	mov	r15, caml_young_ptr
+        mov     r15, caml_young_ptr
     ; Return to caller
-	push	r12
-	ret
+        push    r12
+        ret
 
 ; Start the OCaml program
 
     ; Common code for caml_start_program and caml_callback*
 L106:
     ; Build a callback link
-	sub	rsp, 8	; stack 16-aligned
+        sub     rsp, 8  ; stack 16-aligned
         push    caml_gc_regs
         push    caml_last_return_address
         push    caml_bottom_of_stack
     ; Setup alloc ptr and exception ptr
-	mov	r15, caml_young_ptr
-	mov	r14, caml_exception_pointer
+        mov     r15, caml_young_ptr
+        mov     r14, caml_exception_pointer
     ; Build an exception handler
         lea     r13, L108
         push    r13
         pop     r12    ; dummy register
 L109:
     ; Update alloc ptr and exception ptr
-	mov	caml_young_ptr, r15
-	mov	caml_exception_pointer, r14
+        mov     caml_young_ptr, r15
+        mov     caml_exception_pointer, r14
     ; Pop the callback restoring, link the global variables
         pop     caml_bottom_of_stack
         pop     caml_last_return_address
         pop     caml_gc_regs
-	add	rsp, 8
+        add     rsp, 8
     ; Restore callee-save registers.
         movapd  xmm6, OWORD PTR [rsp + 0*16]
         movapd  xmm7, OWORD PTR [rsp + 1*16]
         PUBLIC  caml_ml_array_bound_error
         ALIGN   16
 caml_ml_array_bound_error:
-	lea	rax, caml_array_bound_error
-	jmp	caml_c_call
+        lea     rax, caml_array_bound_error
+        jmp     caml_c_call
 
         .DATA
         PUBLIC  caml_system__frametable
         PUBLIC  caml_negf_mask
         ALIGN   16
 caml_negf_mask LABEL QWORD
-	QWORD	8000000000000000H, 0
+        QWORD   8000000000000000H, 0
 
         PUBLIC  caml_absf_mask
         ALIGN   16
 caml_absf_mask LABEL QWORD
-	QWORD	7FFFFFFFFFFFFFFFH, 0FFFFFFFFFFFFFFFFH
+        QWORD   7FFFFFFFFFFFFFFFH, 0FFFFFFFFFFFFFFFFH
 
         END
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: arm.S 12210 2012-03-08 19:52:03Z doligez $ */
+/* $Id: arm.S 12800 2012-07-30 18:59:07Z doligez $ */
 
 /* Asm part of the runtime system, ARM processor */
 /* Must be preprocessed by cpp */
 
         .globl  caml_system__code_begin
 caml_system__code_begin:
-        
+
         .align  2
         .globl  caml_call_gc
         .type caml_call_gc, %function
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: i386.S 12179 2012-02-21 17:41:02Z xleroy $ */
+/* $Id: i386.S 12800 2012-07-30 18:59:07Z doligez $ */
 
 /* Asm part of the runtime system, Intel 386 processor */
 /* Must be preprocessed by cpp */
     /* Pop the exception handler */
         popl    G(caml_exception_pointer)
 #ifdef SYS_macosx
-        addl	$12, %esp
+        addl    $12, %esp
 #else
-        addl	$4, %esp
+        addl    $4, %esp
 #endif
         CFI_ADJUST(-8)
 LBL(109):
         .align  FUNCTION_ALIGN
 G(caml_raise_exception):
         PROFILE_C
-	testl   $1, G(caml_backtrace_active)
+        testl   $1, G(caml_backtrace_active)
         jne     LBL(111)
         movl    4(%esp), %eax
         movl    G(caml_exception_pointer), %esp
         movl    %edx, G(caml_bottom_of_stack)
     /* For MacOS X: re-align the stack */
 #ifdef SYS_macosx
-        andl	$-16, %esp
+        andl    $-16, %esp
 #endif
     /* Branch to [caml_array_bound_error] (never returns) */
         call    G(caml_array_bound_error)

asmrun/i386nt.asm

 ;*                                                                     *
 ;***********************************************************************
 
-; $Id: i386nt.asm 12149 2012-02-10 16:15:24Z doligez $
+; $Id: i386nt.asm 12800 2012-07-30 18:59:07Z doligez $
 
 ; Asm part of the runtime system, Intel 386 processor, Intel syntax
 
-	.386
-	.MODEL FLAT
+        .386
+        .MODEL FLAT
 
         EXTERN  _caml_garbage_collection: PROC
         EXTERN  _caml_apply2: PROC
         EXTERN  _caml_array_bound_error: PROC
         EXTERN  _caml_young_limit: DWORD
         EXTERN  _caml_young_ptr: DWORD
-        EXTERN	_caml_bottom_of_stack: DWORD
-        EXTERN	_caml_last_return_address: DWORD
-        EXTERN	_caml_gc_regs: DWORD
-	EXTERN	_caml_exception_pointer: DWORD
+        EXTERN  _caml_bottom_of_stack: DWORD
+        EXTERN  _caml_last_return_address: DWORD
+        EXTERN  _caml_gc_regs: DWORD
+        EXTERN  _caml_exception_pointer: DWORD
         EXTERN  _caml_backtrace_active: DWORD
         EXTERN  _caml_stash_backtrace: PROC
 
         PUBLIC  _caml_alloc2
         PUBLIC  _caml_alloc3
         PUBLIC  _caml_allocN
-	PUBLIC  _caml_call_gc
+        PUBLIC  _caml_call_gc
 
 _caml_call_gc:
     ; Record lowest stack address and return address
-        mov	eax, [esp]
+        mov     eax, [esp]
         mov     _caml_last_return_address, eax
         lea     eax, [esp+4]
         mov     _caml_bottom_of_stack, eax
         push    eax
         mov     _caml_gc_regs, esp
     ; Call the garbage collector
-        call	_caml_garbage_collection
+        call    _caml_garbage_collection
     ; Restore all regs used by the code generator
-	pop     eax
+        pop     eax
         pop     ebx
         pop     ecx
         pop     edx
 
         ALIGN  4
 _caml_alloc1:
-        mov	eax, _caml_young_ptr
-        sub	eax, 8
-        mov	_caml_young_ptr, eax
-        cmp	eax, _caml_young_limit
-        jb	L100
+        mov     eax, _caml_young_ptr
+        sub     eax, 8
+        mov     _caml_young_ptr, eax
+        cmp     eax, _caml_young_limit
+        jb      L100
         ret
-L100:   mov	eax, [esp]
+L100:   mov     eax, [esp]
         mov     _caml_last_return_address, eax
         lea     eax, [esp+4]
         mov     _caml_bottom_of_stack, eax
 
         ALIGN  4
 _caml_alloc2:
-        mov	eax, _caml_young_ptr
-        sub	eax, 12
-        mov	_caml_young_ptr, eax
-        cmp	eax, _caml_young_limit
-        jb	L101
+        mov     eax, _caml_young_ptr
+        sub     eax, 12
+        mov     _caml_young_ptr, eax
+        cmp     eax, _caml_young_limit
+        jb      L101
         ret
-L101:   mov	eax, [esp]
+L101:   mov     eax, [esp]
         mov     _caml_last_return_address, eax
         lea     eax, [esp+4]
         mov     _caml_bottom_of_stack, eax
 
         ALIGN  4
 _caml_alloc3:
-        mov	eax, _caml_young_ptr
-        sub	eax, 16
-        mov	_caml_young_ptr, eax
-        cmp	eax, _caml_young_limit
-        jb	L102
+        mov     eax, _caml_young_ptr
+        sub     eax, 16
+        mov     _caml_young_ptr, eax
+        cmp     eax, _caml_young_limit
+        jb      L102
         ret
-L102:   mov	eax, [esp]
+L102:   mov     eax, [esp]
         mov     _caml_last_return_address, eax
         lea     eax, [esp+4]
         mov     _caml_bottom_of_stack, eax
         neg     eax                     ; eax = size
         push    eax                     ; save desired size
         sub     _caml_young_ptr, eax         ; must update young_ptr
-        mov	eax, [esp+4]
+        mov     eax, [esp+4]
         mov     _caml_last_return_address, eax
         lea     eax, [esp+8]
         mov     _caml_bottom_of_stack, eax
         ALIGN  4
 _caml_c_call:
     ; Record lowest stack address and return address
-        mov	edx, [esp]
-        mov	_caml_last_return_address, edx
-        lea	edx, [esp+4]
-        mov	_caml_bottom_of_stack, edx
+        mov     edx, [esp]
+        mov     _caml_last_return_address, edx
+        lea     edx, [esp+4]
+        mov     _caml_bottom_of_stack, edx
     ; Call the function (address in %eax)
-        jmp	eax
+        jmp     eax
 
 ; Start the OCaml program
 
         ALIGN  4
 _caml_start_program:
     ; Save callee-save registers
-        push	ebx
-        push	esi
-        push	edi
-        push	ebp
+        push    ebx
+        push    esi
+        push    edi
+        push    ebp
     ; Initial code pointer is caml_program
         mov     esi, offset _caml_program
 
 L106:
     ; Build a callback link
         push    _caml_gc_regs
-        push	_caml_last_return_address
-        push	_caml_bottom_of_stack
+        push    _caml_last_return_address
+        push    _caml_bottom_of_stack
     ; Build an exception handler
-        push	L108
-        push	_caml_exception_pointer
-        mov	_caml_exception_pointer, esp
+        push    L108
+        push    _caml_exception_pointer
+        mov     _caml_exception_pointer, esp
     ; Call the OCaml code
-        call	esi
+        call    esi
 L107:
     ; Pop the exception handler
-        pop	_caml_exception_pointer
-        pop	esi             ; dummy register
+        pop     _caml_exception_pointer
+        pop     esi             ; dummy register
 L109:
     ; Pop the callback link, restoring the global variables
     ; used by caml_c_call
-        pop	_caml_bottom_of_stack
-        pop	_caml_last_return_address
+        pop     _caml_bottom_of_stack
+        pop     _caml_last_return_address
         pop     _caml_gc_regs
     ; Restore callee-save registers.
-        pop	ebp
-        pop	edi
-        pop	esi
-        pop	ebx
+        pop     ebp
+        pop     edi
+        pop     esi
+        pop     ebx
     ; Return to caller.
         ret
 L108:
 _caml_raise_exn:
         test    _caml_backtrace_active, 1
         jne     L110
-        mov	esp, _caml_exception_pointer
-        pop	_caml_exception_pointer
+        mov     esp, _caml_exception_pointer
+        pop     _caml_exception_pointer
         ret
 L110:
         mov     esi, eax                ; Save exception bucket in esi
 _caml_raise_exception:
         test    _caml_backtrace_active, 1
         jne     L111
-        mov	eax, [esp+4]
-        mov	esp, _caml_exception_pointer
-        pop	_caml_exception_pointer
+        mov     eax, [esp+4]
+        mov     esp, _caml_exception_pointer
+        pop     _caml_exception_pointer
         ret
 L111:
         mov     esi, [esp+4]            ; Save exception bucket in esi
         ALIGN  4
 _caml_callback_exn:
     ; Save callee-save registers
-        push	ebx
-        push	esi
-        push	edi
-        push	ebp
+        push    ebx
+        push    esi
+        push    edi
+        push    ebp
     ; Initial loading of arguments
-        mov	ebx, [esp+20]   ; closure
-        mov	eax, [esp+24]   ; argument
-        mov	esi, [ebx]      ; code pointer
+        mov     ebx, [esp+20]   ; closure
+        mov     eax, [esp+24]   ; argument
+        mov     esi, [ebx]      ; code pointer
         jmp     L106
 
         PUBLIC  _caml_callback2_exn
         ALIGN  4
 _caml_callback2_exn:
     ; Save callee-save registers
-        push	ebx
-        push	esi
-        push	edi
-        push	ebp
+        push    ebx
+        push    esi
+        push    edi
+        push    ebp
     ; Initial loading of arguments
-        mov	ecx, [esp+20]   ; closure
-        mov	eax, [esp+24]   ; first argument
-        mov	ebx, [esp+28]   ; second argument
-        mov	esi, offset _caml_apply2   ; code pointer
-        jmp	L106
+        mov     ecx, [esp+20]   ; closure
+        mov     eax, [esp+24]   ; first argument
+        mov     ebx, [esp+28]   ; second argument
+        mov     esi, offset _caml_apply2   ; code pointer
+        jmp     L106
 
         PUBLIC  _caml_callback3_exn
-        ALIGN	4
+        ALIGN   4
 _caml_callback3_exn:
     ; Save callee-save registers
-        push	ebx
-        push	esi
-        push	edi
-        push	ebp
+        push    ebx
+        push    esi
+        push    edi
+        push    ebp
     ; Initial loading of arguments
-        mov	edx, [esp+20]   ; closure
-        mov	eax, [esp+24]   ; first argument
-        mov	ebx, [esp+28]   ; second argument
-        mov	ecx, [esp+32]   ; third argument
-        mov	esi, offset _caml_apply3   ; code pointer
-        jmp	L106
+        mov     edx, [esp+20]   ; closure
+        mov     eax, [esp+24]   ; first argument
+        mov     ebx, [esp+28]   ; second argument
+        mov     ecx, [esp+32]   ; third argument
+        mov     esi, offset _caml_apply3   ; code pointer
+        jmp     L106
 
         PUBLIC  _caml_ml_array_bound_error
         ALIGN   4

asmrun/power-elf.S

 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: power-elf.S 12160 2012-02-17 10:43:50Z xleroy $ */
+/* $Id: power-elf.S 12800 2012-07-30 18:59:07Z doligez $ */
 
 #define Addrglobal(reg,glob) \
         addis   reg, 0, glob@ha; \
 
         .globl  caml_system__code_begin
 caml_system__code_begin:
-        
+
         .globl  caml_call_gc
         .type   caml_call_gc, @function
 caml_call_gc:

asmrun/power-rhapsody.S

 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: power-rhapsody.S 12159 2012-02-17 10:12:09Z xleroy $ */
+/* $Id: power-rhapsody.S 12800 2012-07-30 18:59:07Z doligez $ */
 
 #ifdef __ppc64__
 #define X(a,b) b
 
         .globl  _caml_system__code_begin
 _caml_system__code_begin:
-        
+
 /* Invoke the garbage collector. */
 
         .globl  _caml_call_gc
 L112:
         mr      r28, r3        /* preserve exn bucket in callee-save */
                                /* arg 1: exception bucket (already in r3) */
-	Loadglobal r4, _caml_last_return_address, r11 /* arg 2: PC of raise */
-	Loadglobal r5, _caml_bottom_of_stack, r11 /* arg 3: SP of raise */
+        Loadglobal r4, _caml_last_return_address, r11 /* arg 2: PC of raise */
+        Loadglobal r5, _caml_bottom_of_stack, r11 /* arg 3: SP of raise */
         Loadglobal r6, _caml_exception_pointer, r11 /* arg 4: SP of handler */
         addi    r1, r1, -(16*WORD)    /* reserve stack space for C call */
         bl      _caml_stash_backtrace
         gdata   L105 + 4       /* return address into callback */
         .short  -1              /* negative size count => use callback link */
         .short  0               /* no roots here */
-	.align	X(2,3)
+        .align  X(2,3)
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: roots.c 12149 2012-02-10 16:15:24Z doligez $ */
+/* $Id: roots.c 12800 2012-07-30 18:59:07Z doligez $ */
 
 /* To walk the memory roots for garbage collection */
 
     sz += (*caml_stack_usage_hook)();
   return sz;
 }
-
-
 /*                                                                     */
 /***********************************************************************/
 
-/* $Id: sparc.S 12159 2012-02-17 10:12:09Z xleroy $ */
+/* $Id: sparc.S 12800 2012-07-30 18:59:07Z doligez $ */
 
 /* Asm part of the runtime system for the Sparc processor.  */
 /* Must be preprocessed by cpp */
         .half   0               /* no roots */
 
 #ifdef SYS_solaris
-	.type caml_allocN, #function
-	.type caml_call_gc, #function
+        .type caml_allocN, #function
+        .type caml_call_gc, #function
         .type caml_c_call, #function
         .type caml_start_program, #function
         .type caml_raise_exception, #function
-	.type caml_system__frametable, #object
+        .type caml_system__frametable, #object
 #endif

Binary file modified.

Binary file modified.

Binary file modified.

bytecomp/bytepackager.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: bytepackager.ml 12202 2012-03-07 17:50:17Z frisch $ *)
+(* $Id: bytepackager.ml 12800 2012-07-30 18:59:07Z doligez $ *)
 
 (* "Package" a set of .cmo files into one .cmo file having the
    original compilation units as sub-modules. *)
           (* PR#5276, as above *)
           let name = Ident.name id in
           if String.contains name '.' then
-	    Reloc_setglobal (Ident.create_persistent (packagename ^ "." ^ name))
+            Reloc_setglobal (Ident.create_persistent (packagename ^ "." ^ name))
           else
             rel
         end
 let package_files ppf files targetfile =
     let files =
     List.map
-	(fun f ->
+        (fun f ->
         try find_in_path !Config.load_path f
         with Not_found -> raise(Error(File_not_found f)))
-	files in
+        files in
     let prefix = chop_extensions targetfile in
     let targetcmi = prefix ^ ".cmi" in
     let targetname = String.capitalize(Filename.basename prefix) in

bytecomp/translcore.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: translcore.ml 12681 2012-07-10 08:33:16Z garrigue $ *)
+(* $Id: translcore.ml 12871 2012-08-21 07:14:03Z lefessan $ *)
 
 (* Translation from typed abstract syntax to lambda terms,
    for the core language *)
   { prim_name = "caml_obj_dup"; prim_arity = 1; prim_alloc = true;
     prim_native_name = ""; prim_native_float = false }
 
+let find_primitive loc prim_name =
+  match prim_name with
+      "%revapply" -> Prevapply loc
+    | "%apply" -> Pdirapply loc
+    | name -> Hashtbl.find primitives_table name
+
 let transl_prim loc prim args =
   let prim_name = prim.prim_name in
   try
     end
   with Not_found ->
   try
-    let p =
-      match prim_name with
-          "%revapply" -> Prevapply loc
-        | "%apply" -> Pdirapply loc
-        | name -> Hashtbl.find primitives_table name in
+    let p = find_primitive loc prim_name in
     (* Try strength reduction based on the type of the argument *)
     begin match (p, args) with
         (Psetfield(n, _), [arg1; arg2]) -> Psetfield(n, maybe_pointer arg2)
 
 (* Eta-expand a primitive without knowing the types of its arguments *)
 
-let transl_primitive p =
+let transl_primitive loc p =
   let prim =
     try
       let (gencomp, _, _, _, _, _, _, _) =
       gencomp