\section[stable-ptr-ops]{Stable Pointer Operations}

The code that implements @performIO@ is mostly in
@ghc/runtime/c-as-asm/PerformIO.lhc@.  However, this code can be
called from the C world so it goes in a @.lc@ file.

This code is based heavily on the code in @ghc/runtime/main/main.lc@.

It is used to call a (stable pointer to a) function of type
@IoWorld -> PrimIntAndIoWorld@ (ie @PrimIO_Int#@).

(I doubt very much that this works at the moment - and we're going to
change it to take/return a byte array anyway.  Code in PerformIO.lhc
is even more dated.)

\begin{code}
#if !defined(PAR)

#include "rtsdefs.h"

extern StgPtr unstable_Closure;
#if 0
extern int    CStackDelta;
#endif

StgInt entersFromC=0;

void
enterStablePtr(stableIndex, startCode)
  StgStablePtr stableIndex;
  StgFunPtr startCode;
{
    unstable_Closure
      = _deRefStablePointer(stableIndex, StorageMgrInfo.StablePointerTable);

    /* ToDo: Set arity to right value - if necessary */

    /* Inactive code for computing the chunk of C stack we have allocated
       since initially leaving Haskell land.
    */
#if 0 && defined(CONCURRENT) && defined(i386_TARGET_ARCH)
    __asm__ volatile ("mov %%esp,%0" : "=m" (CurrentRegTable->rWrapReturn));
    CStackDelta=(int)(((unsigned int)CurrentRegTable->rCstkptr - (unsigned int)CurrentRegTable->rWrapReturn) / sizeof(W_));
    CurrentTSOinC=CurrentTSO;
# if defined(DEBUG)
    fprintf(stderr,"enterStablePtr: current: %#x c-entry: %#x (delta %d)\n", CurrentRegTable->rWrapReturn, CurrentRegTable->rCstkptr, CStackDelta);
    __asm__ volatile ("mov %%esp,%0" : "=m" (CurrentRegTable->rWrapReturn));
    CStackDelta=(int)(((unsigned int)CurrentRegTable->rCstkptr - (unsigned int)CurrentRegTable->rWrapReturn) / sizeof(W_));
# endif
#endif
    /* 
     * Combining Concurrent Haskell and stable pointers poses a headache or
     * two. If the thread that jumps into Haskell causes a context switch,
     * we're in deep trouble, as miniInterpret() is used to enter the threaded world,
     * which stash away return address and callee-saves registers on the C
     * stack and enter.
     *
     * If the thread should happen to context switch, the scheduler is 
     * currently coded to use longjmp() to jump from the rescheduling
     * code to the main scheduler loop. i.e., we unwind chunks of the
     * C stack, including the return address++ the thread left there
     * before entering the stable pointer.
     * 
     * Ideally, we would like to impose no restrictions on the use of
     * stable pointers with Concurrent Haskell, but currently we 
     * do turn off heap check context switching when a thread jumps into
     * Haskell from C. This reduces the `risk' of a context switch, but
     * doesn't solve the problem - a thread that blocks will still
     * force a re-schedule. To cope with this situation, we use a counter
     * to keep track of whether any threads have entered Haskell from C.
     * If any have, we avoid longjmp()ing in the RTS to preserve the region
     * of the C stack that the thread expects to be there when it exits.
     * 
     * This scheme is a hack (no, really!) to get Haskell callbacks to work
     * with Concurrent Haskell. It is currently only supported for x86 platforms
     * (due to use of asm to get at stack pointer in PerformIO.lhc)
     *
     * ToDo: do Right in the new RTS.
     */
#if defined(CONCURRENT) && defined(i386_TARGET_ARCH)
    entersFromC++;
    miniInterpret(startCode);
    entersFromC--;
#else
    miniInterpret(startCode);
#endif

#if 0 && defined(DEBUG)
    if (CurrentTSO == CurrentTSOinC) {
       CurrentTSOinC=NULL;
    }
    /* C stack should have been reconstructed by now (we'll soon find out..) */
    do {
            char *p;
	    __asm__ volatile ("mov %%esp,%0" : "=m" (p));
            fprintf(stderr,"enterStablePtr-end: current: %#x c-entry: %#x\n", p, CurrentRegTable->rCstkptr);
	} while(0);
#endif
}
\end{code}

\begin{code}
EXTFUN(startPerformIO);

extern void checkInCCallGC(STG_NO_ARGS);

void
performIO(stableIndex)
  StgStablePtr stableIndex;
{
  checkInCCallGC();
  enterStablePtr( stableIndex, (StgFunPtr) startPerformIO );
}

extern StgInt enterInt_Result;
EXTFUN(startEnterInt);

StgInt
enterInt(stableIndex)
  StgStablePtr stableIndex;
{
  checkInCCallGC();
  enterStablePtr( stableIndex, (StgFunPtr) startEnterInt );
  return enterInt_Result;
}

extern StgFloat enterFloat_Result;
EXTFUN(startEnterFloat);

StgInt
enterFloat(stableIndex)
  StgStablePtr stableIndex;
{
  checkInCCallGC();
  enterStablePtr( stableIndex, (StgFunPtr) startEnterFloat );
  return enterFloat_Result;
}
\end{code}

\begin{code}
StgPtr
deRefStablePointer(stableIndex)
  StgStablePtr stableIndex;
{
  return _deRefStablePointer(stableIndex, StorageMgrInfo.StablePointerTable);
}
\end{code}

Despite the file name, we have a little ForeignObj operation here - not
worth putting in a file by itself.

\begin{code}
StgInt 
eqForeignObj(p1, p2)
  StgForeignObj p1;
  StgForeignObj p2;
{
  return (p1 == p2);
}

StgInt 
eqStablePtr(p1, p2)
  StgStablePtr p1;
  StgStablePtr p2;
{
  return (p1 == p2);
}
\end{code}

And some code that HAS NO RIGHT being here.

\begin{code}
StgStablePtr softHeapOverflowHandler = -1;

StgInt
catchSoftHeapOverflow( newHandler, deltaLimit )
  StgStablePtr newHandler;
  StgInt deltaLimit;
{
  StgStablePtr oldHandler = softHeapOverflowHandler;

  /* If we're in a _ccall_GC_ then HpLim will be stored in SAVE_HpLim
     which provides an easy way of changing it. */
  checkInCCallGC();

  StorageMgrInfo.hardHpOverflowSize += deltaLimit;
  SAVE_HpLim -= deltaLimit;

  if (StorageMgrInfo.hardHpOverflowSize < 0) {
    fprintf(stderr, "Error: Setting Hard Heap Overflow Size to negative value!\n");
    EXIT(EXIT_FAILURE);
  }

  softHeapOverflowHandler = newHandler;
  return oldHandler;
}

StgInt
getSoftHeapOverflowHandler(STG_NO_ARGS)
{
  return (StgInt) softHeapOverflowHandler;
}

#endif /* !PAR */
\end{code}