diff options
Diffstat (limited to 'ghc/runtime/c-as-asm/StablePtr.lc')
| -rw-r--r-- | ghc/runtime/c-as-asm/StablePtr.lc | 234 |
1 files changed, 234 insertions, 0 deletions
diff --git a/ghc/runtime/c-as-asm/StablePtr.lc b/ghc/runtime/c-as-asm/StablePtr.lc new file mode 100644 index 0000000000..21de425866 --- /dev/null +++ b/ghc/runtime/c-as-asm/StablePtr.lc @@ -0,0 +1,234 @@ +\section[Stable-Pointers]{Creation and use of Stable Pointers} + +\begin{code} +#ifndef 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} |