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     EXIT(n);
  47     return(0); /* GCC warning food */
  48 }
  49 \end{code}
  50
  51 This may not be the right place for this: (ToDo?)
  52 \begin{code}
  53 #ifdef DEBUG
  54 void
  55 _stgAssert (filename, linenum)
  56   char          *filename;
  57   unsigned int  linenum;
  58 {
  59     fflush(stdout);
  60     fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
  61     abort();
  62 }
  63 #endif /* DEBUG */
  64 \end{code}
  65
  66 A little helper for the native code generator (it can't stomach
  67 loops):
  68 \begin{code}
  69 void
  70 newArrZh_init(result, n, init)
  71 P_ result;
  72 I_ n;
  73 P_ init;
  74 {
  75   P_ p;
  76
  77   SET_MUTUPLE_HDR(result,ArrayOfPtrs_info,CCC,MUTUPLE_VHS+n,0)
  78   for (p = result+MUTUPLE_HS; p < (result+MUTUPLE_HS+n); p++) {
  79         *p = (W_) (init);
  80   }
  81 }
  82
  83 \end{code}
  84
  85 Phantom info table vectors for multiple constructor primitive types that
  86 might have to perform a DynamicReturn (just Bool at the moment).
  87
  88 \begin{code}
  89 ED_RO_(PrelBase_False_inregs_info);
  90 ED_RO_(PrelBase_True_inregs_info);
  91
  92 #ifndef aix_TARGET_OS /* AIX gives link errors with this as a const (RO assembler section) */
  93 const
  94 #endif
  95       W_ PrelBase_Bool_itblvtbl[] = {
  96     (W_) PrelBase_False_inregs_info,
  97     (W_) PrelBase_True_inregs_info
  98 };
  99 \end{code}