static void *
forkOS_createThreadWrapper ( void * entry )
{
rts_lock();
rts_evalStableIO((HsStablePtr) entry, NULL);
rts_unlock();
return NULL;
}
static unsigned __stdcall
forkOS_createThreadWrapper ( void * entry )
{
rts_lock();
rts_evalStableIO((HsStablePtr) entry, NULL);
rts_unlock();
return 0;
}
static void *
forkOS_createThreadWrapper ( void * entry )
{
Capability *cap;
cap = rts_lock();
rts_evalStableIO(&cap, (HsStablePtr) entry, NULL);
rts_unlock(cap);
return NULL;
}
void my_main(void)
{
Capability *cap;
HaskellObj ret;
cap = rts_lock();
cap=rts_evalIO(cap,rts_apply(cap,(HaskellObj)runIO_closure,&HsSdlTest_zdfmyzumainzua1OV_closure) ,&ret);
rts_checkSchedStatus("my_main",cap);
rts_unlock(cap);
}
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);
}
void
ioManagerStart (void)
{
// Make sure the IO manager thread is running
Capability *cap;
if (timer_manager_control_wr_fd < 0 || io_manager_wakeup_fd < 0) {
cap = rts_lock();
ioManagerStartCap(&cap);
rts_unlock(cap);
}
}
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");)
HsFloat convert_hs(HsFloat a1, HsFloat a2)
{
Capability *cap;
HaskellObj ret;
HsFloat cret;
cap = rts_lock();
cap=rts_evalIO(cap,rts_apply(cap,(HaskellObj)runNonIO_closure,rts_apply(cap,rts_apply(cap,&HaskellConvert_zdfconvertzuhszuawO_closure,rts_mkFloat(cap,a1)),rts_mkFloat(cap,a2))) ,&ret);
rts_checkSchedStatus("convert_hs",cap);
cret=rts_getFloat(ret);
rts_unlock(cap);
return cret;
}
HsStablePtr g_value_to_haskellobj(const GValue *value)
{
Capability *cap;
HaskellObj obj;
HsStablePtr ret;
cap = rts_lock();
obj = gtk2hs_value_as_haskellobj(cap, value);
rts_unlock(cap);
ret = (HsStablePtr) getStablePtr((StgPtr) obj);
return ret;
}
void
ioManagerStart (void)
{
initMutex(&event_buf_mutex);
next_event = 0;
// Make sure the IO manager thread is running
Capability *cap;
if (io_manager_event == INVALID_HANDLE_VALUE) {
cap = rts_lock();
rts_evalIO(&cap, ensureIOManagerIsRunning_closure, NULL);
rts_unlock(cap);
}
}
/* Hack: we assume that we're building a batch-mode system unless
* INTERPRETER is set
*/
#ifndef INTERPRETER /* Hack */
static void real_main(void)
{
int exit_status;
SchedulerStatus status;
/* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
startupHaskell(progargc,progargv,NULL);
/* kick off the computation by creating the main thread with a pointer
to mainIO_closure representing the computation of the overall program;
then enter the scheduler with this thread and off we go;
the same for GranSim (we have only one instance of this code)
in a parallel setup, where we have many instances of this code
running on different PEs, we should do this only for the main PE
(IAmMainThread is set in startupHaskell)
*/
/* ToDo: want to start with a larger stack size */
{
Capability *cap = rts_lock();
cap = rts_evalLazyIO(cap,progmain_closure, NULL);
status = rts_getSchedStatus(cap);
taskTimeStamp(myTask());
rts_unlock(cap);
}
/* check the status of the entire Haskell computation */
switch (status) {
case Killed:
errorBelch("main thread exited (uncaught exception)");
exit_status = EXIT_KILLED;
break;
case Interrupted:
errorBelch("interrupted");
exit_status = EXIT_INTERRUPTED;
break;
case HeapExhausted:
exit_status = EXIT_HEAPOVERFLOW;
break;
case Success:
exit_status = EXIT_SUCCESS;
break;
default:
barf("main thread completed with invalid status");
}
shutdownHaskellAndExit(exit_status);
}
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));
}
int main (int argc, char *argv[])
{
// should fail: RTS is not initialised
rts_lock();
}
