ghc/runtime/c-as-asm/StablePtr.lc

   1 \section[Stable-Pointers]{Creation and use of Stable Pointers}
   2
   3 \begin{code}
   4 #if !defined(PAR)
   5
   6 #include "rtsdefs.h"
   7 \end{code}
   8
   9 This files (together with @ghc/runtime/storage/PerformIO.lhc@ and a
  10 small change in @HpOverflow.lc@) consists of the changes in the
  11 runtime system required to implement "Stable Pointers". But we're
  12 getting a bit ahead of ourselves --- what is a stable pointer and what
  13 is it used for?
  14
  15 When Haskell calls C, it normally just passes over primitive integers,
  16 floats, bools, strings, etc.  This doesn't cause any problems at all
  17 for garbage collection because the act of passing them makes a copy
  18 from the heap, stack or wherever they are onto the C-world stack.
  19 However, if we were to pass a heap object such as a (Haskell) @String@
  20 and a garbage collection occured before we finished using it, we'd run
  21 into problems since the heap object might have been moved or even
  22 deleted.
  23
  24 So, if a C call is able to cause a garbage collection or we want to
  25 store a pointer to a heap object between C calls, we must be careful
  26 when passing heap objects. Our solution is to keep a table of all
  27 objects we've given to the C-world and to make sure that the garbage
  28 collector collects these objects --- updating the table as required to
  29 make sure we can still find the object.
  30
  31
  32 Of course, all this rather begs the question: why would we want to
  33 pass a boxed value?
  34
  35 One very good reason is to preserve laziness across the language
  36 interface. Rather than evaluating an integer or a string because it
  37 {\em might\/} be required by the C function, we can wait until the C
  38 function actually wants the value and then force an evaluation.
  39
  40 Another very good reason (the motivating reason!) is that the C code
  41 might want to execute an object of sort $IO ()$ for the side-effects
  42 it will produce. For example, this is used when interfacing to an X
  43 widgets library to allow a direct implementation of callbacks.
  44
  45
  46 The @makeStablePointer# :: a -> PrimIO (StablePtr a)@ function
  47 converts a value into a stable pointer.  It is part of the @PrimIO@
  48 monad, because we want to be sure we don't allocate one twice by
  49 accident, and then only free one of the copies.
  50
  51 \begin{verbatim}
  52 makeStablePointer#  :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
  53 freeStablePointer#  :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
  54 deRefStablePointer# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
  55 \end{verbatim}
  56 There is also a C procedure @FreeStablePtr@ which frees a stable pointer.
  57
  58 There may be additional functions on the C side to allow evaluation,
  59 application, etc of a stable pointer.
  60
  61 \begin{code}
  62 EXTDATA(UnusedSP_closure);
  63 EXTDATA(EmptySPTable_closure);
  64
  65 void
  66 enlargeSPTable( newTable, oldTable )
  67   StgPtr newTable;
  68   StgPtr oldTable;
  69 {
  70   StgInt OldNoPtrs = SPT_NoPTRS(oldTable);
  71   StgInt NewNoPtrs = SPT_NoPTRS(newTable);
  72   StgInt i, NewTop;
  73
  74   ASSERT( NewNoPtrs > OldNoPtrs );
  75   ASSERT( SPT_TOP(oldTable) == 0 );
  76
  77   CHECK_SPT_CLOSURE(oldTable);
  78
  79   /* Copy old stable pointers over */
  80   for( i = 0; i < OldNoPtrs; ++i ) {
  81     SPT_SPTR(newTable, i) = SPT_SPTR(oldTable,i);
  82   }
  83   /* Top up with unused stable pointers */
  84   for( i = OldNoPtrs; i < NewNoPtrs; ++i ) {
  85     SPT_SPTR(newTable, i) = UnusedSP_closure;
  86   }
  87
  88   /* Setup free stack with indices of new stable pointers*/
  89   NewTop = 0;
  90   for( i = OldNoPtrs; i < NewNoPtrs; ++i ) {
  91     SPT_FREE(newTable, NewTop++) = i;
  92   }
  93   SPT_TOP(newTable) = NewTop;
  94
  95   StorageMgrInfo.StablePointerTable = newTable;
  96
  97 #if defined(DEBUG)
  98   /* Now trash the old table to encourage bugs to show themselves */
  99   if ( oldTable != EmptySPTable_closure ) {
 100     I_ size = SPT_SIZE(oldTable) + _FHS;
 101
 102     for( i = 0; i != size; ++i ) {
 103       oldTable[ i ] = DEALLOCATED_TRASH;
 104     }
 105   }
 106 #endif
 107
 108   CHECK_SPT_CLOSURE(newTable);
 109 }
 110 \end{code}
 111
 112
 113 There are a lot of checks in here.  However, they are not to catch
 114 bugs in the compiler - they are to catch bugs in the users program.
 115
 116 ToDo: maybe have a compiler switch to be less paranoid? [ADR]
 117
 118 \begin{code}
 119 EXTDATA(UnusedSP_closure);
 120
 121 void
 122 freeStablePointer(stablePtr)
 123   I_ stablePtr;
 124 {
 125   P_ SPTable = StorageMgrInfo.StablePointerTable;
 126
 127   /* Check what we can of tables integrity - can't check infotable
 128      since we may be in a GC and (compacting) GC may have mangled it. */
 129   CHECK_SPT_Size(SPTable);
 130   CHECK_SPT_Contents(SPTable);
 131
 132   if (! (0 <= stablePtr && stablePtr < SPT_NoPTRS(SPTable)) ) { /* bogus index */
 133     /* This can only happen if the Haskell/C programmer has really messed up. */
 134
 135     fprintf(stderr, "Panic (freeStablePointer): stable pointer %ld not in range 0..%ld.\n",
 136             stablePtr, SPT_NoPTRS(SPTable)-1);
 137     abort();
 138   }
 139
 140   if (SPT_SPTR(SPTable,stablePtr) == UnusedSP_closure) { /* freeing an unused stable pointer */
 141     /* This can only happen if the Haskell/C programmer has already
 142        returned the same stable pointer or never allocated it. */
 143
 144     fprintf(stderr, "Panic: stable pointer %ld freed multiple times (or never allocated)\nby the Haskell/C programmer.\n", stablePtr);
 145     EXIT(EXIT_FAILURE); /* ToDo: abort()? */
 146   }
 147
 148   if (SPT_FULL(SPTable)) { /* free stack full! */
 149     /* This can only happen if the Haskell/C programmer has returned
 150        the same stable pointer several times.
 151      */
 152
 153     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");
 154     EXIT(EXIT_FAILURE); /* ToDo: abort()? */
 155   }
 156
 157   SPT_SPTR(SPTable,stablePtr) = UnusedSP_closure; /* erase old entry */
 158   SPT_PUSH(SPTable,stablePtr);                    /* Add it to free stack */
 159
 160   CHECK_SPT_Size(SPTable);
 161   CHECK_SPT_Contents(SPTable);
 162 }
 163 \end{code}
 164
 165 \begin{code}
 166 StgPtr
 167 _deRefStablePointer(stablePtr,SPTable)
 168   StgInt stablePtr;
 169   StgPtr SPTable;
 170 {
 171   CHECK_SPT_CLOSURE(SPTable);
 172
 173   if (! (0 <= stablePtr && stablePtr < SPT_NoPTRS(SPTable)) ) { /* bogus index */
 174     /* This can only happen if the Haskell/C programmer has really messed up. */
 175
 176     fprintf(stderr, "Panic (deRefStablePointer): stable pointer %ld not in range 0..%ld.\n",
 177             stablePtr, SPT_NoPTRS(SPTable)-1);
 178     EXIT(EXIT_FAILURE); /* ToDo: abort()? */
 179   }
 180
 181   if (SPT_SPTR(SPTable,stablePtr) == UnusedSP_closure) { /* dereferencing an unused stable pointer */
 182     /* This can only happen if the Haskell/C programmer has already
 183        returned this stable pointer. */
 184
 185     fprintf(stderr, "Panic: stable pointer %ld not allocated by the Haskell/C programmer.\n", stablePtr);
 186     EXIT(EXIT_FAILURE); /* ToDo: abort()? */
 187   }
 188
 189   return SPT_SPTR(SPTable,stablePtr);
 190 }
 191 \end{code}
 192
 193 For error detecting in the debug version, we have a check that all
 194 free pointers are really free and all non-free pointers are really not
 195 free.
 196
 197 \begin{code}
 198 #ifdef DEBUG
 199 int ValidateSPTable( P_ SPTable )
 200 {
 201   I_ i, j;
 202   I_ NoPtrs = SPT_NoPTRS( SPTable );
 203   I_ Top = SPT_TOP( SPTable );
 204
 205   for( i = 0; i != Top; ++i ) {
 206     /* Check the free indexes are in range */
 207     if (!( (0 <= SPT_FREE( SPTable, i )) && (SPT_FREE( SPTable, i ) < NoPtrs) ) ) return 1;
 208     /* Check the free indexes are unused */
 209     if ( SPT_SPTR( SPTable, SPT_FREE( SPTable, i ) ) != UnusedSP_closure ) return 2;
 210   }
 211
 212   /* Check each unused stable pointer is in free list (and vice-versa) */
 213   for( i = 0; i != NoPtrs; i++ ) {
 214     if ( SPT_SPTR( SPTable, i ) == UnusedSP_closure ) {
 215       j = 0;
 216       while (j != Top && SPT_FREE( SPTable, j ) != i) {
 217         j++;
 218       }
 219       if (j == Top) return 3; /* Space leak - losing free SPs */
 220     } else {
 221       j = Top;
 222       while (j != NoPtrs && SPT_FREE( SPTable, j ) != i) {
 223         j++;
 224       }
 225     }
 226   }
 227
 228   /* If all that worked, we've got a good structure here */
 229   return 0;
 230 }
 231 #endif /* DEBUG */
 232
 233 #endif /* ! PAR */
 234 \end{code}