ghc/runtime/c-as-asm/StablePtrOps.lc

   1 \section[stable-ptr-ops]{Stable Pointer Operations}
   2
   3 The code that implements @performIO@ is mostly in
   4 @ghc/runtime/c-as-asm/PerformIO.lhc@.  However, this code can be
   5 called from the C world so it goes in a @.lc@ file.
   6
   7 This code is based heavily on the code in @ghc/runtime/main/main.lc@.
   8
   9 It is used to call a (stable pointer to a) function of type
  10 @IoWorld -> PrimIntAndIoWorld@ (ie @PrimIO_Int#@).
  11
  12 (I doubt very much that this works at the moment - and we're going to
  13 change it to take/return a byte array anyway.  Code in PerformIO.lhc
  14 is even more dated.)
  15
  16 \begin{code}
  17 #ifndef PAR
  18
  19 #include "rtsdefs.h"
  20
  21 extern StgPtr unstable_Closure;
  22
  23 #ifndef __STG_TAILJUMPS__
  24 extern int doSanityChks;
  25 extern void checkAStack(STG_NO_ARGS);
  26 #endif
  27
  28 void
  29 enterStablePtr(stableIndex, startCode)
  30   StgStablePtr stableIndex;
  31   StgFunPtr startCode;
  32 {
  33   unstable_Closure = _deRefStablePointer(stableIndex, StorageMgrInfo.StablePointerTable);
  34
  35 /* ToDo: Set arity to right value - if necessary */
  36
  37 #if defined(__STG_TAILJUMPS__)
  38   miniInterpret(startCode);
  39 #else
  40   if (doSanityChks)
  41     miniInterpret_debug(startCode, checkAStack);
  42   else
  43     miniInterpret(startCode);
  44 #endif /* not tail-jumping */
  45
  46 }
  47 \end{code}
  48
  49 \begin{code}
  50 EXTFUN(startPerformIO);
  51
  52 extern void checkInCCallGC(STG_NO_ARGS);
  53
  54 void
  55 performIO(stableIndex)
  56   StgStablePtr stableIndex;
  57 {
  58   checkInCCallGC();
  59   enterStablePtr( stableIndex, (StgFunPtr) startPerformIO );
  60 }
  61
  62 extern StgInt enterInt_Result;
  63 EXTFUN(startEnterInt);
  64
  65 StgInt
  66 enterInt(stableIndex)
  67   StgStablePtr stableIndex;
  68 {
  69   checkInCCallGC();
  70   enterStablePtr( stableIndex, (StgFunPtr) startEnterInt );
  71   return enterInt_Result;
  72 }
  73
  74 extern StgFloat enterFloat_Result;
  75 EXTFUN(startEnterFloat);
  76
  77 StgInt
  78 enterFloat(stableIndex)
  79   StgStablePtr stableIndex;
  80 {
  81   checkInCCallGC();
  82   enterStablePtr( stableIndex, (StgFunPtr) startEnterFloat );
  83   return enterFloat_Result;
  84 }
  85 \end{code}
  86
  87 \begin{code}
  88 StgPtr
  89 deRefStablePointer(stableIndex)
  90   StgStablePtr stableIndex;
  91 {
  92   return _deRefStablePointer(stableIndex, StorageMgrInfo.StablePointerTable);
  93 }
  94 \end{code}
  95
  96 Despite the file name, we have two small malloc ptr operation - not
  97 worth putting in a file by itself.
  98
  99 \begin{code}
 100 StgInt
 101 eqMallocPtr(p1, p2)
 102   StgMallocPtr p1;
 103   StgMallocPtr p2;
 104 {
 105   return (p1 == p2);
 106 }
 107 \end{code}
 108
 109 And some code that HAS NO RIGHT being here.
 110
 111 \begin{code}
 112 StgStablePtr softHeapOverflowHandler = -1;
 113
 114 StgInt
 115 catchSoftHeapOverflow( newHandler, deltaLimit )
 116   StgStablePtr newHandler;
 117   StgInt deltaLimit;
 118 {
 119   StgStablePtr oldHandler = softHeapOverflowHandler;
 120
 121   /* If we're in a _ccall_GC_ then HpLim will be stored in SAVE_HpLim
 122      which provides an easy way of changing it. */
 123   checkInCCallGC();
 124
 125   StorageMgrInfo.hardHpOverflowSize += deltaLimit;
 126   SAVE_HpLim -= deltaLimit;
 127
 128   if (StorageMgrInfo.hardHpOverflowSize < 0) {
 129     fprintf(stderr, "Error: Setting Hard Heap Overflow Size to negative value!\n");
 130     EXIT(EXIT_FAILURE);
 131   }
 132
 133   softHeapOverflowHandler = newHandler;
 134   return oldHandler;
 135 }
 136
 137 StgInt
 138 getSoftHeapOverflowHandler(STG_NO_ARGS)
 139 {
 140   return (StgInt) softHeapOverflowHandler;
 141 }
 142
 143 #endif /* !PAR */
 144 \end{code}