ghc/runtime/storage/SMextn.lc

   1 \section[SM-extensions]{Storage Manager Extensions}
   2
   3 ToDo ADR: Maybe this should be split between SMcopying.lc and
   4 SMcompacting.lc?
   5
   6
   7 This is a collection of C functions use in implementing the stable
   8 pointer and foreign object extensions.
   9
  10 The motivation for making this a separate file/section is twofold:
  11
  12 1) It let's us focus on one thing.
  13
  14 2) If we don't do this, there will be a huge amount of repetition
  15    between the various GC schemes --- a maintenance nightmare.
  16
  17 The second is the major motivation.
  18
  19 There are three main parts to this file:
  20
  21 1) Code which is common to all GC schemes.
  22
  23 2) Code for use in a compacting collector used in the 1-space, dual
  24    mode and for collecting old generations in generational collectors.
  25
  26 3) Code for use in a copying collector used in the 2-space, dual mode
  27    and for collecting young generations in generational collectors.
  28
  29 When debugging, it is incredibly helpful to trash part of the heap
  30 (say) once you're done with it.
  31
  32 Remembering that @sm->hp@ points to the next word to be allocated, a
  33 typical use is
  34
  35 \begin{pseudocode}
  36 #ifdef DEBUG
  37   TrashMem(sm->hp+1, sm->hplim);
  38 #endif
  39 \end{pseudocode}
  40
  41 \begin{code}
  42
  43 #if defined(GC1s)
  44
  45 #define  SCAN_REG_DUMP
  46 #include "SMinternal.h"
  47 REGDUMP(ScanRegDump);
  48
  49 #else /* GC2s, GCdu, GCap, GCgn */
  50
  51 #define SCAV_REG_MAP
  52 #include "SMinternal.h"
  53 REGDUMP(ScavRegDump);
  54
  55 #endif
  56 #include "SMextn.h"
  57
  58 #ifdef DEBUG
  59
  60 void
  61 TrashMem(from, to)
  62   P_ from, to;
  63 {
  64 /* assertion overly strong - if free_mem == 0, sm->hp == sm->hplim */
  65 /*  ASSERT( from <= to ); */
  66     if (RTSflags.GcFlags.trace)
  67         fprintf(stderr,"Trashing from 0x%lx to 0x%lx inclusive\n", (W_) from, (W_) to);
  68     while (from <= to) {
  69         *from++ = DEALLOCATED_TRASH;
  70     }
  71 }
  72
  73 #endif /* DEBUG */
  74 \end{code}
  75
  76 \begin{code}
  77
  78 #if !defined(PAR)       /* To end of the file */
  79
  80 \end{code}
  81
  82 \downsection
  83 \section[SM-extensions-common-code]{Code common to all GC schemes}
  84
  85 \begin{code}
  86 EXTDATA(EmptySPTable_closure);
  87
  88 void initExtensions( sm )
  89   smInfo *sm;
  90 {
  91   sm->ForeignObjList = NULL;
  92 #if defined(GCap) || defined(GCgn)
  93   sm->OldForeignObjList = NULL;
  94 #endif
  95
  96   sm->StablePointerTable = (P_) EmptySPTable_closure;
  97 }
  98
  99 \end{code}
 100
 101 \begin{code}
 102 #if defined(DEBUG)
 103 \end{code}
 104
 105 When a Foreign Object is released, there should be absolutely no
 106 references to it.  To encourage and dangling references to show
 107 themselves, we'll trash its contents when we're done with it.
 108
 109 \begin{code}
 110 #define TRASH_ForeignObj_CLOSURE( mptr ) Trash_ForeignObj_Closure(mptr)
 111
 112 void
 113 Trash_ForeignObj_Closure(mptr)
 114   P_ mptr;
 115 {
 116     int i;
 117     for( i = 0; i < ForeignObj_SIZE + _FHS; i++ ) {
 118       mptr[ i ] = DEALLOCATED_TRASH;
 119     }
 120 }
 121 \end{code}
 122
 123 Also, every time we fiddle with the ForeignObj list, we should check it
 124 still makes sense.  This function returns @0@ if the list is sensible.
 125
 126 (Would maintaining a separate Foreign Obj count allow better testing?)
 127
 128 \begin{code}
 129 void
 130 Validate_ForeignObjList( ForeignObjList )
 131   P_ ForeignObjList;
 132 {
 133   P_ FOptr;
 134
 135   for(FOptr = ForeignObjList;
 136       FOptr != NULL;
 137       FOptr = ForeignObj_CLOSURE_LINK(FOptr) ) {
 138     CHECK_ForeignObj_CLOSURE(FOptr);
 139   }
 140 }
 141 \end{code}
 142
 143 \begin{code}
 144 #else /* !DEBUG */
 145
 146 #define TRASH_ForeignObj_CLOSURE( mp ) /* nothing */
 147
 148 #endif /* !DEBUG */
 149 \end{code}
 150
 151 \begin{code}
 152 #ifdef DEBUG
 153
 154 #define TRACE_ForeignObj(FOptr) Trace_ForeignObj( FOptr )
 155 #define TRACE_FOdies(FOptr) Trace_FOdies()
 156 #define TRACE_FOlives(FOptr) Trace_FOlives()
 157 #define TRACE_FOforwarded(FOptr, newAddress) Trace_FOforwarded( FOptr, newAddress )
 158
 159 void
 160 Trace_ForeignObj( FOptr )
 161   P_ FOptr;
 162 {
 163   if (RTSflags.GcFlags.trace & DEBUG_TRACE_FOREIGNOBJS) {
 164     fprintf(stderr,"DEBUG: ForeignObj(%0x)=<%0x,%0x,%0x,%0x>\n", (W_) FOptr, (W_) FOptr[0], (W_) FOptr[1], (W_) FOptr[2], (W_) FOptr[3]);
 165     fprintf(stderr," Data = %0x, Finaliser = %0x, Next = %0x\n",
 166             (W_) ForeignObj_CLOSURE_DATA(FOptr),
 167             (W_) ForeignObj_CLOSURE_FINALISER(FOptr),
 168             (W_) ForeignObj_CLOSURE_LINK(FOptr) );
 169   }
 170 }
 171
 172 void
 173 Trace_FOdies()
 174 {
 175   if (RTSflags.GcFlags.trace & DEBUG_TRACE_FOREIGNOBJS) {
 176     fprintf(stderr, " dying\n");
 177   }
 178 }
 179
 180 void
 181 Trace_FOlives()
 182 {
 183   if (RTSflags.GcFlags.trace & DEBUG_TRACE_FOREIGNOBJS) {
 184     fprintf(stderr," lived to tell the tale\n");
 185   }
 186 }
 187
 188 void
 189 Trace_FOforwarded( FOPtr, newAddress )
 190   P_ FOPtr, newAddress;
 191 {
 192   if (RTSflags.GcFlags.trace & DEBUG_TRACE_FOREIGNOBJS) {
 193     fprintf(stderr, " forwarded to %lx\n", (W_) newAddress);
 194   }
 195 }
 196
 197 #else
 198
 199 #define TRACE_ForeignObj(FOptr) /* nothing */
 200 #define TRACE_FOdies(FOptr) /* nothing */
 201 #define TRACE_FOlives(FOptr) /* nothing */
 202 #define TRACE_FOforwarded(FOptr, newAddress) /* nothing */
 203
 204 #endif /* DEBUG */
 205 \end{code}
 206
 207
 208 \section[SM-extensions-compacting-code]{Compacting Collector Code}
 209
 210
 211 \begin{code}
 212 #if defined(_INFO_COMPACTING)
 213
 214 /* Sweep up the dead ForeignObjs */
 215
 216 /* Note that this has to happen before the linking phase trashes
 217    the stable pointer table so that the finaliser functions can
 218    safely call freeStablePointer.
 219 */
 220
 221 void
 222 sweepUpDeadForeignObjs( ForeignObjList, base, bits )
 223   P_ ForeignObjList;
 224   P_ base;
 225   BitWord *bits;
 226 {
 227     P_ FOptr, temp;
 228     I_ ForeignObj_deaths = 0;
 229     long _hp_word, bit_index, bit;
 230
 231     /* At this point, the ForeignObjList is in an invalid state (since
 232        some info ptrs will have been mangled) so we can't validate
 233        it. ADR */
 234
 235     DEBUG_STRING("Reporting Dead Foreign objects:");
 236     FOptr = ForeignObjList;
 237     while ( FOptr != NULL ) {
 238
 239       TRACE_ForeignObj(FOptr);
 240
 241       _hp_word = FOptr - base;
 242       bit_index = _hp_word / BITS_IN(BitWord);
 243       bit = 1L << (_hp_word & (BITS_IN(BitWord) - 1));
 244       if ( !( bits[bit_index] & bit ) ) { /* dead */
 245
 246         TRACE_FOdies( FOptr );
 247         if (ForeignObj_CLOSURE_FINALISER(FOptr) != NULL) {
 248            (*(void (*)(StgAddr))(ForeignObj_CLOSURE_FINALISER(FOptr)))((StgAddr)ForeignObj_CLOSURE_DATA(FOptr));
 249            ForeignObj_deaths++;
 250         }
 251
 252         temp = FOptr;
 253         FOptr = ForeignObj_CLOSURE_LINK(FOptr);
 254         /* Now trash the closure to encourage bugs to show themselves */
 255         TRASH_ForeignObj_CLOSURE( temp );
 256
 257       } else {
 258
 259         TRACE_FOlives(FOptr);
 260         FOptr = ForeignObj_CLOSURE_LINK(FOptr);
 261       }
 262     }
 263 }
 264
 265 #endif /* _INFO_COMPACTING */
 266 \end{code}
 267
 268 \section[SM-extensions-copying-code]{Copying Collector Code}
 269
 270 \begin{code}
 271 #if defined(_INFO_COPYING)
 272
 273 /* ToDo: a possible optimisation would be to maintain a flag that
 274    told us whether the SPTable had been updated (with new
 275    pointers) and so needs to be GC'd.  A simple way of doing this
 276    might be to generalise the MUTUPLE closures to MUGEN closures.
 277 */
 278 void evacSPTable( sm )
 279 smInfo *sm;
 280 {
 281   DEBUG_STRING("Evacuate Stable Pointer Table:");
 282   {
 283     P_ evac = sm->StablePointerTable;
 284     sm->StablePointerTable = EVACUATE_CLOSURE(evac);
 285   }
 286 }
 287
 288
 289
 290 /* First attempt at Foreign Obj hackery... Later versions might
 291    do something useful with the two counters. [ADR]      */
 292
 293 #if defined(DEBUG)
 294 #if defined(GCgn)
 295
 296 EXTDATA_RO(Forward_Ref_New_info);
 297 EXTDATA_RO(Forward_Ref_Old_info);
 298 EXTDATA_RO(OldRoot_Forward_Ref_info);
 299
 300 #else
 301
 302 EXTDATA_RO(Forward_Ref_info);
 303
 304 #endif
 305 #endif
 306
 307 /*
 308   Call ForeignObj finalising routine on any dead FOs in oldFOList,
 309   add the remainder to new sticking the result into newFOList.
 310 */
 311 void
 312 reportDeadForeignObjs(oldFOList, new, newFOList)
 313   P_ oldFOList;
 314   P_ new;
 315   P_ *newFOList;
 316 {
 317     P_ FOptr, temp;
 318     I_ FO_no = 0, FO_deaths = 0;
 319
 320     /* At this point, the ForeignObjList is in an invalid state (since
 321        some info ptrs will have been mangled) so we can't validate
 322        it. ADR */
 323
 324     DEBUG_STRING("Updating Foreign Objects List and reporting casualties:");
 325     FOptr = oldFOList;
 326     while ( FOptr != NULL ) {
 327       TRACE_ForeignObj(FOptr);
 328
 329       if ((P_) INFO_PTR(FOptr) == ForeignObj_info ) {
 330         /* can't have been forwarded - must be dead */
 331
 332         TRACE_FOdies(FOptr);
 333         if (ForeignObj_CLOSURE_FINALISER(FOptr) != NULL) {
 334            (*(void (*)(StgAddr))(ForeignObj_CLOSURE_FINALISER(FOptr)))((StgAddr)ForeignObj_CLOSURE_DATA(FOptr));
 335            FO_deaths++;
 336         }
 337
 338         temp  = FOptr;
 339         FOptr = ForeignObj_CLOSURE_LINK(FOptr);
 340
 341         /* Now trash the closure to encourage bugs to show themselves */
 342         TRASH_ForeignObj_CLOSURE( temp );
 343       } else { /* Must have been forwarded - so it must be live */
 344
 345         P_ newAddress = (P_) FORWARD_ADDRESS(FOptr);
 346
 347 #if defined(GCgn)
 348         ASSERT( ( (P_) INFO_PTR(FOptr) == Forward_Ref_New_info ) ||
 349                 ( (P_) INFO_PTR(FOptr) == Forward_Ref_Old_info ) ||
 350                 ( (P_) INFO_PTR(FOptr) == OldRoot_Forward_Ref_info ) );
 351 #else
 352         ASSERT( (P_) INFO_PTR(FOptr) == Forward_Ref_info );
 353 #endif
 354
 355         TRACE_FOforwarded( FOptr, newAddress );
 356         ForeignObj_CLOSURE_LINK(newAddress) = new;
 357         new = newAddress;
 358         FO_no++;
 359         FOptr = ForeignObj_CLOSURE_LINK(FOptr);
 360       }
 361     }
 362
 363     VALIDATE_ForeignObjList( new );
 364     *newFOList = new;
 365 }
 366 #endif /* _INFO_COPYING */
 367 \end{code}
 368
 369 @freeForeigns@ summarily calls the finaliser routines for
 370 all live foreign objects, done when closing down.
 371 (code is just a rip off of the above).
 372
 373 \begin{code}
 374 #if defined(_INFO_COPYING)
 375
 376 #if defined(DEBUG)
 377 # if defined(GCgn)
 378
 379 EXTDATA_RO(Forward_Ref_New_info);
 380 EXTDATA_RO(Forward_Ref_Old_info);
 381 EXTDATA_RO(OldRoot_Forward_Ref_info);
 382
 383 # else
 384
 385 EXTDATA_RO(Forward_Ref_info);
 386
 387 # endif
 388 #endif
 389
 390 /*
 391   Call the ForeignObj finalising routine on all the live FOs,
 392   used when shutting down.
 393 */
 394 int
 395 freeForeigns(foList)
 396   P_ foList;
 397 {
 398     P_ FOptr, temp;
 399     I_ FO_deaths = 0;
 400
 401     /* At this point, exitSM() has been called, the ForeignObjList is in an invalid state (since
 402        some info ptrs will have been mangled) so we can't validate
 403        it. ADR */
 404
 405     DEBUG_STRING("Freeing all live Foreign Objects:");
 406     FOptr = foList;
 407     while ( FOptr != NULL ) {
 408
 409         /* I'm not convinced that the situation of having
 410            indirections linked into the FO list can ever occur,
 411            but chasing indirections doesn't hurt. */
 412        while(IS_INDIRECTION(INFO_PTR(FOptr))) {
 413            FOptr = (P_) IND_CLOSURE_PTR(FOptr);
 414        }
 415        if ((P_) INFO_PTR(FOptr) == ForeignObj_info ) {
 416           TRACE_ForeignObj(FOptr);
 417           TRACE_FOdies(FOptr);
 418           /* ForeignObjs can have a zapped-out finaliser field, in which
 419              case we'll just drop the object silently.
 420           */
 421           if (ForeignObj_CLOSURE_FINALISER(FOptr) != NULL) {
 422              (*(void (*)(StgAddr))(ForeignObj_CLOSURE_FINALISER(FOptr)))((StgAddr)ForeignObj_CLOSURE_DATA(FOptr));
 423              FO_deaths++;
 424           }
 425
 426           temp  = FOptr;
 427           FOptr = ForeignObj_CLOSURE_LINK(FOptr);
 428
 429           /* Now trash the closure to encourage bugs to show themselves */
 430           TRASH_ForeignObj_CLOSURE( temp );
 431       } else {
 432           fprintf(stderr, "Warning: Foreign object list contained unexpected element, bailing out of FO cleanup.\n");
 433           return 1;
 434       }
 435     }
 436     return 0;
 437 }
 438 #endif /* _INFO_COPYING */
 439 \end{code}
 440
 441 \upsection
 442
 443 \begin{code}
 444 #endif /* !PAR */
 445 \end{code}