|
From: Matthew F. <fl...@ml...> - 2006-05-22 08:56:53
|
Allow the C-side implementation of primitives to be shared among
libmlton, C-codegen headers, and Bytecode-codgen implementation.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/check-real.sml
U mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.c
U mlton/branches/on-20050822-x86_64-branch/include/bytecode-main.h
U mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h
U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
A mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math-fns.h
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c
A mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Real-consts.c
A mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Real-ops.h
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Real.c
D mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/frexp.c
A mlton/branches/on-20050822-x86_64-branch/runtime/basis/Word/Word-check.h
A mlton/branches/on-20050822-x86_64-branch/runtime/basis/Word/Word-consts.h
A mlton/branches/on-20050822-x86_64-branch/runtime/basis/Word/Word-ops.h
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Word/Word.c
A mlton/branches/on-20050822-x86_64-branch/runtime/basis/coerce.c
A mlton/branches/on-20050822-x86_64-branch/runtime/basis/coerce.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/Makefile 2006-05-21 23:07:23 UTC (rev 4563)
+++ mlton/branches/on-20050822-x86_64-branch/Makefile 2006-05-22 15:56:43 UTC (rev 4564)
@@ -286,13 +286,11 @@
basis-library/config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml
cp runtime/gen/basis-ffi.sml \
basis-library/primitive/basis-ffi.sml
- mkdir -p "$(INC)/gc"
- mkdir -p "$(INC)/util"
- mkdir -p "$(INC)/platform"
$(CP) runtime/*.h "$(INC)/"
- $(CP) runtime/gc/*.h "$(INC)/gc"
- $(CP) runtime/util/*.h "$(INC)/util"
- $(CP) runtime/platform/*.h "$(INC)/platform"
+ for d in basis basis/Real basis/Word gc platform util; do \
+ mkdir -p "$(INC)/$$d"; \
+ $(CP) runtime/$$d/*.h "$(INC)/$$d"; \
+ done
$(CP) bytecode/interpret.h "$(INC)"
$(MAKE) -C bytecode
bytecode/print-opcodes >"$(LIB)/opcodes"
@@ -331,7 +329,7 @@
@echo 'Instantiating version numbers.'
for f in \
package/debian/changelog \
- "$(SPEC)" \
+ "$(SPEC)" \
package/freebsd/Makefile \
mlton/control/control-flags.sml; \
do \
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2006-05-21 23:07:23 UTC (rev 4563)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2006-05-22 15:56:43 UTC (rev 4564)
@@ -951,11 +951,17 @@
end
structure Real32 =
struct
+type t = Real32.t
val abs = _import "Real32_abs" : Real32.t -> Real32.t;
+val add = _import "Real32_add" : Real32.t * Real32.t -> Real32.t;
val class = _import "Real32_class" : Real32.t -> C_Int.t;
+val div = _import "Real32_div" : Real32.t * Real32.t -> Real32.t;
+val equal = _import "Real32_equal" : Real32.t * Real32.t -> Bool.t;
val frexp = _import "Real32_frexp" : Real32.t * (C_Int.t) ref -> Real32.t;
val gdtoa = _import "Real32_gdtoa" : Real32.t * C_Int.t * C_Int.t * (C_Int.t) ref -> C_String.t;
val ldexp = _import "Real32_ldexp" : Real32.t * C_Int.t -> Real32.t;
+val le = _import "Real32_le" : Real32.t * Real32.t -> Bool.t;
+val lt = _import "Real32_lt" : Real32.t * Real32.t -> Bool.t;
structure Math =
struct
val acos = _import "Real32_Math_acos" : Real32.t -> Real32.t;
@@ -980,18 +986,39 @@
val (minNormalPosGet, minNormalPosSet) = _symbol "Real32_minNormalPos": (unit -> (Real32.t)) * ((Real32.t) -> unit);
val (minPosGet, minPosSet) = _symbol "Real32_minPos": (unit -> (Real32.t)) * ((Real32.t) -> unit);
val modf = _import "Real32_modf" : Real32.t * (Real32.t) ref -> Real32.t;
+val mul = _import "Real32_mul" : Real32.t * Real32.t -> Real32.t;
+val muladd = _import "Real32_muladd" : Real32.t * Real32.t * Real32.t -> Real32.t;
+val mulsub = _import "Real32_mulsub" : Real32.t * Real32.t * Real32.t -> Real32.t;
+val neg = _import "Real32_neg" : Real32.t -> Real32.t;
val nextAfter = _import "Real32_nextAfter" : Real32.t * Real32.t -> Real32.t;
val round = _import "Real32_round" : Real32.t -> Real32.t;
val signBit = _import "Real32_signBit" : Real32.t -> C_Int.t;
val strto = _import "Real32_strto" : NullString8.t -> Real32.t;
+val sub = _import "Real32_sub" : Real32.t * Real32.t -> Real32.t;
+val toReal32 = _import "Real32_toReal32" : Real32.t -> Real32.t;
+val toReal64 = _import "Real32_toReal64" : Real32.t -> Real64.t;
+val toWordS16 = _import "Real32_toWordS16" : Real32.t -> Int16.t;
+val toWordS32 = _import "Real32_toWordS32" : Real32.t -> Int32.t;
+val toWordS64 = _import "Real32_toWordS64" : Real32.t -> Int64.t;
+val toWordS8 = _import "Real32_toWordS8" : Real32.t -> Int8.t;
+val toWordU16 = _import "Real32_toWordU16" : Real32.t -> Word16.t;
+val toWordU32 = _import "Real32_toWordU32" : Real32.t -> Word32.t;
+val toWordU64 = _import "Real32_toWordU64" : Real32.t -> Word64.t;
+val toWordU8 = _import "Real32_toWordU8" : Real32.t -> Word8.t;
end
structure Real64 =
struct
+type t = Real64.t
val abs = _import "Real64_abs" : Real64.t -> Real64.t;
+val add = _import "Real64_add" : Real64.t * Real64.t -> Real64.t;
val class = _import "Real64_class" : Real64.t -> C_Int.t;
+val div = _import "Real64_div" : Real64.t * Real64.t -> Real64.t;
+val equal = _import "Real64_equal" : Real64.t * Real64.t -> Bool.t;
val frexp = _import "Real64_frexp" : Real64.t * (C_Int.t) ref -> Real64.t;
val gdtoa = _import "Real64_gdtoa" : Real64.t * C_Int.t * C_Int.t * (C_Int.t) ref -> C_String.t;
val ldexp = _import "Real64_ldexp" : Real64.t * C_Int.t -> Real64.t;
+val le = _import "Real64_le" : Real64.t * Real64.t -> Bool.t;
+val lt = _import "Real64_lt" : Real64.t * Real64.t -> Bool.t;
structure Math =
struct
val acos = _import "Real64_Math_acos" : Real64.t -> Real64.t;
@@ -1016,10 +1043,25 @@
val (minNormalPosGet, minNormalPosSet) = _symbol "Real64_minNormalPos": (unit -> (Real64.t)) * ((Real64.t) -> unit);
val (minPosGet, minPosSet) = _symbol "Real64_minPos": (unit -> (Real64.t)) * ((Real64.t) -> unit);
val modf = _import "Real64_modf" : Real64.t * (Real64.t) ref -> Real64.t;
+val mul = _import "Real64_mul" : Real64.t * Real64.t -> Real64.t;
+val muladd = _import "Real64_muladd" : Real64.t * Real64.t * Real64.t -> Real64.t;
+val mulsub = _import "Real64_mulsub" : Real64.t * Real64.t * Real64.t -> Real64.t;
+val neg = _import "Real64_neg" : Real64.t -> Real64.t;
val nextAfter = _import "Real64_nextAfter" : Real64.t * Real64.t -> Real64.t;
val round = _import "Real64_round" : Real64.t -> Real64.t;
val signBit = _import "Real64_signBit" : Real64.t -> C_Int.t;
val strto = _import "Real64_strto" : NullString8.t -> Real64.t;
+val sub = _import "Real64_sub" : Real64.t * Real64.t -> Real64.t;
+val toReal32 = _import "Real64_toReal32" : Real64.t -> Real32.t;
+val toReal64 = _import "Real64_toReal64" : Real64.t -> Real64.t;
+val toWordS16 = _import "Real64_toWordS16" : Real64.t -> Int16.t;
+val toWordS32 = _import "Real64_toWordS32" : Real64.t -> Int32.t;
+val toWordS64 = _import "Real64_toWordS64" : Real64.t -> Int64.t;
+val toWordS8 = _import "Real64_toWordS8" : Real64.t -> Int8.t;
+val toWordU16 = _import "Real64_toWordU16" : Real64.t -> Word16.t;
+val toWordU32 = _import "Real64_toWordU32" : Real64.t -> Word32.t;
+val toWordU64 = _import "Real64_toWordU64" : Real64.t -> Word64.t;
+val toWordU8 = _import "Real64_toWordU8" : Real64.t -> Word8.t;
end
structure Socket =
struct
@@ -1135,5 +1177,225 @@
val terminate = _import "Windows_Process_terminate" : C_PId.t * C_Signal.t -> (C_Int.t) C_Errno.t;
end
end
+structure Word16 =
+struct
+type t = Word16.t
+val add = _import "Word16_add" : Word16.t * Word16.t -> Word16.t;
+val andb = _import "Word16_andb" : Word16.t * Word16.t -> Word16.t;
+val equal = _import "Word16_equal" : Word16.t * Word16.t -> Bool.t;
+val lshift = _import "Word16_lshift" : Word16.t * Word32.t -> Word16.t;
+val neg = _import "Word16_neg" : Word16.t -> Word16.t;
+val notb = _import "Word16_notb" : Word16.t -> Word16.t;
+val orb = _import "Word16_orb" : Word16.t * Word16.t -> Word16.t;
+val rol = _import "Word16_rol" : Word16.t * Word32.t -> Word16.t;
+val ror = _import "Word16_ror" : Word16.t * Word32.t -> Word16.t;
+val sub = _import "Word16_sub" : Word16.t * Word16.t -> Word16.t;
+val xorb = _import "Word16_xorb" : Word16.t * Word16.t -> Word16.t;
end
+structure Word32 =
+struct
+type t = Word32.t
+val add = _import "Word32_add" : Word32.t * Word32.t -> Word32.t;
+val andb = _import "Word32_andb" : Word32.t * Word32.t -> Word32.t;
+val equal = _import "Word32_equal" : Word32.t * Word32.t -> Bool.t;
+val lshift = _import "Word32_lshift" : Word32.t * Word32.t -> Word32.t;
+val neg = _import "Word32_neg" : Word32.t -> Word32.t;
+val notb = _import "Word32_notb" : Word32.t -> Word32.t;
+val orb = _import "Word32_orb" : Word32.t * Word32.t -> Word32.t;
+val rol = _import "Word32_rol" : Word32.t * Word32.t -> Word32.t;
+val ror = _import "Word32_ror" : Word32.t * Word32.t -> Word32.t;
+val sub = _import "Word32_sub" : Word32.t * Word32.t -> Word32.t;
+val xorb = _import "Word32_xorb" : Word32.t * Word32.t -> Word32.t;
end
+structure Word64 =
+struct
+type t = Word64.t
+val add = _import "Word64_add" : Word64.t * Word64.t -> Word64.t;
+val andb = _import "Word64_andb" : Word64.t * Word64.t -> Word64.t;
+val equal = _import "Word64_equal" : Word64.t * Word64.t -> Bool.t;
+val lshift = _import "Word64_lshift" : Word64.t * Word32.t -> Word64.t;
+val neg = _import "Word64_neg" : Word64.t -> Word64.t;
+val notb = _import "Word64_notb" : Word64.t -> Word64.t;
+val orb = _import "Word64_orb" : Word64.t * Word64.t -> Word64.t;
+val rol = _import "Word64_rol" : Word64.t * Word32.t -> Word64.t;
+val ror = _import "Word64_ror" : Word64.t * Word32.t -> Word64.t;
+val sub = _import "Word64_sub" : Word64.t * Word64.t -> Word64.t;
+val xorb = _import "Word64_xorb" : Word64.t * Word64.t -> Word64.t;
+end
+structure Word8 =
+struct
+type t = Word8.t
+val add = _import "Word8_add" : Word8.t * Word8.t -> Word8.t;
+val andb = _import "Word8_andb" : Word8.t * Word8.t -> Word8.t;
+val equal = _import "Word8_equal" : Word8.t * Word8.t -> Bool.t;
+val lshift = _import "Word8_lshift" : Word8.t * Word32.t -> Word8.t;
+val neg = _import "Word8_neg" : Word8.t -> Word8.t;
+val notb = _import "Word8_notb" : Word8.t -> Word8.t;
+val orb = _import "Word8_orb" : Word8.t * Word8.t -> Word8.t;
+val rol = _import "Word8_rol" : Word8.t * Word32.t -> Word8.t;
+val ror = _import "Word8_ror" : Word8.t * Word32.t -> Word8.t;
+val sub = _import "Word8_sub" : Word8.t * Word8.t -> Word8.t;
+val xorb = _import "Word8_xorb" : Word8.t * Word8.t -> Word8.t;
+end
+structure WordS16 =
+struct
+val addCheckOverflows = _import "WordS16_addCheckOverflows" : Int16.t * Int16.t -> Bool.t;
+val ge = _import "WordS16_ge" : Int16.t * Int16.t -> Bool.t;
+val gt = _import "WordS16_gt" : Int16.t * Int16.t -> Bool.t;
+val le = _import "WordS16_le" : Int16.t * Int16.t -> Bool.t;
+val lt = _import "WordS16_lt" : Int16.t * Int16.t -> Bool.t;
+val mul = _import "WordS16_mul" : Int16.t * Int16.t -> Int16.t;
+val mulCheckOverflows = _import "WordS16_mulCheckOverflows" : Int16.t * Int16.t -> Bool.t;
+val negCheckOverflows = _import "WordS16_negCheckOverflows" : Int16.t -> Bool.t;
+val quot = _import "WordS16_quot" : Int16.t * Int16.t -> Int16.t;
+val rem = _import "WordS16_rem" : Int16.t * Int16.t -> Int16.t;
+val rshift = _import "WordS16_rshift" : Int16.t * Word32.t -> Int16.t;
+val subCheckOverflows = _import "WordS16_subCheckOverflows" : Int16.t * Int16.t -> Bool.t;
+val toReal32 = _import "WordS16_toReal32" : Int16.t -> Real32.t;
+val toReal64 = _import "WordS16_toReal64" : Int16.t -> Real64.t;
+val toWord16 = _import "WordS16_toWord16" : Int16.t -> Word16.t;
+val toWord32 = _import "WordS16_toWord32" : Int16.t -> Word32.t;
+val toWord64 = _import "WordS16_toWord64" : Int16.t -> Word64.t;
+val toWord8 = _import "WordS16_toWord8" : Int16.t -> Word8.t;
+end
+structure WordS32 =
+struct
+val addCheckOverflows = _import "WordS32_addCheckOverflows" : Int32.t * Int32.t -> Bool.t;
+val ge = _import "WordS32_ge" : Int32.t * Int32.t -> Bool.t;
+val gt = _import "WordS32_gt" : Int32.t * Int32.t -> Bool.t;
+val le = _import "WordS32_le" : Int32.t * Int32.t -> Bool.t;
+val lt = _import "WordS32_lt" : Int32.t * Int32.t -> Bool.t;
+val mul = _import "WordS32_mul" : Int32.t * Int32.t -> Int32.t;
+val mulCheckOverflows = _import "WordS32_mulCheckOverflows" : Int32.t * Int32.t -> Bool.t;
+val negCheckOverflows = _import "WordS32_negCheckOverflows" : Int32.t -> Bool.t;
+val quot = _import "WordS32_quot" : Int32.t * Int32.t -> Int32.t;
+val rem = _import "WordS32_rem" : Int32.t * Int32.t -> Int32.t;
+val rshift = _import "WordS32_rshift" : Int32.t * Word32.t -> Int32.t;
+val subCheckOverflows = _import "WordS32_subCheckOverflows" : Int32.t * Int32.t -> Bool.t;
+val toReal32 = _import "WordS32_toReal32" : Int32.t -> Real32.t;
+val toReal64 = _import "WordS32_toReal64" : Int32.t -> Real64.t;
+val toWord16 = _import "WordS32_toWord16" : Int32.t -> Word16.t;
+val toWord32 = _import "WordS32_toWord32" : Int32.t -> Word32.t;
+val toWord64 = _import "WordS32_toWord64" : Int32.t -> Word64.t;
+val toWord8 = _import "WordS32_toWord8" : Int32.t -> Word8.t;
+end
+structure WordS64 =
+struct
+val addCheckOverflows = _import "WordS64_addCheckOverflows" : Int64.t * Int64.t -> Bool.t;
+val ge = _import "WordS64_ge" : Int64.t * Int64.t -> Bool.t;
+val gt = _import "WordS64_gt" : Int64.t * Int64.t -> Bool.t;
+val le = _import "WordS64_le" : Int64.t * Int64.t -> Bool.t;
+val lt = _import "WordS64_lt" : Int64.t * Int64.t -> Bool.t;
+val mul = _import "WordS64_mul" : Int64.t * Int64.t -> Int64.t;
+val mulCheckOverflows = _import "WordS64_mulCheckOverflows" : Int64.t * Int64.t -> Bool.t;
+val negCheckOverflows = _import "WordS64_negCheckOverflows" : Int64.t -> Bool.t;
+val quot = _import "WordS64_quot" : Int64.t * Int64.t -> Int64.t;
+val rem = _import "WordS64_rem" : Int64.t * Int64.t -> Int64.t;
+val rshift = _import "WordS64_rshift" : Int64.t * Word32.t -> Int64.t;
+val subCheckOverflows = _import "WordS64_subCheckOverflows" : Int64.t * Int64.t -> Bool.t;
+val toReal32 = _import "WordS64_toReal32" : Int64.t -> Real32.t;
+val toReal64 = _import "WordS64_toReal64" : Int64.t -> Real64.t;
+val toWord16 = _import "WordS64_toWord16" : Int64.t -> Word16.t;
+val toWord32 = _import "WordS64_toWord32" : Int64.t -> Word32.t;
+val toWord64 = _import "WordS64_toWord64" : Int64.t -> Word64.t;
+val toWord8 = _import "WordS64_toWord8" : Int64.t -> Word8.t;
+end
+structure WordS8 =
+struct
+val addCheckOverflows = _import "WordS8_addCheckOverflows" : Int8.t * Int8.t -> Bool.t;
+val ge = _import "WordS8_ge" : Int8.t * Int8.t -> Bool.t;
+val gt = _import "WordS8_gt" : Int8.t * Int8.t -> Bool.t;
+val le = _import "WordS8_le" : Int8.t * Int8.t -> Bool.t;
+val lt = _import "WordS8_lt" : Int8.t * Int8.t -> Bool.t;
+val mul = _import "WordS8_mul" : Int8.t * Int8.t -> Int8.t;
+val mulCheckOverflows = _import "WordS8_mulCheckOverflows" : Int8.t * Int8.t -> Bool.t;
+val negCheckOverflows = _import "WordS8_negCheckOverflows" : Int8.t -> Bool.t;
+val quot = _import "WordS8_quot" : Int8.t * Int8.t -> Int8.t;
+val rem = _import "WordS8_rem" : Int8.t * Int8.t -> Int8.t;
+val rshift = _import "WordS8_rshift" : Int8.t * Word32.t -> Int8.t;
+val subCheckOverflows = _import "WordS8_subCheckOverflows" : Int8.t * Int8.t -> Bool.t;
+val toReal32 = _import "WordS8_toReal32" : Int8.t -> Real32.t;
+val toReal64 = _import "WordS8_toReal64" : Int8.t -> Real64.t;
+val toWord16 = _import "WordS8_toWord16" : Int8.t -> Word16.t;
+val toWord32 = _import "WordS8_toWord32" : Int8.t -> Word32.t;
+val toWord64 = _import "WordS8_toWord64" : Int8.t -> Word64.t;
+val toWord8 = _import "WordS8_toWord8" : Int8.t -> Word8.t;
+end
+structure WordU16 =
+struct
+val addCheckOverflows = _import "WordU16_addCheckOverflows" : Word16.t * Word16.t -> Bool.t;
+val ge = _import "WordU16_ge" : Word16.t * Word16.t -> Bool.t;
+val gt = _import "WordU16_gt" : Word16.t * Word16.t -> Bool.t;
+val le = _import "WordU16_le" : Word16.t * Word16.t -> Bool.t;
+val lt = _import "WordU16_lt" : Word16.t * Word16.t -> Bool.t;
+val mul = _import "WordU16_mul" : Word16.t * Word16.t -> Word16.t;
+val mulCheckOverflows = _import "WordU16_mulCheckOverflows" : Word16.t * Word16.t -> Bool.t;
+val quot = _import "WordU16_quot" : Word16.t * Word16.t -> Word16.t;
+val rem = _import "WordU16_rem" : Word16.t * Word16.t -> Word16.t;
+val rshift = _import "WordU16_rshift" : Word16.t * Word32.t -> Word16.t;
+val toReal32 = _import "WordU16_toReal32" : Word16.t -> Real32.t;
+val toReal64 = _import "WordU16_toReal64" : Word16.t -> Real64.t;
+val toWord16 = _import "WordU16_toWord16" : Word16.t -> Word16.t;
+val toWord32 = _import "WordU16_toWord32" : Word16.t -> Word32.t;
+val toWord64 = _import "WordU16_toWord64" : Word16.t -> Word64.t;
+val toWord8 = _import "WordU16_toWord8" : Word16.t -> Word8.t;
+end
+structure WordU32 =
+struct
+val addCheckOverflows = _import "WordU32_addCheckOverflows" : Word32.t * Word32.t -> Bool.t;
+val ge = _import "WordU32_ge" : Word32.t * Word32.t -> Bool.t;
+val gt = _import "WordU32_gt" : Word32.t * Word32.t -> Bool.t;
+val le = _import "WordU32_le" : Word32.t * Word32.t -> Bool.t;
+val lt = _import "WordU32_lt" : Word32.t * Word32.t -> Bool.t;
+val mul = _import "WordU32_mul" : Word32.t * Word32.t -> Word32.t;
+val mulCheckOverflows = _import "WordU32_mulCheckOverflows" : Word32.t * Word32.t -> Bool.t;
+val quot = _import "WordU32_quot" : Word32.t * Word32.t -> Word32.t;
+val rem = _import "WordU32_rem" : Word32.t * Word32.t -> Word32.t;
+val rshift = _import "WordU32_rshift" : Word32.t * Word32.t -> Word32.t;
+val toReal32 = _import "WordU32_toReal32" : Word32.t -> Real32.t;
+val toReal64 = _import "WordU32_toReal64" : Word32.t -> Real64.t;
+val toWord16 = _import "WordU32_toWord16" : Word32.t -> Word16.t;
+val toWord32 = _import "WordU32_toWord32" : Word32.t -> Word32.t;
+val toWord64 = _import "WordU32_toWord64" : Word32.t -> Word64.t;
+val toWord8 = _import "WordU32_toWord8" : Word32.t -> Word8.t;
+end
+structure WordU64 =
+struct
+val addCheckOverflows = _import "WordU64_addCheckOverflows" : Word64.t * Word64.t -> Bool.t;
+val ge = _import "WordU64_ge" : Word64.t * Word64.t -> Bool.t;
+val gt = _import "WordU64_gt" : Word64.t * Word64.t -> Bool.t;
+val le = _import "WordU64_le" : Word64.t * Word64.t -> Bool.t;
+val lt = _import "WordU64_lt" : Word64.t * Word64.t -> Bool.t;
+val mul = _import "WordU64_mul" : Word64.t * Word64.t -> Word64.t;
+val mulCheckOverflows = _import "WordU64_mulCheckOverflows" : Word64.t * Word64.t -> Bool.t;
+val quot = _import "WordU64_quot" : Word64.t * Word64.t -> Word64.t;
+val rem = _import "WordU64_rem" : Word64.t * Word64.t -> Word64.t;
+val rshift = _import "WordU64_rshift" : Word64.t * Word32.t -> Word64.t;
+val toReal32 = _import "WordU64_toReal32" : Word64.t -> Real32.t;
+val toReal64 = _import "WordU64_toReal64" : Word64.t -> Real64.t;
+val toWord16 = _import "WordU64_toWord16" : Word64.t -> Word16.t;
+val toWord32 = _import "WordU64_toWord32" : Word64.t -> Word32.t;
+val toWord64 = _import "WordU64_toWord64" : Word64.t -> Word64.t;
+val toWord8 = _import "WordU64_toWord8" : Word64.t -> Word8.t;
+end
+structure WordU8 =
+struct
+val addCheckOverflows = _import "WordU8_addCheckOverflows" : Word8.t * Word8.t -> Bool.t;
+val ge = _import "WordU8_ge" : Word8.t * Word8.t -> Bool.t;
+val gt = _import "WordU8_gt" : Word8.t * Word8.t -> Bool.t;
+val le = _import "WordU8_le" : Word8.t * Word8.t -> Bool.t;
+val lt = _import "WordU8_lt" : Word8.t * Word8.t -> Bool.t;
+val mul = _import "WordU8_mul" : Word8.t * Word8.t -> Word8.t;
+val mulCheckOverflows = _import "WordU8_mulCheckOverflows" : Word8.t * Word8.t -> Bool.t;
+val quot = _import "WordU8_quot" : Word8.t * Word8.t -> Word8.t;
+val rem = _import "WordU8_rem" : Word8.t * Word8.t -> Word8.t;
+val rshift = _import "WordU8_rshift" : Word8.t * Word32.t -> Word8.t;
+val toReal32 = _import "WordU8_toReal32" : Word8.t -> Real32.t;
+val toReal64 = _import "WordU8_toReal64" : Word8.t -> Real64.t;
+val toWord16 = _import "WordU8_toWord16" : Word8.t -> Word16.t;
+val toWord32 = _import "WordU8_toWord32" : Word8.t -> Word32.t;
+val toWord64 = _import "WordU8_toWord64" : Word8.t -> Word64.t;
+val toWord8 = _import "WordU8_toWord8" : Word8.t -> Word8.t;
+end
+end
+end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/check-real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/check-real.sml 2006-05-21 23:07:23 UTC (rev 4563)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/check-real.sml 2006-05-22 15:56:43 UTC (rev 4564)
@@ -32,18 +32,28 @@
val () = check (R1.Math.tanh, R2.Math.tanh)
val () = check (R1.abs, R2.abs)
+ val () = check (R1.+, R2.add)
val () = check (R1.class, R2.class)
+ val () = check (R1./, R2.div)
+ val () = check (R1.==, R2.equal)
val () = check (R1.frexp, R2.frexp)
val () = check (R1.gdtoa, R2.gdtoa)
val () = check (R1.ldexp, R2.ldexp)
+ val () = check (R1.<=, R2.le)
+ val () = check (R1.<, R2.lt)
val () = check (fn () => R1.maxFinite, R2.maxFiniteGet)
val () = check (fn () => R1.minNormalPos, R2.minNormalPosGet)
val () = check (fn () => R1.minPos, R2.minPosGet)
val () = check (R1.modf, R2.modf)
+ val () = check (R1.*, R2.mul)
+ val () = check (R1.*+, R2.muladd)
+ val () = check (R1.*-, R2.mulsub)
+ val () = check (R1.~, R2.neg)
val () = check (R1.nextAfter, R2.nextAfter)
val () = check (R1.round, R2.round)
val () = check (R1.signBit, R2.signBit)
val () = check (R1.strto, R2.strto)
+ val () = check (R1.-, R2.sub)
end
local
@@ -69,18 +79,28 @@
val () = check (R1.Math.tanh, R2.Math.tanh)
val () = check (R1.abs, R2.abs)
+ val () = check (R1.+, R2.add)
val () = check (R1.class, R2.class)
+ val () = check (R1./, R2.div)
+ val () = check (R1.==, R2.equal)
val () = check (R1.frexp, R2.frexp)
val () = check (R1.gdtoa, R2.gdtoa)
val () = check (R1.ldexp, R2.ldexp)
+ val () = check (R1.<=, R2.le)
+ val () = check (R1.<, R2.lt)
val () = check (fn () => R1.maxFinite, R2.maxFiniteGet)
val () = check (fn () => R1.minNormalPos, R2.minNormalPosGet)
val () = check (fn () => R1.minPos, R2.minPosGet)
val () = check (R1.modf, R2.modf)
+ val () = check (R1.*, R2.mul)
+ val () = check (R1.*+, R2.muladd)
+ val () = check (R1.*-, R2.mulsub)
+ val () = check (R1.~, R2.neg)
val () = check (R1.nextAfter, R2.nextAfter)
val () = check (R1.round, R2.round)
val () = check (R1.signBit, R2.signBit)
val () = check (R1.strto, R2.strto)
+ val () = check (R1.-, R2.sub)
end
in
Modified: mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.c 2006-05-21 23:07:23 UTC (rev 4563)
+++ mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.c 2006-05-22 15:56:43 UTC (rev 4564)
@@ -6,7 +6,7 @@
*/
#define MLTON_GC_INTERNAL_TYPES
-#define MLTON_BASIS_FFI_STATIC
+#define MLTON_CODEGEN_STATIC_INLINE static inline
#include "platform.h"
#include "interpret.h"
@@ -61,18 +61,6 @@
#define R(ty, i) (ty##VReg [i])
-#define quotRem1(qr, size) \
- Word##size WordS##size##_##qr (Word##size w1, Word##size w2);
-#define quotRem2(qr) \
- quotRem1 (qr, 8) \
- quotRem1 (qr, 16) \
- quotRem1 (qr, 32) \
- quotRem1 (qr, 64)
-quotRem2 (quot)
-quotRem2 (rem)
-#undef quotRem1
-#undef quotRem2
-
//----------------------------------------------------------------------
#define Fetch(t, z) \
Modified: mlton/branches/on-20050822-x86_64-branch/include/bytecode-main.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/include/bytecode-main.h 2006-05-21 23:07:23 UTC (rev 4563)
+++ mlton/branches/on-20050822-x86_64-branch/include/bytecode-main.h 2006-05-22 15:56:43 UTC (rev 4564)
@@ -30,20 +30,20 @@
fprintf (stderr, "MLton_callFromC() starting\n"); \
s = &gcState; \
s->savedThread = s->currentThread; \
- s->canHandle += 3; \
+ s->atomicState += 3; \
/* Switch to the C Handler thread. */ \
- GC_switchToThread (s, s->callFromCHandler, 0); \
+ GC_switchToThread (s, s->callFromCHandlerThread, 0); \
nextFun = *(int*)(s->stackTop - GC_RETURNADDRESS_SIZE); \
MLton_Bytecode_interpret (&MLton_bytecode, nextFun); \
GC_switchToThread (s, s->savedThread, 0); \
- s->savedThread = BOGUS_THREAD; \
+ s->savedThread = BOGUS_OBJPTR; \
if (DEBUG_CODEGEN) \
fprintf (stderr, "MLton_callFromC done\n"); \
} \
int main (int argc, char **argv) { \
int nextFun; \
Initialize (al, mg, mfs, mmc, pk, ps); \
- if (gcState.isOriginal) { \
+ if (gcState.amOriginal) { \
real_Init(); \
nextFun = ml; \
} else { \
Modified: mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h 2006-05-21 23:07:23 UTC (rev 4563)
+++ mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h 2006-05-22 15:56:43 UTC (rev 4564)
@@ -11,9 +11,9 @@
#include <stdio.h>
-#include "assert.h"
-#include "c-common.h"
#include "ml-types.h"
+#include "c-types.h"
+#include "c-common.h"
#ifndef TRUE
#define TRUE 1
@@ -169,7 +169,6 @@
fprintf (stderr, "%s:%d: Push (%d)\n", \
__FILE__, __LINE__, bytes); \
StackTop += (bytes); \
- assert (StackBottom <= StackTop); \
} while (0)
#define Return() \
@@ -191,91 +190,24 @@
} while (0) \
/* ------------------------------------------------- */
-/* Real */
+/* Primitives */
/* ------------------------------------------------- */
-#define unaryReal(f, g) \
- Real64 g (Real64 x); \
- static inline Real64 Real64_##f (Real64 x) { \
- return g (x); \
- } \
- static inline Real32 Real32_##f (Real32 x) { \
- return (Real32)(Real64_##f ((Real64)x)); \
- }
-unaryReal(round, rint)
-#undef unaryReal
+#ifndef MLTON_CODEGEN_STATIC_INLINE
+#define MLTON_CODEGEN_STATIC_INLINE static inline
+#endif
+#define MLTON_CCODEGEN_HIDE(z)
+#include "basis/coerce.h"
+#include "basis/Real/Real-ops.h"
+#include "basis/Real/Math-fns.h"
+#include "basis/Word/Word-ops.h"
+#include "basis/Word/Word-consts.h"
+#include "basis/Word/Word-check.h"
-#define binaryReal(f, g) \
- Real64 g (Real64 x, Real64 y); \
- static inline Real64 Real64_Math_##f (Real64 x, Real64 y) { \
- return g (x, y); \
- } \
- static inline Real32 Real32_Math_##f (Real32 x, Real32 y) { \
- return (Real32)(Real64_Math_##f ((Real64)x, (Real64)y)); \
- }
-binaryReal(atan2, atan2)
-#undef binaryReal
+/* ------------------------------------------------- */
+/* Real */
+/* ------------------------------------------------- */
-#define unaryReal(f, g) \
- Real64 g (Real64 x); \
- static inline Real64 Real64_Math_##f (Real64 x) { \
- return g (x); \
- } \
- static inline Real32 Real32_Math_##f (Real32 x) { \
- return (Real32)(Real64_Math_##f ((Real64)x)); \
- }
-unaryReal(acos, acos)
-unaryReal(asin, asin)
-unaryReal(atan, atan)
-unaryReal(cos, cos)
-unaryReal(exp, exp)
-unaryReal(ln, log)
-unaryReal(log10, log10)
-unaryReal(sin, sin)
-unaryReal(sqrt, sqrt)
-unaryReal(tan, tan)
-#undef unaryReal
-
-double ldexp (double x, int i);
-static inline Real64 Real64_ldexp (Real64 x, Int32 i) {
- return ldexp (x, i);
-}
-static inline Real32 Real32_ldexp (Real32 x, Int32 i) {
- return (Real32)Real64_ldexp ((Real64)x, i);
-}
-
-#define binaryReal(name, op) \
- static inline Real32 Real32_##name (Real32 x, Real32 y) { \
- return x op y; \
- } \
- static inline Real64 Real64_##name (Real64 x, Real64 y) { \
- return x op y; \
- }
-binaryReal(add, +)
-binaryReal(div, /)
-binaryReal(mul, *)
-binaryReal(sub, -)
-#undef binaryReal
-
-#define binaryReal(name, op) \
- static inline Bool Real32_##name (Real32 x, Real32 y) { \
- return x op y; \
- } \
- static inline Bool Real64_##name (Real64 x, Real64 y) { \
- return x op y; \
- }
-binaryReal(equal, ==)
-binaryReal(le, <=)
-binaryReal(lt, <)
-#undef binaryReal
-
-#define Real32_muladd(x, y, z) ((x) * (y) + (z))
-#define Real32_mulsub(x, y, z) ((x) * (y) - (z))
-#define Real64_muladd(x, y, z) ((x) * (y) + (z))
-#define Real64_mulsub(x, y, z) ((x) * (y) - (z))
-#define Real32_neg(x) (-(x))
-#define Real64_neg(x) (-(x))
-
typedef volatile union {
Word32 tab[2];
Real64 d;
@@ -317,255 +249,109 @@
/* Word */
/* ------------------------------------------------- */
-#define wordBinary(size, name, op) \
- static inline Word##size Word##size##_##name \
- (Word##size w1, Word##size w2) { \
- return w1 op w2; \
- }
-#define wordCmp(size, name, op) \
- static inline Bool Word##size##_##name \
- (Word##size w1, Word##size w2) { \
- Bool res = w1 op w2; \
- if (DEBUG_CCODEGEN) \
- fprintf (stderr, "%s = 0x%08x " #op " 0x%08x\n", \
- res ? "true": "false", \
- (unsigned int)w1, \
- (unsigned int)w2); \
- return w1 op w2; \
- }
-#define wordShift(size, name, op) \
- static inline Word##size Word##size##_##name \
- (Word##size w1, Word32 w2) { \
- return w1 op w2; \
- }
-#define wordUnary(size, name, op) \
- static inline Word##size Word##size##_##name (Word##size w) { \
- return op w; \
- }
-#define wordOps(size) \
- wordBinary (size, add, +) \
- wordBinary (size, andb, &) \
- wordBinary (S##size, mul, *) \
- wordBinary (U##size, mul, *) \
- wordBinary (size, orb, |) \
- wordBinary (U##size, quot, /) \
- wordBinary (U##size, rem, %) \
- wordBinary (size, sub, -) \
- wordBinary (size, xorb, ^) \
- wordCmp (size, equal, ==) \
- wordCmp (S##size, lt, <) \
- wordCmp (U##size, lt, <) \
- wordShift (size, lshift, <<) \
- wordShift (U##size, rshift, >>) \
- wordUnary (size, neg, -) \
- wordUnary (size, notb, ~) \
- /* WordS_rshift isn't ANSI C, because ANSI doesn't guarantee sign \
- * extension. We use it anyway cause it always seems to work. \
- */ \
- static inline Word##size WordS##size##_rshift (WordS##size w, Word32 s) { \
- return w >> s; \
- } \
- static inline Word##size Word##size##_rol (Word##size w1, Word32 w2) { \
- return (w1 >> (size - w2)) | (w1 << w2); \
- } \
- static inline Word##size Word##size##_ror (Word##size w1, Word32 w2) { \
- return (w1 >> w2) | (w1 << (size - w2)); \
- }
-wordOps(8)
-wordOps(16)
-wordOps(32)
-wordOps(64)
-#undef wordBinary
-#undef wordCmp
-#undef wordOps
-#undef wordShift
-#undef wordUnary
+#define WordS_addCheckCX(size, dst, cW, xW, l) \
+ do { \
+ WordS##size c = cW; \
+ WordS##size x = xW; \
+ WordS_addCheckBodyCX(size, c, x, goto l, dst = c + x); \
+ } while (0)
+#define WordS8_addCheckCX(dst, c, x, l) WordS_addCheckCX(8, dst, c, x, l)
+#define WordS16_addCheckCX(dst, c, x, l) WordS_addCheckCX(16, dst, c, x, l)
+#define WordS32_addCheckCX(dst, c, x, l) WordS_addCheckCX(32, dst, c, x, l)
+#define WordS64_addCheckCX(dst, c, x, l) WordS_addCheckCX(64, dst, c, x, l)
-#define coerce(f, t) \
- static inline t f##_to##t (f x) { \
- return (t)x; \
- }
-coerce (Real32, Real64)
-coerce (Real32, WordS32)
-coerce (Real64, Real32)
-coerce (Real64, WordS32)
-coerce (WordS16, Real32)
-coerce (WordS16, Real64)
-coerce (WordS16, Word32)
-coerce (WordS16, Word64)
-coerce (WordS32, Real32)
-coerce (WordS32, Real64)
-coerce (WordS32, Word64)
-coerce (WordS8, Real32)
-coerce (WordS8, Real64)
-coerce (WordS8, Word16)
-coerce (WordS8, Word32)
-coerce (WordS8, Word64)
-coerce (WordU16, Word32)
-coerce (WordU16, Word64)
-coerce (WordU16, Word8)
-coerce (WordU32, Word16)
-coerce (WordU32, Word64)
-coerce (WordU32, Word8)
-coerce (WordU64, Word16)
-coerce (WordU64, Word32)
-coerce (WordU64, Word8)
-coerce (WordU8, Word16)
-coerce (WordU8, Word32)
-coerce (WordU8, Word64)
-#undef coerce
+#define WordS8_addCheckXC(dst, x, c, l) WordS8_addCheckCX(dst, c, x, l)
+#define WordS16_addCheckXC(dst, x, c, l) WordS16_addCheckCX(dst, c, x, l)
+#define WordS32_addCheckXC(dst, x, c, l) WordS32_addCheckCX(dst, c, x, l)
+#define WordS64_addCheckXC(dst, x, c, l) WordS64_addCheckCX(dst, c, x, l)
-#define WordS8_max (WordS8)0x7F
-#define WordS8_min (WordS8)0x80
-#define WordS16_max (WordS16)0x7FFF
-#define WordS16_min (WordS16)0x8000
-#define WordS32_max (WordS32)0x7FFFFFFF
-#define WordS32_min (WordS32)0x80000000
-#define WordS64_max (WordS64)0x7FFFFFFFFFFFFFFFll
-#define WordS64_min (WordS64)0x8000000000000000ll
-#define Word8_max (Word8)0xFF
-#define Word16_max (Word16)0xFFFF
-#define Word32_max (Word32)0xFFFFFFFF
-#define Word64_max (Word64)0xFFFFFFFFFFFFFFFFull
-
-#define WordS_addCheckXC(size, dst, xW, cW, l) \
- do { \
- WordS##size x = xW; \
- WordS##size c = cW; \
- dst = x + c; \
- if (c >= 0) { \
- if (x > WordS##size##_max - c) \
- goto l; \
- } else if (x < WordS##size##_min - c) \
- goto l; \
- } while (0)
-#define WordS8_addCheckXC(dst, x, c, l) WordS_addCheckXC(8, dst, x, c, l)
-#define WordS16_addCheckXC(dst, x, c, l) WordS_addCheckXC(16, dst, x, c, l)
-#define WordS32_addCheckXC(dst, x, c, l) WordS_addCheckXC(32, dst, x, c, l)
-#define WordS64_addCheckXC(dst, x, c, l) WordS_addCheckXC(64, dst, x, c, l)
-
-#define WordS8_addCheckCX(dst, c, x, l) WordS8_addCheckXC(dst, x, c, l)
-#define WordS16_addCheckCX(dst, c, x, l) WordS16_addCheckXC(dst, x, c, l)
-#define WordS32_addCheckCX(dst, c, x, l) WordS32_addCheckXC(dst, x, c, l)
-#define WordS64_addCheckCX(dst, c, x, l) WordS64_addCheckXC(dst, x, c, l)
-
-#define WordS8_addCheck(dst, x, y, l) WordS8_addCheckXC (dst, x, y, l)
+#define WordS8_addCheck WordS8_addCheckXC
#define WordS16_addCheck WordS16_addCheckXC
#define WordS32_addCheck WordS32_addCheckXC
#define WordS64_addCheck WordS64_addCheckXC
-#define WordS_negCheck(size, dst, nW, l) \
- do { \
- WordS##size n = nW; \
- dst = -n; \
- if (n == WordS##size##_min) \
- goto l; \
- } while (0)
-#define Word8_negCheck(dst, n, l) WordS_negCheck(8, dst, n, l)
-#define Word16_negCheck(dst, n, l) WordS_negCheck(16, dst, n, l)
-#define Word32_negCheck(dst, n, l) WordS_negCheck(32, dst, n, l)
-#define Word64_negCheck(dst, n, l) WordS_negCheck(64, dst, n, l)
+#define WordU_addCheckCX(size, dst, cW, xW, l) \
+ do { \
+ WordU##size c = cW; \
+ WordU##size x = xW; \
+ WordU_addCheckBodyCX(size, c, x, goto l, dst = c + x); \
+ } while (0)
+#define WordU8_addCheckCX(dst, c, x, l) WordU_addCheckCX(8, dst, c, x, l)
+#define WordU16_addCheckCX(dst, c, x, l) WordU_addCheckCX(16, dst, c, x, l)
+#define WordU32_addCheckCX(dst, c, x, l) WordU_addCheckCX(32, dst, c, x, l)
+#define WordU64_addCheckCX(dst, c, x, l) WordU_addCheckCX(64, dst, c, x, l)
-#define WordS_subCheckCX(size, dst, cW, xW, l) \
- do { \
- WordS##size c = cW; \
- WordS##size x = xW; \
- dst = c - x; \
- if (c >= 0) { \
- if (x < c - WordS##size##_max) \
- goto l; \
- } else if (x > c - WordS##size##_min) \
- goto l; \
- } while (0)
+#define WordU8_addCheckXC(dst, x, c, l) WordU8_addCheckCX(dst, c, x, l)
+#define WordU16_addCheckXC(dst, x, c, l) WordU16_addCheckCX(dst, c, x, l)
+#define WordU32_addCheckXC(dst, x, c, l) WordU32_addCheckCX(dst, c, x, l)
+#define WordU64_addCheckXC(dst, x, c, l) WordU64_addCheckCX(dst, c, x, l)
+
+#define WordU8_addCheck WordU8_addCheckXC
+#define WordU16_addCheck WordU16_addCheckXC
+#define WordU32_addCheck WordU32_addCheckXC
+#define WordU64_addCheck WordU64_addCheckXC
+
+
+#define WordS_negCheck(size, dst, xW, l) \
+ do { \
+ WordS##size x = xW; \
+ WordS_negCheckBody(size, x, goto l, dst = -x); \
+ } while (0)
+#define Word8_negCheck(dst, x, l) WordS_negCheck(8, dst, x, l)
+#define Word16_negCheck(dst, x, l) WordS_negCheck(16, dst, x, l)
+#define Word32_negCheck(dst, x, l) WordS_negCheck(32, dst, x, l)
+#define Word64_negCheck(dst, x, l) WordS_negCheck(64, dst, x, l)
+
+
+#define WordS_subCheckCX(size, dst, cW, xW, l) \
+ do { \
+ WordS##size c = cW; \
+ WordS##size x = xW; \
+ WordS_subCheckBodyCX(size, c, x, goto l, dst = c - x); \
+ } while (0)
#define WordS8_subCheckCX(dst, c, x, l) WordS_subCheckCX(8, dst, c, x, l)
#define WordS16_subCheckCX(dst, c, x, l) WordS_subCheckCX(16, dst, c, x, l)
#define WordS32_subCheckCX(dst, c, x, l) WordS_subCheckCX(32, dst, c, x, l)
#define WordS64_subCheckCX(dst, c, x, l) WordS_subCheckCX(64, dst, c, x, l)
-#define WordS_subCheckXC(size, dst, xW, cW, l) \
- do { \
- WordS##size c = cW; \
- WordS##size x = xW; \
- if (c <= 0) { \
- if (x > WordS##size##_max + c) \
- goto l; \
- } else if (x < WordS##size##_min + c) \
- goto l; \
- dst = x - c; \
- } while (0)
-#define WordS8_subCheckXC(dst, c, x, l) WordS_subCheckXC(8, dst, c, x, l)
-#define WordS16_subCheckXC(dst, c, x, l) WordS_subCheckXC(16, dst, c, x, l)
-#define WordS32_subCheckXC(dst, c, x, l) WordS_subCheckXC(32, dst, c, x, l)
-#define WordS64_subCheckXC(dst, c, x, l) WordS_subCheckXC(64, dst, c, x, l)
+#define WordS_subCheckXC(size, dst, xW, cW, l) \
+ do { \
+ WordS##size x = xW; \
+ WordS##size c = cW; \
+ WordS_subCheckBodyXC(size, x, c, goto l, dst = x - c); \
+ } while (0)
+#define WordS8_subCheckXC(dst, x, c, l) WordS_subCheckXC(8, dst, x, c, l)
+#define WordS16_subCheckXC(dst, x, c, l) WordS_subCheckXC(16, dst, x, c, l)
+#define WordS32_subCheckXC(dst, x, c, l) WordS_subCheckXC(32, dst, x, c, l)
+#define WordS64_subCheckXC(dst, x, c, l) WordS_subCheckXC(64, dst, x, c, l)
#define WordS8_subCheck WordS8_subCheckXC
#define WordS16_subCheck WordS16_subCheckXC
#define WordS32_subCheck WordS32_subCheckXC
#define WordS64_subCheck WordS64_subCheckXC
-#define WordU_addCheckXC(size, dst, x, c, l) \
- do { \
- dst = x + c; \
- if (x > Word##size##_max - c) \
- goto l; \
- } while (0)
-#define WordU8_addCheckXC(dst, x, c, l) WordU_addCheckXC(8, dst, x, c, l)
-#define WordU16_addCheckXC(dst, x, c, l) WordU_addCheckXC(16, dst, x, c, l)
-#define WordU32_addCheckXC(dst, x, c, l) WordU_addCheckXC(32, dst, x, c, l)
-#define WordU64_addCheckXC(dst, x, c, l) WordU_addCheckXC(64, dst, x, c, l)
-#define WordU8_addCheckCX(dst, c, x, l) WordU_addCheckXC(8, dst, x, c, l)
-#define WordU16_addCheckCX(dst, c, x, l) WordU_addCheckXC(16, dst, x, c, l)
-#define WordU32_addCheckCX(dst, c, x, l) WordU_addCheckXC(32, dst, x, c, l)
-#define WordU64_addCheckCX(dst, c, x, l) WordU_addCheckXC(64, dst, x, c, l)
-#define WordU8_addCheck WordU8_addCheckXC
-#define WordU16_addCheck WordU16_addCheckXC
-#define WordU32_addCheck WordU32_addCheckXC
-#define WordU64_addCheck WordU64_addCheckXC
+#define WordS_mulCheck(size, dst, xW, yW, l) \
+ do { \
+ WordS##size x = xW; \
+ WordS##size y = yW; \
+ WordS_mulCheckBody(size, x, y, goto l, dst = x * y); \
+ } while (0)
+#define WordS8_mulCheck(dst, x, y, l) WordS_mulCheck(8, dst, x, y, l)
+#define WordS16_mulCheck(dst, x, y, l) WordS_mulCheck(16, dst, x, y, l)
+#define WordS32_mulCheck(dst, x, y, l) WordS_mulCheck(32, dst, x, y, l)
+#define WordS64_mulCheck(dst, x, y, l) WordS_mulCheck(64, dst, x, y, l)
-#define mulOverflow(small, large) \
- static inline Word##small Word##small##_##mulOverflow \
- (Word##small x1, Word##small x2, Bool *overflow) { \
- Word##large tmp; \
- Word##small res; \
- \
- tmp = (Word##large)x1 * x2; \
- res = tmp; \
- *overflow = (tmp != res); \
- return res; \
- }
-mulOverflow(S8, S16)
-mulOverflow(S16, S32)
-mulOverflow(S32, S64)
-mulOverflow(U8, U16)
-mulOverflow(U16, U32)
-mulOverflow(U32, U64)
-#undef mulOverflow
+#define WordU_mulCheck(size, dst, xW, yW, l) \
+ do { \
+ WordU##size x = xW; \
+ WordU##size y = yW; \
+ WordU_mulCheckBody(size, x, y, goto l, dst = x * y); \
+ } while (0)
+#define WordU8_mulCheck(dst, x, y, l) WordU_mulCheck(8, dst, x, y, l)
+#define WordU16_mulCheck(dst, x, y, l) WordU_mulCheck(16, dst, x, y, l)
+#define WordU32_mulCheck(dst, x, y, l) WordU_mulCheck(32, dst, x, y, l)
+#define WordU64_mulCheck(dst, x, y, l) WordU_mulCheck(64, dst, x, y, l)
-#define check(dst, n1, n2, l, ty); \
- do { \
- Bool overflow; \
- ty tmp; \
- tmp = ty##_mulOverflow (n1, n2, &overflow); \
- if (DEBUG_CCODEGEN) \
- fprintf (stderr, "%s:%d: " #ty "_mulOverflow (%d, %d) = %d\n", \
- __FILE__, __LINE__, \
- (int)n1, (int)n2, (int)tmp); \
- if (overflow) { \
- if (DEBUG_CCODEGEN) \
- fprintf (stderr, "%s:%d: overflow\n", \
- __FILE__, __LINE__); \
- goto l; \
- } \
- dst = tmp; \
- } while (0)
-
-#define WordS8_mulCheck(dst, n1, n2, l) check (dst, n1, n2, l, WordS8)
-#define WordS16_mulCheck(dst, n1, n2, l) check (dst, n1, n2, l, WordS16)
-#define WordS32_mulCheck(dst, n1, n2, l) check (dst, n1, n2, l, WordS32)
-#define WordU8_mulCheck(dst, n1, n2, l) check (dst, n1, n2, l, WordU8)
-#define WordU16_mulCheck(dst, n1, n2, l) check (dst, n1, n2, l, WordU16)
-#define WordU32_mulCheck(dst, n1, n2, l) check (dst, n1, n2, l, WordU32)
-
#endif /* #ifndef _C_CHUNK_H_ */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-05-21 23:07:23 UTC (rev 4563)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-05-22 15:56:43 UTC (rev 4564)
@@ -138,10 +138,12 @@
GCHFILES = \
$(shell find gc -type f | grep '\.h$$')
+BASISHFILES = \
+ $(shell find basis -type f | grep '\.h$$')
+
CFILES = \
$(UTILCFILES) \
$(shell find basis -type f | grep '\.c$$' | grep -v Real/) \
- $(shell find Posix -type f | grep '\.c$$') \
gc.c \
platform.c
@@ -154,7 +156,8 @@
c-types.h \
basis-ffi.h \
platform.h \
- platform/$(TARGET_OS).h
+ platform/$(TARGET_OS).h \
+ $(BASISHFILES)
FILES = $(basename $(CFILES))
@@ -255,9 +258,9 @@
# with -fno-strict-aliasing to prevent gcc from taking advantage of
# this aspect of the C spec.
basis/Real/%-gdb.o: basis/Real/%.c gdtoa/arith.h $(HFILES)
- $(CC) $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) -c -o $@ $<
+ $(CC) $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) -Wno-float-equal -c -o $@ $<
basis/Real/%.o: basis/Real/%.c gdtoa/arith.h $(HFILES)
- $(CC) $(OPTCFLAGS) $(OPTWARNCFLAGS) -O1 -fno-strict-aliasing -c -o $@ $<
+ $(CC) $(OPTCFLAGS) $(OPTWARNCFLAGS) -Wno-float-equal -O1 -fno-strict-aliasing -c -o $@ $<
%-gdb.o: %.c $(HFILES)
$(CC) $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) -c -o $@ $<
Added: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math-fns.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math-fns.h 2006-05-21 23:07:23 UTC (rev 4563)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math-fns.h 2006-05-22 15:56:43 UTC (rev 4564)
@@ -0,0 +1,74 @@
+
+#define unaryReal(g, h) \
+ MLTON_CODEGEN_STATIC_INLINE \
+ Real64_t Real64_##g (Real64_t x) { \
+ return h (x); \
+ } \
+ MLTON_CODEGEN_STATIC_INLINE \
+ Real32_t Real32_##g (Real32_t x) { \
+ return h##f (x); \
+ }
+unaryReal(abs, fabs)
+unaryReal(round, rint)
+#undef unaryReal
+
+#define binaryReal(g, h) \
+ MLTON_CODEGEN_STATIC_INLINE \
+ Real64_t Real64_Math_##g (Real64_t x, Real64_t y) { \
+ return h (x, y); \
+ } \
+ MLTON_CODEGEN_STATIC_INLINE \
+ 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(g, h) \
+ MLTON_CODEGEN_STATIC_INLINE \
+ Real64_t Real64_Math_##g (Real64_t x) { \
+ return h (x); \
+ } \
+ MLTON_CODEGEN_STATIC_INLINE \
+ Real32_t Real32_Math_##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
+
+#define binaryRealIntRef(g, h) \
+ MLTON_CODEGEN_STATIC_INLINE \
+ Real64_t Real64_##g (Real64_t x, Ref(C_Int_t) i) { \
+ return h (x, (int*)i); \
+ } \
+ MLTON_CODEGEN_STATIC_INLINE \
+ Real32_t Real32_##g (Real32_t x, Ref(C_Int_t) i) { \
+ return h##f (x, (int*)i); \
+ }
+binaryRealIntRef(frexp, frexp)
+#undef binaryRealIntRef
+
+#define binaryRealInt(g, h) \
+ MLTON_CODEGEN_STATIC_INLINE \
+ Real64_t Real64_##g (Real64_t x, C_Int_t i) { \
+ return h (x, i); \
+ } \
+ MLTON_CODEGEN_STATIC_INLINE \
+ Real32_t Real32_##g (Real32_t x, C_Int_t i) { \
+ return h##f (x, i); \
+ }
+binaryRealInt(ldexp, ldexp)
+#undef binaryRealInt
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-05-21 23:07:23 UTC (rev 4563)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Math.c 2006-05-22 15:56:43 UTC (rev 4564)
@@ -1,55 +1,3 @@
#include "platform.h"
-#define unaryReal(g, h) \
-Real64_t Real64_##g (Real64_t x) { \
- return h (x); \
-} \
-Real32_t Real32_##g (Real32_t x) { \
- return h##f (x); \
-}
-unaryReal(abs, fabs)
-unaryReal(round, rint)
-#undef unaryReal
-
-#define binaryReal(g, h) \
-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) { \
- return h##f (x, y); \
-}
-binaryReal(atan2, atan2)
-binaryReal(pow, pow)
-#undef binaryReal
-
-#define unaryReal(g, h) \
-Real64_t Real64_Math_##g (Real64_t x) { \
- return h (x); \
-} \
-Real32_t Real32_Math_##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
-
-#define binaryRealInt(g, h) \
-Real64_t Real64_##g (Real64_t x, C_Int_t i) { \
- return h (x, i); \
-} \
-Real32_t Real32_##g (Real32_t x, C_Int_t i) { \
- return h##f (x, i); \
-}
-binaryRealInt(ldexp, ldexp)
-#undef binaryRealInt
+#include "Math-fns.h"
Added: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Real-consts.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Real-consts.c 2006-05-21 23:07:23 UTC (rev 4563)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Real-consts.c 2006-05-22 15:56:43 UTC (rev 4564)
@@ -0,0 +1,15 @@
+#include "platform.h"
+
+Real32_t Real32_Math_pi = (Real32_t)3.14159265358979323846;
+Real32_t Real32_Math_e = (Real32_t)2.71828182845904523536;
+
+Real32_t Real32_maxFinite = 3.40282347e+38;
+Real32_t Real32_minNormalPos = 1.17549435e-38;
+Real32_t Real32_minPos = 1.40129846e-45;
+
+Real64_t Real64_Math_pi = 3.14159265358979323846;
+Real64_t Real64_Math_e = 2.71828182845904523536;
+
+Real64_t Real64_maxFinite = 1.7976931348623157e+308;
+Real64_t Real64_minNormalPos = 2.2250738585072014e-308;
+Real64_t Real64_minPos = 4.9406564584124654e-324;
Added: mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Real-ops.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Real-ops.h 2006-05-21 23:07:23 UTC (rev 4563)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/Real/Real-ops.h 2006-05-22 15:56:43 UTC (rev 4564)
@@ -0,0 +1,45 @@
+
+#define binary(size, name, op) \
+ MLTON_CODEGEN_STATIC_INLINE \
+ Real##size##_t Real##size##_##name (Real##size##_t r1, Real##size##_t r2) { \
+ return r1 op r2; \
+ }
+
+#define compare(size, name, op) \
+ MLTON_CODEGEN_STATIC_INLINE \
+ Bool Real##size##_##name (Real##size##_t r1, Real##size##_t r2) { \
+ return r1 op r2; \
+ }...
[truncated message content] |