*** ocaml-3.08.1/Makefile	Fri Jul 16 12:11:33 2004
--- ocaml-3.08.1/Makefile	Mon Oct  4 18:11:34 2004
***************
*** 334,339 ****
--- 334,340 ----
              -e 's|%%ARCH%%|$(ARCH)|' \
              -e 's|%%MODEL%%|$(MODEL)|' \
              -e 's|%%SYSTEM%%|$(SYSTEM)|' \
+             -e 's|%%64%%|$(SIXTY_FOUR)|' \
              -e 's|%%EXT_OBJ%%|.o|' \
              -e 's|%%EXT_ASM%%|.s|' \
              -e 's|%%EXT_LIB%%|.a|' \
*** ocaml-3.08.1/asmcomp/asmpackager.ml	Tue Aug 10 08:16:47 2004
--- ocaml-3.08.1/asmcomp/asmpackager.ml	Mon Oct  4 18:11:34 2004
***************
*** 88,97 ****
                       search_substring " R " l 0) in
          let j = try search_substring "__" l i
                  with Not_found -> String.length l in
!         let k = if l.[i] = '_' then i + 1 else i in
!         if j - k > 4 && String.sub l k 4 = "caml"
!            && List.mem (String.sub l (k + 4) (j - k - 4)) units then
!           symbs := (String.sub l i (String.length l - i)) :: !symbs
        with Not_found ->
          ()
      done
--- 88,98 ----
                       search_substring " R " l 0) in
          let j = try search_substring "__" l i
                  with Not_found -> String.length l in
! 	if i < String.length l then (* ignore missing name *)
!           let k = if l.[i] = '_' then i + 1 else i in
!           if j - k > 4 && String.sub l k 4 = "caml"
!               && List.mem (String.sub l (k + 4) (j - k - 4)) units then
!             symbs := (String.sub l i (String.length l - i)) :: !symbs
        with Not_found ->
          ()
      done
*** ocaml-3.08.1/asmcomp/cmmgen.ml	Wed May 26 07:10:27 2004
--- ocaml-3.08.1/asmcomp/cmmgen.ml	Mon Oct  4 18:14:40 2004
***************
*** 465,483 ****
          else arg in
        Cop(Calloc, [alloc_boxedint_header;
                     Cconst_symbol(operations_boxed_int bi);
!                    arg])
  
  let unbox_int bi arg =
!   match arg with
!     Cop(Calloc, [hdr; ops; Cop(Clsl, [contents; Cconst_int 32])])
!     when bi = Pint32 && size_int = 8 && big_endian ->
        (* Force sign-extension of low 32 bits *)
        Cop(Casr, [Cop(Clsl, [contents; Cconst_int 32]); Cconst_int 32])
!   | Cop(Calloc, [hdr; ops; contents])
!     when bi = Pint32 && size_int = 8 && not big_endian ->
        (* Force sign-extension of low 32 bits *)
        Cop(Casr, [Cop(Clsl, [contents; Cconst_int 32]); Cconst_int 32])
!   | Cop(Calloc, [hdr; ops; contents]) -> 
        contents
    | _ ->
        Cop(Cload(if bi = Pint32 then Thirtytwo_signed else Word),
--- 465,486 ----
          else arg in
        Cop(Calloc, [alloc_boxedint_header;
                     Cconst_symbol(operations_boxed_int bi);
!                    arg'])
  
  let unbox_int bi arg =
!   match bi,arg with
!   | Pint32,Cop(Calloc, [hdr; ops; Cop(Clsl, [Cop(Casr, [contents; Cconst_int n]); Cconst_int 32])])
!     when size_int = 8 && big_endian && n < 32 ->
!       Cop(Casr, [Cop(Clsl, [contents; Cconst_int 32]); Cconst_int (32 + n)])
!   | Pint32,Cop(Calloc, [hdr; ops; Cop(Clsl, [contents; Cconst_int 32])])
!     when size_int = 8 && big_endian ->
        (* Force sign-extension of low 32 bits *)
        Cop(Casr, [Cop(Clsl, [contents; Cconst_int 32]); Cconst_int 32])
!   | Pint32,Cop(Calloc, [hdr; ops; contents])
!     when size_int = 8 && not big_endian ->
        (* Force sign-extension of low 32 bits *)
        Cop(Casr, [Cop(Clsl, [contents; Cconst_int 32]); Cconst_int 32])
!   | _,Cop(Calloc, [hdr; ops; contents]) -> 
        contents
    | _ ->
        Cop(Cload(if bi = Pint32 then Thirtytwo_signed else Word),
*** ocaml-3.08.1/asmcomp/sparc/arch.ml	Fri Nov 29 10:03:08 2002
--- ocaml-3.08.1/asmcomp/sparc/arch.ml	Mon Oct  4 17:50:49 2004
***************
*** 10,15 ****
--- 10,16 ----
  (*                                                                     *)
  (***********************************************************************)
  
+ (* Modified by John Carr, based on: *)
  (* $Id: arch.ml,v 1.8 2002/11/29 15:03:08 xleroy Exp $ *)
  
  (* Specific operations for the Sparc processor *)
***************
*** 17,50 ****
  open Misc
  open Format
  
  (* SPARC V8 adds multiply and divide.
     SPARC V9 adds double precision float operations, conditional
     move, and more instructions that are only useful in 64 bit mode.
     Sun calls 32 bit V9 "V8+". *)
  type arch_version = SPARC_V7 | SPARC_V8 | SPARC_V9
  
! let arch_version = ref SPARC_V7
  
  let command_line_options =
!   [ "-march=v8", Arg.Unit (fun () -> arch_version := SPARC_V8),
          " Generate code for SPARC V8 processors";
      "-march=v9", Arg.Unit (fun () -> arch_version := SPARC_V9),
          " Generate code for SPARC V9 processors" ]
  
! type specific_operation = unit          (* None worth mentioning *)
  
  (* Addressing modes *)
  
  type addressing_mode =
      Ibased of string * int              (* symbol + displ *)
    | Iindexed of int                     (* reg + displ *)
  
  (* Sizes, endianness *)
  
  let big_endian = true
  
! let size_addr = 4
! let size_int = 4
  let size_float = 8
  
  (* Operations on addressing modes *)
--- 18,64 ----
  open Misc
  open Format
  
+ (* If true, generate 64 bit code.  *)
+ let sixty_four = Config.sixty_four
+ 
  (* SPARC V8 adds multiply and divide.
     SPARC V9 adds double precision float operations, conditional
     move, and more instructions that are only useful in 64 bit mode.
     Sun calls 32 bit V9 "V8+". *)
  type arch_version = SPARC_V7 | SPARC_V8 | SPARC_V9
  
! let arch_version = ref (if sixty_four then SPARC_V9 else SPARC_V8)
  
  let command_line_options =
!   if sixty_four then [] else
!   [ "-march=v7", Arg.Unit (fun () -> arch_version := SPARC_V7),
!         " Generate code for SPARC V7 processors";
!     "-march=v8", Arg.Unit (fun () -> arch_version := SPARC_V8),
          " Generate code for SPARC V8 processors";
      "-march=v9", Arg.Unit (fun () -> arch_version := SPARC_V9),
          " Generate code for SPARC V9 processors" ]
  
! type specific_operation =
!     Icmov of string * int * int
!   | Icmov_imm of string * int * int * int
!   | Isethi of string * int
!   | Iaddlo of string * int
!   | Isra32 of int
  
  (* Addressing modes *)
  
  type addressing_mode =
      Ibased of string * int              (* symbol + displ *)
+   | Ilo of string * int                 (* %lo(symbol + displ) *)
    | Iindexed of int                     (* reg + displ *)
+   | Iindexed2                           (* reg + reg *)
  
  (* Sizes, endianness *)
  
  let big_endian = true
  
! let size_addr = if sixty_four then 8 else 4
! let size_int = if sixty_four then 8 else 4
  let size_float = 8
  
  (* Operations on addressing modes *)
***************
*** 55,75 ****
    match addr with
      Ibased(s, n) -> Ibased(s, n + delta)
    | Iindexed n -> Iindexed(n + delta)
  
  let num_args_addressing = function
      Ibased(s, n) -> 0
    | Iindexed n -> 1
  
  (* Printing operations and addressing modes *)
  
  let print_addressing printreg addr ppf arg =
    match addr with
    | Ibased(s, n) ->
!       let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
!       fprintf ppf "\"%s\"%s" s idx
    | Iindexed n ->
!       let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
!       fprintf ppf "%a%s" printreg arg.(0) idx
  
  let print_specific_operation printreg op ppf arg =
!   Misc.fatal_error "Arch_sparc.print_specific_operation"
--- 69,117 ----
    match addr with
      Ibased(s, n) -> Ibased(s, n + delta)
    | Iindexed n -> Iindexed(n + delta)
+   | Ilo _
+   | Iindexed2 -> Misc.fatal_error "Arch_sparc.offset_addressing"
  
  let num_args_addressing = function
      Ibased(s, n) -> 0
+   | Ilo _ -> 1
    | Iindexed n -> 1
+   | Iindexed2 -> 2
  
  (* Printing operations and addressing modes *)
  
  let print_addressing printreg addr ppf arg =
    match addr with
+   | Ibased(s, 0) ->
+       fprintf ppf "\"%s\"" s
    | Ibased(s, n) ->
!       fprintf ppf "\"%s\" + %i" s n
!   | Ilo(s, 0) ->
!       fprintf ppf "%a + %%lo(%s)" printreg arg.(0) s
!   | Ilo(s, n) ->
!       fprintf ppf "%a + %%lo(%s + %i)" printreg arg.(0) s n
!   | Iindexed 0 ->
!       fprintf ppf "%a" printreg arg.(0)
    | Iindexed n ->
!       fprintf ppf "%a + %i" printreg arg.(0) n
!   | Iindexed2 ->
!       fprintf ppf "%a + %a" printreg arg.(0) printreg arg.(1)
  
  let print_specific_operation printreg op ppf arg =
!   match op with
!     Icmov(cond,iffalse,iftrue) ->
!       fprintf ppf "(%a %s %a ? %d : %d)" printreg arg.(0) cond printreg arg.(1) iftrue iffalse
!   | Icmov_imm(cond,arg1,iffalse,iftrue) ->
!       fprintf ppf "(%a %s %d ? %d : %d)" printreg arg.(0) cond arg1 iftrue iffalse
!   | Isethi(sym,0) -> 
!       fprintf ppf "%%hi(%s)" sym
!   | Isethi(sym,off) -> 
!       fprintf ppf "%%hi(%s+%d)" sym off
!   | Iaddlo(sym,0) ->
!       fprintf ppf "%a + %%lo(%s)" printreg arg.(0) sym
!   | Iaddlo(sym,off) ->
!       fprintf ppf "%a + %%lo(%s+%d)" printreg arg.(0) sym off
!   | Isra32 0 ->
!       fprintf ppf "sext %a" printreg arg.(0)
!   | Isra32 n ->
!       fprintf ppf "sra32 %i %a" n printreg arg.(0)
*** ocaml-3.08.1/asmcomp/sparc/proc.ml	Fri Nov 29 10:03:08 2002
--- ocaml-3.08.1/asmcomp/sparc/proc.ml	Mon Oct  4 18:11:34 2004
***************
*** 10,15 ****
--- 10,16 ----
  (*                                                                     *)
  (***********************************************************************)
  
+ (* Modified by John Carr.  Based on: *)
  (* $Id: proc.ml,v 1.7 2002/11/29 15:03:08 xleroy Exp $ *)
  
  (* Description of the Sparc processor *)
***************
*** 30,66 ****
      %o0 - %o5   0 - 5       function results, C functions args / res
      %i0 - %i5   6 - 11      function arguments, preserved by C
      %l0 - %l4   12 - 16     general purpose, preserved by C
!     %g3 - %g4   17 - 18     general purpose, not preserved by C
  
      %l5                     exception pointer
      %l6                     allocation pointer
      %l7                     address of allocation limit
  
      %g0                     always zero
!     %g1 - %g2               temporaries
!     %g5 - %g7               reserved for system libraries
  
      %f0 - %f10  100 - 105   function arguments and results
      %f12 - %f28 106 - 114   general purpose
      %f30                    temporary *)
  
  let int_reg_name = [|
    (* 0-5 *)   "%o0"; "%o1"; "%o2"; "%o3"; "%o4"; "%o5";
    (* 6-11 *)  "%i0"; "%i1"; "%i2"; "%i3"; "%i4"; "%i5";
    (* 12-16 *) "%l0"; "%l1"; "%l2"; "%l3"; "%l4";
!   (* 17-18 *) "%g3"; "%g4"
  |]
!   
  let float_reg_name = [|
    (* 100-105 *) "%f0"; "%f2"; "%f4"; "%f6"; "%f8"; "%f10";
    (* 106-109 *) "%f12"; "%f14"; "%f16"; "%f18";
    (* 110-114 *) "%f20"; "%f22"; "%f24"; "%f26"; "%f28";
!   (* 115 *)     "%f30";
    (* Odd parts of register pairs *)
!   (* 116-121 *) "%f1"; "%f3"; "%f5"; "%f7"; "%f9"; "%f11";
!   (* 122-125 *) "%f13"; "%f15"; "%f17"; "%f19";
!   (* 126-130 *) "%f21"; "%f23"; "%f25"; "%f27"; "%f29";
!   (* 131 *)     "%f31"
  |]
  
  let num_register_classes = 2
--- 31,82 ----
      %o0 - %o5   0 - 5       function results, C functions args / res
      %i0 - %i5   6 - 11      function arguments, preserved by C
      %l0 - %l4   12 - 16     general purpose, preserved by C
!     %g3         17          general purpose, not preserved by C
!                             (preserved in 64 bit mode when compiling
!                             with -xregs=no%appl)
!     %g4		18          general purpose, not preserved by C
!     %g2         19          same as %g3 in 64 bit mode only
  
      %l5                     exception pointer
      %l6                     allocation pointer
      %l7                     address of allocation limit
  
      %g0                     always zero
!     %g1                     temporaries
!     %g3, %g4                temporaries in 32 bit mode
!     %g5                     temporaries in 64 bit mode
!     %g5                     reserved for system libraries in 32 bit mode
!     %g6 - %g7               reserved for system libraries
  
      %f0 - %f10  100 - 105   function arguments and results
      %f12 - %f28 106 - 114   general purpose
+     %f32 - %f62 115 - 130   general purpose, SPARC V9 only
      %f30                    temporary *)
  
  let int_reg_name = [|
    (* 0-5 *)   "%o0"; "%o1"; "%o2"; "%o3"; "%o4"; "%o5";
    (* 6-11 *)  "%i0"; "%i1"; "%i2"; "%i3"; "%i4"; "%i5";
    (* 12-16 *) "%l0"; "%l1"; "%l2"; "%l3"; "%l4";
!   (* 17-19 *) "%g3"; "%g4"; "%g2"; "%g5"
  |]
! 
! (* Ensure that %g2 is not erroneously used as a general purpose
!    register in 32 bit mode. *)
! let () = if not sixty_four then begin int_reg_name.(19) <- "%invalid"; int_reg_name.(20) <- "%invalid" end
! 
  let float_reg_name = [|
    (* 100-105 *) "%f0"; "%f2"; "%f4"; "%f6"; "%f8"; "%f10";
    (* 106-109 *) "%f12"; "%f14"; "%f16"; "%f18";
    (* 110-114 *) "%f20"; "%f22"; "%f24"; "%f26"; "%f28";
!   (* 115-119 *) "%f32"; "%f34"; "%f36"; "%f38"; "%f40";
!   (* 120-124 *) "%f42"; "%f44"; "%f46"; "%f48"; "%f50";
!   (* 125-130 *) "%f52"; "%f54"; "%f56"; "%f58"; "%f60"; "%f62";
!   (* 131 *)     "%f30";
    (* Odd parts of register pairs *)
!   (* 132-137 *) "%f1"; "%f3"; "%f5"; "%f7"; "%f9"; "%f11";
!   (* 138-141 *) "%f13"; "%f15"; "%f17"; "%f19";
!   (* 142-146 *) "%f21"; "%f23"; "%f25"; "%f27"; "%f29";
!   (* 147 *)     "%f31"
  |]
  
  let num_register_classes = 2
***************
*** 71,77 ****
    | Addr -> 0
    | Float -> 1
  
! let num_available_registers = [| 19; 15 |]
  
  let first_available_register = [| 0; 100 |]
  
--- 87,94 ----
    | Addr -> 0
    | Float -> 1
  
! let num_available_registers =
!   [|if sixty_four then 21 else 19; if !arch_version = SPARC_V9 then 31 else 15|]
  
  let first_available_register = [| 0; 100 |]
  
***************
*** 83,99 ****
  (* Representation of hard registers by pseudo-registers *)
  
  let hard_int_reg =
!   let v = Array.create 19 Reg.dummy in
!   for i = 0 to 18 do v.(i) <- Reg.at_location Int (Reg i) done;
    v
  
  let hard_float_reg =
!   let v = Array.create 32 Reg.dummy in
!   for i = 0 to 31 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done;
    v
  
  let all_phys_regs =
!   Array.append hard_int_reg (Array.sub hard_float_reg 0 15)
    (* No need to include the odd parts of float register pairs,
       nor the temporary register %f30 *)
  
--- 100,116 ----
  (* Representation of hard registers by pseudo-registers *)
  
  let hard_int_reg =
!   let v = Array.create 21 Reg.dummy in
!   for i = 0 to 20 do v.(i) <- Reg.at_location Int (Reg i) done;
    v
  
  let hard_float_reg =
!   let v = Array.create 48 Reg.dummy in
!   for i = 0 to 47 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done;
    v
  
  let all_phys_regs =
!   Array.append hard_int_reg (Array.sub hard_float_reg 0 (if !arch_version = SPARC_V9 then 31 else 15))
    (* No need to include the odd parts of float register pairs,
       nor the temporary register %f30 *)
  
***************
*** 130,152 ****
            ofs := !ofs + size_float
          end
    done;
!   (loc, Misc.align !ofs 8)         (* Keep stack 8-aligned *)
  
  let incoming ofs = Incoming ofs
  let outgoing ofs = Outgoing ofs
  let not_supported ofs = fatal_error "Proc.loc_results: cannot call"
  
  let loc_arguments arg =
!   calling_conventions 6 15 100 105 outgoing arg
  let loc_parameters arg =
!   let (loc, ofs) = calling_conventions 6 15 100 105 incoming arg in loc
  let loc_results res =
    let (loc, ofs) = calling_conventions 0 5 100 105 not_supported res in loc
  
! (* On the Sparc, all arguments to C functions, even floating-point arguments,
!    are passed in %o0..%o5, then on the stack *)
  
! let loc_external_arguments arg =
    let loc = ref [] in
    let reg = ref 0 (* %o0 *) in
    let ofs = ref (-4) in              (* start at sp + 92 = sp + 96 - 4 *)
--- 147,192 ----
            ofs := !ofs + size_float
          end
    done;
!   (loc, Misc.align !ofs (2 * size_addr))       (* Keep stack aligned *)
  
  let incoming ofs = Incoming ofs
  let outgoing ofs = Outgoing ofs
  let not_supported ofs = fatal_error "Proc.loc_results: cannot call"
  
  let loc_arguments arg =
!   calling_conventions 6 15 100 110 outgoing arg
!   (* 15 could be 16 in 64 bit mode. *)
  let loc_parameters arg =
!   let (loc, ofs) = calling_conventions 6 15 100 110 incoming arg in loc
  let loc_results res =
    let (loc, ofs) = calling_conventions 0 5 100 105 not_supported res in loc
  
! (* The SPARC 64 bit ABI specifies that the first six arguments are passed
!    in the appropriate type of register, skipping over the corresponding
!    register of the other class. *)
! 
! let loc_external_arguments_64 arg =
!   let loc = ref [] in
!   let ofs = ref (0) in               (* start at (unbiased) sp + 128 *)
!   for i = 0 to Array.length arg - 1 do
!     if i <= 5 (* %o5 or %f5 *) then begin
!       match arg.(i).typ with
!         Int | Addr ->
!           loc := phys_reg i :: !loc;
!       | Float ->
!           loc := phys_reg (i + 100) :: !loc;
!     end else begin
!       loc := stack_slot (outgoing !ofs) arg.(i).typ :: !loc;
!       ofs := !ofs + size_component arg.(i).typ
!     end
!   done;
!   (* Keep stack 16-aligned *)
!   (Array.of_list(List.rev !loc), Misc.align !ofs 16)
! 
! (* On 32 bit SPARC, all arguments to C functions, even floating-point
!    arguments, are passed in %o0..%o5, then on the stack *)
  
! let loc_external_arguments_32 arg =
    let loc = ref [] in
    let reg = ref 0 (* %o0 *) in
    let ofs = ref (-4) in              (* start at sp + 92 = sp + 96 - 4 *)
***************
*** 168,173 ****
--- 208,219 ----
    (* Keep stack 8-aligned *)
    (Array.of_list(List.rev !loc), Misc.align (!ofs + 4) 8)
  
+ let loc_external_arguments =
+   if sixty_four then
+     loc_external_arguments_64
+   else
+     loc_external_arguments_32
+ 
  let loc_external_results res =
    let (loc, ofs) = calling_conventions 0 0 100 100 not_supported res in loc
  
***************
*** 177,189 ****
  
  let destroyed_at_c_call = (* %l0-%l4, %i0-%i5 preserved *)
    Array.of_list(List.map phys_reg
!     [0; 1; 2; 3; 4; 5; 17; 18;
       100; 101; 102; 103; 104; 105; 106; 107;
!      108; 109; 110; 111; 112; 113; 114])
  
  let destroyed_at_oper = function
      Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs
    | Iop(Iextcall(_, false)) -> destroyed_at_c_call
    | _ -> [||]
  
  let destroyed_at_raise = all_phys_regs
--- 223,241 ----
  
  let destroyed_at_c_call = (* %l0-%l4, %i0-%i5 preserved *)
    Array.of_list(List.map phys_reg
!     [0; 1; 2; 3; 4; 5; 17; 18; 19; 20;
       100; 101; 102; 103; 104; 105; 106; 107;
!      108; 109; 110; 111; 112; 113; 114; 115;
!      116; 117; 118; 119; 120; 121; 122; 123;
!      124; 125; 126; 127; 128; 129; 130])
! 
! let destroyed_at_runtime_call = [|hard_int_reg.(19);hard_int_reg.(20)|]
  
  let destroyed_at_oper = function
      Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs
    | Iop(Iextcall(_, false)) -> destroyed_at_c_call
+   | Iop(Ialloc _) -> destroyed_at_runtime_call
+   | Iswitch _ -> [|hard_int_reg.(20)|]
    | _ -> [||]
  
  let destroyed_at_raise = all_phys_regs
***************
*** 196,202 ****
  
  let max_register_pressure = function
      Iextcall(_, _) -> [| 11; 0 |]
!   | _ -> [| 19; 15 |]
  
  (* Layout of the stack *)
  
--- 248,259 ----
  
  let max_register_pressure = function
      Iextcall(_, _) -> [| 11; 0 |]
!   | Ialloc _ -> [|19; if !arch_version = SPARC_V9 then 31 else 15 |]
!   (* 32 double precision floating point registers are available
!      to all SPARC V9 code, but the extra integer register is only
!      available when using the 64 bit ABI. *)
!   | _ -> [|if sixty_four then 21 else 19;
! 	   if !arch_version = SPARC_V9 then 31 else 15 |]
  
  (* Layout of the stack *)
  
***************
*** 206,214 ****
  (* Calling the assembler and the archiver *)
  
  let assemble_file infile outfile =
!   let asprefix = begin match !arch_version with
!     SPARC_V7 -> "as -o "
!   | SPARC_V8 -> "as -xarch=v8 -o "
!   | SPARC_V9 -> "as -xarch=v8plus -o "
    end in
    Ccomp.command (asprefix ^ Filename.quote outfile ^ " " ^ Filename.quote infile)
--- 263,272 ----
  (* Calling the assembler and the archiver *)
  
  let assemble_file infile outfile =
!   let asprefix = begin match !arch_version, sixty_four with
!     SPARC_V7,_ -> "as -o "
!   | SPARC_V8,_ -> "as -xarch=v8 -o "
!   | SPARC_V9,false -> "as -xarch=v8plus -o "
!   | SPARC_V9,true -> "as -xarch=v9 -o "
    end in
    Ccomp.command (asprefix ^ Filename.quote outfile ^ " " ^ Filename.quote infile)
*** ocaml-3.08.1/asmcomp/sparc/scheduling.ml	Fri Nov 29 10:03:08 2002
--- ocaml-3.08.1/asmcomp/sparc/scheduling.ml	Mon Oct  4 18:11:34 2004
***************
*** 14,19 ****
--- 14,20 ----
  
  open Cmm
  open Mach
+ open Linearize
  
  (* Instruction scheduling for the Sparc *)
  
***************
*** 30,45 ****
     two cycle latency and may not issue in the same cycle as any other
     instruction.  Floating point issue rules are complicated, but in
     general independent add and multiply can dual issue with four cycle
!    latency.  *)
  
  method oper_latency = function
!     Ireload -> 2
!   | Iload((Byte_signed|Sixteen_signed|Thirtytwo_signed), _) -> 3
!   | Iload(_, _) -> 2
!   | Iconst_float _ -> 2 (* turned into a load *)
!   | Inegf | Iabsf | Iaddf | Isubf | Imulf -> 4
!   | Idivf -> 15
!   | _ -> 1
  
  (* Issue cycles.  Rough approximations. *)
  
--- 31,49 ----
     two cycle latency and may not issue in the same cycle as any other
     instruction.  Floating point issue rules are complicated, but in
     general independent add and multiply can dual issue with four cycle
!    latency.
! 
!    The scheduler does not consider dual issue.  Add one to the actual
!    cycle costs to attempt to improve scheduling.  *)
  
  method oper_latency = function
!     Ireload -> 3
!   | Iload((Byte_signed|Sixteen_signed|Thirtytwo_signed), _) -> 4
!   | Iload(_, _) -> 3
!   | Iconst_float _ -> 3 (* turned into a load *)
!   | Inegf | Iabsf | Iaddf | Isubf | Imulf -> 5
!   | Idivf -> 16
!   | _ -> 2
  
  (* Issue cycles.  Rough approximations. *)
  
***************
*** 49,60 ****
    | Ialloc _ -> 6
    | Iintop(Icomp _) -> 4
    | Iintop(Icheckbound) -> 2
!   | Iintop_imm(Idiv, _) -> 5
!   | Iintop_imm(Imod, _) -> 5
    | Iintop_imm(Icomp _, _) -> 4
    | Iintop_imm(Icheckbound, _) -> 2
!   | Inegf -> 2
!   | Iabsf -> 2
    | Ifloatofint -> 6
    | Iintoffloat -> 6
    | _ -> 1
--- 53,64 ----
    | Ialloc _ -> 6
    | Iintop(Icomp _) -> 4
    | Iintop(Icheckbound) -> 2
!   | Iintop(Imul | Idiv | Imod) -> 5
!   | Iintop_imm((Imul | Idiv | Imod), _) -> 5
    | Iintop_imm(Icomp _, _) -> 4
    | Iintop_imm(Icheckbound, _) -> 2
!   | Inegf when !Arch.arch_version <> Arch.SPARC_V9 -> 2
!   | Iabsf when !Arch.arch_version <> Arch.SPARC_V9 -> 2
    | Ifloatofint -> 6
    | Iintoffloat -> 6
    | _ -> 1
*** ocaml-3.08.1/asmcomp/sparc/selection.ml	Fri Nov 29 10:03:08 2002
--- ocaml-3.08.1/asmcomp/sparc/selection.ml	Mon Oct  4 17:51:28 2004
***************
*** 10,15 ****
--- 10,16 ----
  (*                                                                     *)
  (***********************************************************************)
  
+ (* Modified by John Carr.  Based on: *)
  (* $Id: selection.ml,v 1.8 2002/11/29 15:03:08 xleroy Exp $ *)
  
  (* Instruction selection for the Sparc processor *)
***************
*** 20,85 ****
  open Arch
  open Mach
  
  class selector = object (self)
  
  inherit Selectgen.selector_generic as super
  
  method is_immediate n = (n <= 4095) && (n >= -4096)
  
  method select_addressing = function
!     Cconst_symbol s ->
!       (Ibased(s, 0), Ctuple [])
!   | Cop(Cadda, [Cconst_symbol s; Cconst_int n]) ->
!       (Ibased(s, n), Ctuple [])
    | Cop(Cadda, [arg; Cconst_int n]) ->
        (Iindexed n, arg)
    | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) ->
        (Iindexed n, Cop(Cadda, [arg1; arg2]))
    | arg ->
        (Iindexed 0, arg)
  
  method select_operation op args =
    match (op, args) with
!   (* For SPARC V7 multiplication, division and modulus are turned into
!      calls to C library routines, except if the dividend is a power of 2.
!      For SPARC V8 and V9, use hardware multiplication and division,
!      but C library routine for modulus. *)
!     (Cmuli, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) ->
!       (Iintop_imm(Ilsl, Misc.log2 n), [arg])
!   | (Cmuli, [Cconst_int n; arg]) when n = 1 lsl (Misc.log2 n) ->
        (Iintop_imm(Ilsl, Misc.log2 n), [arg])
    | (Cmuli, _) when !arch_version = SPARC_V7 ->
        (Iextcall(".umul", false), args)
    | (Cdivi, [arg; Cconst_int n])
!     when self#is_immediate n && n = 1 lsl (Misc.log2 n) ->
        (Iintop_imm(Idiv, n), [arg])
    | (Cdivi, _) when !arch_version = SPARC_V7 ->
        (Iextcall(".div", false), args)
    | (Cmodi, [arg; Cconst_int n])
!     when self#is_immediate n && n = 1 lsl (Misc.log2 n) ->
        (Iintop_imm(Imod, n), [arg])
!   | (Cmodi, _) ->
        (Iextcall(".rem", false), args)
!   | _ ->
!       super#select_operation op args
  
! (* Override insert_move_args to deal correctly with floating-point
!    arguments being passed into pairs of integer registers. *)
! method insert_move_args arg loc stacksize =
!   if stacksize <> 0 then self#insert (Iop(Istackoffset stacksize)) [||] [||];
!   let locpos = ref 0 in
!   for i = 0 to Array.length arg - 1 do
!     let src = arg.(i) in
!     let dst = loc.(!locpos) in
!     match (src, dst) with
!       ({typ = Float}, {typ = Int}) ->
!         let dst2 = loc.(!locpos + 1) in
          self#insert (Iop Imove) [|src|] [|dst; dst2|];
          locpos := !locpos + 2
      | (_, _) ->
          self#insert_move src dst;
          incr locpos
!   done
  
  end
  
--- 21,156 ----
  open Arch
  open Mach
  
+ let condition_suffix = function
+     Ccmpi Ceq -> "e"	| Ccmpi Cne -> "ne"
+   | Ccmpi Cle -> "le"	| Ccmpi Cgt -> "g"
+   | Ccmpi Clt -> "l"	| Ccmpi Cge -> "ge"
+   | Ccmpa Ceq -> "e"    | Ccmpa Cne -> "ne"
+   | Ccmpa Cle -> "leu"  | Ccmpa Cgt -> "gu"
+   | Ccmpa Clt -> "lu"   | Ccmpa Cge -> "geu"
+   | _ -> Misc.fatal_error "Selection.condition_suffix"
+ 
+ let is_log2 x = (x land (x - 1)) = 0
+ 
  class selector = object (self)
  
  inherit Selectgen.selector_generic as super
  
  method is_immediate n = (n <= 4095) && (n >= -4096)
  
+ (* The expressions generated for symbolic addressing must match
+    the patterns in select_operation to recognize sethi. *)
  method select_addressing = function
!     Cconst_symbol s as addr ->
!       (Ilo(s, 0), Cop(Cand, [addr; Cconst_natint 0xfffffc00n]))
!       (*Ibased(s, 0), Ctuple []*)
!   | Cop(Cadda, [Cconst_symbol s; Cconst_int n]) as addr ->
!       (Ilo(s, n), Cop(Cand, [addr; Cconst_natint 0xfffffc00n]))
!       (*Ibased(s, n), Ctuple []*)
    | Cop(Cadda, [arg; Cconst_int n]) ->
        (Iindexed n, arg)
    | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) ->
        (Iindexed n, Cop(Cadda, [arg1; arg2]))
+   | Cop(Cadda, ([_; _] as args)) ->
+       (Iindexed2, Ctuple args)
    | arg ->
        (Iindexed 0, arg)
  
  method select_operation op args =
    match (op, args) with
!     (* Sign extension to 64 bits. *)
!     (Casr, [Cop(Clsl, [arg; Cconst_int 32]); Cconst_int n]) when sixty_four && n >= 32 ->
!       Ispecific (Isra32 (n-32)), [arg]
!     (* Used in array bounds checking.  UltraSPARC has more logical units
!        than shifters. *)
!   | (Clsl, [Cop(Clsr, [arg; Cconst_int right]); Cconst_int left])
!     when left < right && left < 10 ->
!       Iintop_imm(Iand, -(1 lsl left)), [Cop(Clsr, [arg; Cconst_int (right - left)])]
! 
!     (* First, several patterns that show up frequently in conditional
!        moves. *)
!     (* (+ (lsl (cmp a b) c) d) ->  conditional move of d or d + (1 lsl c)
!        One pattern for each of constant and variable b. *)
!   | (Caddi, [Cop(Clsl, [Cop(Ccmpi _ | Ccmpa _ as cmp, [op1;Cconst_int op2]); Cconst_int n1]); Cconst_int n2])
!     when !arch_version = SPARC_V9 && self#is_immediate op2 && self#is_immediate ((1 lsl n1) + n2) ->
!       let iftrue = 1 lsl n1 + n2 and iffalse = n2
!       and opcode = condition_suffix cmp in
!       (Ispecific(Icmov_imm(opcode, op2, iffalse, iftrue)), [op1])
!      (* Recognize sethi.  See select_addressing above. *)
!   | (Cand, [Cconst_symbol s; Cconst_natint 0xfffffc00n]) ->
!       (Ispecific (Isethi (s,0)), [])
!   | (Cand,[Cop(Cadda,[Cconst_symbol s; Cconst_int n]); Cconst_natint 0xfffffc00n]) ->
!       (Ispecific (Isethi (s,n)), [])
!      (* Recognize some conditional move patterns. *)
!   | (Caddi, [Cop(Clsl, [Cop(Ccmpi _ | Ccmpa _ as cmp,ops); Cconst_int n1]); Cconst_int n2])
!     when !arch_version = SPARC_V9 && self#is_immediate ((1 lsl n1) + n2) ->
!       let iftrue = 1 lsl n1 + n2 and iffalse = n2
!       and opcode = condition_suffix cmp in
!       (Ispecific(Icmov(opcode, iffalse, iftrue)), ops)
!     (* (lsl (cmp a b) c) -> conditional move of 0 or (1 lsl c).
!        One pattern for each of constant and variable b.  *)
!   | (Clsl, [Cop(Ccmpi _ | Ccmpa _ as cmp ,[op1;Cconst_int op2]); Cconst_int n])
!     when !arch_version = SPARC_V9 && self#is_immediate op2 && self#is_immediate (1 lsl n) ->
!       let opcode = condition_suffix cmp in
!       (Ispecific(Icmov_imm(opcode, op2, 0, 1 lsl n)), [op1])
!   | (Clsl, [Cop(Ccmpi _ | Ccmpa _ as cmp,ops); Cconst_int n])
!     when !arch_version = SPARC_V9 && self#is_immediate (1 lsl n) ->
!       let opcode = condition_suffix cmp in
!       (Ispecific(Icmov(opcode, 0, 1 lsl n)), ops)
!     (* Left shifts are always preferred to multiplication. *)
!   | (Cmuli, [arg; Cconst_int n]) | (Cmuli, [Cconst_int n; arg]) when is_log2 n ->
        (Iintop_imm(Ilsl, Misc.log2 n), [arg])
+     (* For SPARC V7 without hardware multiply generate a call
+        to the library multiply function. *)
    | (Cmuli, _) when !arch_version = SPARC_V7 ->
        (Iextcall(".umul", false), args)
+     (* emit.mlp has patterns to match division by a power of two. *)
    | (Cdivi, [arg; Cconst_int n])
!     when self#is_immediate n && is_log2 n ->
        (Iintop_imm(Idiv, n), [arg])
+     (* For SPARC V7 without hardware divide generate a call to
+        the library divide function. *)
    | (Cdivi, _) when !arch_version = SPARC_V7 ->
        (Iextcall(".div", false), args)
+     (* emit.mlp has patterns to match modulus with respect to a power of two. *)
    | (Cmodi, [arg; Cconst_int n])
!     when self#is_immediate n && is_log2 n ->
        (Iintop_imm(Imod, n), [arg])
!     (* Always use the C library remainder function in 32 bit mode. *)
!   | (Cmodi, _) when not sixty_four ->
        (Iextcall(".rem", false), args)
!   | _ -> super#select_operation op args
  
!   (* Override insert_move_args to deal correctly with floating-point
!      arguments being passed into pairs of integer registers. *)
!   method insert_move_args arg loc stacksize =
!     if sixty_four then super#insert_move_args arg loc stacksize else begin
!     if stacksize <> 0 then self#insert (Iop(Istackoffset stacksize)) [||] [||];
!     let locpos = ref 0 in
!     for i = 0 to Array.length arg - 1 do
!       let src = arg.(i) in
!       let dst = loc.(!locpos) in
!       match (src, dst) with
!       	({typ = Float}, {typ = Int}) ->
!           let dst2 = loc.(!locpos + 1) in
          self#insert (Iop Imove) [|src|] [|dst; dst2|];
          locpos := !locpos + 2
      | (_, _) ->
          self#insert_move src dst;
          incr locpos
!     done
!     end
! 
!   (* Override insert_op to split symbolic addressing into two instructions. *)
!   method insert_op op rs rd =
!     begin match op with
!       Iconst_symbol s ->
!       	super#insert (Iop(Ispecific(Isethi (s,0)))) rs rd;
!       	super#insert (Iop(Ispecific(Iaddlo (s,0)))) rd rd
!     | _ ->
!       	super#insert (Iop op) rs rd
!     end;
!     rd
  
  end
  
*** ocaml-3.08.1/asmrun/Makefile	Sat Aug 21 12:22:34 2004
--- ocaml-3.08.1/asmrun/Makefile	Mon Oct  4 18:11:34 2004
***************
*** 73,78 ****
--- 73,84 ----
  
  power.p.o: power-$(SYSTEM).o
  	cp power-$(SYSTEM).o power.p.o
+ 
+ sparc.o: sparc-$(MODEL).o
+ 	cp sparc-$(MODEL).o sparc.o
+ 
+ sparc.p.o: sparc-$(MODEL).o
+ 	cp sparc-$(MODEL).o sparc.p.o
  
  main.c: ../byterun/main.c
  	ln -s ../byterun/main.c main.c
Only in ocaml-3.08.1/asmrun: Makefile.orig
*** ocaml-3.08.1/asmrun/fail.c	Mon May 17 13:25:52 2004
--- ocaml-3.08.1/asmrun/fail.c	Mon Oct  4 18:11:34 2004
***************
*** 63,69 ****
  #define PUSHED_AFTER >
  #endif
    while (caml_local_roots != NULL && 
!          (char *) caml_local_roots PUSHED_AFTER caml_exception_pointer) {
      caml_local_roots = caml_local_roots->next;
    }
  #undef PUSHED_AFTER
--- 63,69 ----
  #define PUSHED_AFTER >
  #endif
    while (caml_local_roots != NULL && 
! 	 (char *) caml_local_roots PUSHED_AFTER caml_exception_pointer + STACK_BIAS) {
      caml_local_roots = caml_local_roots->next;
    }
  #undef PUSHED_AFTER
*** ocaml-3.08.1/asmrun/signals.c	Sat Jun 19 12:13:32 2004
--- ocaml-3.08.1/asmrun/signals.c	Mon Oct  4 18:11:34 2004
***************
*** 212,217 ****
--- 212,235 ----
    caml_async_signal_mode = 0;
  }
  
+ #ifdef POSIX_SIGNALS
+ static void reraise(int sig, int now)
+ {
+   struct sigaction sa;
+   sa.sa_handler = 0;
+   sa.sa_flags = 0;
+   sigemptyset(&sa.sa_mask);
+   sigaction(sig, &sa, 0);
+   /* If the signal was sent using kill() (si_code == 0) or will
+      not recur then raise it here.  Otherwise return.  The
+      offending instruction will be reexecuted and the signal
+      will recur.  */
+   if (now == 1)
+     raise(sig);
+   return;
+ }
+ #endif
+ 
  #if defined(TARGET_alpha) || defined(TARGET_mips)
  static void handle_signal(int sig, int code, struct sigcontext * context)
  #elif defined(TARGET_power) && defined(SYS_elf)
***************
*** 277,285 ****
  #if defined(TARGET_sparc) && defined(SYS_solaris)
      { greg_t * gregs = ((ucontext_t *)context)->uc_mcontext.gregs;
        if (In_code_area(gregs[REG_PC])) {
!       /* Cached in register l7, which is saved on the stack 7 words
! 	 after the stack pointer.  */
!         ((long *)(gregs[REG_SP]))[7] = (long) caml_young_limit;
        }
      }
  #endif
--- 295,304 ----
  #if defined(TARGET_sparc) && defined(SYS_solaris)
      { greg_t * gregs = ((ucontext_t *)context)->uc_mcontext.gregs;
        if (In_code_area(gregs[REG_PC])) {
! 	long sp = gregs[REG_SP];
!         /* Cached in register l7, which is saved on the stack 7 words
!            after the unbiased stack pointer.  */
!         ((long *)(sp + STACK_BIAS))[7] = (long)caml_young_limit;
        }
      }
  #endif
***************
*** 458,478 ****
  #endif
  
  #if defined(TARGET_sparc) && defined(SYS_solaris)
! static void trap_handler(int sig, siginfo_t * info, void * context)
  {
    long * sp;
  
!   if (info->si_code != ILL_ILLTRP) {
!     fprintf(stderr, "Fatal error: illegal instruction, code 0x%x\n",
!             info->si_code);
!     exit(100);
!   }
!   /* Recover [caml_young_ptr] and [caml_exception_pointer]
!      from the %l5 and %l6 regs */
!   sp = (long *) (((ucontext_t *)context)->uc_mcontext.gregs[REG_SP]);
!   caml_exception_pointer = (char *) sp[5];
!   caml_young_ptr = (char *) sp[6];
!   caml_array_bound_error();
  }
  #endif
  
--- 477,522 ----
  #endif
  
  #if defined(TARGET_sparc) && defined(SYS_solaris)
! static void trap_handler(int sig, siginfo_t * info, void * arg)
  {
+   ucontext_t *context = (ucontext_t *) arg;
+   int code = info->si_code;
    long * sp;
  
!   switch (sig)
!     {
!     case SIGILL:
!       if (info->si_code != ILL_ILLTRP) {
! 	fprintf(stderr, "Fatal error: illegal instruction, code 0x%x\n", code);
! 	/* Illegal instruction exceptions occur before the instruction
! 	   completes and will recur on return from the signal handler. */
! 	reraise(SIGILL, code == 0);
! 	return;
!       }
!       break;
!     case SIGFPE:
!       if (code != FPE_INTDIV) {
! 	fprintf(stderr, "Fatal error: floatingpoint exception, code 0x%x\n", code);
! 	/* Floating point exceptions occur after the instruction completes
! 	   and will not recur on return from the signal handler. */
! 	reraise(SIGFPE, 1);
! 	return;
!       }
!       break;
!     }
!   /* Recover young_ptr and caml_exception_pointer from the %l5 and %l6 regs. */
!   sp = (long *) (context->uc_mcontext.gregs[REG_SP] + STACK_BIAS);
!   caml_exception_pointer = (char *) sp[5];	/* %l5 */
!   caml_young_ptr = (char *) sp[6];		/* %l6 */
!   switch (sig)
!     {
!     case SIGILL:
!       caml_array_bound_error();
!       break;
!     case SIGFPE:
!       caml_raise_zero_divide();
!       break;
!     }
  }
  #endif
  
***************
*** 595,600 ****
--- 639,645 ----
      sigemptyset(&act.sa_mask);
      act.sa_flags = SA_SIGINFO | SA_NODEFER;
      sigaction(SIGILL, &act, NULL);
+     sigaction(SIGFPE, &act, NULL);
    }
  #endif
  #if defined(TARGET_power)
Only in ocaml-3.08.1/asmrun: sparc-default.S
Only in ocaml-3.08.1/asmrun: sparc-sparc64.S
Only in ocaml-3.08.1/asmrun: sparc.S
*** ocaml-3.08.1/asmrun/stack.h	Tue Dec 16 13:09:04 2003
--- ocaml-3.08.1/asmrun/stack.h	Mon Oct  4 18:11:34 2004
***************
*** 18,23 ****
--- 18,25 ----
  #ifndef CAML_STACK_H
  #define CAML_STACK_H
  
+ #define STACK_BIAS 0
+ 
  /* Macros to access the stack frame */
  #ifdef TARGET_alpha
  #define Saved_return_address(sp) *((long *)((sp) - 8))
***************
*** 28,35 ****
--- 30,46 ----
  #endif
  
  #ifdef TARGET_sparc
+ #ifdef __sparcv9
+ /* The saved stack pointer has been adjusted by 2047 to point at the
+    real base of the stack frame. */
+ #define Saved_return_address(sp) *((long *)((sp) + 168))
+ #define Callback_link(sp) ((struct caml_context *)((sp) + 192))
+ #undef STACK_BIAS
+ #define STACK_BIAS 2047
+ #else
  #define Saved_return_address(sp) *((long *)((sp) + 92))
  #define Callback_link(sp) ((struct caml_context *)((sp) + 104))
+ #endif
  #endif
  
  #ifdef TARGET_i386
*** ocaml-3.08.1/configure	Thu Aug 12 12:02:00 2004
--- ocaml-3.08.1/configure	Mon Oct  4 18:11:34 2004
***************
*** 589,594 ****
--- 589,598 ----
    x86_64-*-openbsd*)            arch=amd64; system=openbsd;;
  esac
  
+ if test "$arch" = "sparc" -a "$2" = 8; then
+     model="sparc64"
+ fi
+ 
  if test -z "$ccoption"; then
    case "$arch,$system,$cc" in
      alpha,digital,gcc*) nativecc=cc;;
***************
*** 607,612 ****
--- 611,618 ----
    alpha,cc*,digital,*) nativecccompopts=-std1;;
    mips,cc*,irix,*)     nativecccompopts=-n32
                         nativecclinkopts="-n32 -Wl,-woff,84";;
+   sparc,gcc*,solaris,*)if test $2 = 8; then nativecc="${nativecc} -mcmodel=medlow"; fi;;
+   sparc,*,solaris,*)   if test $2 = 8; then nativecc="${nativecc} -xcode=abs32"; fi;;
    *,*,nextstep,*)      nativecccompopts="$gcc_warnings -U__GNUC__ -posix"
                         nativecclinkopts="-posix";;
    *,*,rhapsody,*darwin[1-5].*)
***************
*** 630,640 ****
    alpha,*,netbsd)   aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
    alpha,*,openbsd)  aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
    mips,*,irix)      asflags='-n32 -O2'; asppflags="$asflags";;
    sparc,*,bsd)      aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
    sparc,*,linux)    aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
    sparc,*,*)        case "$cc" in
                        gcc*) aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
!                          *) asppflags='-P -DSYS_$(SYSTEM)';;
                      esac;;
    i386,*,solaris)   aspp='/usr/ccs/bin/as'; asppflags='-P -DSYS_$(SYSTEM)';;
    i386,*,*)         aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
--- 636,656 ----
    alpha,*,netbsd)   aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
    alpha,*,openbsd)  aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
    mips,*,irix)      asflags='-n32 -O2'; asppflags="$asflags";;
+   sparc,sparc64,bsd) aspp='gcc -m64'; asppflags='-c -DSYS_$(SYSTEM)';;
    sparc,*,bsd)      aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
+   sparc,sparc64,linux) aspp='gcc -m64'; asppflags='-c -DSYS_$(SYSTEM)';;
    sparc,*,linux)    aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
+   sparc,sparc64,solaris)  case "$cc" in
+                       gcc*) aspp='gcc -m64'; asppflags='-c -DSYS_$(SYSTEM)';;
+                          *) aspp="/usr/ccs/bin/as"; asppflags="-xarch=v9 -P -DSYS_$(SYSTEM)";;
+                     esac;;
+   sparc,*,solaris)  case "$cc" in
+                       gcc*) aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
+                          *) aspp="/usr/ccs/bin/as"; asppflags="-P -DSYS_$(SYSTEM)";;
+                     esac;;
    sparc,*,*)        case "$cc" in
                        gcc*) aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
!                          *) asppflags="-P -DSYS_$(SYSTEM)";;
                      esac;;
    i386,*,solaris)   aspp='/usr/ccs/bin/as'; asppflags='-P -DSYS_$(SYSTEM)';;
    i386,*,*)         aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
***************
*** 671,688 ****
    IFS=':'
    for d in ${binutils_path}; do
      if test -z "$d"; then continue; fi
!     if test -f "$d/objcopy" && test -f "$d/nm"; then
        echo "objcopy and nm found in $d"
!       if test `$d/objcopy --help | grep -s -c 'redefine-sym'` -eq 0; then
!         echo "$d/objcopy does not support option --redefine-sym, discarded"
          continue;
        fi
!       if test `$d/nm --version | grep -s -c 'GNU nm'` -eq 0; then
!         echo "$d/nm is not from GNU binutils, discarded"
          continue;
        fi
!       binutils_objcopy="$d/objcopy"
!       binutils_nm="$d/nm"
        break
      fi
    done
--- 687,722 ----
    IFS=':'
    for d in ${binutils_path}; do
      if test -z "$d"; then continue; fi
!     if test -f "$d/objcopy"; then
!       objcopy_candidate="$d/objcopy"
!     else
!       if test -f "$d/gobjcopy"; then
!         objcopy_candidate="$d/gobjcopy"
!       else
!         objcopy_candidate=""
!       fi
!     fi
!     if test -f "$d/nm"; then
!       nm_candidate="$d/nm"
!     else
!       if test -f "$d/gnm"; then
!         nm_candidate="$d/gnm"
!       else
! 	nm_candidate=""
!       fi
!     fi
!     if test -n "$objcopy_candidate" && test -n "$nm_candidate"; then
        echo "objcopy and nm found in $d"
!       if test `"$objcopy_candidate" --help | grep -s -c 'redefine-sym'` -eq 0; then
!         echo "$objcopy_candidate does not support option --redefine-sym, discarded"
          continue;
        fi
!       if test `"$nm_candidate" --version | grep -s -c 'GNU nm'` -eq 0; then
!         echo "$nm_candidate is not from GNU binutils, discarded"
          continue;
        fi
!       binutils_objcopy="$objcopy_candidate"
!       binutils_nm="$nm_candidate"
        break
      fi
    done
***************
*** 1461,1466 ****
--- 1495,1505 ----
  echo "ARCH=$arch" >> Makefile
  echo "MODEL=$model" >> Makefile
  echo "SYSTEM=$system" >> Makefile
+ if test $2 = 8; then
+     echo "SIXTY_FOUR=true" >> Makefile
+ else
+     echo "SIXTY_FOUR=false" >> Makefile
+ fi
  echo "NATIVECC=$nativecc" >> Makefile
  echo "NATIVECCCOMPOPTS=$nativecccompopts" >> Makefile
  echo "NATIVECCPROFOPTS=$nativeccprofopts" >> Makefile
*** ocaml-3.08.1/utils/config.mli	Thu Jul  3 11:13:23 2003
--- ocaml-3.08.1/utils/config.mli	Mon Oct  4 18:11:34 2004
***************
*** 96,101 ****
--- 96,103 ----
          (* Name of processor submodel for the native-code compiler *)
  val system: string
          (* Name of operating system for the native-code compiler *)
+ val sixty_four: bool
+         (* True on a 64 bit system. *)
  
  val ext_obj: string
          (* Extension for object files, e.g. [.o] under Unix. *)
*** ocaml-3.08.1/utils/config.mlp	Sat Jun 12 04:55:49 2004
--- ocaml-3.08.1/utils/config.mlp	Mon Oct  4 18:11:34 2004
***************
*** 64,69 ****
--- 64,70 ----
  let architecture = "%%ARCH%%"
  let model = "%%MODEL%%"
  let system = "%%SYSTEM%%"
+ let sixty_four = %%64%%
  
  let ext_obj = "%%EXT_OBJ%%"
  let ext_asm = "%%EXT_ASM%%"
