X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fruntime%2Fgum%2FGlobAddr.lc;h=9ab536063589220655b3b2a9dae1a2c01ebfcba6;hb=10521d8418fd3a1cf32882718b5bd28992db36fd;hp=af690e3daf3e3589c7e897d41b699a88bad51490;hpb=e7d21ee4f8ac907665a7e170c71d59e13a01da09;p=ghc-hetmet.git

diff --git a/ghc/runtime/gum/GlobAddr.lc b/ghc/runtime/gum/GlobAddr.lc
index af690e3..9ab5360 100644
--- a/ghc/runtime/gum/GlobAddr.lc
+++ b/ghc/runtime/gum/GlobAddr.lc
@@ -29,15 +29,13 @@ allocGALA(STG_NO_ARGS)
 
     if ((gl = freeGALAList) != NULL) {
 	freeGALAList = gl->next;
-    } else if ((gl = (GALA *) malloc(GCHUNK * sizeof(GALA))) != NULL) {
+    } else {
+	gl = (GALA *) stgMallocBytes(GCHUNK * sizeof(GALA), "allocGALA");
+
 	freeGALAList = gl + 1;
 	for (p = freeGALAList; p < gl + GCHUNK - 1; p++)
 	    p->next = p + 1;
 	p->next = NULL;
-    } else {
-	fflush(stdout);
-	fprintf(stderr, "VM exhausted\n");
-	EXIT(EXIT_FAILURE);
     }
     return gl;
 }
@@ -55,8 +53,7 @@ HashTable *taskIDtoPEtable = NULL;
 static int nextPE = 0;
 
 W_
-taskIDtoPE(gtid)
-GLOBAL_TASK_ID gtid;
+taskIDtoPE(GLOBAL_TASK_ID gtid)
 {
     return (W_) lookupHashTable(taskIDtoPEtable, gtid);
 }
@@ -92,7 +89,7 @@ P_ addr;
     GALA *gala;
 
     /* We never look for GA's on indirections */
-    ASSERT(INFO_PTR(addr) != (W_) Ind_info);
+    ASSERT(INFO_PTR(addr) != (W_) Ind_info_TO_USE);
     if ((gala = lookupHashTable(LAtoGALAtable, (W_) addr)) == NULL)
 	return NULL;
     else
@@ -119,7 +116,7 @@ P_
 GALAlookup(ga)
 globalAddr *ga;
 {
-    W_ pga = PACK_GA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
+    W_ pga = PackGA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
     GALA *gala;
     P_ la;
 
@@ -128,11 +125,12 @@ globalAddr *ga;
     else {
 	la = gala->la; 
 	/* 
-         * Bypass any indirections when returning a local closure to the caller.
-         * Note that we do not short-circuit the entry in the GALA tables right
-         * now, because we would have to do a hash table delete and insert in
-         * the LAtoGALAtable to keep that table up-to-date for preferred GALA pairs.
-         * That's probably a bit expensive.
+	 * Bypass any indirections when returning a local closure to
+	 * the caller.  Note that we do not short-circuit the entry in
+	 * the GALA tables right now, because we would have to do a
+	 * hash table delete and insert in the LAtoGALAtable to keep
+	 * that table up-to-date for preferred GALA pairs.  That's
+	 * probably a bit expensive.
          */
         while (IS_INDIRECTION(INFO_PTR(la)))
 	    la = (P_) IND_CLOSURE_PTR(la);
@@ -165,8 +163,7 @@ Allocate an indirection slot for the closure currently at address @addr@.
 \begin{code}
 
 static GALA *
-allocIndirection(addr)
-P_ addr;
+allocIndirection(P_ addr)
 {
     GALA *gala;
 
@@ -199,7 +196,7 @@ rtsBool preferred;
 {
     GALA *oldGALA = lookupHashTable(LAtoGALAtable, (W_) addr);
     GALA *newGALA = allocIndirection(addr);
-    W_ pga = PACK_GA(thisPE, newGALA->ga.loc.gc.slot);
+    W_ pga = PackGA(thisPE, newGALA->ga.loc.gc.slot);
 
     ASSERT(GALAlookup(&(newGALA->ga)) == NULL);
 
@@ -241,7 +238,7 @@ rtsBool preferred;
 {
     GALA *oldGALA = lookupHashTable(LAtoGALAtable, (W_) addr);
     GALA *newGALA = allocGALA();
-    W_ pga = PACK_GA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
+    W_ pga = PackGA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
 
     ASSERT(ga->loc.gc.gtid != mytid);
     ASSERT(ga->weight > 0);
@@ -303,7 +300,7 @@ globalAddr *
 addWeight(ga)
 globalAddr *ga;
 {
-    W_ pga = PACK_GA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
+    W_ pga = PackGA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
     GALA *gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga);
 
 #ifdef DEBUG_WEIGHT
@@ -357,6 +354,36 @@ RebuildLAGAtable(STG_NO_ARGS)
 	    insertHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
     }
 }
+\end{code}
+
+\begin{code}
+W_
+PackGA (pe, slot)
+  W_ pe;
+  int slot;
+{
+    int pe_shift = (BITS_IN(W_)*3)/4;
+    int pe_bits  = BITS_IN(W_) - pe_shift;
+
+    if ( pe_bits < 8 || slot >= (1L << pe_shift) ) { /* big trouble */
+	fflush(stdout);
+	fprintf(stderr, "PackGA: slot# too big (%d) or not enough pe_bits (%d)\n",slot,pe_bits);
+	EXIT(EXIT_FAILURE);
+    }
+
+    return((((W_)(pe)) << pe_shift) | ((W_)(slot)));
+	
+    /* the idea is to use 3/4 of the bits (e.g., 24) for indirection-
+       table "slot", and 1/4 for the pe# (e.g., 8).
+       
+       We check for too many bits in "slot", and double-check (at
+       compile-time?) that we have enough bits for "pe".  We *don't*
+       check for too many bits in "pe", because SysMan enforces a
+       MAX_PEs limit at the very very beginning.
+
+       Phil & Will 95/08
+    */
+}
 
 #endif /* PAR -- whole file */
 \end{code}