[project @ 2000-10-09 10:28:33 by daan]
[ghc-hetmet.git] / ghc / rts / Evaluator.c
index 82603e0..c7e91da 100644 (file)
@@ -5,8 +5,8 @@
  * Copyright (c) 1994-1998.
  *
  * $RCSfile: Evaluator.c,v $
- * $Revision: 1.47 $
- * $Date: 2000/04/11 20:44:19 $
+ * $Revision: 1.57 $
+ * $Date: 2000/10/09 10:28:33 $
  * ---------------------------------------------------------------------------*/
 
 #include "Rts.h"
 /* Make it possible for the evaluator to get hold of bytecode
    for a given function by name.  Useful but a hack.  Sigh.
  */
-extern void* getHugs_AsmObject_for ( char* s );
-extern int /*Bool*/ combined;
+extern void* /* StgClosure* */ getHugs_BCO_cptr_for ( char* s );
+extern int   /* Bool */ combined;
 
-/* --------------------------------------------------------------------------
- * Crude profiling stuff (mainly to assess effect of optimiser)
- * ------------------------------------------------------------------------*/
-
-#ifdef CRUDE_PROFILING
-
-#define M_CPTAB 10000
-#define CP_NIL (-1)
-
-int cpInUse = -1;
-int cpCurr;
-
-typedef 
-   struct { int /*StgVar*/ who; 
-            int /*StgVar*/ twho; 
-            int enters; 
-            int bytes; 
-            int insns; 
-   }
-   CPRecord;
-
-CPRecord cpTab[M_CPTAB];
-
-void cp_init ( void )
-{
-   int i;
-   cpCurr = CP_NIL;
-   cpInUse = 0;
-   for (i = 0; i < M_CPTAB; i++)
-      cpTab[i].who = CP_NIL;
-}
-
-
-
-void cp_enter ( StgBCO* b )
-{
-   int is_ret_cont;
-   int h;
-   int /*StgVar*/ v = b->stgexpr;
-   if ((void*)v == NULL) return;
-
-   is_ret_cont = 0;
-   if (v > 500000000) {
-      is_ret_cont = 1;
-      v -= 1000000000;
-   }
-
-   if (v < 0) 
-      h = (-v) % M_CPTAB; else
-      h = v % M_CPTAB;
-  
-   assert (h >= 0 && h < M_CPTAB);
-   while (cpTab[h].who != v && cpTab[h].who != CP_NIL) { 
-      h++; if (h == M_CPTAB) h = 0;
-   };
-   cpCurr = h;
-   if (cpTab[cpCurr].who == CP_NIL) {
-      cpTab[cpCurr].who = v;
-      if (!is_ret_cont) cpTab[cpCurr].enters = 1;
-      cpTab[cpCurr].bytes = cpTab[cpCurr].insns = 0;
-      cpInUse++;
-      if (cpInUse * 2 > M_CPTAB) {
-         fprintf(stderr, "\nCRUDE_PROFILING hash table is too full\n" );
-         assert(0);
-      }
-   } else {
-      if (!is_ret_cont) cpTab[cpCurr].enters++;
-   }   
-
-
-}
-
-void cp_bill_words ( int nw )
-{
-   if (cpCurr == CP_NIL) return;
-   cpTab[cpCurr].bytes += sizeof(StgWord)*nw;
-}
-
-
-void cp_bill_insns ( int ni )
-{
-   if (cpCurr == CP_NIL) return;
-   cpTab[cpCurr].insns += ni;
-}
-
-
-static double percent ( double a, double b )
-{
-   return (100.0 * a) / b;
-}
-
-
-void cp_show ( void )
-{
-   int i, j, max, maxN, totE, totB, totI, cumE, cumB, cumI;
-   char nm[200];
-
-   if (cpInUse == -1) return;
-
-   fflush(stdout);fflush(stderr);
-   printf ( "\n\n" );
-
-   totE = totB = totI = 0;
-   for (i = 0; i < M_CPTAB; i++) {
-      cpTab[i].twho = cpTab[i].who;
-      if (cpTab[i].who != CP_NIL) {
-         totE += cpTab[i].enters;
-         totB += cpTab[i].bytes;
-         totI += cpTab[i].insns;
-      }
-   }
-  
-   printf ( "Totals:   "
-            "%6d (%7.3f M) enters,   "
-            "%6d (%7.3f M) insns,   "
-            "%6d  (%7.3f M) bytes\n\n", 
-            totE, totE/1000000.0, totI, totI/1000000.0, totB, totB/1000000.0 );
-
-   cumE = cumB = cumI = 0;
-   for (j = 0; j < 32; j++) {
-
-      maxN = max = -1;
-      for (i = 0; i < M_CPTAB; i++)
-         if (cpTab[i].who != CP_NIL &&
-             cpTab[i].enters > maxN) {
-            maxN = cpTab[i].enters;
-            max = i;
-         }
-      if (max == -1) break;
-
-      cumE += cpTab[max].enters;
-      cumB += cpTab[max].bytes;
-      cumI += cpTab[max].insns;
-
-      strcpy(nm, maybeName(cpTab[max].who));
-      if (strcmp(nm, "(unknown)")==0)
-         sprintf ( nm, "id%d", -cpTab[max].who);
-
-      printf ( "%20s %7d es (%4.1f%%, %4.1f%% c)    "
-                    "%7d bs (%4.1f%%, %4.1f%% c)    "
-                    "%7d is (%4.1f%%, %4.1f%% c)\n",
-                nm,
-                cpTab[max].enters, percent(cpTab[max].enters,totE), percent(cumE,totE),
-                cpTab[max].bytes,  percent(cpTab[max].bytes,totB),  percent(cumB,totB),
-                cpTab[max].insns,  percent(cpTab[max].insns,totI),  percent(cumI,totI)
-             );
-
-      cpTab[max].twho = cpTab[max].who;
-      cpTab[max].who  = CP_NIL;
-   }
-
-   for (i = 0; i < M_CPTAB; i++)
-      cpTab[i].who = cpTab[i].twho;
-
-   printf ( "\n" );
-}
-
-#endif
 
 
 /* --------------------------------------------------------------------------
@@ -339,7 +181,6 @@ void      SloppifyIntegerEnd ( StgPtr );
           SSS;                                                 \
            cap->rCurrentTSO->sp    = gSp;                      \
            cap->rCurrentTSO->su    = gSu;                      \
-           cap->rCurrentTSO->splim = gSpLim;                   \
            return retVal;                                      \
         }
 
@@ -418,7 +259,7 @@ void      SloppifyIntegerEnd ( StgPtr );
 {                                                                 \
    StgUpdateFrame *__frame;                                       \
    __frame = (StgUpdateFrame *)(xSp + (xSp_offset)) - 1;          \
-   SET_INFO(__frame, (StgInfoTable *)&Upd_frame_info);            \
+   SET_INFO(__frame, (StgInfoTable *)&upd_frame_info);            \
    __frame->link = xSu;                                           \
    __frame->updatee = (StgClosure *)(target);                     \
    xSu = __frame;                                                 \
@@ -473,7 +314,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
 
     gSp    = cap->rCurrentTSO->sp;
     gSu    = cap->rCurrentTSO->su;
-    gSpLim = cap->rCurrentTSO->splim;
+    gSpLim = cap->rCurrentTSO->stack + RESERVED_STACK_WORDS;
 
 #ifdef DEBUG
     /* use the t values to check that Su/Sp/SpLim do not change unexpectedly */
@@ -491,10 +332,12 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
 
     enterLoop:
 
+    numEnters++;
+
 #ifdef DEBUG
-    assert(gSp == tSp);
-    assert(gSu == tSu);
-    assert(gSpLim == tSpLim);
+    ASSERT(gSp == tSp);
+    ASSERT(gSu == tSu);
+    ASSERT(gSpLim == tSpLim);
     IF_DEBUG(evaluator,
              SSS;
              enterCountI++;
@@ -530,8 +373,8 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
           cap->rCurrentTSO->why_blocked = BlockedOnDelay;
           ACQUIRE_LOCK(&sched_mutex);
           
-#if defined(HAVE_SETITIMER) || defined(mingw32_TARGET_OS)
-          cap->rCurrentTSO->block_info.delay 
+#if defined(HAVE_SETITIMER) /* || defined(mingw32_TARGET_OS) */
+          cap->rCurrentTSO->block_info.delay
             = hugsBlock.delay + ticks_since_select;
 #else
           cap->rCurrentTSO->block_info.target
@@ -588,11 +431,6 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
                 RETURN(HeapOverflow);
             }
 
-#           if CRUDE_PROFILING
-            cp_enter ( bco );
-#           endif
-
-
             bciPtr = &(bcoInstr(bco,0));
 
             LoopTopLabel
@@ -611,10 +449,6 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
                     LLL;
                    );
 
-#           if CRUDE_PROFILING
-            SSS; cp_bill_insns(1); LLL;
-#           endif
-
             Dispatch
 
             Case(i_INTERNAL_ERROR):
@@ -688,8 +522,12 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
                                      xPopUpdateFrame(obj);
                                      break;
                                 case STOP_FRAME:
+                                     barf("STOP frame during pap update");
+#if 0
+                                    cap->rCurrentTSO->what_next = ThreadComplete;
                                      SSS; PopStopFrame(obj); LLL;
                                      RETURN(ThreadFinished);
+#endif
                                 case SEQ_FRAME:
                                      SSS; PopSeqFrame(); LLL;
                                      ASSERT(xSp != (P_)xSu);
@@ -746,6 +584,29 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
                     xPushPtr(p);
                     Continue;
                 }
+#ifdef XMLAMBDA
+            /* allocate rows, implemented on top of Arrays */
+            Case(i_ALLOC_ROW):
+                {
+                    StgMutArrPtrs* p;
+                    int n = BCO_INSTR_8;
+                    SSS; p = stgCast(StgMutArrPtrs*,grabHpNonUpd(sizeofW(StgMutArrPtrs) + n)); LLL;
+                    SET_HDR(p,&MUT_ARR_PTRS_FROZEN_info,CCCS);
+                    p->ptrs = n;
+                    xPushPtr(p);
+                    Continue;
+                }
+            Case(i_ALLOC_ROW_big):
+                {
+                    StgMutArrPtrs* p;
+                    int n = BCO_INSTR_16;
+                    SSS; p = stgCast(StgMutArrPtrs*,grabHpNonUpd(sizeofW(StgMutArrPtrs) + n)); LLL;
+                    SET_HDR(p,&MUT_ARR_PTRS_FROZEN_info,CCCS);
+                    p->ptrs = n;
+                    xPushPtr(p);
+                    Continue;
+                }
+#endif
             Case(i_MKAP):
                 {
                     int x = BCO_INSTR_8;  /* ToDo: Word not Int! */
@@ -849,6 +710,112 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
                              );
                     Continue;
                 }
+#ifdef XMLAMBDA
+            /* pack values into a row. */
+            Case(i_PACK_ROW):
+                {
+                    int offset       = BCO_INSTR_8;
+                    StgMutArrPtrs* p = stgCast(StgMutArrPtrs*,xStackPtr(offset));
+                    StgWord        n = p->ptrs;
+                    nat i;
+
+                    for (i=0; i<n; ++i)
+                    {
+                      p->payload[i] = xPopCPtr();
+                    }
+                    IF_DEBUG(evaluator,
+                             fprintf(stderr,"\tBuilt "); 
+                             SSS;
+                             printObj(stgCast(StgClosure*,p));
+                             LLL;
+                            );
+                    Continue;
+                }
+            Case(i_PACK_ROW_big):
+                {
+                    int offset       = BCO_INSTR_16;
+                    StgMutArrPtrs* p = stgCast(StgMutArrPtrs*,xStackPtr(offset));
+                    StgWord        n = p->ptrs;
+                    nat i;
+
+                    for (i=0; i<n; ++i)
+                    {
+                      p->payload[i] = xPopCPtr();
+                    }
+                    IF_DEBUG(evaluator,
+                             fprintf(stderr,"\tBuilt "); 
+                             SSS;
+                             printObj(stgCast(StgClosure*,p));
+                             LLL;
+                            );
+                    Continue;
+                }
+            /* pack values into an Inj */
+            Case(i_PACK_INJ):
+                {
+                    const int size  = CONSTR_sizeW(sizeofW(StgPtr),sizeofW(StgInt));
+                    int offset  = BCO_INSTR_8;
+                    
+                    StgClosure* o;                    
+                    SSS; o = (StgClosure*)grabHpNonUpd(size); LLL;
+                    SET_HDR(o,Inj_con_info,??);
+                    
+                    payloadWord(o,sizeofW(StgPtr)) = xTaggedStackInt(offset);
+                    payloadPtr(o,0)                = xPopPtr();                                        
+                    
+                    IF_DEBUG(evaluator,
+                             fprintf(stderr,"\tBuilt "); 
+                             SSS;
+                             printObj(stgCast(StgClosure*,o));
+                             LLL;
+                             );
+                    xPushPtr(stgCast(StgPtr,o));
+                    Continue;
+                }
+            Case(i_PACK_INJ_big):
+                {
+                    const int size  = CONSTR_sizeW(sizeofW(StgPtr),sizeofW(StgInt));
+                    int offset  = BCO_INSTR_16;
+                    
+                    StgClosure* o;                    
+                    SSS; o = (StgClosure*)grabHpNonUpd(size); LLL;
+                    SET_HDR(o,Inj_con_info,??);
+
+                    payloadWord(o,sizeofW(StgPtr)) = xTaggedStackInt(offset);
+                    payloadPtr(o,0)                = xPopPtr();                    
+
+                    IF_DEBUG(evaluator,
+                             fprintf(stderr,"\tBuilt "); 
+                             SSS;
+                             printObj(stgCast(StgClosure*,o));
+                             LLL;
+                             );
+                    xPushPtr(stgCast(StgPtr,o));
+                    Continue;
+                }
+            Case(i_PACK_INJ_CONST):
+                {
+                    const int size  = CONSTR_sizeW(sizeofW(StgPtr),sizeofW(StgInt));
+                    int index  = BCO_INSTR_8;
+                    
+                    StgClosure* o;                    
+                    SSS; o = (StgClosure*)grabHpNonUpd(size); LLL;
+                    SET_HDR(o,Inj_con_info,??);
+
+                    payloadWord(o,sizeofW(StgPtr)) = index;
+                    payloadPtr(o,0)                = xPopPtr();                    
+
+                    IF_DEBUG(evaluator,
+                             fprintf(stderr,"\tBuilt "); 
+                             SSS;
+                             printObj(stgCast(StgClosure*,o));
+                             LLL;
+                             );
+                    xPushPtr(stgCast(StgPtr,o));
+                    Continue;
+                }
+
+#endif /* XMLAMBDA */
             Case(i_SLIDE):
                 {
                     int x = BCO_INSTR_8;
@@ -894,6 +861,45 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
                     }
                     Continue;
                 }
+#ifdef XMLAMBDA
+            /* Test Inj indices. */
+            Case(i_TEST_INJ):
+                {
+                    int  offset    = BCO_INSTR_8;
+                    StgWord jump   = BCO_INSTR_16;
+                    
+                    int index  = payloadWord( (StgClosure*)xStackPtr(0), sizeofW(StgPtr) );
+                    if (index != xTaggedStackInt(offset) )
+                    {
+                      bciPtr += jump;
+                    }
+                    Continue;
+                }
+            Case(i_TEST_INJ_big):
+                {
+                    int  offset    = BCO_INSTR_16;
+                    StgWord jump   = BCO_INSTR_16;
+                    
+                    int index  = payloadWord( (StgClosure*)xStackPtr(0), sizeofW(StgPtr) );
+                    if (index != xTaggedStackInt(offset) )
+                    {
+                      bciPtr += jump;
+                    }
+                    Continue;
+                }
+            Case(i_TEST_INJ_CONST):
+                {
+                    int  value     = BCO_INSTR_8;
+                    StgWord jump   = BCO_INSTR_16;
+                    
+                    int index  = payloadWord( (StgClosure*)xStackPtr(0), sizeofW(StgPtr) );
+                    if (index != value )
+                    {
+                      bciPtr += jump;
+                    }
+                    Continue;
+                }  
+#endif /* XMLAMBDA */
             Case(i_UNPACK):
                 {
                     StgClosure* o = stgCast(StgClosure*,xStackPtr(0));
@@ -913,6 +919,29 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
                     }
                     Continue;
                 }
+#ifdef XMLAMBDA
+            /* extract all fields of a row */
+            Case(i_UNPACK_ROW):
+                {
+                    StgMutArrPtrs* p = stgCast(StgMutArrPtrs*,xStackPtr(0));
+                    int i = p->ptrs;
+                    while (--i >= 0)
+                    {
+                      xPushCPtr(p->payload[i]);
+                    }
+                    Continue;
+                }
+            /* extract the value of an INJ */
+            Case(i_UNPACK_INJ):
+                {
+                    StgClosure* con = stgCast(StgClosure*,xStackPtr(0));
+                    
+                    ASSERT(get_itbl(con) == Inj_con_info);
+                    
+                    xPushPtr(payloadPtr(con,0));                    
+                    Continue;
+                }
+#endif /* XMLAMBA */
             Case(i_VAR_big):
                 {
                     int n = BCO_INSTR_16;
@@ -1191,7 +1220,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
                     StgClosure* o;
                     SSS; o = (StgClosure*)grabHpNonUpd(Stablezh_sizeW); LLL;
                     SET_HDR(o,StablePtr_con_info,??);
-                    payloadWord(o,0) = xPopTaggedStable();
+                    payloadWord(o,0) = (W_)xPopTaggedStable();
                     IF_DEBUG(evaluator,
                              fprintf(stderr,"\tBuilt "); 
                              SSS;
@@ -1327,6 +1356,20 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
             Case(i_VAR_WORD_big):
             Case(i_RETADDR_big):
             Case(i_ALLOC_PAP):
+#ifndef XMLAMBDA
+            Case(i_UNPACK_INJ):
+            Case(i_UNPACK_ROW):
+            Case(i_TEST_INJ_CONST):
+            Case(i_TEST_INJ_big):
+            Case(i_TEST_INJ):
+            Case(i_PACK_INJ_CONST):
+            Case(i_PACK_INJ_big):
+            Case(i_PACK_INJ):
+            Case(i_PACK_ROW_big):
+            Case(i_PACK_ROW):
+            Case(i_ALLOC_ROW_big):
+            Case(i_ALLOC_ROW):
+#endif
                     bciPtr--;
                     printf ( "\n\n" );
                     disInstr ( bco, PC );
@@ -1356,22 +1399,19 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
                 xPushCPtr(obj); /* code to restart with */
                 RETURN(StackOverflow);
             }
-            /* ToDo: look for xSp==xSu && stackInt(0) == UPD_FRAME 
-               and insert an indirection immediately */
             SSS; bh = (StgBlockingQueue*)grabHpUpd(BLACKHOLE_sizeW()); LLL;
             SET_INFO(bh,&CAF_BLACKHOLE_info);
             bh->blocking_queue = EndTSOQueue;
             IF_DEBUG(gccafs,
-                     fprintf(stderr,"Created CAF_BLACKHOLE %p for CAF %p in evaluator\n",bh,caf));
+                     fprintf(stderr,"Created CAF_BLACKHOLE %p for CAF %p"
+                                    " in evaluator\n",bh,caf));
             SET_INFO(caf,&CAF_ENTERED_info);
             caf->value = (StgClosure*)bh;
-            if (caf->mut_link == NULL) { 
-               SSS; recordOldToNewPtrs((StgMutClosure*)caf); LLL; 
-            }
+
+            SSS; newCAF_made_by_Hugs(caf); LLL;
+
             xPushUpdateFrame(bh,0);
             xSp -= sizeofW(StgUpdateFrame);
-            caf->link = enteredCAFs;
-            enteredCAFs = caf;
             obj = caf->body;
             goto enterLoop;
         }
@@ -1455,6 +1495,10 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
     case CONSTR_CHARLIKE:
     case CONSTR_STATIC:
     case CONSTR_NOCAF_STATIC:
+#ifdef XMLAMBDA
+/* rows are mutarrays and should be treated as constructors. */
+    case MUT_ARR_PTRS_FROZEN:
+#endif
         {
             while (1) {
                 switch (get_itbl(stgCast(StgClosure*,xSp))->type) {
@@ -1479,7 +1523,9 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
                                                 + cap->rCurrentTSO->stack_size,xSu);
                                  LLL;
                                  );
+                        cap->rCurrentTSO->what_next = ThreadComplete;
                         SSS; PopStopFrame(obj); LLL;
+                        xPushPtr((P_)obj);
                         RETURN(ThreadFinished);
                     }
                 case RET_BCO:
@@ -1525,7 +1571,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
         }
     }
     barf("Ran off the end of enter - yoiks");
-    assert(0);
+    ASSERT(0);
 }
 
 #undef RETURN
@@ -1608,6 +1654,11 @@ static inline StgWord         stackWord          ( StgStackOffset i )
 static inline void            setStackWord       ( StgStackOffset i, StgWord w ) 
    { gSp[i] = w; }
 
+#ifdef XMLAMBDA
+static inline void            setStackPtr        ( StgStackOffset i, StgPtr p )
+   { *(stgCast(StgPtr*, gSp+i)) = p; }
+#endif
+
 static inline void            PushTaggedRealWorld( void            ) 
    { PushTag(REALWORLD_TAG);  }
        inline void            PushTaggedInt      ( StgInt        x ) 
@@ -1623,7 +1674,7 @@ static inline void            PushTaggedRealWorld( void            )
        inline void            PushTaggedDouble   ( StgDouble     x ) 
    { gSp -= sizeofW(StgDouble);     ASSIGN_DBL(gSp,x); PushTag(DOUBLE_TAG); }
        inline void            PushTaggedStablePtr   ( StgStablePtr  x ) 
-   { gSp -= sizeofW(StgStablePtr);  *gSp = x;          PushTag(STABLE_TAG); }
+   { gSp -= sizeofW(StgStablePtr);  *gSp = (W_)x;      PushTag(STABLE_TAG); }
 static inline void            PushTaggedBool     ( int           x ) 
    { PushTaggedInt(x); }
 
@@ -1650,7 +1701,7 @@ static inline void            PopTaggedRealWorld ( void )
    { StgDouble r; PopTag(DOUBLE_TAG);  r = PK_DBL(gSp);                  
      gSp += sizeofW(StgDouble);     return r;}
        inline StgStablePtr    PopTaggedStablePtr    ( void ) 
-   { StgInt    r; PopTag(STABLE_TAG);  r = *stgCast(StgStablePtr*, gSp); 
+   { StgStablePtr r; PopTag(STABLE_TAG);  r = *stgCast(StgStablePtr*, gSp); 
      gSp += sizeofW(StgStablePtr);  return r;}
 
 
@@ -1686,18 +1737,12 @@ static inline StgStablePtr    taggedStackStable  ( StgStackOffset i )
 static inline StgPtr grabHpUpd( nat size )
 {
     ASSERT( size >= MIN_UPD_SIZE + sizeofW(StgHeader) );
-#ifdef CRUDE_PROFILING
-    cp_bill_words ( size );
-#endif
     return allocate(size);
 }
 
 static inline StgPtr grabHpNonUpd( nat size )
 {
     ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
-#ifdef CRUDE_PROFILING
-    cp_bill_words ( size );
-#endif
     return allocate(size);
 }
 
@@ -1788,7 +1833,7 @@ static inline StgClosure* raiseAnError ( StgClosure* exception )
      * thunks which are currently under evaluation.
      */
     HaskellObj primRaiseClosure
-       = asmClosureOfObject(getHugs_AsmObject_for("primRaise"));
+       = getHugs_BCO_cptr_for("primRaise");
     HaskellObj reraiseClosure
        = rts_apply ( primRaiseClosure, exception );
    
@@ -1829,9 +1874,9 @@ static StgClosure* makeErrorCall ( const char* msg )
       (thinks: probably not so, but anyway ...)
    */
    HaskellObj error 
-      = asmClosureOfObject(getHugs_AsmObject_for("error"));
+      = getHugs_BCO_cptr_for("error");
    HaskellObj unpack
-      = asmClosureOfObject(getHugs_AsmObject_for("hugsprimUnpackString"));
+      = getHugs_BCO_cptr_for("hugsprimUnpackString");
    HaskellObj thunk
       = rts_apply ( unpack, rts_mkAddr ( (void*)msg ) );
    thunk
@@ -2261,12 +2306,14 @@ void SloppifyIntegerEnd ( StgPtr arr0 )
 }
 
 
+__attribute__ ((unused))
 static void myStackCheck ( Capability* cap )
 {
    /* fprintf(stderr, "myStackCheck\n"); */
    if (!(gSpLim <= gSp && gSp <= stgCast(StgPtr,gSu))) {
       fprintf(stderr, "myStackCheck: invalid initial gSp/gSu \n" );
-      assert(0);
+      barf("aborting");
+      ASSERT(0);
    }
    while (1) {
       if (!( (P_)gSu >= (P_)cap->rCurrentTSO->stack 
@@ -2274,7 +2321,8 @@ static void myStackCheck ( Capability* cap )
               (P_)gSu <= (P_)(cap->rCurrentTSO->stack 
                               + cap->rCurrentTSO->stack_size))) {
          fprintf ( stderr, "myStackCheck: gSu out of stack\n" );
-         assert(0);
+         barf("aborting");
+         ASSERT(0);
       }
       switch (get_itbl(stgCast(StgClosure*,gSu))->type) {
       case CATCH_FRAME:
@@ -2289,7 +2337,9 @@ static void myStackCheck ( Capability* cap )
       case STOP_FRAME:
          goto postloop;
       default:
-         fprintf(stderr, "myStackCheck: invalid activation record\n"); assert(0);
+         fprintf(stderr, "myStackCheck: invalid activation record\n"); 
+         barf("aborting");
+         ASSERT(0);
       }
    }
    postloop:
@@ -2450,8 +2500,8 @@ static void* enterBCO_primop1 ( int primop1code )
         case i_intToAddr:       OP_I_A((StgAddr)x);  break;  /*  ToDo */
         case i_addrToInt:       OP_A_I((StgInt)x);   break;  /* ToDo */
 
-        case i_intToStable:     OP_I_s(x);           break;
-        case i_stableToInt:     OP_s_I(x);           break;
+        case i_intToStable:     OP_I_s((StgStablePtr)x); break;
+        case i_stableToInt:     OP_s_I((W_)x);           break;
 
         case i_indexCharOffAddr:   OP_AI_C(indexCharOffAddrzh(r,x,y));      break;
         case i_readCharOffAddr:    OP_AI_C(indexCharOffAddrzh(r,x,y));      break;
@@ -2712,6 +2762,71 @@ static void* enterBCO_primop2 ( int primop2code,
                 StgClosure* err = PopCPtr();
                 return (raiseAnError(err));
             }
+#ifdef XMLAMBDA
+/*------------------------------------------------------------------------
+  Insert and Remove primitives on Rows
+------------------------------------------------------------------------*/
+        case i_rowInsertAt:
+            {
+                nat j;
+                /* get: row, index and value */
+                StgMutArrPtrs* row = stgCast(StgMutArrPtrs*,PopPtr());
+                nat         i   = PopTaggedInt();     
+                StgClosure* x   = PopCPtr();
+                
+                /* allocate new row */
+                StgWord     n    = row->ptrs;                
+                StgMutArrPtrs* newRow 
+                    = stgCast(StgMutArrPtrs*,allocate(sizeofW(StgMutArrPtrs) + n + 1));                
+                SET_HDR(newRow,&MUT_ARR_PTRS_FROZEN_info,CCCS);
+                newRow->ptrs = n+1;
+  
+                ASSERT(i <= n);
+      
+                /* copy the fields, inserting the new value */
+                for (j = 0; j < i; j++) {
+                  newRow->payload[j] = row->payload[j];
+                }
+                newRow->payload[i] = x;
+                for (j = i+1; j <= n; j++)
+                {
+                  newRow->payload[j] = row->payload[j-1];
+                }
+
+                PushPtr(stgCast(StgPtr,newRow));
+                break; 
+            }
+
+        case i_rowRemoveAt:
+            {
+                nat j;
+                /* get row and index */
+                StgMutArrPtrs* row = stgCast(StgMutArrPtrs*,PopPtr());
+                nat         i   = PopTaggedInt(); /* or Word?? */
+                
+                /* allocate new row */
+                StgWord     n    = row->ptrs;                
+                StgMutArrPtrs* newRow 
+                    = stgCast(StgMutArrPtrs*,allocate(sizeofW(StgMutArrPtrs) + n - 1));                
+                SET_HDR(newRow,&MUT_ARR_PTRS_FROZEN_info,CCCS);
+                newRow->ptrs = n-1;
+  
+                ASSERT(i < n);
+      
+                /* copy the fields, except for the removed value. */
+                for (j = 0; j < i; j++) {
+                  newRow->payload[j] = row->payload[j];
+                }
+                for (j = i+1; j < n; j++)
+                {
+                  newRow->payload[j-1] = row->payload[j];
+                }
+
+                PushCPtr(row->payload[i]);
+                PushPtr(stgCast(StgPtr,newRow));
+                break; 
+            }
+#endif /* XMLAMBDA */
 
         case i_newRef:
             {
@@ -3101,11 +3216,12 @@ static void* enterBCO_primop2 ( int primop2code,
                 deleteThread(tso);
                 if (tso == cap->rCurrentTSO) { /* suicide */
                     *return2 = ThreadFinished;
-                    return (void*)(1+(NULL));
+                    return (void*)(1+(char*)(NULL));
                 }
                 break;
             }
         case i_raiseInThread:
+          barf("raiseInThread");
          ASSERT(0); /* not (yet) supported */
         case i_delay:
          {
@@ -3521,5 +3637,4 @@ void B__decodeFloat (B* man, I_* exp, StgFloat flt)
 }
 
 #endif /* FLOATS_AS_DOUBLES */
-
 #endif /* INTERPRETER */