ghc/runtime/gum/RBH.lc

   1 %
   2 % (c) The AQUA/Parade Projects, Glasgow University, 1995
   3 %
   4 %************************************************************************
   5 %*                                                                      *
   6 \section[RBH.lc]{Revertible Black Hole Manipulation}
   7 %*                                                                      *
   8 %************************************************************************
   9
  10 \begin{code}
  11 #if defined(PAR) || defined(GRAN) /* whole file */
  12
  13 #include "rtsdefs.h"
  14 \end{code}
  15
  16 Turn a closure into a revertible black hole.  After the conversion,
  17 the first two words of the closure will be a link to the mutables
  18 list (if appropriate for the garbage collector), and a pointer
  19 to the blocking queue.  The blocking queue is terminated by a 2-word
  20 SPEC closure which holds the original contents of the first two
  21 words of the closure.
  22
  23 \begin{code}
  24 EXTFUN(RBH_Save_0_info);
  25 EXTFUN(RBH_Save_1_info);
  26 EXTFUN(RBH_Save_2_info);
  27
  28 P_
  29 convertToRBH(closure)
  30 P_ closure;
  31 {
  32     P_ infoPtr, newInfoPtr;
  33     W_ size, ptrs, nonptrs, vhs;
  34     P_  rbh_save;
  35     rtsBool isSpec;
  36     char str[80];
  37
  38     if ((rbh_save = AllocateHeap(SPEC_HS + 2)) == NULL)
  39         return NULL;
  40
  41     infoPtr = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str);
  42     ASSERT(size >= MIN_UPD_SIZE);
  43
  44     switch (BASE_INFO_TYPE(infoPtr)) {
  45     case INFO_SPEC_TYPE:
  46         isSpec = rtsTrue;
  47         break;
  48     case INFO_GEN_TYPE:
  49         isSpec = rtsFalse;
  50         break;
  51     default:
  52         fprintf(stderr, "Panic: turn %#lx (IP %#lx) into RBH\n", (W_)closure, (W_)infoPtr);
  53         EXIT(EXIT_FAILURE);
  54     }
  55
  56     /* Fill in the RBH_Save closure with the original data */
  57     rbh_save[SPEC_HS] = closure[isSpec ? SPEC_HS : GEN_HS];
  58     rbh_save[SPEC_HS + 1] = closure[(isSpec ? SPEC_HS : GEN_HS) + 1];
  59
  60     /*
  61      * Set the info_ptr for the rbh_Save closure according to the number of pointers
  62      * in the original
  63      */
  64
  65     newInfoPtr = (P_) (ptrs == 0 ? RBH_Save_0_info :
  66                        ptrs == 1 ? RBH_Save_1_info :
  67                        RBH_Save_2_info);
  68     SET_INFO_PTR(rbh_save, newInfoPtr);
  69
  70     /* Do some magic garbage collection mangling on the first word */
  71
  72 #if defined(GCap) || defined(GCgn)
  73
  74     /*
  75      * If the closure's in the old generation, we have to make sure it goes on the
  76      * mutables list
  77      */
  78
  79     if (closure <= StorageMgrInfo.OldLim) {
  80         MUT_LINK(closure) = (W_) StorageMgrInfo.OldMutables;
  81         StorageMgrInfo.OldMutables = closure;
  82     } else
  83         MUT_LINK(closure) = MUT_NOT_LINKED;
  84 #endif
  85
  86     /*
  87      * Second word points to the RBH_Save closure with the original data. This may
  88      * become a blocking queue terminated by the RBH_Save closure.
  89      */
  90     if (isSpec)
  91         SPEC_RBH_BQ(closure) = (W_) rbh_save;
  92     else
  93         GEN_RBH_BQ(closure) = (W_) rbh_save;
  94
  95     /* OK, now actually turn it into a RBH (what a great system!) */
  96     SET_INFO_PTR(closure, RBH_INFOPTR(INFO_PTR(closure)));
  97
  98     return closure;
  99 }
 100
 101 \end{code}
 102
 103 Converting a closure to a FetchMe is trivial, unless the closure has
 104 acquired a blocking queue.  If that has happened, we first have to
 105 awaken the blocking queue.  What a nuisance!  Fortunately,
 106 @AwakenBlockingQueue@ should now know what to do.
 107
 108 A note on GrAnSim: In GrAnSim we don't have FetchMe closures. However, we
 109 have to turn a RBH back to its original form when the simulated transfer
 110 of the closure has been finished. Therefore we need the @convertFromRBH@
 111 routine below. After converting the RBH back to its original form and
 112 awakening all TSOs, the first TSO will reenter the closure which is now
 113 local and carry on merrily reducing it (the other TSO will be less merrily
 114 blocked on the now local closure; we're costing the difference between
 115 local and global blocks in the BQ code).
 116
 117 \begin{code}
 118 #if defined(PAR)
 119
 120 EXTDATA_RO(FetchMe_info);
 121
 122 void
 123 convertToFetchMe(closure, ga)
 124 P_ closure;
 125 globalAddr *ga;
 126 {
 127     P_ ip = (P_) INFO_PTR(closure);
 128     P_ bqe;
 129 #if defined(GCap) || defined(GCgn)
 130     rtsBool linked = IS_MUTABLE(ip) && MUT_LINK(closure) != MUT_NOT_LINKED;
 131 #endif
 132
 133     switch(INFO_TYPE(ip)) {
 134     case INFO_SPEC_RBH_TYPE:
 135         bqe = (P_) SPEC_RBH_BQ(closure);
 136         break;
 137     case INFO_GEN_RBH_TYPE:
 138         bqe = (P_) GEN_RBH_BQ(closure);
 139         break;
 140     default:
 141 #ifdef DEBUG
 142         fprintf(stderr, "Weird...just tried to convert %#lx (IP %#lx) to FetchMe\n",
 143           closure, ip);
 144 #endif
 145         return;
 146     }
 147
 148     SET_INFO_PTR(closure, FetchMe_info);
 149
 150 #if defined(GCap) || defined(GCgn)
 151     /* If we modify a fetchme in the old generation,
 152        we have to make sure it goes on the mutables list */
 153
 154     if(closure <= StorageMgrInfo.OldLim) {
 155         if (!linked) {
 156             MUT_LINK(closure) = (W_) StorageMgrInfo.OldMutables;
 157             StorageMgrInfo.OldMutables = closure;
 158         }
 159     } else
 160         MUT_LINK(closure) = MUT_NOT_LINKED;
 161 #endif
 162
 163     FETCHME_GA(closure) = ga;
 164     if (IS_MUTABLE(INFO_PTR(bqe)))
 165         AwakenBlockingQueue(bqe);
 166 }
 167 #else  /* GRAN */
 168 /* Prototype */
 169 void UnlinkFromMUT(P_ closure);
 170
 171 void
 172 convertFromRBH(closure)  /* The corresponding function in GUM is: */
 173                          /* convertToFetchMe */
 174 P_ closure;
 175 {
 176     P_ ip = (P_) INFO_PTR(closure);
 177     P_ bqe, rbh_save = PrelBase_Z91Z93_closure;
 178     int isSpec;
 179 #if defined(GCap) || defined(GCgn)
 180     rtsBool linked = IS_MUTABLE(ip) && MUT_LINK(closure) != MUT_NOT_LINKED;
 181     P_ oldLink = MUT_LINK(closure);
 182 #endif
 183
 184     switch(INFO_TYPE(ip)) {
 185     case INFO_SPEC_RBH_TYPE:
 186         bqe = (P_) SPEC_RBH_BQ(closure);
 187         isSpec = 1;
 188         break;
 189     case INFO_GEN_RBH_TYPE:
 190         bqe = (P_) GEN_RBH_BQ(closure);
 191         isSpec = 0;
 192         break;
 193     default:
 194 #if 1
 195         fprintf(stderr, "Weird...just tried to convert %#lx (IP %#lx) to FetchMe\n",
 196           closure, ip);
 197 #endif
 198         return;
 199     }
 200
 201 #  if defined(GCap) || defined(GCgn)
 202     /* If the RBH is turned back to a SPEC or GEN closure we have to take
 203        it off  the mutables list */
 204
 205     if (linked) {
 206 #  if defined(GRAN_CHECK)
 207       if (RTSflags.GranFlags.debug & 0x100) {
 208             fprintf(stderr,"\n**>>>> Unlinking closure %#lx from mutables list on PE %d @ %ld (next mutable=%#lx)\n",
 209                            closure,
 210                            where_is(closure), CurrentTime[where_is(closure)],
 211                            MUT_LINK(closure));
 212             GN(closure);
 213           }
 214 #  endif
 215       UnlinkFromMUT(closure);
 216     }
 217 #  endif
 218
 219     /* FETCHME_GA(closure) = ga; */
 220     if (IS_MUTABLE(INFO_PTR(bqe))) {
 221       PROC old_proc = CurrentProc,        /* NB: For AwakenBlockingQueue, */
 222            new_proc = where_is(closure);  /*     CurentProc must be where */
 223                                           /*     closure lives. */
 224       CurrentProc = new_proc;
 225
 226 #  if defined(GRAN_CHECK)
 227       if (RTSflags.GranFlags.debug & 0x100)
 228         fprintf(stderr,"===== AwBQ of node 0x%lx (%s) [PE %2u]\n",
 229                        closure, (isSpec ? "SPEC_RBH" : "GEN_RBH"), new_proc);
 230 #  endif
 231
 232       rbh_save = AwakenBlockingQueue(bqe);     /* AwakenBlockingQueue(bqe); */
 233       CurrentProc = old_proc;
 234     } else {
 235         rbh_save = bqe;
 236     }
 237
 238     /* Put data from special RBH save closures back into the closure */
 239     if ( rbh_save == PrelBase_Z91Z93_closure ) {
 240       fprintf(stderr,"convertFromRBH: No RBH_Save_? closure found at end of BQ!\n");
 241       EXIT(EXIT_FAILURE);
 242     } else {
 243       closure[isSpec ? SPEC_HS : GEN_HS] = rbh_save[SPEC_HS];
 244       closure[(isSpec ? SPEC_HS : GEN_HS) + 1] = rbh_save[SPEC_HS + 1];
 245     }
 246
 247     /* Put back old info pointer (only in GrAnSim) -- HWL */
 248     SET_INFO_PTR(closure, REVERT_INFOPTR(INFO_PTR(closure)));
 249
 250 #  if (defined(GCap) || defined(GCgn))
 251     /* If we convert from an RBH in the old generation,
 252        we have to make sure it goes on the mutables list */
 253
 254     if(closure <= StorageMgrInfo.OldLim) {
 255         if (IS_MUTABLE(INFO_PTR(closure)) && MUT_LINK(closure) == MUT_NOT_LINKED) {
 256             MUT_LINK(closure) = (W_) StorageMgrInfo.OldMutables;
 257             StorageMgrInfo.OldMutables = closure;
 258         }
 259     }
 260 #  endif
 261 }
 262
 263 /* Remove closure from the mutables list */
 264
 265 void
 266 UnlinkFromMUT(P_ closure)
 267 {
 268   P_ curr = StorageMgrInfo.OldMutables, prev = NULL;
 269
 270   while (curr != NULL && curr != closure) {
 271     ASSERT(MUT_LINK(curr)!=MUT_NOT_LINKED);
 272     prev=curr;
 273     curr=MUT_LINK(curr);
 274   }
 275   if (curr==closure) {
 276    if (prev==NULL)
 277      StorageMgrInfo.OldMutables = MUT_LINK(curr);
 278    else
 279      MUT_LINK(prev) = MUT_LINK(curr);
 280    MUT_LINK(curr) = MUT_NOT_LINKED;
 281   }
 282
 283 #if 0 && (defined(GCap) || defined(GCgn))
 284   {
 285     closq newclos;
 286     extern closq ex_RBH_q;
 287
 288     newclos = (closq) stgMallocBytes(sizeof(struct clos), "UnlinkFromMUT");
 289     CLOS_CLOSURE(newclos) = closure;
 290     CLOS_PREV(newclos) = NULL;
 291     CLOS_NEXT(newclos) = ex_RBH_q;
 292     if (ex_RBH_q!=NULL)
 293       CLOS_PREV(ex_RBH_q) = newclos;
 294     ex_RBH_q = newclos;
 295   }
 296 #endif
 297 }
 298
 299 #endif /* PAR */
 300
 301 #endif /* PAR || GRAN -- whole file */
 302 \end{code}