X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FRtsAPI.c;h=fb9c0107a0a57f764b134aaacf2a9b1f9e45c08e;hp=d0bdead1c9b36181ada4c01de354e1e4085e1a35;hb=2007d2138cf17efe6a1701510dbafdfc30e8926c;hpb=5cbe7adb6051a9d1738dfb5735c8c923b74c5945

diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c
index d0bdead..fb9c010 100644
--- a/rts/RtsAPI.c
+++ b/rts/RtsAPI.c
@@ -8,17 +8,15 @@
 
 #include "PosixSource.h"
 #include "Rts.h"
-#include "OSThreads.h"
 #include "RtsAPI.h"
-#include "SchedAPI.h"
-#include "RtsFlags.h"
+#include "HsFFI.h"
+
 #include "RtsUtils.h"
 #include "Prelude.h"
 #include "Schedule.h"
 #include "Capability.h"
 #include "Stable.h"
-
-#include <stdlib.h>
+#include "Weak.h"
 
 /* ----------------------------------------------------------------------------
    Building Haskell objects from C datatypes.
@@ -30,7 +28,7 @@
 HaskellObj
 rts_mkChar (Capability *cap, HsChar c)
 {
-  StgClosure *p = (StgClosure *)allocateLocal(cap, CONSTR_sizeW(0,1));
+  StgClosure *p = (StgClosure *)allocate(cap, CONSTR_sizeW(0,1));
   SET_HDR(p, Czh_con_info, CCS_SYSTEM);
   p->payload[0]  = (StgClosure *)(StgWord)(StgChar)c;
   return p;
@@ -39,7 +37,7 @@ rts_mkChar (Capability *cap, HsChar c)
 HaskellObj
 rts_mkInt (Capability *cap, HsInt i)
 {
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
   SET_HDR(p, Izh_con_info, CCS_SYSTEM);
   p->payload[0]  = (StgClosure *)(StgInt)i;
   return p;
@@ -48,7 +46,7 @@ rts_mkInt (Capability *cap, HsInt i)
 HaskellObj
 rts_mkInt8 (Capability *cap, HsInt8 i)
 {
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
   SET_HDR(p, I8zh_con_info, CCS_SYSTEM);
   /* Make sure we mask out the bits above the lowest 8 */
   p->payload[0]  = (StgClosure *)(StgInt)i;
@@ -58,7 +56,7 @@ rts_mkInt8 (Capability *cap, HsInt8 i)
 HaskellObj
 rts_mkInt16 (Capability *cap, HsInt16 i)
 {
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
   SET_HDR(p, I16zh_con_info, CCS_SYSTEM);
   /* Make sure we mask out the relevant bits */
   p->payload[0]  = (StgClosure *)(StgInt)i;
@@ -68,7 +66,7 @@ rts_mkInt16 (Capability *cap, HsInt16 i)
 HaskellObj
 rts_mkInt32 (Capability *cap, HsInt32 i)
 {
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
   SET_HDR(p, I32zh_con_info, CCS_SYSTEM);
   p->payload[0]  = (StgClosure *)(StgInt)i;
   return p;
@@ -77,18 +75,16 @@ rts_mkInt32 (Capability *cap, HsInt32 i)
 HaskellObj
 rts_mkInt64 (Capability *cap, HsInt64 i)
 {
-  llong *tmp;
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,2));
+  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2));
   SET_HDR(p, I64zh_con_info, CCS_SYSTEM);
-  tmp  = (llong*)&(p->payload[0]);
-  *tmp = (StgInt64)i;
+  ASSIGN_Int64((P_)&(p->payload[0]), i);
   return p;
 }
 
 HaskellObj
 rts_mkWord (Capability *cap, HsWord i)
 {
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
   SET_HDR(p, Wzh_con_info, CCS_SYSTEM);
   p->payload[0]  = (StgClosure *)(StgWord)i;
   return p;
@@ -98,7 +94,7 @@ HaskellObj
 rts_mkWord8 (Capability *cap, HsWord8 w)
 {
   /* see rts_mkInt* comments */
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
   SET_HDR(p, W8zh_con_info, CCS_SYSTEM);
   p->payload[0]  = (StgClosure *)(StgWord)(w & 0xff);
   return p;
@@ -108,7 +104,7 @@ HaskellObj
 rts_mkWord16 (Capability *cap, HsWord16 w)
 {
   /* see rts_mkInt* comments */
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
   SET_HDR(p, W16zh_con_info, CCS_SYSTEM);
   p->payload[0]  = (StgClosure *)(StgWord)(w & 0xffff);
   return p;
@@ -118,7 +114,7 @@ HaskellObj
 rts_mkWord32 (Capability *cap, HsWord32 w)
 {
   /* see rts_mkInt* comments */
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
   SET_HDR(p, W32zh_con_info, CCS_SYSTEM);
   p->payload[0]  = (StgClosure *)(StgWord)(w & 0xffffffff);
   return p;
@@ -127,20 +123,18 @@ rts_mkWord32 (Capability *cap, HsWord32 w)
 HaskellObj
 rts_mkWord64 (Capability *cap, HsWord64 w)
 {
-  ullong *tmp;
-
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,2));
+  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2));
   /* see mk_Int8 comment */
   SET_HDR(p, W64zh_con_info, CCS_SYSTEM);
-  tmp  = (ullong*)&(p->payload[0]);
-  *tmp = (StgWord64)w;
+  ASSIGN_Word64((P_)&(p->payload[0]), w);
   return p;
 }
 
+
 HaskellObj
 rts_mkFloat (Capability *cap, HsFloat f)
 {
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
+  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
   SET_HDR(p, Fzh_con_info, CCS_SYSTEM);
   ASSIGN_FLT((P_)p->payload, (StgFloat)f);
   return p;
@@ -149,7 +143,7 @@ rts_mkFloat (Capability *cap, HsFloat f)
 HaskellObj
 rts_mkDouble (Capability *cap, HsDouble d)
 {
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,sizeofW(StgDouble)));
+  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,sizeofW(StgDouble)));
   SET_HDR(p, Dzh_con_info, CCS_SYSTEM);
   ASSIGN_DBL((P_)p->payload, (StgDouble)d);
   return p;
@@ -158,7 +152,7 @@ rts_mkDouble (Capability *cap, HsDouble d)
 HaskellObj
 rts_mkStablePtr (Capability *cap, HsStablePtr s)
 {
-  StgClosure *p = (StgClosure *)allocateLocal(cap,sizeofW(StgHeader)+1);
+  StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1);
   SET_HDR(p, StablePtr_con_info, CCS_SYSTEM);
   p->payload[0]  = (StgClosure *)s;
   return p;
@@ -167,7 +161,7 @@ rts_mkStablePtr (Capability *cap, HsStablePtr s)
 HaskellObj
 rts_mkPtr (Capability *cap, HsPtr a)
 {
-  StgClosure *p = (StgClosure *)allocateLocal(cap,sizeofW(StgHeader)+1);
+  StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1);
   SET_HDR(p, Ptr_con_info, CCS_SYSTEM);
   p->payload[0]  = (StgClosure *)a;
   return p;
@@ -176,7 +170,7 @@ rts_mkPtr (Capability *cap, HsPtr a)
 HaskellObj
 rts_mkFunPtr (Capability *cap, HsFunPtr a)
 {
-  StgClosure *p = (StgClosure *)allocateLocal(cap,sizeofW(StgHeader)+1);
+  StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1);
   SET_HDR(p, FunPtr_con_info, CCS_SYSTEM);
   p->payload[0]  = (StgClosure *)a;
   return p;
@@ -203,7 +197,7 @@ rts_apply (Capability *cap, HaskellObj f, HaskellObj arg)
 {
     StgThunk *ap;
 
-    ap = (StgThunk *)allocateLocal(cap,sizeofW(StgThunk) + 2);
+    ap = (StgThunk *)allocate(cap,sizeofW(StgThunk) + 2);
     SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_SYSTEM);
     ap->payload[0] = f;
     ap->payload[1] = arg;
@@ -267,13 +261,12 @@ rts_getInt32 (HaskellObj p)
 HsInt64
 rts_getInt64 (HaskellObj p)
 {
-    HsInt64* tmp;
     // See comment above:
     // ASSERT(p->header.info == I64zh_con_info ||
     //        p->header.info == I64zh_static_info);
-    tmp = (HsInt64*)&(UNTAG_CLOSURE(p)->payload[0]);
-    return *tmp;
+    return PK_Int64((P_)&(UNTAG_CLOSURE(p)->payload[0]));
 }
+
 HsWord
 rts_getWord (HaskellObj p)
 {
@@ -310,16 +303,13 @@ rts_getWord32 (HaskellObj p)
     return (HsWord32)(HsWord)(UNTAG_CLOSURE(p)->payload[0]);
 }
 
-
 HsWord64
 rts_getWord64 (HaskellObj p)
 {
-    HsWord64* tmp;
     // See comment above:
     // ASSERT(p->header.info == W64zh_con_info ||
     //        p->header.info == W64zh_static_info);
-    tmp = (HsWord64*)&(UNTAG_CLOSURE(p)->payload[0]);
-    return *tmp;
+    return PK_Word64((P_)&(UNTAG_CLOSURE(p)->payload[0]));
 }
 
 HsFloat
@@ -393,11 +383,7 @@ StgTSO *
 createGenThread (Capability *cap, nat stack_size,  StgClosure *closure)
 {
   StgTSO *t;
-#if defined(GRAN)
-  t = createThread (cap, stack_size, NO_PRI);
-#else
   t = createThread (cap, stack_size);
-#endif
   pushClosure(t, (W_)closure);
   pushClosure(t, (W_)&stg_enter_info);
   return t;
@@ -407,11 +393,7 @@ StgTSO *
 createIOThread (Capability *cap, nat stack_size,  StgClosure *closure)
 {
   StgTSO *t;
-#if defined(GRAN)
-  t = createThread (cap, stack_size, NO_PRI);
-#else
   t = createThread (cap, stack_size);
-#endif
   pushClosure(t, (W_)&stg_noforceIO_info);
   pushClosure(t, (W_)&stg_ap_v_info);
   pushClosure(t, (W_)closure);
@@ -428,11 +410,7 @@ StgTSO *
 createStrictIOThread(Capability *cap, nat stack_size,  StgClosure *closure)
 {
   StgTSO *t;
-#if defined(GRAN)
-  t = createThread(cap, stack_size, NO_PRI);
-#else
   t = createThread(cap, stack_size);
-#endif
   pushClosure(t, (W_)&stg_forceIO_info);
   pushClosure(t, (W_)&stg_ap_v_info);
   pushClosure(t, (W_)closure);
@@ -532,7 +510,7 @@ rts_evalLazyIO_ (Capability *cap, HaskellObj p, unsigned int stack_size,
 void
 rts_checkSchedStatus (char* site, Capability *cap)
 {
-    SchedulerStatus rc = cap->running_task->stat;
+    SchedulerStatus rc = cap->running_task->incall->stat;
     switch (rc) {
     case Success:
 	return;
@@ -551,7 +529,7 @@ rts_checkSchedStatus (char* site, Capability *cap)
 SchedulerStatus
 rts_getSchedStatus (Capability *cap)
 {
-    return cap->running_task->stat;
+    return cap->running_task->incall->stat;
 }
 
 Capability *
@@ -560,13 +538,15 @@ rts_lock (void)
     Capability *cap;
     Task *task;
 
-    // ToDo: get rid of this lock in the common case.  We could store
-    // a free Task in thread-local storage, for example.  That would
-    // leave just one lock on the path into the RTS: cap->lock when
-    // acquiring the Capability.
-    ACQUIRE_LOCK(&sched_mutex);
     task = newBoundTask();
-    RELEASE_LOCK(&sched_mutex);
+
+    if (task->running_finalizers) {
+        errorBelch("error: a C finalizer called back into Haskell.\n"
+                   "   This was previously allowed, but is disallowed in GHC 6.10.2 and later.\n"
+                   "   To create finalizers that may call back into Haskell, use\n"
+                   "   Foreign.Concurrent.newForeignPtr instead of Foreign.newForeignPtr.");
+        stg_exit(EXIT_FAILURE);
+    }
 
     cap = NULL;
     waitForReturnCapability(&cap, task);