X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fruntime%2Fprims%2FByteOps.lc;fp=ghc%2Fruntime%2Fprims%2FByteOps.lc;h=d923511897f99abc61711bcf59bf14315db76588;hb=e7d21ee4f8ac907665a7e170c71d59e13a01da09;hp=0000000000000000000000000000000000000000;hpb=e48474bff05e6cfb506660420f025f694c870d38;p=ghc-hetmet.git

diff --git a/ghc/runtime/prims/ByteOps.lc b/ghc/runtime/prims/ByteOps.lc
new file mode 100644
index 0000000..d923511
--- /dev/null
+++ b/ghc/runtime/prims/ByteOps.lc
@@ -0,0 +1,140 @@
+%---------------------------------------------------------------*
+%
+\section{Underlying code for converting to/from ``bytes''}
+%
+%---------------------------------------------------------------*
+
+Stolen from HBC, more or less.
+
+A \tr{I_ foo2bytes__(foo in, ptr arr)} routine takes a \tr{foo}
+input \tr{in}, scribbles some appropriate bytes into the array passed
+to it, \tr{arr}, and returns the number of bytes so put.
+
+A \tr{I_ bytes2foo__(ptr arr, foo *out)} routine looks at the
+array of bytes given to it (\tr{arr}) and gives them back interpreted
+as a \tr{foo} (sticks it in the place pointed to by \tr{out}).  It
+returns the number of bytes taken.
+
+\begin{code}
+
+#include "rtsdefs.h"
+
+#if __STDC__
+    /* need the ANSI arg decl, so "short" and "float" args dont get promoted */
+#define X2BYTES(type)				\
+I_						\
+CAT2(type,2bytes__)(type in, unsigned char *arr)\
+{ 						\
+    union {					\
+	type i;					\
+	unsigned char cs[sizeof (type)];	\
+    } u;					\
+    int k;					\
+						\
+    u.i = in;					\
+    for (k = sizeof (type) - 1; k >= 0; k--)	\
+	arr[k] = u.cs[k];			\
+						\
+    return(sizeof (type));			\
+}
+
+#else /* not STDC */
+#define X2BYTES(type)				\
+I_						\
+CAT2(type,2bytes__)(in, arr)			\
+  type in;					\
+  unsigned char *arr;				\
+{ 						\
+    union {					\
+	type i;					\
+	unsigned char cs[sizeof (type)];	\
+    } u;					\
+    int k;					\
+						\
+    u.i = in;					\
+    for (k = sizeof (type) - 1; k >= 0; k--)	\
+	arr[k] = u.cs[k];			\
+						\
+    return(sizeof (type));			\
+}
+#endif /* not STDC */
+
+X2BYTES(long)
+X2BYTES(int)
+X2BYTES(short)
+X2BYTES(float)
+X2BYTES(double)
+    
+#define BYTES2X(ctype,htype)			\
+I_						\
+CAT3(bytes2,ctype,__)(in, out)			\
+  P_ in;					\
+  htype *out;					\
+{						\
+    union {					\
+	ctype i;				\
+	unsigned char cs[sizeof (ctype)];	\
+    } u;					\
+    int k;					\
+    unsigned char *arr = (unsigned char *) in;	\
+						\
+    for (k = 0; k < sizeof(ctype); k++)		\
+	u.cs[k] = arr[k];			\
+						\
+    *out = (htype) u.i;				\
+						\
+    return(sizeof (ctype));			\
+}
+    
+static STG_INLINE
+void
+assign_flt(p_dest, src)
+  W_ p_dest[];
+  StgFloat src;
+{ 
+    float_thing y;
+    y.f = src;
+    *p_dest = y.fu;
+}
+
+
+static STG_INLINE
+void
+assign_dbl(p_dest, src)
+  W_ p_dest[];
+  StgDouble src;
+{
+    double_thing y;
+    y.d = src;
+    p_dest[0] = y.du.dhi;
+    p_dest[1] = y.du.dlo;
+}
+
+#define BYTES2FX(ctype,htype,assign_fx)		\
+I_						\
+CAT3(bytes2,ctype,__)(in, out)			\
+  P_ in;					\
+  htype *out;					\
+{						\
+    union {					\
+	ctype i;				\
+	unsigned char cs[sizeof (ctype)];	\
+    } u;					\
+    int k;					\
+    unsigned char *arr = (unsigned char *) in;	\
+						\
+    for (k = 0; k < sizeof(ctype); k++)		\
+	u.cs[k] = arr[k];			\
+						\
+    assign_fx(out, (htype) u.i);		\
+						\
+    return(sizeof (ctype));			\
+}
+    
+BYTES2X(long,I_)
+BYTES2X(int,I_)
+BYTES2X(short,I_)
+
+BYTES2FX(float,StgFloat,assign_flt)
+BYTES2FX(double,StgDouble,assign_dbl)
+\end{code}