diff options
Diffstat (limited to 'ghc/runtime/prims/PrimMisc.lc')
-rw-r--r-- | ghc/runtime/prims/PrimMisc.lc | 97 |
1 files changed, 97 insertions, 0 deletions
diff --git a/ghc/runtime/prims/PrimMisc.lc b/ghc/runtime/prims/PrimMisc.lc new file mode 100644 index 0000000000..4c299945dd --- /dev/null +++ b/ghc/runtime/prims/PrimMisc.lc @@ -0,0 +1,97 @@ +%---------------------------------------------------------------* +% +\section{Executable code for random primitives} +% +%---------------------------------------------------------------* + +\begin{code} +#include "rtsdefs.h" + +I_ __GenSymCounter = 0; +I_ __SeqWorldCounter = 0; + +I_ +genSymZh(STG_NO_ARGS) +{ + return(__GenSymCounter++); +} +I_ +resetGenSymZh(STG_NO_ARGS) /* it's your funeral */ +{ + __GenSymCounter=0; + return(__GenSymCounter); +} + +I_ +byteArrayHasNUL__ (ba, len) + const char *ba; + I_ len; +{ + I_ i; + + for (i = 0; i < len; i++) { + if (*(ba + i) == '\0') { + return(1); /* true */ + } + } + + return(0); /* false */ +} + +I_ +stg_exit (n) /* can't call regular "exit" from Haskell + because it has no return value */ + I_ n; +{ + EXIT(n); + return(0); /* GCC warning food */ +} +\end{code} + +This may not be the right place for this: (ToDo?) +\begin{code} +#ifdef DEBUG +void +_stgAssert (filename, linenum) + char *filename; + unsigned int linenum; +{ + fflush(stdout); + fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum); + abort(); +} +#endif /* DEBUG */ +\end{code} + +A little helper for the native code generator (it can't stomach +loops): +\begin{code} +void +newArrZh_init(result, n, init) +P_ result; +I_ n; +P_ init; +{ + P_ p; + + SET_MUTUPLE_HDR(result,ArrayOfPtrs_info,CCC,MUTUPLE_VHS+n,0) + for (p = result+MUTUPLE_HS; p < (result+MUTUPLE_HS+n); p++) { + *p = (W_) (init); + } +} + +\end{code} + +Phantom info table vectors for multiple constructor primitive types that +might have to perform a DynamicReturn (just Bool at the moment). + +\begin{code} + +ED_RO_(False_inregs_info); +ED_RO_(True_inregs_info); +const W_ Bool_itblvtbl[] = { + (W_) False_inregs_info, + (W_) True_inregs_info +}; + +\end{code} |