[MLton-commit] r4410
Matthew Fluet
MLton@mlton.org
Tue, 25 Apr 2006 08:29:04 -0700
Refactored real
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/patch.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-real.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/nullstring.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/TODO
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/IEEEReal-consts.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/class.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/frexp.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/modf.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/nextAfter.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/real.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/signBit.c
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/strto.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
U mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -928,11 +928,11 @@
struct
type t = int
- val inf = _const "FP_INFINITE": t;
- val nan = _const "FP_NAN": t;
- val normal = _const "FP_NORMAL": t;
- val subnormal = _const "FP_SUBNORMAL": t;
- val zero = _const "FP_ZERO": t;
+ val inf = _const "IEEEReal_FloatClass_FP_INFINITE": t;
+ val nan = _const "IEEEReal_FloatClass_FP_NAN": t;
+ val normal = _const "IEEEReal_FloatClass_FP_NORMAL": t;
+ val subnormal = _const "IEEEReal_FloatClass_FP_SUBNORMAL": t;
+ val zero = _const "IEEEReal_FloatClass_FP_ZERO": t;
end
structure Math =
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/patch.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/patch.sml 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/patch.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,147 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-(* Patch in fromLarge and toLarge now that IntInf is defined. *)
-
-structure Int8: INTEGER_EXTRA =
- struct
- open Int8
-
- val fromLarge = fromInt o IntInf.toInt
- val toLarge = IntInf.fromInt o toInt
- end
-
-structure Int16: INTEGER_EXTRA =
- struct
- open Int16
-
- val fromLarge = fromInt o IntInf.toInt
- val toLarge = IntInf.fromInt o toInt
- end
-
-structure Int32: INTEGER_EXTRA =
- struct
- open Int32
-
- val fromLarge = IntInf.toInt
- val toLarge = IntInf.fromInt
- end
-
-structure Int64: INTEGER_EXTRA =
- struct
- open Int64
-
- val fromLarge = IntInf.toInt64
- val toLarge = IntInf.fromInt64
-
- val op * =
- if Primitive.detectOverflow
- then fn (i, j) => fromLarge (IntInf.* (toLarge i, toLarge j))
- else op *?
-
- (* Must redefine scan because the Integer functor defines it in terms of
- * Int64.*, which wasn't defined yet.
- *)
- fun scan radix reader state =
- case IntInf.scan radix reader state of
- NONE => NONE
- | SOME (i, s) => SOME (fromLarge i, s)
-
- val fromString = StringCvt.scanString (scan StringCvt.DEC)
- end
-
-structure Int = Int32
-structure Position = Int64
-structure FixedInt = Int64
-
-structure Word8: WORD_EXTRA =
- struct
- open Word8
-
- val toLargeIntX = LargeInt.fromInt o toIntX
- val toLargeInt = LargeInt.fromInt o toInt
-
- fun fromLargeInt (i: LargeInt.int): word =
- fromInt (LargeInt.toInt (LargeInt.mod (i, 0x100)))
- end
-
-structure Word16: WORD_EXTRA =
- struct
- open Word16
-
- val toLargeIntX = LargeInt.fromInt o toIntX
- val toLargeInt = LargeInt.fromInt o toInt
-
- fun fromLargeInt (i: LargeInt.int): word =
- fromInt (LargeInt.toInt (LargeInt.mod (i, 0x10000)))
- end
-
-structure Word32: WORD32_EXTRA =
- struct
- open Word32
-
- val toLargeIntX = IntInf.fromInt o toIntX
-
- fun highBitSet w = w >= 0wx80000000
-
- fun toLargeInt (w: word): LargeInt.int =
- if highBitSet w
- then IntInf.+ (0x80000000, toLargeIntX (andb (w, 0wx7FFFFFFF)))
- else toLargeIntX w
-
- local
- val t32: LargeInt.int = 0x100000000
- val t31: LargeInt.int = 0x80000000
- in
- fun fromLargeInt (i: IntInf.int): word =
- fromInt
- (let
- open IntInf
- val low32 = i mod t32
- in
- toInt (if low32 >= t31
- then low32 - t32
- else low32)
- end)
- end
- end
-
-structure Word = Word32
-
-structure SysWord = Word32
-
-structure Word64: WORD =
- struct
- open Word64
-
- structure W = Word64
-
- val t32: LargeInt.int = 0x100000000
- val t64: LargeInt.int = 0x10000000000000000
-
- fun toLargeInt w =
- IntInf.+
- (Word32.toLargeInt (Word32.fromLarge w),
- IntInf.<< (Word32.toLargeInt (Word32.fromLarge (>> (w, 0w32))),
- 0w32))
-
- fun toLargeIntX w =
- if Word32.toLarge 0w0 = andb (w, << (Word32.toLarge 0w1, 0w63))
- then toLargeInt w
- else IntInf.- (toLargeInt w, t64)
-
- fun fromLargeInt (i: IntInf.int): word =
- let
- val (d, m) = IntInf.divMod (i, t32)
- in
- W.orb (W.<< (Word32.toLarge (Word32.fromLargeInt d), 0w32),
- Word32.toLarge (Word32.fromLargeInt m))
- end
- end
-
-structure LargeWord = Word64
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -40,6 +40,14 @@
end
structure IEEEReal =
struct
+structure FloatClass =
+struct
+val FP_INFINITE = _const "IEEEReal_FloatClass_FP_INFINITE" : C_Int.t;
+val FP_NAN = _const "IEEEReal_FloatClass_FP_NAN" : C_Int.t;
+val FP_NORMAL = _const "IEEEReal_FloatClass_FP_NORMAL" : C_Int.t;
+val FP_SUBNORMAL = _const "IEEEReal_FloatClass_FP_SUBNORMAL" : C_Int.t;
+val FP_ZERO = _const "IEEEReal_FloatClass_FP_ZERO" : C_Int.t;
+end
val getRoundingMode = _import "IEEEReal_getRoundingMode" : unit -> C_Int.t;
structure RoundingMode =
struct
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-real.sml 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-real.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -16,16 +16,6 @@
val precision: Primitive.Int32.int
val radix: Primitive.Int32.int
- structure Class :
- sig
- eqtype t
- val inf: t
- val nan: t
- val normal: t
- val subnormal: t
- val zero: t
- end
-
structure Math :
sig
type real
@@ -60,17 +50,17 @@
val == : real * real -> bool
val ?= : real * real -> bool
val abs: real -> real
- val class: real -> Class.t
- val frexp: real * C_Int.int ref -> real
- val gdtoa: real * C_Int.int * C_Int.int * C_Int.int ref -> C_String.t
- val ldexp: real * C_Int.int -> real
+ val class: real -> C_Int.t
+ val frexp: real * C_Int.t ref -> real
+ val gdtoa: real * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t
+ val ldexp: real * C_Int.t -> real
val maxFinite: real
val minNormalPos: real
val minPos: real
val modf: real * real ref -> real
val nextAfter: real * real -> real
val round: real -> real
- val signBit: real -> C_Int.int
+ val signBit: real -> C_Int.t
val strto: Primitive.NullString8.t -> real
val ~ : real -> real
@@ -99,30 +89,13 @@
open Primitive
-local
-
- structure Class =
- struct
- type t = C_Int.int
-
- val inf = _const "FP_INFINITE": t;
- val nan = _const "FP_NAN": t;
- val normal = _const "FP_NORMAL": t;
- val subnormal = _const "FP_SUBNORMAL": t;
- val zero = _const "FP_ZERO": t;
- end
-
-in
-
-structure Real32 =
+structure Real32 : PRIM_REAL =
struct
open Real32
val precision : Int32.int = 24
val radix : Int32.int = 2
- structure Class = Class
-
structure Math =
struct
type real = real
@@ -132,18 +105,18 @@
val atan = _prim "Real32_Math_atan": real -> real;
val atan2 = _prim "Real32_Math_atan2": real * real -> real;
val cos = _prim "Real32_Math_cos": real -> real;
- val cosh = _import "coshf": real -> real;
+ val cosh = _import "Real32_Math_cosh": real -> real;
val e = #1 _symbol "Real32_Math_e": real GetSet.t; ()
val exp = _prim "Real32_Math_exp": real -> real;
val ln = _prim "Real32_Math_ln": real -> real;
val log10 = _prim "Real32_Math_log10": real -> real;
val pi = #1 _symbol "Real32_Math_pi": real GetSet.t; ()
- val pow = _import "powf": real * real -> real;
+ val pow = _import "Real32_Math_pow": real * real -> real;
val sin = _prim "Real32_Math_sin": real -> real;
- val sinh = _import "sinhf": real -> real;
+ val sinh = _import "Real32_Math_sinh": real -> real;
val sqrt = _prim "Real32_Math_sqrt": real -> real;
val tan = _prim "Real32_Math_tan": real -> real;
- val tanh = _import "tanhf": real -> real;
+ val tanh = _import "Real32_Math_tanh": real -> real;
end
val * = _prim "Real32_mul": real * real -> real;
@@ -152,24 +125,24 @@
val + = _prim "Real32_add": real * real -> real;
val - = _prim "Real32_sub": real * real -> real;
val / = _prim "Real32_div": real * real -> real;
+ val ~ = _prim "Real32_neg": real -> real;
val op < = _prim "Real32_lt": real * real -> bool;
val op <= = _prim "Real32_le": real * real -> bool;
val == = _prim "Real32_equal": real * real -> bool;
val ?= = _prim "Real32_qequal": real * real -> bool;
val abs = _prim "Real32_abs": real -> real;
- val class = _import "Real32_class": real -> Class.t;
- val frexp = _import "Real32_frexp": real * C_Int.int ref -> real;
- val gdtoa = _import "Real32_gdtoa": real * C_Int.int * C_Int.int * C_Int.int ref -> C_String.t;
- val ldexp = _prim "Real32_ldexp": real * C_Int.int -> real;
+ val class = _import "Real32_class": real -> C_Int.t;
+ val frexp = _import "Real32_frexp": real * C_Int.t ref -> real;
+ val gdtoa = _import "Real32_gdtoa": real * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t;
+ val ldexp = _prim "Real32_ldexp": real * C_Int.t -> real;
val maxFinite = #1 _symbol "Real32_maxFinite": real GetSet.t; ()
val minNormalPos = #1 _symbol "Real32_minNormalPos": real GetSet.t; ()
val minPos = #1 _symbol "Real32_minPos": real GetSet.t; ()
val modf = _import "Real32_modf": real * real ref -> real;
val nextAfter = _import "Real32_nextAfter": real * real -> real;
val round = _prim "Real32_round": real -> real;
- val signBit = _import "Real32_signBit": real -> C_Int.int;
+ val signBit = _import "Real32_signBit": real -> C_Int.t;
val strto = _import "Real32_strto": NullString8.t -> real;
- val ~ = _prim "Real32_neg": real -> real;
val fromInt8Unsafe = _prim "WordS8_toReal32": Int8.int -> real;
val fromInt16Unsafe = _prim "WordS16_toReal32": Int16.int -> real;
@@ -197,15 +170,13 @@
end
end
-structure Real64 =
+structure Real64 : PRIM_REAL =
struct
open Real64
val precision : Int32.int = 53
val radix : Int32.int = 2
- structure Class = Class
-
structure Math =
struct
type real = real
@@ -215,44 +186,44 @@
val atan = _prim "Real64_Math_atan": real -> real;
val atan2 = _prim "Real64_Math_atan2": real * real -> real;
val cos = _prim "Real64_Math_cos": real -> real;
- val cosh = _import "cosh": real -> real;
+ val cosh = _import "Real64_Math_cosh": real -> real;
val e = #1 _symbol "Real64_Math_e": real GetSet.t; ()
val exp = _prim "Real64_Math_exp": real -> real;
val ln = _prim "Real64_Math_ln": real -> real;
val log10 = _prim "Real64_Math_log10": real -> real;
val pi = #1 _symbol "Real64_Math_pi": real GetSet.t; ()
- val pow = _import "pow": real * real -> real;
+ val pow = _import "Real64_Math_pow": real * real -> real;
val sin = _prim "Real64_Math_sin": real -> real;
- val sinh = _import "sinh": real -> real;
+ val sinh = _import "Real64_Math_sinh": real -> real;
val sqrt = _prim "Real64_Math_sqrt": real -> real;
val tan = _prim "Real64_Math_tan": real -> real;
- val tanh = _import "tanh": real -> real;
+ val tanh = _import "Real64_Math_tanh": real -> real;
end
-
+
val * = _prim "Real64_mul": real * real -> real;
val *+ = _prim "Real64_muladd": real * real * real -> real;
val *- = _prim "Real64_mulsub": real * real * real -> real;
val + = _prim "Real64_add": real * real -> real;
val - = _prim "Real64_sub": real * real -> real;
val / = _prim "Real64_div": real * real -> real;
+ val ~ = _prim "Real64_neg": real -> real;
val op < = _prim "Real64_lt": real * real -> bool;
val op <= = _prim "Real64_le": real * real -> bool;
val == = _prim "Real64_equal": real * real -> bool;
val ?= = _prim "Real64_qequal": real * real -> bool;
val abs = _prim "Real64_abs": real -> real;
- val class = _import "Real64_class": real -> Class.t;
- val frexp = _import "Real64_frexp": real * C_Int.int ref -> real;
- val gdtoa = _import "Real64_gdtoa": real * C_Int.int * C_Int.int * C_Int.int ref -> C_String.t;
- val ldexp = _prim "Real64_ldexp": real * C_Int.int -> real;
+ val class = _import "Real64_class": real -> C_Int.t;
+ val frexp = _import "Real64_frexp": real * C_Int.t ref -> real;
+ val gdtoa = _import "Real64_gdtoa": real * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t;
+ val ldexp = _prim "Real64_ldexp": real * C_Int.t -> real;
val maxFinite = #1 _symbol "Real64_maxFinite": real GetSet.t; ()
val minNormalPos = #1 _symbol "Real64_minNormalPos": real GetSet.t; ()
val minPos = #1 _symbol "Real64_minPos": real GetSet.t; ()
val modf = _import "Real64_modf": real * real ref -> real;
val nextAfter = _import "Real64_nextAfter": real * real -> real;
val round = _prim "Real64_round": real -> real;
- val signBit = _import "Real64_signBit": real -> C_Int.int;
+ val signBit = _import "Real64_signBit": real -> C_Int.t;
val strto = _import "Real64_strto": NullString8.t -> real;
- val ~ = _prim "Real64_neg": real -> real;
val fromInt8Unsafe = _prim "WordS8_toReal64": Int8.int -> real;
val fromInt16Unsafe = _prim "WordS16_toReal64": Int16.int -> real;
@@ -281,5 +252,3 @@
end
end
-
-end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sig 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sig 2006-04-25 15:28:59 UTC (rev 4410)
@@ -34,5 +34,6 @@
sig
include IEEE_REAL
+ val mkClass: ('a -> C_Int.t) -> 'a -> float_class
val withRoundingMode: rounding_mode * (unit -> 'a) -> 'a
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sml 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/IEEE-real.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -15,15 +15,40 @@
exception Unordered
datatype real_order = LESS | EQUAL | GREATER | UNORDERED
+ structure Prim = PrimitiveFFI.IEEEReal
+
datatype float_class =
INF
| NAN
| NORMAL
| SUBNORMAL
| ZERO
-
- structure Prim = PrimitiveFFI.IEEEReal
+ local
+ val classes =
+ let
+ open Prim.FloatClass
+ in
+ (* order here is chosen based on putting the more
+ * commonly used classes at the front.
+ *)
+ [(FP_NORMAL, NORMAL),
+ (FP_ZERO, ZERO),
+ (FP_INFINITE, INF),
+ (FP_NAN, NAN),
+ (FP_SUBNORMAL, SUBNORMAL)]
+ end
+ in
+ fun mkClass class x =
+ let
+ val i = class x
+ in
+ case List.find (fn (i', _) => i = i') classes of
+ NONE => raise Fail "Real_class returned bogus integer"
+ | SOME (_, c) => c
+ end
+ end
+
structure RoundingMode =
struct
datatype t =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sig 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sig 2006-04-25 15:28:59 UTC (rev 4410)
@@ -8,16 +8,6 @@
sig
include PRE_REAL_GLOBAL
- structure Class :
- sig
- eqtype t
- val inf: t
- val nan: t
- val normal: t
- val subnormal: t
- val zero: t
- end
-
val * : real * real -> real
val *+ : real * real * real -> real
val *- : real * real * real -> real
@@ -40,10 +30,9 @@
val precision: Primitive.Int32.int
val radix: Primitive.Int32.int
+ val class: real -> C_Int.t
val signBit: real -> C_Int.t
- val class: real -> Class.t
-
val nextAfter: real * real -> real
val frexp: real * C_Int.int ref -> real
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sml 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/real/real.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -108,30 +108,7 @@
val nan = posInf + negInf
- local
- val classes =
- let
- open R.Class
- in
- (* order here is chosen based on putting the more
- * commonly used classes at the front.
- *)
- [(normal, NORMAL),
- (zero, ZERO),
- (inf, INF),
- (nan, NAN),
- (subnormal, SUBNORMAL)]
- end
- in
- fun class x =
- let
- val i = R.class x
- in
- case List.find (fn (i', _) => i = i') classes of
- NONE => raise Fail "Real_class returned bogus integer"
- | SOME (_, c) => c
- end
- end
+ val class = IEEEReal.mkClass R.class
val abs =
if MLton.Codegen.isNative
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/nullstring.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/nullstring.sml 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/nullstring.sml 2006-04-25 15:28:59 UTC (rev 4410)
@@ -0,0 +1,18 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure NullString =
+ struct
+ open Primitive.NullString8
+
+ val nullTerm = fromString o String.nullTerm
+ end
+structure NullStringArray =
+ struct
+ open Primitive.NullString8Array
+ end
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-04-25 15:28:59 UTC (rev 4410)
@@ -184,6 +184,7 @@
cd gen && mlton gen-basis-ffi.sml
cd gen && ./gen-basis-ffi
cp gen/basis-ffi.h basis-ffi.h
+ cp gen/basis-ffi.sml ../basis-library.refactor/primitive/basis-ffi.sml
rm -f gen/gen-basis-ffi
gc-gdb.o: gc.c $(GCCFILES) $(HFILES)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-04-25 15:28:59 UTC (rev 4410)
@@ -16,15 +16,7 @@
that correspond to bit-wise identities.
basis/Int/Word.c
-basis/IntInf.c
basis/MLton/allocTooLarge.c
basis/MLton/bug.c
-basis/Real/Math.c
-basis/Real/class.c
-basis/Real/frexp.c
-basis/Real/gdtoa.c
-basis/Real/modf.c
-basis/Real/nextAfter.c
-basis/Real/real.c
-basis/Real/signBit.c
-basis/Real/strto.c
+basis/Real/PackReal.c
+basis/Int/PackWord.c
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/IEEEReal-consts.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/IEEEReal-consts.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/IEEEReal-consts.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,5 +1,30 @@
#include "platform.h"
+#if not HAS_FPCLASSIFY
+#ifndef FP_INFINITE
+#define FP_INFINITE 1
+#endif
+#ifndef FP_NAN
+#define FP_NAN 0
+#endif
+#ifndef FP_NORMAL
+#define FP_NORMAL 4
+#endif
+#ifndef FP_SUBNORMAL
+#define FP_SUBNORMAL 3
+#endif
+#ifndef FP_ZERO
+#define FP_ZERO 2
+#endif
+#endif
+
+const C_Int_t IEEEReal_FloatClass_FP_INFINITE = FP_INFINITE;
+const C_Int_t IEEEReal_FloatClass_FP_NAN = FP_NAN;
+const C_Int_t IEEEReal_FloatClass_FP_NORMAL = FP_NORMAL;
+const C_Int_t IEEEReal_FloatClass_FP_SUBNORMAL = FP_SUBNORMAL;
+const C_Int_t IEEEReal_FloatClass_FP_ZERO = FP_ZERO;
+
+
#define FE_NOSUPPORT -1
/* Can't handle undefined rounding modes with code like the following.
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,57 +1,61 @@
#include "platform.h"
-#define unaryReal(f, g) \
- Real64 Real64_##f (Real64 x); \
- Real64 Real64_##f (Real64 x) { \
- return g (x); \
- } \
- Real32 Real32_##f (Real32 x); \
- Real32 Real32_##f (Real32 x) { \
- return (Real32)(Real64_##f ((Real64)x)); \
- }
+#define unaryReal(g, h) \
+Real64_t Real64_##g (Real64_t x); \
+Real64_t Real64_##g (Real64_t x) { \
+ return h (x); \
+} \
+Real32_t Real32_##g (Real32_t x); \
+Real32_t Real32_##g (Real32_t x) { \
+ return h##f (x); \
+}
unaryReal(abs, fabs)
unaryReal(round, rint)
#undef unaryReal
-#define binaryReal(f, g) \
- Real64 Real64_Math_##f (Real64 x, Real64 y); \
- Real64 Real64_Math_##f (Real64 x, Real64 y) { \
- return g (x, y); \
- } \
- Real32 Real32_Math_##f (Real32 x, Real32 y); \
- Real32 Real32_Math_##f (Real32 x, Real32 y) { \
- return (Real32)(Real64_Math_##f ((Real64)x, (Real64)y)); \
- }
+#define binaryReal(g, h) \
+Real64_t Real64_Math_##g (Real64_t x, Real64_t y); \
+Real64_t Real64_Math_##g (Real64_t x, Real64_t y) { \
+ return h (x, y); \
+} \
+Real32_t Real32_Math_##g (Real32_t x, Real32_t y); \
+Real32_t Real32_Math_##g (Real32_t x, Real32_t y) { \
+ return h##f (x, y); \
+}
binaryReal(atan2, atan2)
+binaryReal(pow, pow)
#undef binaryReal
-#define unaryReal(f, g) \
- Real64 Real64_Math_##f (Real64 x); \
- Real64 Real64_Math_##f (Real64 x) { \
- return g (x); \
- } \
- Real32 Real32_Math_##f (Real32 x); \
- Real32 Real32_Math_##f (Real32 x) { \
- return (Real32)(Real64_Math_##f ((Real64)x)); \
- }
+#define unaryReal(g, h) \
+Real64_t Real64_##g (Real64_t x); \
+Real64_t Real64_##g (Real64_t x) { \
+ return h (x); \
+} \
+Real32_t Real32_##g (Real32_t x); \
+Real32_t Real32_##g (Real32_t x) { \
+ return h##f (x); \
+}
unaryReal(acos, acos)
unaryReal(asin, asin)
unaryReal(atan, atan)
unaryReal(cos, cos)
+unaryReal(cosh, cosh)
unaryReal(exp, exp)
unaryReal(ln, log)
unaryReal(log10, log10)
unaryReal(sin, sin)
+unaryReal(sinh, sinh)
unaryReal(sqrt, sqrt)
unaryReal(tan, tan)
+unaryReal(tanh, tanh)
#undef unaryReal
-Real64 Real64_ldexp (Real64 x, Int32 i);
-Real64 Real64_ldexp (Real64 x, Int32 i) {
- return ldexp (x, i);
+Real64_t Real64_ldexp (Real64_t x, C_Int_t i);
+Real64_t Real64_ldexp (Real64_t x, C_Int_t i) {
+ return ldexp (x, i);
}
-Real32 Real32_ldexp (Real32 x, Int32 i);
-Real32 Real32_ldexp (Real32 x, Int32 i) {
- return (Real32)Real64_ldexp ((Real64)x, i);
+Real32_t Real32_ldexp (Real32_t x, C_Int_t i);
+Real32_t Real32_ldexp (Real32_t x, C_Int_t i) {
+ return ldexpf (x, i);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/class.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/class.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/class.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,57 +1,73 @@
#include "platform.h"
+C_Int_t Real32_class (Real32_t f);
+
#if HAS_FPCLASSIFY
-Int Real32_class (Real32 f) {
- return fpclassify (f);
+C_Int_t Real32_class (Real32_t f) {
+ return fpclassify (f);
}
#elif HAS_FPCLASSIFY32
-Int Real32_class (Real32 f) {
- return fpclassify32 (f);
+C_Int_t Real32_class (Real32_t f) {
+ return fpclassify32 (f);
}
#else
+/* This code assumes IEEE 754/854 and little endian.
+ *
+ * In memory, the 32 bits of a float are layed out as follows.
+ *
+ * d[0] bits 7-0 of mantissa
+ * d[1] bits 15-8 of mantissa
+ * d[2] bit 0 of exponent
+ * bits 22-16 of mantissa
+ * d[7] sign bit
+ * bits 7-2 of exponent
+ */
+
/* masks for word 0 */
#define EXPONENT_MASK32 0x7F800000
#define MANTISSA_MASK32 0x007FFFFF
#define SIGNBIT_MASK32 0x80000000
#define MANTISSA_HIGHBIT_MASK32 0x00400000
-Int Real32_class (Real32 f) {
- uint word0;
- int res;
+C_Int_t Real32_class (Real32_t f) {
+ uint32_t word0;
+ int res;
- word0 = ((uint *)&f)[0]; /* this generates a gcc warning */
- if ((word0 & EXPONENT_MASK32) == EXPONENT_MASK32) {
- if (word0 & MANTISSA_MASK32)
- res = FP_NAN;
- else
- res = FP_INFINITE;
- } else if (word0 & EXPONENT_MASK32)
- res = FP_NORMAL;
- else if (word0 & MANTISSA_MASK32)
- res = FP_SUBNORMAL;
- else
- res = FP_ZERO;
- return res;
+ word0 = ((uint32_t *)&f)[0]; /* this generates a gcc warning */
+ if ((word0 & EXPONENT_MASK32) == EXPONENT_MASK32) {
+ if (word0 & MANTISSA_MASK32)
+ res = FP_NAN;
+ else
+ res = FP_INFINITE;
+ } else if (word0 & EXPONENT_MASK32)
+ res = FP_NORMAL;
+ else if (word0 & MANTISSA_MASK32)
+ res = FP_SUBNORMAL;
+ else
+ res = FP_ZERO;
+ return res;
}
#endif
+C_Int_t Real64_class (Real64_t d);
+
#if HAS_FPCLASSIFY
-Int Real64_class (Real64 d) {
- return fpclassify (d);
+C_Int_t Real64_class (Real64_t d) {
+ return fpclassify (d);
}
#elif HAS_FPCLASSIFY64
-Int Real64_class (Real64 d) {
- return fpclassify64 (d);
+C_Int_t Real64_class (Real64_t d) {
+ return fpclassify64 (d);
}
#else
@@ -72,16 +88,6 @@
* bits 51-48 of mantissa
* d[7] sign bit
* bits 10-4 of exponent
- *
- *
- * In memory, the 32 bits of a float are layed out as follows.
- *
- * d[0] bits 7-0 of mantissa
- * d[1] bits 15-8 of mantissa
- * d[2] bit 0 of exponent
- * bits 22-16 of mantissa
- * d[7] sign bit
- * bits 7-2 of exponent
*/
/* masks for word 1 */
@@ -90,24 +96,24 @@
#define SIGNBIT_MASK64 0x80000000
#define MANTISSA_HIGHBIT_MASK64 0x00080000
-Int Real64_class (Real64 d) {
- Word word0, word1;
- Int res;
+C_Int_t Real64_class (Real64_t d) {
+ uint32_t word0, word1;
+ int res;
- word0 = ((Word *)&d)[0];
- word1 = ((Word *)&d)[1];
- if ((word1 & EXPONENT_MASK64) == EXPONENT_MASK64) {
- if (word0 or (word1 & MANTISSA_MASK64))
- res = FP_NAN;
- else
- res = FP_INFINITE;
- } else if (word1 & EXPONENT_MASK64)
- res = FP_NORMAL;
- else if (word0 or (word1 & MANTISSA_MASK64))
- res = FP_SUBNORMAL;
- else
- res = FP_ZERO;
- return res;
+ word0 = ((uint32_t*)&d)[0];
+ word1 = ((uint32_t*)&d)[1];
+ if ((word1 & EXPONENT_MASK64) == EXPONENT_MASK64) {
+ if (word0 or (word1 & MANTISSA_MASK64))
+ res = FP_NAN;
+ else
+ res = FP_INFINITE;
+ } else if (word1 & EXPONENT_MASK64)
+ res = FP_NORMAL;
+ else if (word0 or (word1 & MANTISSA_MASK64))
+ res = FP_SUBNORMAL;
+ else
+ res = FP_ZERO;
+ return res;
}
#else
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/frexp.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/frexp.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/frexp.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,9 +1,11 @@
#include "platform.h"
-Real64 Real64_frexp (Real64 x, Int *exp) {
- int exp_;
- Real64 res;
- res = frexp (x, &exp_);
- *exp = exp_;
- return res;
+Real32_t Real32_frexp (Real32_t x, Ref(C_Int_t) exp);
+Real32_t Real32_frexp (Real32_t x, Ref(C_Int_t) exp) {
+ return frexpf (x, (int*)exp);
}
+
+Real64_t Real64_frexp (Real64_t x, Ref(C_Int_t) exp);
+Real64_t Real64_frexp (Real64_t x, Ref(C_Int_t) exp) {
+ return frexp (x, (int*)exp);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/gdtoa.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -6,69 +6,71 @@
#endif
/* This code is patterned on g_dfmt from the gdtoa sources. */
-C_String_t Real64_gdtoa (double d, int mode, int ndig, int *decpt) {
- ULong bits[2];
- int ex;
- static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, 0 };
- int i;
- ULong *L;
- char *result;
- ULong sign;
- int x0, x1;
-
- if (MLton_Platform_Arch_bigendian) {
- x0 = 0;
- x1 = 1;
- } else {
- x0 = 1;
- x1 = 0;
- }
- L = (ULong*)&d;
- sign = L[x0] & 0x80000000L;
- bits[0] = L[x1];
- bits[1] = L[x0] & 0xfffff;
- if (0 != (ex = (L[x0] >> 20) & 0x7ff))
- bits[1] |= 0x100000;
- else
- ex = 1;
- ex -= 0x3ff + 52;
- i = STRTOG_Normal;
- result = gdtoa (&fpi, ex, bits, &i, mode, ndig, decpt, NULL);
- if (DEBUG)
- fprintf (stderr, "%s = gdtoa (%g, %d, %d) decpt = %d\n",
- result, d, mode, ndig, *decpt);
- return (C_String_t)result;
+C_String_t Real32_gdtoa (Real32_t f, C_Int_t mode, C_Int_t ndig, Ref(C_Int_t) decpt);
+C_String_t Real32_gdtoa (Real32_t f, C_Int_t mode, C_Int_t ndig, Ref(C_Int_t) decpt) {
+ ULong bits[1];
+ int ex;
+ static FPI fpi = { 24, 1-127-24+1, 254-127-24+1, 1, 0 };
+ int i;
+ ULong *L;
+ char *result;
+ ULong sign;
+ int x0, x1;
+
+ if (MLton_Platform_Arch_bigendian) {
+ x0 = 0;
+ x1 = 1;
+ } else {
+ x0 = 1;
+ x1 = 0;
+ }
+ L = (ULong*)&f;
+ sign = L[0] & 0x80000000L;
+ bits[0] = L[0] & 0x7fffff;
+ if (0 != (ex = (L[0] >> 23) & 0xff))
+ bits[0] |= 0x800000;
+ else
+ ex = 1;
+ ex -= 0x7f + 23;
+ i = STRTOG_Normal;
+ result = gdtoa (&fpi, ex, bits, &i, mode, ndig, (int*)decpt, NULL);
+ if (DEBUG)
+ fprintf (stderr, "%s = gdtoa (%g, %d, %d) decpt = %d\n",
+ result, (double)f, mode, ndig, *decpt);
+ return (C_String_t)result;
}
-C_String_t Real32_gdtoa (float f, int mode, int ndig, int *decpt) {
- ULong bits[1];
- int ex;
- static FPI fpi = { 24, 1-127-24+1, 254-127-24+1, 1, 0 };
- int i;
- ULong *L;
- char *result;
- ULong sign;
- int x0, x1;
-
- if (MLton_Platform_Arch_bigendian) {
- x0 = 0;
- x1 = 1;
- } else {
- x0 = 1;
- x1 = 0;
- }
- L = (ULong*)&f;
- sign = L[0] & 0x80000000L;
- bits[0] = L[0] & 0x7fffff;
- if (0 != (ex = (L[0] >> 23) & 0xff))
- bits[0] |= 0x800000;
- else
- ex = 1;
- ex -= 0x7f + 23;
- i = STRTOG_Normal;
- result = gdtoa (&fpi, ex, bits, &i, mode, ndig, decpt, NULL);
- if (DEBUG)
- fprintf (stderr, "%s = gdtoa (%g, %d, %d) decpt = %d\n",
- result, (double)f, mode, ndig, *decpt);
- return (C_String_t)result;
+C_String_t Real64_gdtoa (Real64_t d, C_Int_t mode, C_Int_t ndig, Ref(C_Int_t) decpt);
+C_String_t Real64_gdtoa (Real64_t d, C_Int_t mode, C_Int_t ndig, Ref(C_Int_t) decpt) {
+ ULong bits[2];
+ int ex;
+ static FPI fpi = { 53, 1-1023-53+1, 2046-1023-53+1, 1, 0 };
+ int i;
+ ULong *L;
+ char *result;
+ ULong sign;
+ int x0, x1;
+
+ if (MLton_Platform_Arch_bigendian) {
+ x0 = 0;
+ x1 = 1;
+ } else {
+ x0 = 1;
+ x1 = 0;
+ }
+ L = (ULong*)&d;
+ sign = L[x0] & 0x80000000L;
+ bits[0] = L[x1];
+ bits[1] = L[x0] & 0xfffff;
+ if (0 != (ex = (L[x0] >> 20) & 0x7ff))
+ bits[1] |= 0x100000;
+ else
+ ex = 1;
+ ex -= 0x3ff + 52;
+ i = STRTOG_Normal;
+ result = gdtoa (&fpi, ex, bits, &i, mode, ndig, (int*)decpt, NULL);
+ if (DEBUG)
+ fprintf (stderr, "%s = gdtoa (%g, %d, %d) decpt = %d\n",
+ result, d, mode, ndig, *decpt);
+ return (C_String_t)result;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/modf.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/modf.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/modf.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,12 +1,11 @@
#include "platform.h"
-Real64 Real64_modf (Real64 x, Real64 *exp) {
- return modf (x, exp);
+Real64_t Real64_modf (Real64_t x, Ref(Real64_t) exp);
+Real64_t Real64_modf (Real64_t x, Ref(Real64_t) exp) {
+ return modf (x, (Real64_t*)exp);
}
-Real32 Real32_modf (Real32 x, Real32 *exp) {
- Real64 exp_, res;
- res = modf ((Real64) x, &exp_);
- *exp = (Real32)exp_;
- return (Real32)res;
+Real32_t Real32_modf (Real32_t x, Ref(Real32_t) exp);
+Real32_t Real32_modf (Real32_t x, Ref(Real32_t) exp) {
+ return modff (x, (Real32_t*)exp);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/nextAfter.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/nextAfter.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/nextAfter.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,6 +1,12 @@
#include "platform.h"
/* nextafter is a macro, so we must have a C wrapper to work correctly. */
-Real64 Real64_nextAfter (Real64 x1, Real64 x2) {
- return nextafter (x1, x2);
+Real32_t Real32_nextAfter (Real32_t x1, Real32_t x2);
+Real32_t Real32_nextAfter (Real32_t x1, Real32_t x2) {
+ return nextafterf (x1, x2);
}
+
+Real64_t Real64_nextAfter (Real64_t x1, Real64_t x2);
+Real64_t Real64_nextAfter (Real64_t x1, Real64_t x2) {
+ return nextafter (x1, x2);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/real.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/real.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/real.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,23 +1,25 @@
#include "platform.h"
-Real32 Real32_Math_pi = (Real32)3.14159265358979323846;
-Real32 Real32_Math_e = (Real32)2.7182818284590452354;
+Real32_t Real32_Math_pi = (Real32_t)3.14159265358979323846;
+Real32_t Real32_Math_e = (Real32_t)2.7182818284590452354;
-Real32 Real32_maxFinite = 3.40282347e+38;
-Real32 Real32_minNormalPos = 1.17549435e-38;
-Real32 Real32_minPos = 1.40129846e-45;
+Real32_t Real32_maxFinite = 3.40282347e+38;
+Real32_t Real32_minNormalPos = 1.17549435e-38;
+Real32_t Real32_minPos = 1.40129846e-45;
-Real64 Real64_Math_pi = 3.14159265358979323846;
-Real64 Real64_Math_e = 2.7182818284590452354;
+Real64_t Real64_Math_pi = 3.14159265358979323846;
+Real64_t Real64_Math_e = 2.7182818284590452354;
-Real64 Real64_maxFinite = 1.7976931348623157e+308;
-Real64 Real64_minNormalPos = 2.2250738585072014e-308;
-Real64 Real64_minPos = 4.9406564584124654e-324;
+Real64_t Real64_maxFinite = 1.7976931348623157e+308;
+Real64_t Real64_minNormalPos = 2.2250738585072014e-308;
+Real64_t Real64_minPos = 4.9406564584124654e-324;
-#define ternary(size, name, op) \
- Real##size Real##size##_mul##name \
- (Real##size r1, Real##size r2, Real##size r3) { \
- return r1 * r2 op r3; \
+#define ternary(size, name, op) \
+ Real##size##_t Real##size##_mul##name \
+ (Real##size##_t r1, Real##size##_t r2, Real##size##_t r3); \
+ Real##size##_t Real##size##_mul##name \
+ (Real##size##_t r1, Real##size##_t r2, Real##size##_t r3) { \
+ return r1 * r2 op r3; \
}
ternary(32, add, +)
ternary(64, add, +)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/signBit.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/signBit.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/signBit.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,13 +1,16 @@
#include "platform.h"
+C_Int_t Real32_signBit (Real32_t f);
+C_Int_t Real64_signBit (Real64_t d);
+
#if HAS_SIGNBIT
-Int Real32_signBit (Real32 f) {
- return signbit (f);
+C_Int_t Real32_signBit (Real32_t f) {
+ return signbit (f);
}
-Int Real64_signBit (Real64 d) {
- return signbit (d);
+C_Int_t Real64_signBit (Real64_t d) {
+ return signbit (d);
}
#else
@@ -15,15 +18,15 @@
#if (defined __i386__)
enum {
- R32_byte = 3,
- R64_byte = 7,
+ R32_byte = 3,
+ R64_byte = 7,
};
#elif (defined __ppc__ || defined __sparc__)
enum {
- R32_byte = 0,
- R64_byte = 0,
+ R32_byte = 0,
+ R64_byte = 0,
};
#else
@@ -32,12 +35,12 @@
#endif
-Int Real32_signBit (Real32 f) {
- return (((unsigned char *)&f)[R32_byte] & 0x80) >> 7;
+C_Int_t Real32_signBit (Real32_t f) {
+ return (((unsigned char *)&f)[R32_byte] & 0x80) >> 7;
}
-Int Real64_signBit (Real64 d) {
- return (((unsigned char *)&d)[R64_byte] & 0x80) >> 7;
+C_Int_t Real64_signBit (Real64_t d) {
+ return (((unsigned char *)&d)[R64_byte] & 0x80) >> 7;
}
#endif
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/strto.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/strto.c 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/strto.c 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,22 +1,24 @@
#include "platform.h"
-Real32 gdtoa_strtof (char *s, char **endptr);
-Real64 gdtoa_strtod (char *s, char **endptr);
+Real32_t gdtoa_strtof (char *s, char **endptr);
+Real64_t gdtoa_strtod (char *s, char **endptr);
-Real32 Real32_strto (Pointer s) {
- char *endptr;
- Real32 res;
-
- res = gdtoa_strtof ((char *)s, &endptr);
- assert (NULL != endptr);
- return res;
+Real32_t Real32_strto (NullString8_t s);
+Real32_t Real32_strto (NullString8_t s) {
+ char *endptr;
+ Real32_t res;
+
+ res = gdtoa_strtof ((char*)s, &endptr);
+ assert (NULL != endptr);
+ return res;
}
-Real64 Real64_strto (Pointer s) {
- char *endptr;
- Real64 res;
-
- res = gdtoa_strtod ((char *)s, &endptr);
- assert (NULL != endptr);
- return res;
+Real64_t Real64_strto (NullString8_t s);
+Real64_t Real64_strto (NullString8_t s) {
+ char *endptr;
+ Real64 res;
+
+ res = gdtoa_strtod ((char*)s, &endptr);
+ assert (NULL != endptr);
+ return res;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-04-25 15:28:59 UTC (rev 4410)
@@ -1,3 +1,6 @@
+# Posix.FileSys.PC.2_SYMLINKS = _const : C_Int.t
+# Posix.FileSys.Stat.getBlkCnt = _import : unit -> C_BlkCnt.t
+# Posix.FileSys.Stat.getBlkSize = _import : unit -> C_BlkSize.t
CommandLine.argc = _symbol : C_Int.t
CommandLine.argv = _symbol : C_StringArray.t
CommandLine.commandName = _symbol : C_String.t
@@ -24,6 +27,11 @@
Date.localTime = _import : C_Time.t ref -> C_Int.t C_Errno.t
Date.mkTime = _import : unit -> C_Time.t C_Errno.t
Date.strfTime = _import : Char8.t array * C_Size.t * NullString8.t -> C_Size.t
+IEEEReal.FloatClass.FP_INFINITE = _const : C_Int.t
+IEEEReal.FloatClass.FP_NAN = _const : C_Int.t
+IEEEReal.FloatClass.FP_NORMAL = _const : C_Int.t
+IEEEReal.FloatClass.FP_SUBNORMAL = _const : C_Int.t
+IEEEReal.FloatClass.FP_ZERO = _const : C_Int.t
IEEEReal.RoundingMode.FE_DOWNWARD = _const : C_Int.t
IEEEReal.RoundingMode.FE_NOSUPPORT = _const : C_Int.t
IEEEReal.RoundingMode.FE_TONEAREST = _const : C_Int.t
@@ -235,7 +243,6 @@
Posix.FileSys.O.TEXT = _const : C_Int.t
Posix.FileSys.O.TRUNC = _const : C_Int.t
Posix.FileSys.O.WRONLY = _const : C_Int.t
-# Posix.FileSys.PC.2_SYMLINKS = _const : C_Int.t
Posix.FileSys.PC.ALLOC_SIZE_MIN = _const : C_Int.t
Posix.FileSys.PC.ASYNC_IO = _const : C_Int.t
Posix.FileSys.PC.CHOWN_RESTRICTED = _const : C_Int.t
@@ -287,8 +294,6 @@
Posix.FileSys.ST.isSock = _import : C_Mode.t -> Bool.t
Posix.FileSys.Stat.fstat = _import : C_Fd.t -> C_Int.t C_Errno.t
Posix.FileSys.Stat.getATime = _import : unit -> C_Time.t
-# Posix.FileSys.Stat.getBlkCnt = _import : unit -> C_BlkCnt.t
-# Posix.FileSys.Stat.getBlkSize = _import : unit -> C_BlkSize.t
Posix.FileSys.Stat.getCTime = _import : unit -> C_Time.t
Posix.FileSys.Stat.getDev = _import : unit -> C_Dev.t
Posix.FileSys.Stat.getGId = _import : unit -> C_GId.t
@@ -329,9 +334,9 @@
Posix.FileSys.unlink = _import : NullString8.t -> C_Int.t C_Errno.t
Posix.IO.FD.CLOEXEC = _const : C_Fd.t
Posix.IO.FLock.F_GETLK = _const : C_Int.t
+Posix.IO.FLock.F_RDLCK = _const : C_Short.t
Posix.IO.FLock.F_SETLK = _const : C_Int.t
Posix.IO.FLock.F_SETLKW = _const : C_Int.t
-Posix.IO.FLock.F_RDLCK = _const : C_Short.t
Posix.IO.FLock.F_UNLCK = _const : C_Short.t
Posix.IO.FLock.F_WRLCK = _const : C_Short.t
Posix.IO.FLock.SEEK_CUR = _const : C_Short.t
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-04-25 02:43:32 UTC (rev 4409)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2006-04-25 15:28:59 UTC (rev 4410)
@@ -77,24 +77,6 @@
#define EXECVE execve
#endif
-#if not HAS_FPCLASSIFY
-#ifndef FP_INFINITE
-#define FP_INFINITE 1
-#endif
-#ifndef FP_NAN
-#define FP_NAN 0
-#endif
-#ifndef FP_NORMAL
-#define FP_NORMAL 4
-#endif
-#ifndef FP_SUBNORMAL
-#define FP_SUBNORMAL 3
-#endif
-#ifndef FP_ZERO
-#define FP_ZERO 2
-#endif
-#endif
-
#ifndef SPAWN_MODE
#define SPAWN_MODE 0
#endif
@@ -247,31 +229,6 @@
Word32 Word8Vector_subWord32Rev (Pointer v, Int offset);
/* ------------------------------------------------- */
-/* Real */
-/* ------------------------------------------------- */
-
-Real64 Real64_modf (Real64 x, Real64 *exp);
-Real32 Real32_modf (Real32 x, Real32 *exp);
-Real64 Real64_frexp (Real64 x, Int *exp);
-C_String_t Real64_gdtoa (double d, int mode, int ndig, int *decpt);
-C_String_t Real32_gdtoa (float f, int mode, int ndig, int *decpt);
-Int Real32_class (Real32 f);
-Int Real64_class (Real64 d);
-Real32 Real32_strto (Pointer s);
-Real64 Real64_strto (Pointer s);
-Real64 Real64_nextAfter (Real64 x1, Real64 x2);
-Int Real32_signBit (Real32 f);
-Int Real64_signBit (Real64 d);
-#define ternary(size, name) \
- Real##size Real##size##_mul##name \
- (Real##size r1, Real##size r2, Real##size r3);
-ternary(32, add)
-ternary(64, add)
-ternary(32, sub)
-ternary(64, sub)
-#undef ternary
-
-/* ------------------------------------------------- */
/* Socket */
/* ------------------------------------------------- */