예제 #1
0
/*
 * Function: startSignalHandlers()
 *
 * Run the handlers associated with the stacked up console events. Console
 * event delivery is blocked for the duration of this call.
 */
void startSignalHandlers(Capability *cap)
{
    StgStablePtr handler;

    if (console_handler < 0) {
        return;
    }

    blockUserSignals();
    ACQUIRE_LOCK(&sched_mutex);

    handler = deRefStablePtr((StgStablePtr)console_handler);
    while (stg_pending_events > 0) {
        stg_pending_events--;
        scheduleThread(cap,
            createIOThread(cap,
                RtsFlags.GcFlags.initialStkSize,
                rts_apply(cap,
                    (StgClosure *)handler,
                    rts_mkInt(cap,
                        stg_pending_buf[stg_pending_events]))));
    }

    RELEASE_LOCK(&sched_mutex);
    unblockUserSignals();
}
예제 #2
0
StgPtr hs_spt_lookup(StgWord64 key[2]) {
  if (spt) {
    ACQUIRE_LOCK(&spt_lock);
    const StgStablePtr * entry = lookupHashTable(spt, (StgWord)key);
    RELEASE_LOCK(&spt_lock);
    const StgPtr ret = entry ? deRefStablePtr(*entry) : NULL;
    return ret;
  } else
    return NULL;
}
예제 #3
0
파일: hsgvalue.c 프로젝트: abarbu/Clutterhs
void g_value_from_haskellobj(GValue *value, HsStablePtr hsVal)
{
    HaskellObj ret;
    StgPtr stableVal;
    Capability *cap;

    stableVal = (StgPtr) deRefStablePtr(hsVal);

    /* evaluate the value you're putting in the GValue */
    cap = rts_lock();

    WHEN_DEBUG(g_debug("g_value_from_haskellobj: about to rts_eval");)
예제 #4
0
파일: hsgclosure.c 프로젝트: Javran/gtk2hs
static void
gtk2hs_closure_marshal(GClosure *closure,
                       GValue *return_value,
                       guint n_param_values,
                       const GValue *param_values,
                       gpointer invocation_hint,
                       gpointer marshal_data)
{

    Gtk2HsClosure *hc = (Gtk2HsClosure *)closure;
    HaskellObj call, ret;
#ifdef GHC_RTS_USES_CAPABILITY
    Capability *cap;
#else
    SchedulerStatus cap;
#endif
    guint i;

    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): about to run callback, n_param_values=%d", hc->callback, n_param_values));
#ifdef GHC_RTS_USES_CAPABILITY
    cap = rts_lock();
#else
    rts_lock();
#endif

    call = (StgClosure *)deRefStablePtr(hc->callback);

    /* construct the function call */
    for (i = 0; i < n_param_values; i++) {
        WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): param_values[%d]=%s :: %s",
                           hc->callback,
                           i,
                           g_strdup_value_contents(&param_values[i]),
                           g_type_name(G_VALUE_TYPE(&param_values[i]))));
        call = rts_apply(CAP call, gtk2hs_value_as_haskellobj(CAP &param_values[i]));
    }

    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): about to rts_evalIO", hc->callback));

    /* perform the call */
#if __GLASGOW_HASKELL__>=704
    rts_evalIO(&cap, rts_apply(CAP (HaskellObj)runIO_closure, call),&ret);
#else
    cap=rts_evalIO(CAP rts_apply(CAP (HaskellObj)runIO_closure, call),&ret);
#endif

    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): about to rts_checkSchedStatus", hc->callback));

    /* barf if anything went wrong */
    /* TODO: pass a sensible value for call site so we get better error messages */
    /* or perhaps we can propogate any error? */
    rts_checkSchedStatus("gtk2hs_closure_marshal", cap);
    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): ret=%p", hc->callback, ret));

    if (return_value) {
        WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): return_value :: %s, ret=%p, UNTAG_CLOSURE(ret)=%p",
                           hc->callback,
                           /*                           g_strdup_value_contents(return_value), */
                           g_type_name(G_VALUE_TYPE(return_value)),
                           ret,
                           UNTAG_CLOSURE(ret)));
        gtk2hs_value_from_haskellobj(return_value, ret);
    }

#ifdef GHC_RTS_USES_CAPABILITY
    rts_unlock(cap);
#else
    rts_unlock();
#endif
    WHEN_DEBUG(g_debug("gtk2hs_closure_marshal(%p): done running callback", hc->callback));
}
예제 #5
0
파일: Core_stub.c 프로젝트: leafyoung/siege
void ZZookeeperziCore_d2Ei(StgStablePtr the_stableptr, HsInt32 a1, HsPtr a2)
{
Capability *cap;
HaskellObj ret;
cap = rts_lock();
cap=rts_evalIO(cap,rts_apply(cap,(HaskellObj)runIO_closure,rts_apply(cap,rts_apply(cap,(StgClosure*)deRefStablePtr(the_stableptr),rts_mkInt32(cap,a1)),rts_mkPtr(cap,a2))) ,&ret);
rts_checkSchedStatus("ZZookeeperziCore_d2Ei",cap);
rts_unlock(cap);
}