/* * 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(); }
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; }
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");)
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(¶m_values[i]), g_type_name(G_VALUE_TYPE(¶m_values[i])))); call = rts_apply(CAP call, gtk2hs_value_as_haskellobj(CAP ¶m_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)); }
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); }