1 files changed, 362 insertions, 0 deletions
diff --git a/ghc/runtime/gum/GlobAddr.lc b/ghc/runtime/gum/GlobAddr.lc
new file mode 100644
index 0000000000..af690e3daf
--- /dev/null
+++ b/ghc/runtime/gum/GlobAddr.lc
@@ -0,0 +1,362 @@
+%
+% (c) The AQUA/Parade Projects, Glasgow University, 1995
+%
+%************************************************************************
+%*                                                                      *
+\section[GlobAddr.lc]{Global Address Manipulation}
+%*									*
+%************************************************************************
+
+\begin{code}
+#ifdef PAR /* whole file */
+
+#include "rtsdefs.h"
+\end{code}
+
+@globalAddr@ structures are allocated in chunks to reduce malloc overhead.
+
+\begin{code}
+
+GALA *freeGALAList = NULL;
+
+#define GCHUNK	    (1024 * sizeof(W_) / sizeof(GALA))
+			    /* Number of globalAddr cells to allocate in one go */
+
+static GALA *
+allocGALA(STG_NO_ARGS)
+{
+    GALA *gl, *p;
+
+    if ((gl = freeGALAList) != NULL) {
+	freeGALAList = gl->next;
+    } else if ((gl = (GALA *) malloc(GCHUNK * sizeof(GALA))) != NULL) {
+	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;
+}
+
+\end{code}
+
+We don't really like GLOBAL_TASK_ID, so we keep a table of TASK_ID to
+PE mappings.  The idea is that a PE identifier will fit in 16 bits, whereas 
+a TASK_ID may not.
+
+\begin{code}
+
+HashTable *taskIDtoPEtable = NULL;
+
+static int nextPE = 0;
+
+W_
+taskIDtoPE(gtid)
+GLOBAL_TASK_ID gtid;
+{
+    return (W_) lookupHashTable(taskIDtoPEtable, gtid);
+}
+
+int thisPE;
+
+void 
+registerTask(gtid)
+GLOBAL_TASK_ID gtid;
+{
+    if (gtid == mytid)
+	thisPE = nextPE;
+
+    insertHashTable(taskIDtoPEtable, gtid, (void *) (W_) nextPE++);
+}
+
+\end{code}
+
+The local address to global address mapping returns a globalAddr structure
+(pe task id, slot, weight) for any closure in the local heap which has a
+global identity.  Such closures may be copies of normal form objects with
+a remote `master' location, @FetchMe@ nodes referencing remote objects, or
+globally visible objects in the local heap (for which we are the master).
+
+\begin{code}
+
+HashTable *LAtoGALAtable = NULL;
+
+globalAddr *
+LAGAlookup(addr)
+P_ addr;
+{
+    GALA *gala;
+
+    /* We never look for GA's on indirections */
+    ASSERT(INFO_PTR(addr) != (W_) Ind_info);
+    if ((gala = lookupHashTable(LAtoGALAtable, (W_) addr)) == NULL)
+	return NULL;
+    else
+	return &(gala->ga);
+}
+
+\end{code}
+
+We also manage a mapping of global addresses to local addresses, so that
+we can ``common up'' multiple references to the same object as they arrive
+in data packets from remote PEs.
+
+The global address to local address mapping is actually managed via a
+``packed global address'' to GALA hash table.  The packed global
+address takes the interesting part of the @globalAddr@ structure
+(i.e. the pe and slot fields) and packs them into a single word
+suitable for hashing.
+
+\begin{code}
+
+HashTable *pGAtoGALAtable = NULL;
+
+P_
+GALAlookup(ga)
+globalAddr *ga;
+{
+    W_ pga = PACK_GA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
+    GALA *gala;
+    P_ la;
+
+    if ((gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga)) == NULL)
+	return NULL;
+    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.
+         */
+        while (IS_INDIRECTION(INFO_PTR(la)))
+	    la = (P_) IND_CLOSURE_PTR(la);
+	return la;
+    }
+}
+
+\end{code}
+
+External references to our globally-visible closures are managed through an
+indirection table.  The idea is that the closure may move about as the result
+of local garbage collections, but its global identity is determined by its
+slot in the indirection table, which never changes.
+
+The indirection table is maintained implicitly as part of the global
+address to local address table.  We need only keep track of the
+highest numbered indirection index allocated so far, along with a free
+list of lower numbered indices no longer in use.
+
+\begin{code}
+
+static I_ nextIndirection = 0;
+
+GALA *freeIndirections = NULL;
+
+\end{code}
+
+Allocate an indirection slot for the closure currently at address @addr@.
+
+\begin{code}
+
+static GALA *
+allocIndirection(addr)
+P_ addr;
+{
+    GALA *gala;
+
+    if ((gala = freeIndirections) != NULL) {
+        freeIndirections = gala->next;
+    } else {
+	gala = allocGALA();
+        gala->ga.loc.gc.gtid = mytid;
+        gala->ga.loc.gc.slot = nextIndirection++;
+    }
+    gala->ga.weight = MAX_GA_WEIGHT;
+    gala->la = addr;
+    return gala;
+}
+
+\end{code}
+
+Make a local closure at @addr@ globally visible.  We have to allocate an
+indirection slot for it, and update both the local address to global address
+and global address to local address maps.
+
+\begin{code}
+
+GALA *liveIndirections = NULL;
+
+globalAddr *
+MakeGlobal(addr, preferred)
+P_ addr;
+rtsBool preferred;
+{
+    GALA *oldGALA = lookupHashTable(LAtoGALAtable, (W_) addr);
+    GALA *newGALA = allocIndirection(addr);
+    W_ pga = PACK_GA(thisPE, newGALA->ga.loc.gc.slot);
+
+    ASSERT(GALAlookup(&(newGALA->ga)) == NULL);
+
+    newGALA->la = addr;
+    newGALA->preferred = preferred;
+
+    if (preferred) {
+	/* The new GA is now the preferred GA for the LA */
+	if (oldGALA != NULL) {
+	    oldGALA->preferred = rtsFalse;
+	    (void) removeHashTable(LAtoGALAtable, (W_) addr, (void *) oldGALA);
+	}
+	insertHashTable(LAtoGALAtable, (W_) addr, (void *) newGALA);
+    }
+
+    newGALA->next = liveIndirections;
+    liveIndirections = newGALA;
+
+    insertHashTable(pGAtoGALAtable, pga, (void *) newGALA);
+
+    return &(newGALA->ga);
+}
+
+\end{code}
+
+Assign an existing remote global address to an existing closure.
+We do not retain the @globalAddr@ structure that's passed in as an argument,
+so it can be a static in the calling routine.
+
+\begin{code}
+
+GALA *liveRemoteGAs = NULL;
+
+globalAddr *
+setRemoteGA(addr, ga, preferred)
+P_ addr;
+globalAddr *ga;
+rtsBool preferred;
+{
+    GALA *oldGALA = lookupHashTable(LAtoGALAtable, (W_) addr);
+    GALA *newGALA = allocGALA();
+    W_ pga = PACK_GA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
+
+    ASSERT(ga->loc.gc.gtid != mytid);
+    ASSERT(ga->weight > 0);
+    ASSERT(GALAlookup(ga) == NULL);
+
+    newGALA->ga = *ga;
+    newGALA->la = addr;
+    newGALA->preferred = preferred;
+
+    if (preferred) {
+	/* The new GA is now the preferred GA for the LA */
+	if (oldGALA != NULL) {
+	    oldGALA->preferred = rtsFalse;
+	    (void) removeHashTable(LAtoGALAtable, (W_) addr, (void *) oldGALA);
+	}
+	insertHashTable(LAtoGALAtable, (W_) addr, (void *) newGALA);
+    }
+    newGALA->next = liveRemoteGAs;
+    liveRemoteGAs = newGALA;
+
+    insertHashTable(pGAtoGALAtable, pga, (void *) newGALA);
+
+    ga->weight = 0;
+
+    return &(newGALA->ga);
+}
+\end{code}
+
+Give me a bit of weight to give away on a new reference to a particular global
+address.  If we run down to nothing, we have to assign a new GA.
+
+\begin{code}
+
+void
+splitWeight(to, from)
+globalAddr *to, *from;
+{
+    /* Make sure we have enough weight to split */
+    if (from->weight == 1)
+	from = MakeGlobal(GALAlookup(from), rtsTrue);
+
+    to->loc = from->loc;
+
+    if (from->weight == 0)
+	to->weight = 1L << (BITS_IN(unsigned) - 1);
+    else
+	to->weight = from->weight / 2;
+
+    from->weight -= to->weight;
+}
+
+\end{code}
+
+Here, I am returning a bit of weight that a remote PE no longer needs.
+
+\begin{code}
+
+globalAddr *
+addWeight(ga)
+globalAddr *ga;
+{
+    W_ pga = PACK_GA(taskIDtoPE(ga->loc.gc.gtid), ga->loc.gc.slot);
+    GALA *gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga);
+
+#ifdef DEBUG_WEIGHT
+    fprintf(stderr, "Adding weight %x to (%x, %d, %x), preferred = %d\n", ga->weight,
+      gala->ga.loc.gc.gtid, gala->ga.loc.gc.slot, gala->ga.weight, gala->preferred);
+#endif
+    gala->ga.weight += ga->weight;    
+    ga->weight = 0;
+
+    return &(gala->ga);
+}
+
+\end{code}
+
+Initialize all of the global address structures: the task ID to PE id
+map, the local address to global address map, the global address to
+local address map, and the indirection table.
+
+\begin{code}
+
+void
+initGAtables(STG_NO_ARGS)
+{
+    taskIDtoPEtable = allocHashTable();
+    LAtoGALAtable = allocHashTable();
+    pGAtoGALAtable = allocHashTable();
+}
+
+\end{code}
+
+Rebuild the LA->GA table, assuming that the addresses in the GALAs are correct.
+
+\begin{code}
+
+void
+RebuildLAGAtable(STG_NO_ARGS)
+{
+    GALA *gala;
+
+    /* The old LA->GA table is worthless */
+    freeHashTable(LAtoGALAtable, NULL);
+    LAtoGALAtable = allocHashTable();
+
+    for (gala = liveIndirections; gala != NULL; gala = gala->next) {
+	if (gala->preferred)
+	    insertHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
+    }
+
+    for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
+	if (gala->preferred)
+	    insertHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
+    }
+}
+
+#endif /* PAR -- whole file */
+\end{code}