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 #if !defined(PAR)
  18
  19 #include "rtsdefs.h"
  20
  21 extern StgPtr unstable_Closure;
  22 #if 0
  23 extern int    CStackDelta;
  24 #endif
  25
  26 StgInt entersFromC=0;
  27
  28 void
  29 enterStablePtr(stableIndex, startCode)
  30   StgStablePtr stableIndex;
  31   StgFunPtr startCode;
  32 {
  33     unstable_Closure
  34       = _deRefStablePointer(stableIndex, StorageMgrInfo.StablePointerTable);
  35
  36     /* ToDo: Set arity to right value - if necessary */
  37
  38     /* Inactive code for computing the chunk of C stack we have allocated
  39        since initially leaving Haskell land.
  40     */
  41 #if 0 && defined(CONCURRENT) && defined(i386_TARGET_ARCH)
  42     __asm__ volatile ("mov %%esp,%0" : "=m" (CurrentRegTable->rWrapReturn));
  43     CStackDelta=(int)(((unsigned int)CurrentRegTable->rCstkptr - (unsigned int)CurrentRegTable->rWrapReturn) / sizeof(W_));
  44     CurrentTSOinC=CurrentTSO;
  45 # if defined(DEBUG)
  46     fprintf(stderr,"enterStablePtr: current: %#x c-entry: %#x (delta %d)\n", CurrentRegTable->rWrapReturn, CurrentRegTable->rCstkptr, CStackDelta);
  47     __asm__ volatile ("mov %%esp,%0" : "=m" (CurrentRegTable->rWrapReturn));
  48     CStackDelta=(int)(((unsigned int)CurrentRegTable->rCstkptr - (unsigned int)CurrentRegTable->rWrapReturn) / sizeof(W_));
  49 # endif
  50 #endif
  51     /*
  52      * Combining Concurrent Haskell and stable pointers poses a headache or
  53      * two. If the thread that jumps into Haskell causes a context switch,
  54      * we're in deep trouble, as miniInterpret() is used to enter the threaded world,
  55      * which stash away return address and callee-saves registers on the C
  56      * stack and enter.
  57      *
  58      * If the thread should happen to context switch, the scheduler is
  59      * currently coded to use longjmp() to jump from the rescheduling
  60      * code to the main scheduler loop. i.e., we unwind chunks of the
  61      * C stack, including the return address++ the thread left there
  62      * before entering the stable pointer.
  63      *
  64      * Ideally, we would like to impose no restrictions on the use of
  65      * stable pointers with Concurrent Haskell, but currently we
  66      * do turn off heap check context switching when a thread jumps into
  67      * Haskell from C. This reduces the `risk' of a context switch, but
  68      * doesn't solve the problem - a thread that blocks will still
  69      * force a re-schedule. To cope with this situation, we use a counter
  70      * to keep track of whether any threads have entered Haskell from C.
  71      * If any have, we avoid longjmp()ing in the RTS to preserve the region
  72      * of the C stack that the thread expects to be there when it exits.
  73      *
  74      * This scheme is a hack (no, really!) to get Haskell callbacks to work
  75      * with Concurrent Haskell. It is currently only supported for x86 platforms
  76      * (due to use of asm to get at stack pointer in PerformIO.lhc)
  77      *
  78      * ToDo: do Right in the new RTS.
  79      */
  80 #if defined(CONCURRENT) && defined(i386_TARGET_ARCH)
  81     entersFromC++;
  82     miniInterpret(startCode);
  83     entersFromC--;
  84 #else
  85     miniInterpret(startCode);
  86 #endif
  87
  88 #if 0 && defined(DEBUG)
  89     if (CurrentTSO == CurrentTSOinC) {
  90        CurrentTSOinC=NULL;
  91     }
  92     /* C stack should have been reconstructed by now (we'll soon find out..) */
  93     do {
  94             char *p;
  95             __asm__ volatile ("mov %%esp,%0" : "=m" (p));
  96             fprintf(stderr,"enterStablePtr-end: current: %#x c-entry: %#x\n", p, CurrentRegTable->rCstkptr);
  97         } while(0);
  98 #endif
  99 }
 100 \end{code}
 101
 102 \begin{code}
 103 EXTFUN(startPerformIO);
 104
 105 extern void checkInCCallGC(STG_NO_ARGS);
 106
 107 void
 108 performIO(stableIndex)
 109   StgStablePtr stableIndex;
 110 {
 111   checkInCCallGC();
 112   enterStablePtr( stableIndex, (StgFunPtr) startPerformIO );
 113 }
 114
 115 extern StgInt enterInt_Result;
 116 EXTFUN(startEnterInt);
 117
 118 StgInt
 119 enterInt(stableIndex)
 120   StgStablePtr stableIndex;
 121 {
 122   checkInCCallGC();
 123   enterStablePtr( stableIndex, (StgFunPtr) startEnterInt );
 124   return enterInt_Result;
 125 }
 126
 127 extern StgFloat enterFloat_Result;
 128 EXTFUN(startEnterFloat);
 129
 130 StgInt
 131 enterFloat(stableIndex)
 132   StgStablePtr stableIndex;
 133 {
 134   checkInCCallGC();
 135   enterStablePtr( stableIndex, (StgFunPtr) startEnterFloat );
 136   return enterFloat_Result;
 137 }
 138 \end{code}
 139
 140 \begin{code}
 141 StgPtr
 142 deRefStablePointer(stableIndex)
 143   StgStablePtr stableIndex;
 144 {
 145   return _deRefStablePointer(stableIndex, StorageMgrInfo.StablePointerTable);
 146 }
 147 \end{code}
 148
 149 Despite the file name, we have a little ForeignObj operation here - not
 150 worth putting in a file by itself.
 151
 152 \begin{code}
 153 StgInt
 154 eqForeignObj(p1, p2)
 155   StgForeignObj p1;
 156   StgForeignObj p2;
 157 {
 158   return (p1 == p2);
 159 }
 160
 161 StgInt
 162 eqStablePtr(p1, p2)
 163   StgStablePtr p1;
 164   StgStablePtr p2;
 165 {
 166   return (p1 == p2);
 167 }
 168 \end{code}
 169
 170 And some code that HAS NO RIGHT being here.
 171
 172 \begin{code}
 173 StgStablePtr softHeapOverflowHandler = -1;
 174
 175 StgInt
 176 catchSoftHeapOverflow( newHandler, deltaLimit )
 177   StgStablePtr newHandler;
 178   StgInt deltaLimit;
 179 {
 180   StgStablePtr oldHandler = softHeapOverflowHandler;
 181
 182   /* If we're in a _ccall_GC_ then HpLim will be stored in SAVE_HpLim
 183      which provides an easy way of changing it. */
 184   checkInCCallGC();
 185
 186   StorageMgrInfo.hardHpOverflowSize += deltaLimit;
 187   SAVE_HpLim -= deltaLimit;
 188
 189   if (StorageMgrInfo.hardHpOverflowSize < 0) {
 190     fprintf(stderr, "Error: Setting Hard Heap Overflow Size to negative value!\n");
 191     EXIT(EXIT_FAILURE);
 192   }
 193
 194   softHeapOverflowHandler = newHandler;
 195   return oldHandler;
 196 }
 197
 198 StgInt
 199 getSoftHeapOverflowHandler(STG_NO_ARGS)
 200 {
 201   return (StgInt) softHeapOverflowHandler;
 202 }
 203
 204 #endif /* !PAR */
 205 \end{code}