From ba312921049033fdff76df73be358df8f9bd26ae Mon Sep 17 00:00:00 2001 From: sof Date: Sat, 14 Jul 2001 00:06:15 +0000 Subject: [PATCH] [project @ 2001-07-14 00:06:13 by sof] Heal HEID - eqForeignObjZh in include/PrimOps.h didn't have quite the right shape (the result is a macro arg). hslibs/lang/ForeignObj wasn't up on the change to eqForeignObj now being a primop. - recent ghc/compiler/deSugar/ changes broke the handling of CCall & FFI decls quite a bit. Backed out most the rewrites of Type.splitFoo to TcType.tcSplitFoo (i.e., now back to using TcType.tcSplitFoo). The backed-out newtype-related changes were by no means accidental. But, I don't profess to understand their intention to make the proper fix, so my change is just a stop-gap measure to get HEAD back to the land of the living. - recent changes to the behaviour of 'hiding' & qualified names broke hslibs/lang/CString hslibs/data/edison/Seq/ListSeq, hslibs/data/edison/Coll/TestOrdBag, hslibs/data/edison/Coll/UnbalancedSet, hslibs/data/edison/Coll/TestOrdSet, hslibs/data/edison/Seq/TestSeq - rename 64-bit 'primop' funs that now live in lib/std/cbits/longlong.c back to what they used to be called (i.e., prefixed with "stg_"). Why? - less likely they'll clash with other (user supplied) entry points at link-time. - matches protos in ghc/includes/PrimOp.h --- ghc/compiler/deSugar/DsCCall.lhs | 10 +++-- ghc/compiler/deSugar/DsForeign.lhs | 26 +++++++------ ghc/includes/PrimOps.h | 4 +- ghc/lib/std/PrelInt.lhs | 50 ++++++++++++------------- ghc/lib/std/PrelWord.lhs | 46 +++++++++++------------ ghc/lib/std/cbits/longlong.c | 72 ++++++++++++++++++------------------ 6 files changed, 107 insertions(+), 101 deletions(-) diff --git a/ghc/compiler/deSugar/DsCCall.lhs b/ghc/compiler/deSugar/DsCCall.lhs index bdfa3c0..eca07f7 100644 --- a/ghc/compiler/deSugar/DsCCall.lhs +++ b/ghc/compiler/deSugar/DsCCall.lhs @@ -28,7 +28,8 @@ import ForeignCall ( ForeignCall, CCallTarget(..) ) import TcType ( Type, isUnLiftedType, mkFunTys, mkFunTy, tyVarsOfType, mkForAllTys, mkTyConApp, - isBoolTy, isUnitTy, isPrimitiveType + isBoolTy, isUnitTy, isPrimitiveType, + tcSplitTyConApp_maybe ) import Type ( splitTyConApp_maybe, repType, eqType ) -- Sees the representation type import PrimOp ( PrimOp(TouchOp) ) @@ -95,7 +96,7 @@ dsCCall :: CLabelString -- C routine to invoke dsCCall lbl args may_gc is_asm result_ty = mapAndUnzipDs unboxArg args `thenDs` \ (unboxed_args, arg_wrappers) -> - boxResult [] result_ty `thenDs` \ (ccall_result_ty, res_wrapper) -> + boxResult [] ({-repType-} result_ty) `thenDs` \ (ccall_result_ty, res_wrapper) -> getUniqueDs `thenDs` \ uniq -> let target | is_asm = CasmTarget lbl @@ -190,7 +191,7 @@ unboxArg arg (data_con_arg_ty1 : _) = data_con_arg_tys (_ : _ : data_con_arg_ty3 : _) = data_con_arg_tys - maybe_arg3_tycon = splitTyConApp_maybe data_con_arg_ty3 + maybe_arg3_tycon = tcSplitTyConApp_maybe data_con_arg_ty3 Just (arg3_tycon,_) = maybe_arg3_tycon \end{code} @@ -215,7 +216,7 @@ boxResult :: [Id] -> Type -> DsM (Type, CoreExpr -> CoreExpr) -- the call. The arg_ids passed in are the Ids passed to the actual ccall. boxResult arg_ids result_ty - = case splitTyConApp_maybe result_ty of + = case tcSplitTyConApp_maybe result_ty of -- The result is IO t, so wrap the result in an IO constructor Just (io_tycon, [io_res_ty]) | io_tycon `hasKey` ioTyConKey @@ -324,4 +325,5 @@ resultWrapper result_ty = pprPanic "resultWrapper" (ppr result_ty) where result_ty_rep = repType result_ty + \end{code} diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs index 5017aa2..9c979a3 100644 --- a/ghc/compiler/deSugar/DsForeign.lhs +++ b/ghc/compiler/deSugar/DsForeign.lhs @@ -35,6 +35,10 @@ import Type ( splitTyConApp_maybe, funResultTy, Type, mkFunTys, mkForAllTys, mkTyConApp, mkFunTy, applyTy, eqType, repType ) +import TcType ( tcSplitForAllTys, tcSplitFunTys, + tcSplitTyConApp_maybe, tcSplitAppTy, + tcFunResultTy + ) import ForeignCall ( ForeignCall(..), CCallSpec(..), Safety(..), playSafe, @@ -145,8 +149,8 @@ dsFImport mod_name fn_id (CDynImport cconv) = dsFExportDynamic mod_name fn_id cc dsFCall mod_Name fn_id fcall = let ty = idType fn_id - (tvs, fun_ty) = splitForAllTys ty - (arg_tys, io_res_ty) = splitFunTys fun_ty + (tvs, fun_ty) = tcSplitForAllTys ty + (arg_tys, io_res_ty) = tcSplitFunTys fun_ty in newSysLocalsDs arg_tys `thenDs` \ args -> mapAndUnzipDs unboxArg (map Var args) `thenDs` \ (val_args, arg_wrappers) -> @@ -220,7 +224,7 @@ dsFExport mod_name fn_id ty ext_name cconv isDyn -- Look at the result type of the exported function, orig_res_ty -- If it's IO t, return (\x.x, IO t, t) -- If it's plain t, return (\x.returnIO x, IO t, t) - (case splitTyConApp_maybe orig_res_ty of + (case tcSplitTyConApp_maybe orig_res_ty of Just (ioTyCon, [res_ty]) -> ASSERT( ioTyCon `hasKey` ioTyConKey ) -- The function already returns IO t @@ -229,7 +233,7 @@ dsFExport mod_name fn_id ty ext_name cconv isDyn other -> -- The function returns t, so wrap the call in returnIO dsLookupGlobalValue returnIOName `thenDs` \ retIOId -> returnDs (\body -> mkApps (Var retIOId) [Type orig_res_ty, body], - funResultTy (applyTy (idType retIOId) orig_res_ty), + tcFunResultTy (applyTy (idType retIOId) orig_res_ty), -- We don't have ioTyCon conveniently to hand orig_res_ty) @@ -297,11 +301,11 @@ dsFExport mod_name fn_id ty ext_name cconv isDyn returnDs (f_helper_glob, (f_helper_glob, the_body), h_stub, c_stub) where - (tvs,sans_foralls) = splitForAllTys ty - (fe_arg_tys', orig_res_ty) = splitFunTys sans_foralls + (tvs,sans_foralls) = tcSplitForAllTys ty + (fe_arg_tys', orig_res_ty) = tcSplitFunTys sans_foralls - (_, stbl_ptr_ty') = splitForAllTys stbl_ptr_ty - (_, stbl_ptr_to_ty) = splitAppTy stbl_ptr_ty' + (_, stbl_ptr_ty') = tcSplitForAllTys stbl_ptr_ty + (_, stbl_ptr_to_ty) = tcSplitAppTy stbl_ptr_ty' fe_arg_tys | isDyn = tail fe_arg_tys' | otherwise = fe_arg_tys' @@ -392,9 +396,9 @@ dsFExportDynamic mod_name id cconv where ty = idType id - (tvs,sans_foralls) = splitForAllTys ty - ([arg_ty], io_res_ty) = splitFunTys sans_foralls - Just (ioTyCon, [res_ty]) = splitTyConApp_maybe io_res_ty + (tvs,sans_foralls) = tcSplitForAllTys ty + ([arg_ty], io_res_ty) = tcSplitFunTys sans_foralls + Just (ioTyCon, [res_ty]) = tcSplitTyConApp_maybe io_res_ty export_ty = mkFunTy (mkTyConApp stablePtrTyCon [arg_ty]) arg_ty toCName :: Id -> String diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h index e648ef0..67e896b 100644 --- a/ghc/includes/PrimOps.h +++ b/ghc/includes/PrimOps.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.h,v 1.77 2001/07/13 11:39:48 rrt Exp $ + * $Id: PrimOps.h,v 1.78 2001/07/14 00:06:14 sof Exp $ * * (c) The GHC Team, 1998-2000 * @@ -912,7 +912,7 @@ EXTFUN_RTS(mkForeignObjzh_fast); #define writeForeignObjzh(res,datum) \ (ForeignObj_CLOSURE_DATA(res) = (P_)(datum)) -#define eqForeignObjzh(f1,f2) ((f1)==(f2)) +#define eqForeignObjzh(r,f1,f2) r=(f1)==(f2) #define indexCharOffForeignObjzh(r,fo,i) indexCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) #define indexWideCharOffForeignObjzh(r,fo,i) indexWideCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) #define indexIntOffForeignObjzh(r,fo,i) indexIntOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) diff --git a/ghc/lib/std/PrelInt.lhs b/ghc/lib/std/PrelInt.lhs index 43f9db9..2041e57 100644 --- a/ghc/lib/std/PrelInt.lhs +++ b/ghc/lib/std/PrelInt.lhs @@ -463,31 +463,31 @@ instance Bits Int64 where bitSize _ = 64 isSigned _ = True -foreign import "eqInt64" unsafe eqInt64# :: Int64# -> Int64# -> Bool -foreign import "neInt64" unsafe neInt64# :: Int64# -> Int64# -> Bool -foreign import "ltInt64" unsafe ltInt64# :: Int64# -> Int64# -> Bool -foreign import "leInt64" unsafe leInt64# :: Int64# -> Int64# -> Bool -foreign import "gtInt64" unsafe gtInt64# :: Int64# -> Int64# -> Bool -foreign import "geInt64" unsafe geInt64# :: Int64# -> Int64# -> Bool -foreign import "plusInt64" unsafe plusInt64# :: Int64# -> Int64# -> Int64# -foreign import "minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64# -foreign import "timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64# -foreign import "negateInt64" unsafe negateInt64# :: Int64# -> Int64# -foreign import "quotInt64" unsafe quotInt64# :: Int64# -> Int64# -> Int64# -foreign import "remInt64" unsafe remInt64# :: Int64# -> Int64# -> Int64# -foreign import "intToInt64" unsafe intToInt64# :: Int# -> Int64# -foreign import "int64ToInt" unsafe int64ToInt# :: Int64# -> Int# -foreign import "wordToWord64" unsafe wordToWord64# :: Word# -> Word64# -foreign import "int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64# -foreign import "word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64# -foreign import "and64" unsafe and64# :: Word64# -> Word64# -> Word64# -foreign import "or64" unsafe or64# :: Word64# -> Word64# -> Word64# -foreign import "xor64" unsafe xor64# :: Word64# -> Word64# -> Word64# -foreign import "not64" unsafe not64# :: Word64# -> Word64# -foreign import "iShiftL64" unsafe iShiftL64# :: Int64# -> Int# -> Int64# -foreign import "iShiftRA64" unsafe iShiftRA64# :: Int64# -> Int# -> Int64# -foreign import "shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64# -foreign import "shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64# +foreign import "stg_eqInt64" unsafe eqInt64# :: Int64# -> Int64# -> Bool +foreign import "stg_neInt64" unsafe neInt64# :: Int64# -> Int64# -> Bool +foreign import "stg_ltInt64" unsafe ltInt64# :: Int64# -> Int64# -> Bool +foreign import "stg_leInt64" unsafe leInt64# :: Int64# -> Int64# -> Bool +foreign import "stg_gtInt64" unsafe gtInt64# :: Int64# -> Int64# -> Bool +foreign import "stg_geInt64" unsafe geInt64# :: Int64# -> Int64# -> Bool +foreign import "stg_plusInt64" unsafe plusInt64# :: Int64# -> Int64# -> Int64# +foreign import "stg_minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64# +foreign import "stg_timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64# +foreign import "stg_negateInt64" unsafe negateInt64# :: Int64# -> Int64# +foreign import "stg_quotInt64" unsafe quotInt64# :: Int64# -> Int64# -> Int64# +foreign import "stg_remInt64" unsafe remInt64# :: Int64# -> Int64# -> Int64# +foreign import "stg_intToInt64" unsafe intToInt64# :: Int# -> Int64# +foreign import "stg_int64ToInt" unsafe int64ToInt# :: Int64# -> Int# +foreign import "stg_wordToWord64" unsafe wordToWord64# :: Word# -> Word64# +foreign import "stg_int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64# +foreign import "stg_word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64# +foreign import "stg_and64" unsafe and64# :: Word64# -> Word64# -> Word64# +foreign import "stg_or64" unsafe or64# :: Word64# -> Word64# -> Word64# +foreign import "stg_xor64" unsafe xor64# :: Word64# -> Word64# -> Word64# +foreign import "stg_not64" unsafe not64# :: Word64# -> Word64# +foreign import "stg_iShiftL64" unsafe iShiftL64# :: Int64# -> Int# -> Int64# +foreign import "stg_iShiftRA64" unsafe iShiftRA64# :: Int64# -> Int# -> Int64# +foreign import "stg_shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64# +foreign import "stg_shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64# {-# RULES "fromIntegral/Int->Int64" fromIntegral = \(I# x#) -> I64# (intToInt64# x#) diff --git a/ghc/lib/std/PrelWord.lhs b/ghc/lib/std/PrelWord.lhs index 95f84e4..0a8bc1d 100644 --- a/ghc/lib/std/PrelWord.lhs +++ b/ghc/lib/std/PrelWord.lhs @@ -598,29 +598,29 @@ instance Bits Word64 where bitSize _ = 64 isSigned _ = False -foreign import "eqWord64" unsafe eqWord64# :: Word64# -> Word64# -> Bool -foreign import "neWord64" unsafe neWord64# :: Word64# -> Word64# -> Bool -foreign import "ltWord64" unsafe ltWord64# :: Word64# -> Word64# -> Bool -foreign import "leWord64" unsafe leWord64# :: Word64# -> Word64# -> Bool -foreign import "gtWord64" unsafe gtWord64# :: Word64# -> Word64# -> Bool -foreign import "geWord64" unsafe geWord64# :: Word64# -> Word64# -> Bool -foreign import "int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64# -foreign import "word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64# -foreign import "plusInt64" unsafe plusInt64# :: Int64# -> Int64# -> Int64# -foreign import "minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64# -foreign import "timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64# -foreign import "negateInt64" unsafe negateInt64# :: Int64# -> Int64# -foreign import "intToInt64" unsafe intToInt64# :: Int# -> Int64# -foreign import "wordToWord64" unsafe wordToWord64# :: Word# -> Word64# -foreign import "word64ToWord" unsafe word64ToWord# :: Word64# -> Word# -foreign import "quotWord64" unsafe quotWord64# :: Word64# -> Word64# -> Word64# -foreign import "remWord64" unsafe remWord64# :: Word64# -> Word64# -> Word64# -foreign import "and64" unsafe and64# :: Word64# -> Word64# -> Word64# -foreign import "or64" unsafe or64# :: Word64# -> Word64# -> Word64# -foreign import "xor64" unsafe xor64# :: Word64# -> Word64# -> Word64# -foreign import "not64" unsafe not64# :: Word64# -> Word64# -foreign import "shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64# -foreign import "shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64# +foreign import "stg_eqWord64" unsafe eqWord64# :: Word64# -> Word64# -> Bool +foreign import "stg_neWord64" unsafe neWord64# :: Word64# -> Word64# -> Bool +foreign import "stg_ltWord64" unsafe ltWord64# :: Word64# -> Word64# -> Bool +foreign import "stg_leWord64" unsafe leWord64# :: Word64# -> Word64# -> Bool +foreign import "stg_gtWord64" unsafe gtWord64# :: Word64# -> Word64# -> Bool +foreign import "stg_geWord64" unsafe geWord64# :: Word64# -> Word64# -> Bool +foreign import "stg_int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64# +foreign import "stg_word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64# +foreign import "stg_plusInt64" unsafe plusInt64# :: Int64# -> Int64# -> Int64# +foreign import "stg_minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64# +foreign import "stg_timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64# +foreign import "stg_negateInt64" unsafe negateInt64# :: Int64# -> Int64# +foreign import "stg_intToInt64" unsafe intToInt64# :: Int# -> Int64# +foreign import "stg_wordToWord64" unsafe wordToWord64# :: Word# -> Word64# +foreign import "stg_word64ToWord" unsafe word64ToWord# :: Word64# -> Word# +foreign import "stg_quotWord64" unsafe quotWord64# :: Word64# -> Word64# -> Word64# +foreign import "stg_remWord64" unsafe remWord64# :: Word64# -> Word64# -> Word64# +foreign import "stg_and64" unsafe and64# :: Word64# -> Word64# -> Word64# +foreign import "stg_or64" unsafe or64# :: Word64# -> Word64# -> Word64# +foreign import "stg_xor64" unsafe xor64# :: Word64# -> Word64# -> Word64# +foreign import "stg_not64" unsafe not64# :: Word64# -> Word64# +foreign import "stg_shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64# +foreign import "stg_shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64# {-# RULES "fromIntegral/Int->Word64" fromIntegral = \(I# x#) -> W64# (int64ToWord64# (intToInt64# x#)) diff --git a/ghc/lib/std/cbits/longlong.c b/ghc/lib/std/cbits/longlong.c index 6578504..d418053 100644 --- a/ghc/lib/std/cbits/longlong.c +++ b/ghc/lib/std/cbits/longlong.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: longlong.c,v 1.1 2001/07/13 11:03:47 rrt Exp $ + * $Id: longlong.c,v 1.2 2001/07/14 00:06:15 sof Exp $ * * (c) The GHC Team, 1998-1999 * @@ -32,46 +32,46 @@ The exceptions to the rule are primops that cast to and from /* Relational operators */ -StgBool gtWord64 (StgWord64 a, StgWord64 b) {return a > b;} -StgBool geWord64 (StgWord64 a, StgWord64 b) {return a >= b;} -StgBool eqWord64 (StgWord64 a, StgWord64 b) {return a == b;} -StgBool neWord64 (StgWord64 a, StgWord64 b) {return a != b;} -StgBool ltWord64 (StgWord64 a, StgWord64 b) {return a < b;} -StgBool leWord64 (StgWord64 a, StgWord64 b) {return a <= b;} +StgBool stg_gtWord64 (StgWord64 a, StgWord64 b) {return a > b;} +StgBool stg_geWord64 (StgWord64 a, StgWord64 b) {return a >= b;} +StgBool stg_eqWord64 (StgWord64 a, StgWord64 b) {return a == b;} +StgBool stg_neWord64 (StgWord64 a, StgWord64 b) {return a != b;} +StgBool stg_ltWord64 (StgWord64 a, StgWord64 b) {return a < b;} +StgBool stg_leWord64 (StgWord64 a, StgWord64 b) {return a <= b;} -StgBool gtInt64 (StgInt64 a, StgInt64 b) {return a > b;} -StgBool geInt64 (StgInt64 a, StgInt64 b) {return a >= b;} -StgBool eqInt64 (StgInt64 a, StgInt64 b) {return a == b;} -StgBool neInt64 (StgInt64 a, StgInt64 b) {return a != b;} -StgBool ltInt64 (StgInt64 a, StgInt64 b) {return a < b;} -StgBool leInt64 (StgInt64 a, StgInt64 b) {return a <= b;} +StgBool stg_gtInt64 (StgInt64 a, StgInt64 b) {return a > b;} +StgBool stg_geInt64 (StgInt64 a, StgInt64 b) {return a >= b;} +StgBool stg_eqInt64 (StgInt64 a, StgInt64 b) {return a == b;} +StgBool stg_neInt64 (StgInt64 a, StgInt64 b) {return a != b;} +StgBool stg_ltInt64 (StgInt64 a, StgInt64 b) {return a < b;} +StgBool stg_leInt64 (StgInt64 a, StgInt64 b) {return a <= b;} /* Arithmetic operators */ -StgWord64 remWord64 (StgWord64 a, StgWord64 b) {return a % b;} -StgWord64 quotWord64 (StgWord64 a, StgWord64 b) {return a / b;} -StgInt64 remInt64 (StgInt64 a, StgInt64 b) {return a % b;} -StgInt64 quotInt64 (StgInt64 a, StgInt64 b) {return a / b;} -StgInt64 negateInt64 (StgInt64 a) {return -a;} -StgInt64 plusInt64 (StgInt64 a, StgInt64 b) {return a + b;} -StgInt64 minusInt64 (StgInt64 a, StgInt64 b) {return a - b;} -StgInt64 timesInt64 (StgInt64 a, StgInt64 b) {return a * b;} +StgWord64 stg_remWord64 (StgWord64 a, StgWord64 b) {return a % b;} +StgWord64 stg_quotWord64 (StgWord64 a, StgWord64 b) {return a / b;} +StgInt64 stg_remInt64 (StgInt64 a, StgInt64 b) {return a % b;} +StgInt64 stg_quotInt64 (StgInt64 a, StgInt64 b) {return a / b;} +StgInt64 stg_negateInt64 (StgInt64 a) {return -a;} +StgInt64 stg_plusInt64 (StgInt64 a, StgInt64 b) {return a + b;} +StgInt64 stg_minusInt64 (StgInt64 a, StgInt64 b) {return a - b;} +StgInt64 stg_timesInt64 (StgInt64 a, StgInt64 b) {return a * b;} /* Logical operators: */ -StgWord64 and64 (StgWord64 a, StgWord64 b) {return a & b;} -StgWord64 or64 (StgWord64 a, StgWord64 b) {return a | b;} -StgWord64 xor64 (StgWord64 a, StgWord64 b) {return a ^ b;} -StgWord64 not64 (StgWord64 a) {return ~a;} -StgWord64 shiftL64 (StgWord64 a, StgInt b) {return a << b;} -StgWord64 shiftRL64 (StgWord64 a, StgInt b) {return a >> b;} +StgWord64 stg_and64 (StgWord64 a, StgWord64 b) {return a & b;} +StgWord64 stg_or64 (StgWord64 a, StgWord64 b) {return a | b;} +StgWord64 stg_xor64 (StgWord64 a, StgWord64 b) {return a ^ b;} +StgWord64 stg_not64 (StgWord64 a) {return ~a;} +StgWord64 stg_shiftL64 (StgWord64 a, StgInt b) {return a << b;} +StgWord64 stg_shiftRL64 (StgWord64 a, StgInt b) {return a >> b;} /* Right shifting of signed quantities is not portable in C, so the behaviour you'll get from using these primops depends on the whatever your C compiler is doing. ToDo: fix. -- sof 8/98 */ -StgInt64 iShiftL64 (StgInt64 a, StgInt b) {return a << b;} -StgInt64 iShiftRA64 (StgInt64 a, StgInt b) {return a >> b;} -StgInt64 iShiftRL64 (StgInt64 a, StgInt b) +StgInt64 stg_iShiftL64 (StgInt64 a, StgInt b) {return a << b;} +StgInt64 stg_iShiftRA64 (StgInt64 a, StgInt b) {return a >> b;} +StgInt64 stg_iShiftRL64 (StgInt64 a, StgInt b) {return (StgInt64) ((StgWord64) a >> b);} /* Casting between longs and longer longs: @@ -79,11 +79,11 @@ StgInt64 iShiftRL64 (StgInt64 a, StgInt b) expressed as macros, since these may cause some heap allocation). */ -StgInt64 intToInt64 (StgInt i) {return (StgInt64) i;} -StgInt int64ToInt (StgInt64 i) {return (StgInt) i;} -StgWord64 int64ToWord64 (StgInt64 i) {return (StgWord64) i;} -StgWord64 wordToWord64 (StgWord w) {return (StgWord64) w;} -StgWord word64ToWord (StgWord64 w) {return (StgWord) w;} -StgInt64 word64ToInt64 (StgWord64 w) {return (StgInt64) w;} +StgInt64 stg_intToInt64 (StgInt i) {return (StgInt64) i;} +StgInt stg_int64ToInt (StgInt64 i) {return (StgInt) i;} +StgWord64 stg_int64ToWord64 (StgInt64 i) {return (StgWord64) i;} +StgWord64 stg_wordToWord64 (StgWord w) {return (StgWord64) w;} +StgWord stg_word64ToWord (StgWord64 w) {return (StgWord) w;} +StgInt64 stg_word64ToInt64 (StgWord64 w) {return (StgInt64) w;} #endif /* SUPPORT_LONG_LONGS */ -- 1.7.10.4