From 47774449c9d66b768a70851fe82c5222c1f60689 Mon Sep 17 00:00:00 2001 From: ken Date: Thu, 26 Jul 2001 03:08:39 +0000 Subject: [PATCH] [project @ 2001-07-26 03:08:38 by ken] Run prelude/primops.txt through the preprocessor, to weed out primitives that don't (need to) exist on 64-bit architectures. --- ghc/compiler/Makefile | 29 ++++++++++++++++------------ ghc/compiler/prelude/primops.txt | 39 +++++++++++++++++++++++++++++++++++++- ghc/includes/Derived.h | 25 ++++++++++++++++++++++++ ghc/includes/StgTypes.h | 15 ++++----------- ghc/lib/std/Makefile | 7 +++---- ghc/rts/PrimOps.hc | 4 ++-- ghc/utils/genprimopcode/Main.hs | 2 +- 7 files changed, 90 insertions(+), 31 deletions(-) create mode 100644 ghc/includes/Derived.h diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile index 79409d2..fc58adf 100644 --- a/ghc/compiler/Makefile +++ b/ghc/compiler/Makefile @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Makefile,v 1.177 2001/07/21 19:08:44 sof Exp $ +# $Id: Makefile,v 1.178 2001/07/26 03:08:38 ken Exp $ TOP = .. include $(TOP)/mk/boilerplate.mk @@ -305,6 +305,11 @@ SRC_C_OPTS += -O -I. -IcodeGen # Generate supporting stuff for prelude/PrimOp.lhs # from prelude/primops.txt +# Run prelude/primops.txt through the preprocessor, to weed out +# primitives that don't (need to) exist on 64-bit architectures. +prelude/primops.i: prelude/primops.txt + $(CPP) -I$(GHC_INCLUDE_DIR) -x c $< 2>/dev/null | $(SED) -e '/^#/d' > $@ + GENPOC=$(TOP)/utils/genprimopcode/genprimopcode PRIMOP_BITS=primop-data-decl.hs-incl \ @@ -327,27 +332,27 @@ ifneq "$(BootingFromHc)" "YES" depend :: $(PRIMOP_BITS) endif -primop-data-decl.hs-incl: prelude/primops.txt +primop-data-decl.hs-incl: prelude/primops.i $(GENPOC) --data-decl < $< > $@ -primop-tag.hs-incl: prelude/primops.txt +primop-tag.hs-incl: prelude/primops.i $(GENPOC) --primop-tag < $< > $@ -primop-list.hs-incl: prelude/primops.txt +primop-list.hs-incl: prelude/primops.i $(GENPOC) --primop-list < $< > $@ -primop-has-side-effects.hs-incl: prelude/primops.txt +primop-has-side-effects.hs-incl: prelude/primops.i $(GENPOC) --has-side-effects < $< > $@ -primop-out-of-line.hs-incl: prelude/primops.txt +primop-out-of-line.hs-incl: prelude/primops.i $(GENPOC) --out-of-line < $< > $@ -primop-commutable.hs-incl: prelude/primops.txt +primop-commutable.hs-incl: prelude/primops.i $(GENPOC) --commutable < $< > $@ -primop-needs-wrapper.hs-incl: prelude/primops.txt +primop-needs-wrapper.hs-incl: prelude/primops.i $(GENPOC) --needs-wrapper < $< > $@ -primop-can-fail.hs-incl: prelude/primops.txt +primop-can-fail.hs-incl: prelude/primops.i $(GENPOC) --can-fail < $< > $@ -primop-strictness.hs-incl: prelude/primops.txt +primop-strictness.hs-incl: prelude/primops.i $(GENPOC) --strictness < $< > $@ -primop-usage.hs-incl: prelude/primops.txt +primop-usage.hs-incl: prelude/primops.i $(GENPOC) --usage < $< > $@ -primop-primop-info.hs-incl: prelude/primops.txt +primop-primop-info.hs-incl: prelude/primops.i $(GENPOC) --primop-primop-info < $< > $@ diff --git a/ghc/compiler/prelude/primops.txt b/ghc/compiler/prelude/primops.txt index a68f6dc..1ec7e39 100644 --- a/ghc/compiler/prelude/primops.txt +++ b/ghc/compiler/prelude/primops.txt @@ -1,5 +1,5 @@ ----------------------------------------------------------------------- --- $Id: primops.txt,v 1.22 2001/07/23 10:48:56 simonpj Exp $ +-- $Id: primops.txt,v 1.23 2001/07/26 03:08:38 ken Exp $ -- -- Primitive Operations -- @@ -25,6 +25,9 @@ -- - the User's Guide -- +#include "config.h" +#include "Derived.h" + -- The default attribute values which apply if you don't specify -- other ones. Attribute values can be True, False, or arbitrary -- text between curly brackets. This is a kludge to enable @@ -353,9 +356,11 @@ primop ISrlOp "iShiftRL#" GenPrimOp Int# -> Int# -> Int# --- Int64# --- ------------------------------------------------------------------------ +#ifdef SUPPORT_LONG_LONGS primop Int64ToIntegerOp "int64ToInteger#" GenPrimOp Int64# -> (# Int#, ByteArr# #) with out_of_line = True +#endif ------------------------------------------------------------------------ @@ -423,11 +428,13 @@ primop Integer2WordOp "integer2Word#" GenPrimOp Int# -> ByteArr# -> Word# with needs_wrapper = True +#ifdef SUPPORT_LONG_LONGS primop IntegerToInt64Op "integerToInt64#" GenPrimOp Int# -> ByteArr# -> Int64# primop IntegerToWord64Op "integerToWord64#" GenPrimOp Int# -> ByteArr# -> Word64# +#endif primop IntegerAndOp "andInteger#" GenPrimOp Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #) @@ -495,9 +502,11 @@ primop WordLeOp "leWord#" Compare Word# -> Word# -> Bool --- Word64# --- ------------------------------------------------------------------------ +#ifdef SUPPORT_LONG_LONGS primop Word64ToIntegerOp "word64ToInteger#" GenPrimOp Word64# -> (# Int#, ByteArr# #) with out_of_line = True +#endif ------------------------------------------------------------------------ --- Explicitly sized Int# and Word# --- @@ -559,8 +568,10 @@ primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp ByteArr# -> Int# -> Int# +#ifdef SUPPORT_LONG_LONGS primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp ByteArr# -> Int# -> Int64# +#endif primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp ByteArr# -> Int# -> Word# @@ -571,8 +582,10 @@ primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp ByteArr# -> Int# -> Word# +#ifdef SUPPORT_LONG_LONGS primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp ByteArr# -> Int# -> Word64# +#endif primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp @@ -608,8 +621,10 @@ primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #) +#ifdef SUPPORT_LONG_LONGS primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp MutByteArr# s -> Int# -> State# s -> (# State# s, Int64# #) +#endif primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #) @@ -620,8 +635,10 @@ primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #) +#ifdef SUPPORT_LONG_LONGS primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp MutByteArr# s -> Int# -> State# s -> (# State# s, Word64# #) +#endif @@ -669,9 +686,11 @@ primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp MutByteArr# s -> Int# -> Int# -> State# s -> State# s with has_side_effects = True +#ifdef SUPPORT_LONG_LONGS primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp MutByteArr# s -> Int# -> Int64# -> State# s -> State# s with has_side_effects = True +#endif primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp MutByteArr# s -> Int# -> Word# -> State# s -> State# s @@ -685,9 +704,11 @@ primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp MutByteArr# s -> Int# -> Word# -> State# s -> State# s with has_side_effects = True +#ifdef SUPPORT_LONG_LONGS primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp MutByteArr# s -> Int# -> Word64# -> State# s -> State# s with has_side_effects = True +#endif primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp @@ -723,8 +744,10 @@ primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp Addr# -> Int# -> Int# +#ifdef SUPPORT_LONG_LONGS primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp Addr# -> Int# -> Int64# +#endif primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp Addr# -> Int# -> Word# @@ -735,8 +758,10 @@ primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp Addr# -> Int# -> Word# +#ifdef SUPPORT_LONG_LONGS primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp Addr# -> Int# -> Word64# +#endif primop EqForeignObj "eqForeignObj#" GenPrimOp @@ -776,8 +801,10 @@ primop IndexOffForeignObjOp_Int16 "indexInt16OffForeignObj#" GenPrimOp primop IndexOffForeignObjOp_Int32 "indexInt32OffForeignObj#" GenPrimOp ForeignObj# -> Int# -> Int# +#ifdef SUPPORT_LONG_LONGS primop IndexOffForeignObjOp_Int64 "indexInt64OffForeignObj#" GenPrimOp ForeignObj# -> Int# -> Int64# +#endif primop IndexOffForeignObjOp_Word8 "indexWord8OffForeignObj#" GenPrimOp ForeignObj# -> Int# -> Word# @@ -788,8 +815,10 @@ primop IndexOffForeignObjOp_Word16 "indexWord16OffForeignObj#" GenPrimOp primop IndexOffForeignObjOp_Word32 "indexWord32OffForeignObj#" GenPrimOp ForeignObj# -> Int# -> Word# +#ifdef SUPPORT_LONG_LONGS primop IndexOffForeignObjOp_Word64 "indexWord64OffForeignObj#" GenPrimOp ForeignObj# -> Int# -> Word64# +#endif primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, Char# #) @@ -824,8 +853,10 @@ primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, Int# #) +#ifdef SUPPORT_LONG_LONGS primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, Int64# #) +#endif primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, Word# #) @@ -836,8 +867,10 @@ primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, Word# #) +#ifdef SUPPORT_LONG_LONGS primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, Word64# #) +#endif primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp @@ -888,9 +921,11 @@ primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp Addr# -> Int# -> Int# -> State# s -> State# s with has_side_effects = True +#ifdef SUPPORT_LONG_LONGS primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp Addr# -> Int# -> Int64# -> State# s -> State# s with has_side_effects = True +#endif primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp Addr# -> Int# -> Word# -> State# s -> State# s @@ -904,9 +939,11 @@ primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp Addr# -> Int# -> Word# -> State# s -> State# s with has_side_effects = True +#ifdef SUPPORT_LONG_LONGS primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp Addr# -> Int# -> Word64# -> State# s -> State# s with has_side_effects = True +#endif diff --git a/ghc/includes/Derived.h b/ghc/includes/Derived.h new file mode 100644 index 0000000..bda5ce4 --- /dev/null +++ b/ghc/includes/Derived.h @@ -0,0 +1,25 @@ +/* ----------------------------------------------------------------------------- + * $Id: Derived.h,v 1.1 2001/07/26 03:08:39 ken Exp $ + * + * (c) The GHC Team, 1998-2001 + * + * Configuration information derived from config.h. + * + * NOTE: assumes #include "config.h" + * + * NB: THIS FILE IS INCLUDED IN NON-C CODE AND DATA! #defines only please. + * ---------------------------------------------------------------------------*/ + +#ifndef DERIVED_H +#define DERIVED_H + +/* + * SUPPORT_LONG_LONGS controls whether we need to support long longs on a + * particular platform. On 64-bit platforms, we don't need to support + * long longs since regular machine words will do just fine. + */ +#if HAVE_LONG_LONG && SIZEOF_VOID_P < 8 +#define SUPPORT_LONG_LONGS 1 +#endif + +#endif /* DERIVED_H */ diff --git a/ghc/includes/StgTypes.h b/ghc/includes/StgTypes.h index ea0b5ba..fd9401d 100644 --- a/ghc/includes/StgTypes.h +++ b/ghc/includes/StgTypes.h @@ -1,10 +1,10 @@ /* ----------------------------------------------------------------------------- - * $Id: StgTypes.h,v 1.16 2001/07/23 17:23:19 simonmar Exp $ + * $Id: StgTypes.h,v 1.17 2001/07/26 03:08:39 ken Exp $ * * (c) The GHC Team, 1998-2000 * * Various C datatypes used in the run-time system. This is the - * lowest-level include file (after config.h). + * lowest-level include file, after config.h and Derived.h. * * This module should define types *only*, all beginning with "Stg". * @@ -36,6 +36,8 @@ #ifndef STGTYPES_H #define STGTYPES_H +#include "Derived.h" + /* * First, platform-dependent definitions of size-specific integers. * Assume for now that the int type is 32 bits. @@ -57,15 +59,6 @@ typedef unsigned int StgWord32; #error GHC untested on this architecture: sizeof(unsigned int) != 4 #endif -/* This #define controls whether we need to support long longs on a particular - * platform. - * - * ToDo: find a proper home for (derived) configuration information like this. - */ -#if HAVE_LONG_LONG && SIZEOF_VOID_P < 8 -#define SUPPORT_LONG_LONGS -#endif - #ifdef SUPPORT_LONG_LONGS /* assume long long is 64 bits */ typedef signed long long int StgInt64; diff --git a/ghc/lib/std/Makefile b/ghc/lib/std/Makefile index 86489ed..56e364d 100644 --- a/ghc/lib/std/Makefile +++ b/ghc/lib/std/Makefile @@ -67,10 +67,9 @@ SRC_MKDEPENDHS_OPTS += -I$(GHC_INCLUDE_DIR) #----------------------------------------------------------------------------- # Rules -PrelPrimopWrappers.hs: ../../compiler/prelude/primops.txt - rm -f PrelPrimopWrappers.hs - ../../utils/genprimopcode/genprimopcode --make-haskell-wrappers \ - < ../../compiler/prelude/primops.txt > PrelPrimopWrappers.hs +PrelPrimopWrappers.hs: ../../compiler/prelude/primops.i + rm -f $@ + ../../utils/genprimopcode/genprimopcode --make-haskell-wrappers < $< > $@ PrelGHC.$(way_)hi : PrelGHC.hi-boot cp $< $@ diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc index 8b4946c..6894b26 100644 --- a/ghc/rts/PrimOps.hc +++ b/ghc/rts/PrimOps.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.hc,v 1.81 2001/07/23 17:28:33 simonmar Exp $ + * $Id: PrimOps.hc,v 1.82 2001/07/26 03:08:39 ken Exp $ * * (c) The GHC Team, 1998-2000 * @@ -595,7 +595,7 @@ FN_(word64ToIntegerzh_fast) } -#endif /* HAVE_LONG_LONG */ +#endif /* SUPPORT_LONG_LONGS */ /* ToDo: this is shockingly inefficient */ diff --git a/ghc/utils/genprimopcode/Main.hs b/ghc/utils/genprimopcode/Main.hs index 2d267fc..fa50d05 100644 --- a/ghc/utils/genprimopcode/Main.hs +++ b/ghc/utils/genprimopcode/Main.hs @@ -14,7 +14,7 @@ import Maybe ( catMaybes ) main = getArgs >>= \args -> if length args /= 1 || head args `notElem` known_args - then error ("usage: genprimopcode command < primops.txt > ...\n" + then error ("usage: genprimopcode command < primops.i > ...\n" ++ " where command is one of\n" ++ unlines (map (" "++) known_args) ) -- 1.7.10.4