X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2Frts%2FInterpreter.c;h=56e9bb67cea7c43ec25d9bc8c4ffe8c6c27123b9;hp=b31ade08fbd3404b402ac8240fdbfacbbee6efdd;hb=beb5737b7ee42c4e9373a505e7d957206d69a30e;hpb=76e3742711eb9eb2fed7654c56e602b54c517e87

diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c
index b31ade0..56e9bb6 100644
--- a/ghc/rts/Interpreter.c
+++ b/ghc/rts/Interpreter.c
@@ -69,15 +69,9 @@
 
 
 STATIC_INLINE StgPtr
-allocate_UPD (int n_words)
-{
-   return allocate(stg_max(sizeofW(StgHeader)+MIN_UPD_SIZE, n_words));
-}
-
-STATIC_INLINE StgPtr
 allocate_NONUPD (int n_words)
 {
-    return allocate(stg_max(sizeofW(StgHeader)+MIN_NONUPD_SIZE, n_words));
+    return allocate(stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
 }
 
 
@@ -560,9 +554,7 @@ do_apply:
 	    else /* arity > n */ {
 		// build a new PAP and return it.
 		StgPAP *new_pap;
-		nat size;
-		size = PAP_sizeW(pap->n_args + m);
-		new_pap = (StgPAP *)allocate(size);
+		new_pap = (StgPAP *)allocate(PAP_sizeW(pap->n_args + m));
 		SET_HDR(new_pap,&stg_PAP_info,CCCS);
 		new_pap->arity = pap->arity - n;
 		new_pap->n_args = pap->n_args + m;
@@ -606,9 +598,8 @@ do_apply:
 	    else /* arity > n */ {
 		// build a PAP and return it.
 		StgPAP *pap;
-		nat size, i;
-		size = PAP_sizeW(m);
-		pap = (StgPAP *)allocate(size);
+		nat i;
+		pap = (StgPAP *)allocate(PAP_sizeW(m));
 		SET_HDR(pap, &stg_PAP_info,CCCS);
 		pap->arity = arity - n;
 		pap->fun = obj;
@@ -932,8 +923,7 @@ run_BCO:
 	case bci_ALLOC_AP: {
 	    StgAP* ap; 
 	    int n_payload = BCO_NEXT;
-	    int request   = PAP_sizeW(n_payload);
-	    ap = (StgAP*)allocate_UPD(request);
+	    ap = (StgAP*)allocate(AP_sizeW(n_payload));
 	    Sp[-1] = (W_)ap;
 	    ap->n_args = n_payload;
 	    SET_HDR(ap, &stg_AP_info, CCS_SYSTEM/*ToDo*/)
@@ -945,8 +935,7 @@ run_BCO:
 	    StgPAP* pap; 
 	    int arity = BCO_NEXT;
 	    int n_payload = BCO_NEXT;
-	    int request   = PAP_sizeW(n_payload);
-	    pap = (StgPAP*)allocate_NONUPD(request);
+	    pap = (StgPAP*)allocate(PAP_sizeW(n_payload));
 	    Sp[-1] = (W_)pap;
 	    pap->n_args = n_payload;
 	    pap->arity = arity;
@@ -962,13 +951,12 @@ run_BCO:
 	    StgAP* ap = (StgAP*)Sp[stkoff];
 	    ASSERT((int)ap->n_args == n_payload);
 	    ap->fun = (StgClosure*)Sp[0];
-
+	    
 	    // The function should be a BCO, and its bitmap should
 	    // cover the payload of the AP correctly.
 	    ASSERT(get_itbl(ap->fun)->type == BCO
-		   && (get_itbl(ap)->type == PAP || 
-		       BCO_BITMAP_SIZE(ap->fun) == ap->n_args));
-
+		   && BCO_BITMAP_SIZE(ap->fun) == ap->n_args);
+	    
 	    for (i = 0; i < n_payload; i++)
 		ap->payload[i] = (StgClosure*)Sp[i+1];
 	    Sp += n_payload+1;
@@ -979,6 +967,27 @@ run_BCO:
 	    goto nextInsn;
 	}
 
+	case bci_MKPAP: {
+	    int i;
+	    int stkoff = BCO_NEXT;
+	    int n_payload = BCO_NEXT;
+	    StgPAP* pap = (StgPAP*)Sp[stkoff];
+	    ASSERT((int)pap->n_args == n_payload);
+	    pap->fun = (StgClosure*)Sp[0];
+	    
+	    // The function should be a BCO
+	    ASSERT(get_itbl(pap->fun)->type == BCO);
+	    
+	    for (i = 0; i < n_payload; i++)
+		pap->payload[i] = (StgClosure*)Sp[i+1];
+	    Sp += n_payload+1;
+	    IF_DEBUG(interpreter,
+		     debugBelch("\tBuilt "); 
+		     printObj((StgClosure*)pap);
+		);
+	    goto nextInsn;
+	}
+
 	case bci_UNPACK: {
 	    /* Unpack N ptr words from t.o.s constructor */
 	    int i;