+++ /dev/null
-\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}
projects / ghc-hetmet.git / blobdiff