# -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.215 2002/04/22 14:35:02 simonmar Exp $
+# $Id: Makefile,v 1.216 2002/04/22 14:54:09 simonmar Exp $
TOP = ..
# because it contains 'ccall strlen' and 'ccall memcmp', which gets
# inlined by gcc, causing a lack of registers.
#
-utils/PrimPacked_HC_OPTS = -fvia-C -monly-2-regs
+utils/PrimPacked_HC_OPTS = -fvia-C
# ByteCodeItbls uses primops that the NCG doesn't support yet.
ghci/ByteCodeItbls_HC_OPTS = -fvia-C
/* -----------------------------------------------------------------------------
- * $Id: hschooks.h,v 1.3 2000/12/20 09:56:26 simonmar Exp $
+ * $Id: hschooks.h,v 1.4 2002/04/22 14:54:10 simonmar Exp $
*
* Hooks into the RTS from the compiler.
*
#include "HsFFI.h"
void enableTimingStats( void );
void setHeapSize( HsInt size );
+
+// Out-of-line string functions, see PrimPacked.lhs
+HsInt ghc_strlen( HsAddr a );
+HsInt ghc_memcmp( HsAddr a1, HsAddr a2, HsInt len );
+HsInt ghc_memcmp_off( HsAddr a1, HsInt i, HsAddr a2, HsInt len );
subsystem, mostly.
\begin{code}
-{-# OPTIONS -monly-3-regs -optc-DNON_POSIX_SOURCE #-}
+{-# OPTIONS -monly-3-regs -optc-DNON_POSIX_SOURCE -#include "hschooks.h" #-}
module PrimPacked
(
strLength, -- :: _Addr -> Int
import GHC.ST
#endif
-\end{code}
-
-Return the length of a @\\NUL@ terminated character string:
-
-\begin{code}
-strLength :: Addr -> Int
-strLength a =
- unsafePerformIO (
- _ccall_ strlen a >>= \ len@(I# _) ->
- return len
- )
-{-# NOINLINE strLength #-}
\end{code}
Copying a char string prefix into a byte array,
\begin{code}
eqStrPrefix :: Addr# -> ByteArray# -> Int# -> Bool
eqStrPrefix a# barr# len# =
- unsafePerformIO (
- _ccall_ memcmp (A# a#) (ByteArray bot bot barr#) (I# len#) >>= \ (I# x#) ->
- return (x# ==# 0#))
- where
- bot :: Int
- bot = error "eqStrPrefix"
+ unsafePerformIO $ do
+ x <- memcmp_ba a# barr# (I# len#)
+ return (x == 0)
eqCharStrPrefix :: Addr# -> Addr# -> Int# -> Bool
eqCharStrPrefix a1# a2# len# =
- unsafePerformIO (
- _ccall_ memcmp (A# a1#) (A# a2#) (I# len#) >>= \ (I# x#) ->
- return (x# ==# 0#))
+ unsafePerformIO $ do
+ x <- memcmp a1# a2# (I# len#)
+ return (x == 0)
eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
eqStrPrefixBA b1# b2# start# len# =
- unsafePerformIO (
- _casm_ ``%r=(int)memcmp((char *)%0+(int)%1,%2,%3); ''
- (ByteArray bot bot b2#)
- (I# start#)
- (ByteArray bot bot b1#)
- (I# len#) >>= \ (I# x#) ->
- return (x# ==# 0#))
- where
- bot :: Int
- bot = error "eqStrPrefixBA"
+ unsafePerformIO $ do
+ x <- memcmp_baoff_ba b2# (I# start#) b1# (I# len#)
+ return (x == 0)
eqCharStrPrefixBA :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
eqCharStrPrefixBA a# b2# start# len# =
- unsafePerformIO (
- _casm_ ``%r=(int)memcmp((char *)%0+(int)%1,%2,%3); ''
- (ByteArray bot bot b2#)
- (I# start#)
- (A# a#)
- (I# len#) >>= \ (I# x#) ->
- return (x# ==# 0#))
- where
- bot :: Int
- bot = error "eqCharStrPrefixBA"
+ unsafePerformIO $ do
+ x <- memcmp_baoff b2# (I# start#) a# (I# len#)
+ return (x == 0)
+\end{code}
+
+\begin{code}
+foreign import ccall "ghc_strlen" unsafe
+ strLength :: Addr -> Int
+
+foreign import ccall "ghc_memcmp" unsafe
+ memcmp :: Addr# -> Addr# -> Int -> IO Int
+
+foreign import ccall "ghc_memcmp" unsafe
+ memcmp_ba :: Addr# -> ByteArray# -> Int -> IO Int
+
+foreign import ccall "ghc_memcmp_off" unsafe
+ memcmp_baoff :: ByteArray# -> Int -> Addr# -> Int -> IO Int
+
+foreign import ccall "ghc_memcmp_off" unsafe
+ memcmp_baoff_ba :: ByteArray# -> Int -> ByteArray# -> Int -> IO Int
\end{code}