[project @ 2000-05-10 09:00:20 by sewardj]
[ghc-hetmet.git] / ghc / rts / Assembler.c
index e2a4451..fa0984a 100644 (file)
@@ -5,8 +5,8 @@
  * Copyright (c) 1994-1998.
  *
  * $RCSfile: Assembler.c,v $
- * $Revision: 1.17 $
- * $Date: 1999/11/19 13:54:53 $
+ * $Revision: 1.29 $
+ * $Date: 2000/05/10 09:00:20 $
  *
  * This module provides functions to construct BCOs and other closures
  * required by the bytecode compiler.
 #include "Assembler.h"
 #undef INSIDE_ASSEMBLER_C
 
-/* --------------------------------------------------------------------------
- * References between BCOs
- *
- * These are necessary because there can be circular references between 
- * BCOs so we have to keep track of all the references to each object
- * and fill in all the references once we're done.
- *
- * ToDo: generalise to allow references between any objects
- * ------------------------------------------------------------------------*/
+static StgClosure* asmAlloc ( nat size );
+extern void* getNameOrTupleClosureCPtr ( int /*Cell*/ c );
 
-typedef struct {
-    AsmObject ref;  /* who refers to it                       */
-    AsmNat i;       /* index into some table held by referer  */
-} AsmRef;
 
-/* --------------------------------------------------------------------------
- * Queues (of instructions, ptrs, nonptrs)
- * ------------------------------------------------------------------------*/
-
-#define Queue Instrs
-#define Type  StgWord8
-#include "QueueTemplate.h"
-#undef Type
-#undef Queue
-
-#define Queue Ptrs
-#define Type  AsmObject
-#include "QueueTemplate.h"
-#undef Type
-#undef Queue
-
-#define Queue Refs
-#define Type  AsmRef
-#include "QueueTemplate.h"
-#undef Type
-#undef Queue
-
-#define Queue NonPtrs
-#define Type  StgWord
-#include "QueueTemplate.h"
-#undef Type
-#undef Queue
+/* Defined in this file ... */
+AsmObject    asmNewObject      ( void );
+void         asmAddEntity      ( AsmObject, Asm_Kind, StgWord );
+int          asmCalcHeapSizeW  ( AsmObject );
+StgClosure*  asmDerefEntity    ( Asm_Entity );
 
 /* --------------------------------------------------------------------------
- * AsmObjects are used to build heap objects.
- *
- * AsmObjects can contain circular references to each other
- * so we have to keep track of all the references which can't be filled
- * in yet.
- *
- * When we finish building an AsmObject, we allocate an actual heap object and
- * fill in all the references to the asmObject with pointers to the heap object.
- *
- * We obtain a limited form of polymorphism through inheritance by putting 
- * the AsmObject first in every structure (as in C++ implementations).
- * We use the closure type of the allocated object to figure out
- * where the payload lives in the closure.
+ * Initialising and managing objects and entities
  * ------------------------------------------------------------------------*/
-/* ToDo: clean up terminology: is Closure right or should it be object or ... */
 
-struct AsmObject_ {
-    Refs           refs;
-    Ptrs           ptrs;
-    AsmNat         num_unresolved; /* number of unfilled references */
-    StgClosure*    closure;        /* where object was allocated    */
-};
-    
-struct AsmCon_ {
-    struct AsmObject_ object;  /* must be first in struct */
+static struct AsmObject_* objects;
+
+#define INITIALISE_TABLE(Type,table,size,used)                       \
+   size = used = 0;                                                  \
+   table = NULL;
+
+#define ENSURE_SPACE_IN_TABLE(Type,table,size,used)                  \
+   if (used == size) {                                               \
+      Type* new;                                                     \
+      size = (size ? 2*size : 1);                                    \
+      new = malloc ( size * sizeof(Type));                           \
+      if (!new)                                                      \
+         barf("bytecode assembler: can't expand table of type "      \
+              #Type);                                                \
+      memcpy ( new, table, used * sizeof(Type) );                    \
+      if (table) free(table);                                        \
+      table = new;                                                   \
+   }
 
-    AsmInfo info;
-};
-  
-struct AsmCAF_ {
-    struct AsmObject_ object;  /* must be first in struct */
-};
+void asmInitialise ( void )
+{
+   objects = NULL;
+}
 
-struct AsmBCO_ {
-    struct AsmObject_ object;  /* must be first in struct */
 
-    Instrs   is;          
-    NonPtrs  nps;
+AsmObject asmNewObject ( void )
+{
+   AsmObject obj = malloc(sizeof(struct AsmObject_));
+   if (!obj)
+      barf("bytecode assembler: can't malloc in asmNewObject");
+   obj->next    = objects;
+   objects      = obj;
+   obj->n_refs  = obj->n_words = obj->n_insns = 0;
+   obj->closure = NULL;
+   obj->magic   = 0x31415927;
+   INITIALISE_TABLE(AsmEntity,obj->entities,
+                              obj->sizeEntities,
+                              obj->usedEntities);
+   return obj;
+}
 
-    int /*StgExpr*/  stgexpr;    
 
-    /* abstract machine ("executed" during compilation) */
-    AsmSp    sp;          /* stack ptr */
-    AsmSp    max_sp;
-    StgWord  hp;          /* heap ptr  */
-    StgWord  max_hp;
-    Instr    lastOpc;
-};
-
-static void asmResolveRef( AsmObject obj, AsmNat i, AsmClosure reference )
+void asmAddEntity ( AsmObject   obj, 
+                    Asm_Kind    kind,
+                    StgWord     val )
 {
-    ASSERT(obj->closure);
-    switch (get_itbl(obj->closure)->type) {
-    case BCO:
-        {
-            StgBCO* bco = stgCast(StgBCO*,obj->closure);
-            ASSERT(i < bco->n_ptrs && bcoConstPtr(bco,i) == NULL);
-            bcoConstCPtr(bco,i) = reference;
-            break;
-        }
-    case CAF_UNENTERED:
-        {
-            StgCAF* caf = stgCast(StgCAF*,obj->closure);
-            ASSERT(i == 0 && caf->body == NULL);
-            caf->body = reference;
-            break;
-        }
-    case CONSTR:
-        {
-            StgClosure* con = stgCast(StgClosure*,obj->closure);
-            ASSERT(i < get_itbl(con)->layout.payload.nptrs && payloadCPtr(con,i) == NULL);
-            payloadCPtr(con,i) = reference;
-            break;
-        }
-    case AP_UPD:
-        {
-            StgAP_UPD* ap = stgCast(StgAP_UPD*,obj->closure);
-            ASSERT(i < 1+ap->n_args);
-            if (i==0) {
-                ASSERT(ap->fun == NULL);
-                ap->fun = reference;
-            } else {
-                ASSERT(payloadCPtr(ap,i-1) == NULL);
-                payloadCPtr(ap,i-1) = reference;
-            }
-            break;
-        }
-    default:
-            barf("asmResolveRef");
-    }
-    obj->num_unresolved -= 1;
+   ENSURE_SPACE_IN_TABLE(
+      Asm_Entity,obj->entities,
+      obj->sizeEntities,obj->usedEntities);
+   obj->entities[obj->usedEntities].kind = kind;
+   obj->entities[obj->usedEntities].val  = val;
+   obj->usedEntities++;
+   switch (kind) {
+      case Asm_RefNoOp: case Asm_RefObject: case Asm_RefHugs: 
+         obj->n_refs++; break;
+      case Asm_NonPtrWord: 
+         obj->n_words++; break;
+      case Asm_Insn8:
+         obj->n_insns++; break;
+      default:
+         barf("asmAddEntity");
+   }
 }
 
-static void asmAddRef( AsmObject referent, AsmObject referer, AsmNat i )
+static int asmFindInNonPtrs ( AsmBCO bco, StgWord w )
 {
-    if (referent->closure) {
-        asmResolveRef(referer,i,(AsmClosure)referent->closure);
-    } else {
-        insertRefs(&(referent->refs),(AsmRef){referer,i});
-    }
+   int i, j = 0;
+   for (i = 0; i < bco->usedEntities; i++) {
+      if (bco->entities[i].kind == Asm_NonPtrWord) {
+         if (bco->entities[i].val == w) return j;
+         j++;
+      }
+   }
+   return -1;
 }
 
-void asmAddPtr( AsmObject obj, AsmObject arg )
+static void setInstrs ( AsmBCO bco, int instr_no, StgWord new_instr_byte )
 {
-    ASSERT(obj->closure == 0); /* can't extend an object once it's allocated */
-    insertPtrs( &obj->ptrs, arg );
+   int i, j = 0;
+   for (i = 0; i < bco->usedEntities; i++) {
+      if (bco->entities[i].kind == Asm_Insn8) {
+         if (j == instr_no) {
+            bco->entities[i].val = new_instr_byte;
+            return;
+         }
+         j++;
+      }
+   }
+   barf("setInstrs");
 }
 
-static void asmBeginObject( AsmObject obj )
+void* asmGetClosureOfObject ( AsmObject obj )
 {
-    obj->closure = NULL;
-    obj->num_unresolved = 0;
-    initRefs(&obj->refs);
-    initPtrs(&obj->ptrs);
+   return obj->closure;
 }
 
-static void asmEndObject( AsmObject obj, StgClosure* c )
-{
-    obj->num_unresolved = obj->ptrs.len;
-    obj->closure = c;
-    mapQueue(Ptrs,    AsmObject, obj->ptrs, asmAddRef(x,obj,i));
-    mapQueue(Refs,    AsmRef,    obj->refs, asmResolveRef(x.ref,x.i,c));
 
-    if (obj->num_unresolved == 0) {
-        freePtrs(&obj->ptrs);
-        freeRefs(&obj->refs);
-        /* we don't print until all ptrs are resolved */
-        IF_DEBUG(codegen,printObj(obj->closure));
-    }
-}
+/* --------------------------------------------------------------------------
+ * Top level assembler/BCO linker functions
+ * ------------------------------------------------------------------------*/
 
-int asmObjectHasClosure ( AsmObject obj )
-{
-    return (obj->num_unresolved == 0 && obj->closure);
+int asmCalcHeapSizeW ( AsmObject obj )
+{
+   int p, np, is, ws;
+   switch (obj->kind) {
+      case Asm_BCO:
+         p  = obj->n_refs;
+         np = obj->n_words;
+         is = obj->n_insns + (obj->max_sp <= 255 ? 2 : 3);
+         ws = BCO_sizeW ( p, np, is );
+         break;
+      case Asm_CAF:
+         ws = CAF_sizeW();
+         break;
+      case Asm_Con:
+         p  = obj->n_refs;
+         np = obj->n_words;
+         ws = CONSTR_sizeW ( p, np );
+         break;
+      default:
+         barf("asmCalcHeapSizeW");
+   }
+   if (ws - sizeofW(StgHeader) < MIN_NONUPD_SIZE)
+      ws = sizeofW(StgHeader) + MIN_NONUPD_SIZE;
+   return ws;
 }
 
-AsmClosure asmClosureOfObject ( AsmObject obj )
+
+void asmAllocateHeapSpace ( void )
 {
-    ASSERT(asmObjectHasClosure(obj));
-    return obj->closure;
+   AsmObject obj;
+   for (obj = objects; obj; obj = obj->next) {
+      StgClosure* c = asmAlloc ( asmCalcHeapSizeW ( obj ) );
+      obj->closure = c;
+   }
 }
 
-void asmMarkObject ( AsmObject obj )
+void asmShutdown ( void ) 
 {
-    ASSERT(obj->num_unresolved == 0 && obj->closure);
-    obj->closure = MarkRoot(obj->closure);
+   AsmObject obj;
+   AsmObject next = NULL;
+   for (obj = objects; obj; obj = next) {
+      next = obj->next;
+      obj->magic = 0x27180828;
+      if ( /*paranoia*/ obj->entities)
+         free(obj->entities);
+      free(obj);
+   }
+   objects = NULL;
+}
+
+StgClosure* asmDerefEntity ( Asm_Entity entity )
+{
+   switch (entity.kind) {
+      case Asm_RefNoOp:
+         return (StgClosure*)entity.val;
+      case Asm_RefObject:
+         ASSERT(entity.val);
+         ASSERT( ((AsmObject)(entity.val))->magic == 0x31415927 );
+         return ((AsmObject)(entity.val))->closure;
+      case Asm_RefHugs:
+         return getNameOrTupleClosureCPtr(entity.val);
+      default:
+         barf("asmDerefEntity");
+   }
+   return NULL; /*notreached*/
+}
+
+void asmCopyAndLink ( void )
+{
+   int       j, k;
+   AsmObject obj;
+
+   for (obj = objects; obj; obj = obj->next) {
+      StgClosure** p   = (StgClosure**)(obj->closure);
+      ASSERT(p);
+
+      switch (obj->kind) {
+
+         case Asm_BCO: {
+            AsmBCO  abco  = (AsmBCO)obj;
+            StgBCO* bco   = (StgBCO*)p;
+            SET_HDR(bco,&BCO_info,??);
+            bco->n_ptrs   = abco->n_refs;
+            bco->n_words  = abco->n_words;
+            bco->n_instrs = abco->n_insns + (obj->max_sp <= 255 ? 2 : 3);
+            bco->stgexpr  = abco->stgexpr;
+
+            /* First copy in the ptrs. */
+            k = 0;
+            for (j = 0; j < obj->usedEntities; j++) {
+               switch (obj->entities[j].kind) {
+               case Asm_RefNoOp: 
+               case Asm_RefObject:
+               case Asm_RefHugs:
+                  bcoConstCPtr(bco,k++) 
+                     = (StgClosure*)asmDerefEntity(obj->entities[j]); break;
+               default: 
+                  break;
+               }
+            }
+
+            /* Now the non-ptrs. */
+            k = 0;
+            for (j = 0; j < obj->usedEntities; j++) {
+               switch (obj->entities[j].kind) {
+               case Asm_NonPtrWord: 
+                  bcoConstWord(bco,k++) = obj->entities[j].val; break;
+               default: 
+                  break;
+               }
+            }
+
+            /* Finally the insns, adding a stack check at the start. */
+            k = 0;
+            abco->max_sp = stg_max(abco->sp,abco->max_sp);
+
+            ASSERT(abco->max_sp <= 65535);
+            if (abco->max_sp <= 255) {
+               bcoInstr(bco,k++) = i_STK_CHECK;
+               bcoInstr(bco,k++) = abco->max_sp;
+            } else {
+               bcoInstr(bco,k++) = i_STK_CHECK_big;
+               bcoInstr(bco,k++) = abco->max_sp / 256;
+               bcoInstr(bco,k++) = abco->max_sp % 256;
+            }
+            for (j = 0; j < obj->usedEntities; j++) {
+               switch (obj->entities[j].kind) {
+               case Asm_Insn8:
+                  bcoInstr(bco,k++) = obj->entities[j].val; break;
+               case Asm_RefNoOp: 
+               case Asm_RefObject:
+               case Asm_RefHugs:
+               case Asm_NonPtrWord:
+                  break;
+               default: 
+                  barf("asmCopyAndLink: strange stuff in AsmBCO");
+               }
+            }
+
+            ASSERT((unsigned int)k == bco->n_instrs);
+            break;
+         }
+
+         case Asm_CAF: {
+            StgCAF* caf = (StgCAF*)p;
+            SET_HDR(caf,&CAF_UNENTERED_info,??); 
+            caf->link     = NULL;
+            caf->mut_link = NULL;
+            caf->value    = (StgClosure*)0xdeadbeef;
+            ASSERT(obj->usedEntities == 1);
+            switch (obj->entities[0].kind) {
+               case Asm_RefNoOp:
+               case Asm_RefObject:
+               case Asm_RefHugs:
+                  caf->body = (StgClosure*)asmDerefEntity(obj->entities[0]);
+                  break;
+               default:
+                  barf("asmCopyAndLink: strange stuff in AsmCAF");
+            }
+            p += CAF_sizeW();
+            break;
+         }
+
+         case Asm_Con: {            
+            SET_HDR((StgClosure*)p,obj->itbl,??);
+            p++;
+            /* First put in the pointers, then the non-pointers. */
+            for (j = 0; j < obj->usedEntities; j++) {
+               switch (obj->entities[j].kind) {
+               case Asm_RefNoOp: 
+               case Asm_RefObject:
+               case Asm_RefHugs:
+                  *p++ = asmDerefEntity(obj->entities[j]); break;
+               default: 
+                  break;
+               }
+            }
+            for (j = 0; j < obj->usedEntities; j++) {
+               switch (obj->entities[j].kind) {
+               case Asm_NonPtrWord: 
+                 *p++ = (StgClosure*)(obj->entities[j].val); break;
+               default: 
+                 barf("asmCopyAndLink: strange stuff in AsmCon");
+               }
+            }
+            break;
+         }
+
+         default:
+            barf("asmCopyAndLink");
+      }
+   }
 }
 
+
 /* --------------------------------------------------------------------------
- * Heap allocation
+ * Keeping track of the simulated stack pointer
  * ------------------------------------------------------------------------*/
 
 static StgClosure* asmAlloc( nat size )
@@ -262,26 +380,6 @@ static StgClosure* asmAlloc( nat size )
     return o;
 }
 
-static void grabHpUpd( AsmBCO bco, nat size )
-{
-    /* ToDo: sometimes we should test for MIN_UPD_SIZE instead */
-    ASSERT( size >= MIN_UPD_SIZE + sizeofW(StgHeader) );
-    bco->hp += size;
-}
-
-static void grabHpNonUpd( AsmBCO bco, nat size )
-{
-    /* ToDo: sometimes we should test for MIN_UPD_SIZE instead */
-    ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
-    bco->hp += size;
-}
-
-static void resetHp( AsmBCO bco, nat hp )
-{
-    bco->max_hp = stg_max(bco->hp,bco->max_hp);
-    bco->hp     = hp;
-}
-
 static void setSp( AsmBCO bco, AsmSp sp )
 {
     bco->max_sp = stg_max(bco->sp,bco->max_sp);
@@ -307,128 +405,81 @@ static void decSp ( AsmBCO bco, int sp_delta )
  * 
  * ------------------------------------------------------------------------*/
 
-AsmObject asmMkObject( AsmClosure c )
-{
-    AsmObject obj = malloc(sizeof(struct AsmObject_));
-    if (obj == NULL) {
-        barf("Can't allocate AsmObject");
-    }
-    asmBeginObject(obj);
-    asmEndObject(obj,c);
-    return obj;
-}
-
 AsmCon asmBeginCon( AsmInfo info )
 {
-    AsmCon con = malloc(sizeof(struct AsmCon_));
-    if (con == NULL) {
-        barf("Can't allocate AsmCon");
-    }
-    asmBeginObject(&con->object);
-    con->info = info;
-    return con;
+   AsmCon con = asmNewObject();
+   con->kind = Asm_Con;
+   con->itbl = info;
+   return con;
 }
 
-void asmEndCon( AsmCon con )
+void asmEndCon( AsmCon con __attribute__ ((unused)) )
 {
-    nat p  = con->object.ptrs.len;
-    nat np = stg_max(0,MIN_NONUPD_SIZE-p);
-
-    StgClosure* c = asmAlloc(CONSTR_sizeW(p,np));
-    StgClosure* o = stgCast(StgClosure*,c);
-    SET_HDR(o,con->info,??);
-    mapQueue(Ptrs,    AsmObject, con->object.ptrs, payloadCPtr(o,i) = NULL);
-    { nat i; for( i=0; i<np; ++i ) { payloadWord(o,p+i) = 0xdeadbeef; } }
-    asmEndObject(&con->object,c);
 }
 
 AsmCAF asmBeginCAF( void )
 {
-    AsmCAF caf = malloc(sizeof(struct AsmCAF_));
-    if (caf == NULL) {
-        barf("Can't allocate AsmCAF");
-    }
-    asmBeginObject(&caf->object);
-    return caf;
+   AsmCAF caf = asmNewObject();
+   caf->kind = Asm_CAF;
+   return caf;
 }
 
-void asmEndCAF( AsmCAF caf, AsmBCO body )
+void asmEndCAF( AsmCAF caf __attribute__ ((unused)) )
 {
-    StgClosure* c = asmAlloc(CAF_sizeW());
-    StgCAF*     o = stgCast(StgCAF*,c);
-    SET_HDR(o,&CAF_UNENTERED_info,??);
-    o->body  = NULL;
-    o->value = stgCast(StgClosure*,0xdeadbeef);
-    o->link  = stgCast(StgCAF*,0xdeadbeef);
-    o->mut_link = NULL;
-    asmAddPtr(&caf->object,&body->object);
-    asmEndObject(&caf->object,c);
 }
 
 AsmBCO asmBeginBCO( int /*StgExpr*/ e )
 {
-    AsmBCO bco = malloc(sizeof(struct AsmBCO_));
-    if (bco == NULL) {
-        barf("Can't allocate AsmBCO");
-    }
-    asmBeginObject(&bco->object);
-    initInstrs(&bco->is);
-    initNonPtrs(&bco->nps);
-
-    bco->stgexpr = e;
-    bco->max_sp = bco->sp = 0;
-    bco->max_hp = bco->hp = 0;
-    bco->lastOpc = i_INTERNAL_ERROR;
-    return bco;
+   AsmBCO bco = asmNewObject();
+   bco->kind    = Asm_BCO;
+   bco->stgexpr = e;
+   bco->sp      = 0;
+   bco->max_sp  = 0;
+   bco->lastOpc = i_INTERNAL_ERROR;
+   return bco;
 }
 
-void asmEndBCO( AsmBCO bco )
-{
-    nat p  = bco->object.ptrs.len;
-    nat np = bco->nps.len;
-    nat is = bco->is.len + (bco->max_sp <= 255 ? 2 : 3);  /* 2 or 3 for stack check */
-
-    StgClosure* c = asmAlloc(BCO_sizeW(p,np,is));
-    StgBCO*     o = stgCast(StgBCO*,c);
-    SET_HDR(o,&BCO_info,??);
-    o->n_ptrs   = p;
-    o->n_words  = np;
-    o->n_instrs = is;
-    o->stgexpr  = bco->stgexpr;
-    mapQueue(Ptrs,    AsmObject, bco->object.ptrs, bcoConstCPtr(o,i) = NULL);
-    mapQueue(NonPtrs, StgWord,   bco->nps,  bcoConstWord(o,i) = x);
-    {
-        nat j = 0;
-        bco->max_sp = stg_max(bco->sp,bco->max_sp);
-        bco->max_hp = stg_max(bco->hp,bco->max_hp);
-
-        ASSERT(bco->max_sp <= 65535);
-        if (bco->max_sp <= 255) {
-           bcoInstr(o,j++) = i_STK_CHECK;
-           bcoInstr(o,j++) = bco->max_sp;
-        } else {
-           bcoInstr(o,j++) = i_STK_CHECK_big;
-           bcoInstr(o,j++) = bco->max_sp / 256;
-           bcoInstr(o,j++) = bco->max_sp % 256;
-        }
-
-        mapQueue(Instrs,  StgWord8,   bco->is,   bcoInstr(o,j++) = x);
-        ASSERT(j == is);
-    }
-    freeInstrs(&bco->is);
-    freeNonPtrs(&bco->nps);
-    asmEndObject(&bco->object,c);
+void asmEndBCO( AsmBCO bco __attribute__ ((unused)) )
+{
 }
 
 /* --------------------------------------------------------------------------
  * 
  * ------------------------------------------------------------------------*/
 
+static void asmAddInstr ( AsmBCO bco, StgWord i )
+{
+   asmAddEntity ( bco, Asm_Insn8, i );
+}
+
+static void asmAddNonPtrWord ( AsmObject obj, StgWord i )
+{
+   asmAddEntity ( obj, Asm_NonPtrWord, i );
+}
+
+void asmAddRefHugs ( AsmObject obj,int /*Name*/ n )
+{
+   asmAddEntity ( obj, Asm_RefHugs, n );
+}
+
+void asmAddRefObject ( AsmObject obj, AsmObject p )
+{
+   ASSERT(p->magic == 0x31415927);
+   asmAddEntity ( obj, Asm_RefObject, (StgWord)p );
+}
+
+void asmAddRefNoOp ( AsmObject obj, StgPtr p )
+{
+   asmAddEntity ( obj, Asm_RefNoOp, (StgWord)p );
+}
+
+
+
 static void asmInstrOp ( AsmBCO bco, StgWord i )
 {
     ASSERT(i <= BIGGEST_OPCODE); /* must be a valid opcode */
     bco->lastOpc = i;
-    insertInstrs(&(bco->is),i);
+    asmAddInstr(bco,i);
 }
 
 static void asmInstr8 ( AsmBCO bco, StgWord i )
@@ -436,16 +487,17 @@ static void asmInstr8 ( AsmBCO bco, StgWord i )
   if (i >= 256) {
     ASSERT(i < 256); /* must be a byte */
   }
-    insertInstrs(&(bco->is),i);
+    asmAddInstr(bco,i);
 }
 
 static void asmInstr16 ( AsmBCO bco, StgWord i )
 {
     ASSERT(i < 65536); /* must be a short */
-    insertInstrs(&(bco->is),i / 256);
-    insertInstrs(&(bco->is),i % 256);
+    asmAddInstr(bco,i / 256);
+    asmAddInstr(bco,i % 256);
 }
 
+#if 0
 static Instr asmInstrBack ( AsmBCO bco, StgWord n )
 {
    return bco->is.elems[bco->is.len - n];
@@ -456,25 +508,16 @@ static void asmInstrRecede ( AsmBCO bco, StgWord n )
    if (bco->is.len < n) barf("asmInstrRecede");
    bco->is.len -= n;
 }
+#endif
 
-static void asmPtr( AsmBCO bco, AsmObject x )
-{
-    insertPtrs( &bco->object.ptrs, x );
-}
-
-static void asmWord( AsmBCO bco, StgWord i )
-{
-    insertNonPtrs( &bco->nps, i );
-}
-
-#define asmWords(bco,ty,x)                               \
+#define asmAddNonPtrWords(bco,ty,x)                      \
     {                                                    \
         union { ty a; AsmWord b[sizeofW(ty)]; } p;       \
         nat i;                                           \
         if (sizeof(ty) < sizeof(AsmWord)) p.b[0]=0;      \
         p.a = x;                                         \
         for( i = 0; i < sizeofW(ty); i++ ) {             \
-            asmWord(bco,p.b[i]);                         \
+            asmAddNonPtrWord(bco,p.b[i]);                \
         }                                                \
     }
 
@@ -500,8 +543,8 @@ static StgWord repSizeW( AsmRep rep )
     case FOREIGN_REP: 
 #endif
     case ALPHA_REP:    /* a                        */ 
-    case BETA_REP:     /* b                       */ 
-    case GAMMA_REP:    /* c                       */ 
+    case BETA_REP:     /* b                        */ 
+    case GAMMA_REP:    /* c                       */ 
     case DELTA_REP:    /* d                       */ 
     case HANDLER_REP:  /* IOError -> IO a         */ 
     case ERROR_REP:    /* IOError                 */ 
@@ -532,6 +575,7 @@ int asmRepSizeW ( AsmRep rep )
 
 static void emiti_ ( AsmBCO bco, Instr opcode )
 {
+#if 0
    StgInt x, y;
    if (bco->lastOpc == i_SLIDE && opcode == i_ENTER) {
       /* SLIDE x y ; ENTER   ===>  SE x y */
@@ -553,10 +597,14 @@ static void emiti_ ( AsmBCO bco, Instr opcode )
    else {
       asmInstrOp(bco,opcode);
    }
+#else
+   asmInstrOp(bco,opcode);
+#endif
 }
 
 static void emiti_8 ( AsmBCO bco, Instr opcode, int arg1 )
 {
+#if 0
    StgInt x;
    if (bco->lastOpc == i_VAR && opcode == i_VAR) {
       /* VAR x ; VAR y ===>  VV x y */
@@ -575,6 +623,10 @@ static void emiti_8 ( AsmBCO bco, Instr opcode, int arg1 )
       asmInstrOp(bco,opcode);
       asmInstr8(bco,arg1);
    }
+#else
+   asmInstrOp(bco,opcode);
+   asmInstr8(bco,arg1);
+#endif
 }
 
 static void emiti_16 ( AsmBCO bco, Instr opcode, int arg1 )
@@ -764,6 +816,13 @@ static void emit_i_RETADDR ( AsmBCO bco, int arg1 )
       emiti_16(bco,i_RETADDR_big,arg1);
 }
 
+static void emit_i_ALLOC_CONSTR ( AsmBCO bco, int arg1 )
+{
+   ASSERT(arg1 >= 0);
+   if (arg1 < 256)
+      emiti_8 (bco,i_ALLOC_CONSTR,    arg1); else
+      emiti_16(bco,i_ALLOC_CONSTR_big,arg1);
+}
 
 /* --------------------------------------------------------------------------
  * Arg checks.
@@ -780,8 +839,6 @@ void   asmEndArgCheck   ( AsmBCO bco, AsmSp last_arg )
     nat args = bco->sp - last_arg;
     if (args != 0) { /* optimisation */
         emiti_8(bco,i_ARG_CHECK,args);
-        grabHpNonUpd(bco,PAP_sizeW(args-1));
-        resetHp(bco,0);
     }
 }
 
@@ -890,32 +947,25 @@ AsmVar asmBox( AsmBCO bco, AsmRep rep )
     switch (rep) {
     case CHAR_REP:
             emiti_(bco,i_PACK_CHAR);
-            grabHpNonUpd(bco,Czh_sizeW);
             break;
     case INT_REP:
             emiti_(bco,i_PACK_INT);
-            grabHpNonUpd(bco,Izh_sizeW);
             break;
     case THREADID_REP:
     case WORD_REP:
             emiti_(bco,i_PACK_WORD);
-            grabHpNonUpd(bco,Wzh_sizeW);
             break;
     case ADDR_REP:
             emiti_(bco,i_PACK_ADDR);
-            grabHpNonUpd(bco,Azh_sizeW);
             break;
     case FLOAT_REP:
             emiti_(bco,i_PACK_FLOAT);
-            grabHpNonUpd(bco,Fzh_sizeW);
             break;
     case DOUBLE_REP:
             emiti_(bco,i_PACK_DOUBLE);
-            grabHpNonUpd(bco,Dzh_sizeW);
             break;
     case STABLE_REP:
             emiti_(bco,i_PACK_STABLE);
-            grabHpNonUpd(bco,Stablezh_sizeW);
             break;
 
     default:
@@ -971,50 +1021,50 @@ AsmVar asmUnbox( AsmBCO bco, AsmRep rep )
 
 void asmConstInt( AsmBCO bco, AsmInt x )
 {
-    emit_i_CONST_INT(bco,bco->nps.len);
-    asmWords(bco,AsmInt,x);
+    emit_i_CONST_INT(bco,bco->n_words);
+    asmAddNonPtrWords(bco,AsmInt,x);
     incSp(bco, repSizeW(INT_REP));
 }
 
 void asmConstInteger( AsmBCO bco, AsmString x )
 {
-    emit_i_CONST_INTEGER(bco,bco->nps.len);
-    asmWords(bco,AsmString,x);
+    emit_i_CONST_INTEGER(bco,bco->n_words);
+    asmAddNonPtrWords(bco,AsmString,x);
     incSp(bco, repSizeW(INTEGER_REP));
 }
 
 void asmConstAddr( AsmBCO bco, AsmAddr x )
 {
-    emit_i_CONST_ADDR(bco,bco->nps.len);
-    asmWords(bco,AsmAddr,x);
+    emit_i_CONST_ADDR(bco,bco->n_words);
+    asmAddNonPtrWords(bco,AsmAddr,x);
     incSp(bco, repSizeW(ADDR_REP));
 }
 
 void asmConstWord( AsmBCO bco, AsmWord x )
 {
-    emit_i_CONST_INT(bco,bco->nps.len);
-    asmWords(bco,AsmWord,(AsmInt)x);
+    emit_i_CONST_INT(bco,bco->n_words);
+    asmAddNonPtrWords(bco,AsmWord,(AsmInt)x);
     incSp(bco, repSizeW(WORD_REP));
 }
 
 void asmConstChar( AsmBCO bco, AsmChar x )
 {
-    emit_i_CONST_CHAR(bco,bco->nps.len);
-    asmWords(bco,AsmChar,x);
+    emit_i_CONST_CHAR(bco,bco->n_words);
+    asmAddNonPtrWords(bco,AsmChar,x);
     incSp(bco, repSizeW(CHAR_REP));
 }
 
 void asmConstFloat( AsmBCO bco, AsmFloat x )
 {
-    emit_i_CONST_FLOAT(bco,bco->nps.len);
-    asmWords(bco,AsmFloat,x);
+    emit_i_CONST_FLOAT(bco,bco->n_words);
+    asmAddNonPtrWords(bco,AsmFloat,x);
     incSp(bco, repSizeW(FLOAT_REP));
 }
 
 void asmConstDouble( AsmBCO bco, AsmDouble x )
 {
-    emit_i_CONST_DOUBLE(bco,bco->nps.len);
-    asmWords(bco,AsmDouble,x);
+    emit_i_CONST_DOUBLE(bco,bco->n_words);
+    asmAddNonPtrWords(bco,AsmDouble,x);
     incSp(bco, repSizeW(DOUBLE_REP));
 }
 
@@ -1028,14 +1078,14 @@ AsmSp asmBeginCase( AsmBCO bco )
     return bco->sp;
 }
 
-void asmEndCase( AsmBCO bco )
+void asmEndCase( AsmBCO bco __attribute__ ((unused)) )
 {
 }
 
 AsmSp asmContinuation( AsmBCO bco, AsmBCO ret_addr )
 {
-    emit_i_RETADDR(bco,bco->object.ptrs.len);
-    asmPtr(bco,&(ret_addr->object));
+    emit_i_RETADDR(bco,bco->n_refs);
+    asmAddRefObject(bco,ret_addr);
     incSp(bco, 2 * sizeofW(StgPtr));
     return bco->sp;
 }
@@ -1070,25 +1120,25 @@ void asmEndAlt( AsmBCO bco, AsmSp  sp )
 AsmPc asmTest( AsmBCO bco, AsmWord tag )
 {
     emiti_8_16(bco,i_TEST,tag,0);
-    return bco->is.len;
+    return bco->n_insns;
 }
 
-AsmPc asmTestInt( AsmBCO bco, AsmVar v, AsmInt x )
+AsmPc asmTestInt ( AsmBCO bco, AsmVar v, AsmInt x )
 {
     asmVar(bco,v,INT_REP);
     asmConstInt(bco,x);
     emiti_16(bco,i_TEST_INT,0);
     decSp(bco, 2*repSizeW(INT_REP));
-    return bco->is.len;
+    return bco->n_insns;
 }
 
-void asmFixBranch( AsmBCO bco, AsmPc from )
+void asmFixBranch ( AsmBCO bco, AsmPc from )
 {
-    int distance = bco->is.len - from;
+    int distance = bco->n_insns - from;
     ASSERT(distance >= 0);
     ASSERT(distance < 65536);
-    setInstrs(&(bco->is),from-2,distance/256);
-    setInstrs(&(bco->is),from-1,distance%256);
+    setInstrs(bco,from-2,distance/256);
+    setInstrs(bco,from-1,distance%256);
 }
 
 void asmPanic( AsmBCO bco )
@@ -1105,18 +1155,23 @@ AsmSp asmBeginPrim( AsmBCO bco )
     return bco->sp;
 }
 
-void   asmEndPrim( AsmBCO bco, const AsmPrim* prim, AsmSp base )
+void asmEndPrim( AsmBCO bco, const AsmPrim* prim, AsmSp base )
 {
     emiti_8(bco,prim->prefix,prim->opcode);
     setSp(bco, base);
 }
 
+char* asmGetPrimopName ( AsmPrim* p )
+{
+   return p->name;
+}
+
 /* Hugs used to let you add arbitrary primops with arbitrary types
  * just by editing Prelude.hs or any other file you wanted.
  * We deliberately avoided that approach because we wanted more
  * control over which primops are provided.
  */
-const AsmPrim asmPrimOps[] = {
+AsmPrim asmPrimOps[] = {
 
     /* Char# operations */
       { "primGtChar",                "CC", "B",  MONAD_Id, i_PRIMOP1, i_gtChar }
@@ -1323,9 +1378,9 @@ const AsmPrim asmPrimOps[] = {
     , { "primIsIEEEDouble",          "",   "B",  MONAD_Id, i_PRIMOP1, i_isIEEEDouble }
 
     /* Ref operations */
-    , { "primNewRef",                "a",  "R",  MONAD_IO, i_PRIMOP2, i_newRef }
-    , { "primWriteRef",              "Ra", "",   MONAD_IO, i_PRIMOP2, i_writeRef }
-    , { "primReadRef",               "R",  "a",  MONAD_IO, i_PRIMOP2, i_readRef }
+    , { "primNewRef",                "a",  "R",  MONAD_ST, i_PRIMOP2, i_newRef }
+    , { "primWriteRef",              "Ra", "",   MONAD_ST, i_PRIMOP2, i_writeRef }
+    , { "primReadRef",               "R",  "a",  MONAD_ST, i_PRIMOP2, i_readRef }
     , { "primSameRef",               "RR", "B",  MONAD_Id, i_PRIMOP2, i_sameRef }
 
     /* PrimArray operations */
@@ -1379,7 +1434,7 @@ const AsmPrim asmPrimOps[] = {
 
 #ifdef PROVIDE_FOREIGN
     /* ForeignObj# operations */
-    , { "primMakeForeignObj",        "A",  "f",  MONAD_IO, i_PRIMOP2, i_makeForeignObj }
+    , { "primMkForeignObj",          "A",  "f",  MONAD_IO, i_PRIMOP2, i_mkForeignObj }
 #endif
 #ifdef PROVIDE_WEAK
     /* WeakPair# operations */
@@ -1406,36 +1461,50 @@ const AsmPrim asmPrimOps[] = {
 #endif
 #ifdef PROVIDE_CONCURRENT
     /* Concurrency operations */
-    , { "primFork",                  "a", "T",   MONAD_IO, i_PRIMOP2, i_fork }
+    , { "primForkIO",                "a", "T",   MONAD_IO, i_PRIMOP2, i_forkIO }
     , { "primKillThread",            "T", "",    MONAD_IO, i_PRIMOP2, i_killThread }
-    , { "primDelay",                 "I", "",    MONAD_IO, i_PRIMOP2, i_delay }
+    , { "primRaiseInThread",         "TE", "",   MONAD_IO, i_PRIMOP2, i_raiseInThread }
+
     , { "primWaitRead",              "I", "",    MONAD_IO, i_PRIMOP2, i_waitRead }
     , { "primWaitWrite",             "I", "",    MONAD_IO, i_PRIMOP2, i_waitWrite }
+    , { "primYield",                 "", "",     MONAD_IO, i_PRIMOP2, i_yield }    , { "primDelay",                 "I", "",    MONAD_IO, i_PRIMOP2, i_delay }
+    , { "primGetThreadId",           "",   "T",  MONAD_IO, i_PRIMOP2, i_getThreadId }
+    , { "primCmpThreadIds",          "TT", "I",  MONAD_Id, i_PRIMOP2, i_cmpThreadIds }
 #endif
-    , { "primNewEmptyMVar",         "",  "r",   MONAD_IO, i_PRIMOP2, i_newMVar }
+    , { "primNewEmptyMVar",          "",  "r",   MONAD_IO, i_PRIMOP2, i_newMVar }
       /* primTakeMVar is handwritten bytecode */
     , { "primPutMVar",               "ra", "",   MONAD_IO, i_PRIMOP2, i_putMVar } 
     , { "primSameMVar",              "rr", "B",  MONAD_Id, i_PRIMOP2, i_sameMVar }
-    , { "primGetThreadId",           "",   "T",  MONAD_IO, i_PRIMOP2, i_getThreadId }
-    , { "primCmpThreadIds",          "TT", "I",  MONAD_Id, i_PRIMOP2, i_cmpThreadIds }
-    , { "primForkIO",                 "a", "T",  MONAD_IO, i_PRIMOP2, i_forkIO }
+
   
     /* Ccall is polyadic - so it's excluded from this table */
 
     , { 0,0,0,0,0,0 }
 };
 
-const AsmPrim ccall_ccall_Id
+AsmPrim ccall_ccall_Id
    = { "ccall", 0, 0, MONAD_IO, i_PRIMOP2, i_ccall_ccall_Id };
-const AsmPrim ccall_ccall_IO
+AsmPrim ccall_ccall_IO
    = { "ccall", 0, 0, MONAD_IO, i_PRIMOP2, i_ccall_ccall_IO };
-const AsmPrim ccall_stdcall_Id 
+AsmPrim ccall_stdcall_Id 
    = { "ccall", 0, 0, MONAD_IO, i_PRIMOP2, i_ccall_stdcall_Id };
-const AsmPrim ccall_stdcall_IO 
+AsmPrim ccall_stdcall_IO 
    = { "ccall", 0, 0, MONAD_IO, i_PRIMOP2, i_ccall_stdcall_IO };
 
+#ifdef DEBUG
+void checkBytecodeCount( void );
+void checkBytecodeCount( void ) 
+{
+  if (MAX_Primop1 >= 255) {
+    printf("Too many Primop1 bytecodes (%d)\n",MAX_Primop1);
+  }
+  if (MAX_Primop2 >= 255) {
+    printf("Too many Primop2 bytecodes (%d)\n",MAX_Primop2);
+  }
+}
+#endif
 
-const AsmPrim* asmFindPrim( char* s )
+AsmPrim* asmFindPrim( char* s )
 {
     int i;
     for (i=0; asmPrimOps[i].name; ++i) {
@@ -1446,7 +1515,7 @@ const AsmPrim* asmFindPrim( char* s )
     return 0;
 }
 
-const AsmPrim* asmFindPrimop( AsmInstr prefix, AsmInstr op )
+AsmPrim* asmFindPrimop( AsmInstr prefix, AsmInstr op )
 {
     nat i;
     for (i=0; asmPrimOps[i].name; ++i) {
@@ -1461,31 +1530,51 @@ const AsmPrim* asmFindPrimop( AsmInstr prefix, AsmInstr op )
  * Handwritten primops
  * ------------------------------------------------------------------------*/
 
-AsmBCO asm_BCO_catch ( void )
+void* /* StgBCO* */ asm_BCO_catch ( void )
 {
-   AsmBCO bco = asmBeginBCO(0 /*NIL*/);
+   AsmBCO  bco;
+   StgBCO* closure;
+   asmInitialise();
+
+   bco = asmBeginBCO(0 /*NIL*/);
    emiti_8(bco,i_ARG_CHECK,2);
    emiti_8(bco,i_PRIMOP1,i_pushcatchframe);
    incSp(bco, (1-2)*sizeofW(StgPtr) + sizeofW(StgCatchFrame));
    emiti_(bco,i_ENTER);
    decSp(bco, sizeofW(StgPtr));
    asmEndBCO(bco);
-   return bco;
+
+   asmAllocateHeapSpace();
+   asmCopyAndLink();
+   closure = (StgBCO*)(bco->closure);
+   asmShutdown();
+   return closure;
 }
 
-AsmBCO asm_BCO_raise ( void )
+void* /* StgBCO* */ asm_BCO_raise ( void )
 {
-   AsmBCO bco = asmBeginBCO(0 /*NIL*/);
+   AsmBCO bco;
+   StgBCO* closure;
+   asmInitialise();
+
+   bco = asmBeginBCO(0 /*NIL*/);
    emiti_8(bco,i_ARG_CHECK,1);
    emiti_8(bco,i_PRIMOP2,i_raise);
    decSp(bco,sizeofW(StgPtr));
    asmEndBCO(bco);
-   return bco;
+
+   asmAllocateHeapSpace();
+   asmCopyAndLink();
+   closure = (StgBCO*)(bco->closure);
+   asmShutdown();
+   return closure;
 }
 
-AsmBCO asm_BCO_seq ( void )
+void* /* StgBCO* */ asm_BCO_seq ( void )
 {
    AsmBCO eval, cont;
+   StgBCO* closure;
+   asmInitialise();
 
    cont = asmBeginBCO(0 /*NIL*/);
    emiti_8(cont,i_ARG_CHECK,2);   /* should never fail */
@@ -1497,8 +1586,8 @@ AsmBCO asm_BCO_seq ( void )
 
    eval = asmBeginBCO(0 /*NIL*/);
    emiti_8(eval,i_ARG_CHECK,2);
-   emit_i_RETADDR(eval,eval->object.ptrs.len);
-   asmPtr(eval,&(cont->object));
+   emit_i_RETADDR(eval,eval->n_refs);
+   asmAddRefObject(eval,cont);
    emit_i_VAR(eval,2);
    emit_i_SLIDE(eval,3,1);
    emiti_8(eval,i_PRIMOP1,i_pushseqframe);
@@ -1506,12 +1595,18 @@ AsmBCO asm_BCO_seq ( void )
    incSp(eval, sizeofW(StgSeqFrame) + 4*sizeofW(StgPtr));
    asmEndBCO(eval);
 
-   return eval;
+   asmAllocateHeapSpace();
+   asmCopyAndLink();
+   closure = (StgBCO*)(eval->closure);
+   asmShutdown();
+   return closure;
 }
 
-AsmBCO asm_BCO_takeMVar ( void )
+void* /* StgBCO* */ asm_BCO_takeMVar ( void )
 {
    AsmBCO kase, casecont, take;
+   StgBCO* closure;
+   asmInitialise();
 
    take = asmBeginBCO(0 /*NIL*/);
    emit_i_VAR(take,0);
@@ -1529,8 +1624,8 @@ AsmBCO asm_BCO_takeMVar ( void )
    emit_i_VAR(casecont,4);
    emit_i_VAR(casecont,4);
    emit_i_VAR(casecont,2);
-   emit_i_CONST(casecont,casecont->object.ptrs.len);
-   asmPtr(casecont,&(take->object));
+   emit_i_CONST(casecont,casecont->n_refs);
+   asmAddRefObject(casecont,take);
    emit_i_SLIDE(casecont,4,5);
    emiti_(casecont,i_ENTER);
    incSp(casecont,20);
@@ -1538,14 +1633,18 @@ AsmBCO asm_BCO_takeMVar ( void )
 
    kase = asmBeginBCO(0 /*NIL*/);
    emiti_8(kase,i_ARG_CHECK,3);
-   emit_i_RETADDR(kase,kase->object.ptrs.len);
-   asmPtr(kase,&(casecont->object));
+   emit_i_RETADDR(kase,kase->n_refs);
+   asmAddRefObject(kase,casecont);
    emit_i_VAR(kase,2);
    emiti_(kase,i_ENTER);
    incSp(kase,20);
    asmEndBCO(kase);
 
-   return kase;
+   asmAllocateHeapSpace();
+   asmCopyAndLink();
+   closure = (StgBCO*)(kase->closure);
+   asmShutdown();
+   return closure;
 }
 
 
@@ -1555,11 +1654,21 @@ AsmBCO asm_BCO_takeMVar ( void )
 
 AsmVar asmAllocCONSTR   ( AsmBCO bco, AsmInfo info )
 {
+    int i;
     ASSERT( sizeW_fromITBL(info) >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
-    emiti_8(bco,i_ALLOC_CONSTR,bco->nps.len);
-    asmWords(bco,AsmInfo,info);
+
+    /* Look in this bco's collection of nonpointers (literals)
+       to see if the itbl pointer is already there.  If so, re-use it. */
+    i = asmFindInNonPtrs ( bco, (StgWord)info );
+
+    if (i == -1) {
+       emit_i_ALLOC_CONSTR(bco,bco->n_words);
+       asmAddNonPtrWords(bco,AsmInfo,info);
+    } else {
+       emit_i_ALLOC_CONSTR(bco,i);
+    }
+
     incSp(bco, sizeofW(StgClosurePtr));
-    grabHpNonUpd(bco,sizeW_fromITBL(info));
     return bco->sp;
 }
 
@@ -1579,7 +1688,7 @@ void asmEndPack( AsmBCO bco, AsmVar v, AsmSp start, AsmInfo info )
     setSp(bco, start);
 }
 
-void asmBeginUnpack( AsmBCO bco )
+void asmBeginUnpack( AsmBCO bco __attribute__ ((unused)) )
 {
     /* dummy to make it look prettier */
 }
@@ -1593,7 +1702,6 @@ AsmVar asmAllocAP( AsmBCO bco, AsmNat words )
 {
     emiti_8(bco,i_ALLOC_AP,words);
     incSp(bco, sizeofW(StgPtr));
-    grabHpUpd(bco,AP_sizeW(words));
     return bco->sp;
 }
 
@@ -1628,20 +1736,27 @@ void asmEndMkPAP( AsmBCO bco, AsmVar v, AsmSp start )
     setSp(bco, start);
 }
 
-AsmVar asmClosure( AsmBCO bco, AsmObject p )
+AsmVar asmPushRefHugs ( AsmBCO bco, int /*Name*/ n )
+{
+    emit_i_CONST(bco,bco->n_refs);
+    asmAddRefHugs(bco,n);
+    incSp(bco, sizeofW(StgPtr));
+    return bco->sp;
+}
+
+AsmVar asmPushRefObject ( AsmBCO bco, AsmObject p )
 {
-    emit_i_CONST(bco,bco->object.ptrs.len);
-    asmPtr(bco,p);
+    emit_i_CONST(bco,bco->n_refs);
+    asmAddRefObject(bco,p);
     incSp(bco, sizeofW(StgPtr));
     return bco->sp;
 }
 
-AsmVar asmGHCClosure( AsmBCO bco, AsmObject p )
+AsmVar asmPushRefNoOp ( AsmBCO bco, StgPtr p )
 {
-    // A complete hack.  Pushes the address as a tagged int
-    // and then uses SLIDE to get rid of the tag.  Appalling.
-    asmConstInt(bco, (AsmInt)p);
-    emit_i_SLIDE(bco,0,1); decSp(bco,1);
+    emit_i_CONST(bco,bco->n_refs);
+    asmAddRefNoOp(bco,p);
+    incSp(bco, sizeofW(StgPtr));
     return bco->sp;
 }
 
@@ -1675,4 +1790,3 @@ AsmInfo asmMkInfo( AsmNat tag, AsmNat ptrs )
 /*-------------------------------------------------------------------------*/
 
 #endif /* INTERPRETER */
-