\section[Stable-Pointers]{Creation and use of Stable Pointers}

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

#include "rtsdefs.h"
\end{code}

This files (together with @ghc/runtime/storage/PerformIO.lhc@ and a
small change in @HpOverflow.lc@) consists of the changes in the
runtime system required to implement "Stable Pointers". But we're
getting a bit ahead of ourselves --- what is a stable pointer and what
is it used for?

When Haskell calls C, it normally just passes over primitive integers,
floats, bools, strings, etc.  This doesn't cause any problems at all
for garbage collection because the act of passing them makes a copy
from the heap, stack or wherever they are onto the C-world stack.
However, if we were to pass a heap object such as a (Haskell) @String@
and a garbage collection occured before we finished using it, we'd run
into problems since the heap object might have been moved or even
deleted.

So, if a C call is able to cause a garbage collection or we want to
store a pointer to a heap object between C calls, we must be careful
when passing heap objects. Our solution is to keep a table of all
objects we've given to the C-world and to make sure that the garbage
collector collects these objects --- updating the table as required to
make sure we can still find the object.


Of course, all this rather begs the question: why would we want to
pass a boxed value?

One very good reason is to preserve laziness across the language
interface. Rather than evaluating an integer or a string because it
{\em might\/} be required by the C function, we can wait until the C
function actually wants the value and then force an evaluation.

Another very good reason (the motivating reason!) is that the C code
might want to execute an object of sort $IO ()$ for the side-effects
it will produce. For example, this is used when interfacing to an X
widgets library to allow a direct implementation of callbacks.


The @makeStablePointer# :: a -> PrimIO (StablePtr a)@ function
converts a value into a stable pointer.  It is part of the @PrimIO@
monad, because we want to be sure we don't allocate one twice by
accident, and then only free one of the copies.

\begin{verbatim}
makeStablePointer#  :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
freeStablePointer#  :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
deRefStablePointer# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
\end{verbatim}
There is also a C procedure @FreeStablePtr@ which frees a stable pointer.

There may be additional functions on the C side to allow evaluation,
application, etc of a stable pointer.

\begin{code}
EXTDATA(UnusedSP_closure);
EXTDATA(EmptySPTable_closure);

void
enlargeSPTable( newTable, oldTable )
  StgPtr newTable;
  StgPtr oldTable;
{
  StgInt OldNoPtrs = SPT_NoPTRS(oldTable);
  StgInt NewNoPtrs = SPT_NoPTRS(newTable);
  StgInt i, NewTop;

  ASSERT( NewNoPtrs > OldNoPtrs );
  ASSERT( SPT_TOP(oldTable) == 0 );

  CHECK_SPT_CLOSURE(oldTable);

  /* Copy old stable pointers over */
  for( i = 0; i < OldNoPtrs; ++i ) {
    SPT_SPTR(newTable, i) = SPT_SPTR(oldTable,i);
  }
  /* Top up with unused stable pointers */
  for( i = OldNoPtrs; i < NewNoPtrs; ++i ) {
    SPT_SPTR(newTable, i) = UnusedSP_closure;
  }

  /* Setup free stack with indices of new stable pointers*/
  NewTop = 0;
  for( i = OldNoPtrs; i < NewNoPtrs; ++i ) {
    SPT_FREE(newTable, NewTop++) = i;
  }
  SPT_TOP(newTable) = NewTop;

  StorageMgrInfo.StablePointerTable = newTable;

#if defined(DEBUG)
  /* Now trash the old table to encourage bugs to show themselves */
  if ( oldTable != EmptySPTable_closure ) { 
    I_ size = SPT_SIZE(oldTable) + _FHS;

    for( i = 0; i != size; ++i ) {
      oldTable[ i ] = DEALLOCATED_TRASH;
    }
  }
#endif     

  CHECK_SPT_CLOSURE(newTable);
}
\end{code}


There are a lot of checks in here.  However, they are not to catch
bugs in the compiler - they are to catch bugs in the users program.

ToDo: maybe have a compiler switch to be less paranoid? [ADR]

\begin{code}
EXTDATA(UnusedSP_closure);

void
freeStablePointer(stablePtr)
  I_ stablePtr;
{
  P_ SPTable = StorageMgrInfo.StablePointerTable;

  /* Check what we can of tables integrity - can't check infotable
     since we may be in a GC and (compacting) GC may have mangled it. */
  CHECK_SPT_Size(SPTable);
  CHECK_SPT_Contents(SPTable);

  if (! (0 <= stablePtr && stablePtr < SPT_NoPTRS(SPTable)) ) { /* bogus index */
    /* This can only happen if the Haskell/C programmer has really messed up. */
   
    fprintf(stderr, "Panic (freeStablePointer): stable pointer %ld not in range 0..%ld.\n",
	    stablePtr, SPT_NoPTRS(SPTable)-1);
    abort();
  }

  if (SPT_SPTR(SPTable,stablePtr) == UnusedSP_closure) { /* freeing an unused stable pointer */
    /* This can only happen if the Haskell/C programmer has already
       returned the same stable pointer or never allocated it. */
   
    fprintf(stderr, "Panic: stable pointer %ld freed multiple times (or never allocated)\nby the Haskell/C programmer.\n", stablePtr);
    EXIT(EXIT_FAILURE); /* ToDo: abort()? */
  }

  if (SPT_FULL(SPTable)) { /* free stack full! */
    /* This can only happen if the Haskell/C programmer has returned
       the same stable pointer several times.
     */
   
    fprintf(stderr, "Panic: stable pointer free stack overflowed.\nThis is probably due to the same stable pointer being freed multiple times\nby the Haskell/C programmer.\n");
    EXIT(EXIT_FAILURE); /* ToDo: abort()? */
  }

  SPT_SPTR(SPTable,stablePtr) = UnusedSP_closure; /* erase old entry */
  SPT_PUSH(SPTable,stablePtr);			  /* Add it to free stack */  

  CHECK_SPT_Size(SPTable);
  CHECK_SPT_Contents(SPTable);
}
\end{code}

\begin{code}
StgPtr
_deRefStablePointer(stablePtr,SPTable)
  StgInt stablePtr;
  StgPtr SPTable;
{
  CHECK_SPT_CLOSURE(SPTable);

  if (! (0 <= stablePtr && stablePtr < SPT_NoPTRS(SPTable)) ) { /* bogus index */
    /* This can only happen if the Haskell/C programmer has really messed up. */
   
    fprintf(stderr, "Panic (deRefStablePointer): stable pointer %ld not in range 0..%ld.\n",
	    stablePtr, SPT_NoPTRS(SPTable)-1);
    EXIT(EXIT_FAILURE); /* ToDo: abort()? */
  }

  if (SPT_SPTR(SPTable,stablePtr) == UnusedSP_closure) { /* dereferencing an unused stable pointer */
    /* This can only happen if the Haskell/C programmer has already
       returned this stable pointer. */
   
    fprintf(stderr, "Panic: stable pointer %ld not allocated by the Haskell/C programmer.\n", stablePtr);
    EXIT(EXIT_FAILURE); /* ToDo: abort()? */
  }

  return SPT_SPTR(SPTable,stablePtr);
}
\end{code}

For error detecting in the debug version, we have a check that all
free pointers are really free and all non-free pointers are really not
free.

\begin{code}
#ifdef DEBUG
int ValidateSPTable( P_ SPTable )
{
  I_ i, j;
  I_ NoPtrs = SPT_NoPTRS( SPTable );
  I_ Top = SPT_TOP( SPTable );

  for( i = 0; i != Top; ++i ) {
    /* Check the free indexes are in range */
    if (!( (0 <= SPT_FREE( SPTable, i )) && (SPT_FREE( SPTable, i ) < NoPtrs) ) ) return 1;
    /* Check the free indexes are unused */
    if ( SPT_SPTR( SPTable, SPT_FREE( SPTable, i ) ) != UnusedSP_closure ) return 2;
  }

  /* Check each unused stable pointer is in free list (and vice-versa) */
  for( i = 0; i != NoPtrs; i++ ) {
    if ( SPT_SPTR( SPTable, i ) == UnusedSP_closure ) {
      j = 0;
      while (j != Top && SPT_FREE( SPTable, j ) != i) {
	j++;
      }
      if (j == Top) return 3; /* Space leak - losing free SPs */
    } else {
      j = Top;
      while (j != NoPtrs && SPT_FREE( SPTable, j ) != i) {
	j++;
      }
    }
  }	

  /* If all that worked, we've got a good structure here */
  return 0;
}
#endif /* DEBUG */

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