ghc/runtime/prims/PrimMisc.lc

   1 %---------------------------------------------------------------*
   2 %
   3 \section{Executable code for random primitives}
   4 %
   5 %---------------------------------------------------------------*
   6
   7 \begin{code}
   8 #include "rtsdefs.h"
   9
  10 I_ __GenSymCounter = 0;
  11 I_ __SeqWorldCounter = 0;
  12
  13 I_
  14 genSymZh(STG_NO_ARGS)
  15 {
  16     return(__GenSymCounter++);
  17 }
  18 I_
  19 resetGenSymZh(STG_NO_ARGS) /* it's your funeral */
  20 {
  21     __GenSymCounter=0;
  22     return(__GenSymCounter);
  23 }
  24
  25 I_
  26 byteArrayHasNUL__ (ba, len)
  27   const char *ba;
  28   I_ len;
  29 {
  30     I_ i;
  31
  32     for (i = 0; i < len; i++) {
  33         if (*(ba + i) == '\0') {
  34             return(1); /* true */
  35         }
  36     }
  37
  38     return(0); /* false */
  39 }
  40
  41 I_
  42 stg_exit (n) /* can't call regular "exit" from Haskell
  43                 because it has no return value */
  44   I_ n;
  45 {
  46     /* Storage manager shutdown */
  47     shutdownHaskell();
  48     EXIT(n);
  49     return(0); /* GCC warning food */
  50 }
  51 \end{code}
  52
  53 This may not be the right place for this: (ToDo?)
  54 \begin{code}
  55 #ifdef DEBUG
  56 void
  57 _stgAssert (filename, linenum)
  58   char          *filename;
  59   unsigned int  linenum;
  60 {
  61     fflush(stdout);
  62     fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
  63     abort();
  64 }
  65 #endif /* DEBUG */
  66 \end{code}
  67
  68 A little helper for the native code generator (it can't stomach
  69 loops):
  70 \begin{code}
  71 void
  72 newArrZh_init(result, n, init)
  73 P_ result;
  74 I_ n;
  75 P_ init;
  76 {
  77   P_ p;
  78
  79   SET_MUTUPLE_HDR(result,ArrayOfPtrs_info,CCC,MUTUPLE_VHS+n,0)
  80   for (p = result+MUTUPLE_HS; p < (result+MUTUPLE_HS+n); p++) {
  81         *p = (W_) (init);
  82   }
  83 }
  84
  85 \end{code}
  86
  87 Phantom info table vectors for multiple constructor primitive types that
  88 might have to perform a DynamicReturn (just Bool at the moment).
  89
  90 \begin{code}
  91 ED_RO_(PrelBase_False_inregs_info);
  92 ED_RO_(PrelBase_True_inregs_info);
  93
  94 #ifndef aix_TARGET_OS /* AIX gives link errors with this as a const (RO assembler section) */
  95 const
  96 #endif
  97       W_ PrelBase_Bool_itblvtbl[] = {
  98     (W_) PrelBase_False_inregs_info,
  99     (W_) PrelBase_True_inregs_info
 100 };
 101 \end{code}