inline static HaskellObj gtk2hs_value_as_haskellobj(Capability *cap, const GValue *value) {
switch (G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(value))) {
case G_TYPE_INTERFACE:
if (g_type_is_a(G_VALUE_TYPE(value), G_TYPE_OBJECT))
return rts_mkPtr(cap, g_value_get_object(value));
else
break;
case G_TYPE_CHAR:
return rts_mkChar(cap, g_value_get_char(value));
case G_TYPE_UCHAR:
return rts_mkChar(cap, g_value_get_uchar(value));
case G_TYPE_BOOLEAN:
return rts_mkBool(cap, g_value_get_boolean(value));
case G_TYPE_INT:
return rts_mkInt(cap, g_value_get_int(value));
case G_TYPE_UINT:
return rts_mkWord(cap, g_value_get_uint(value));
case G_TYPE_LONG:
return rts_mkInt(cap, g_value_get_long(value));
case G_TYPE_ULONG:
return rts_mkWord(cap, g_value_get_ulong(value));
/* case G_TYPE_INT64:
return rts_mkInt64(cap, g_value_get_int64(value));
case G_TYPE_UINT64:
return rts_mkWord64(cap, g_value_get_uint64(value)); */
case G_TYPE_ENUM:
return rts_mkInt(cap, g_value_get_enum(value));
case G_TYPE_FLAGS:
return rts_mkWord(cap, g_value_get_enum(value));
case G_TYPE_FLOAT:
return rts_mkFloat(cap, g_value_get_float(value));
case G_TYPE_DOUBLE:
return rts_mkDouble(cap, g_value_get_double(value));
case G_TYPE_STRING:
return rts_mkPtr(cap, (char *)g_value_get_string(value)); /* CHECKME: is the string freed? */
case G_TYPE_POINTER:
return rts_mkPtr(cap, g_value_get_pointer(value));
case G_TYPE_BOXED:
return rts_mkPtr(cap, g_value_get_boxed(value));
/* case G_TYPE_PARAM:
return g_value_get_param(value); */
case G_TYPE_OBJECT:
return rts_mkPtr(cap, g_value_get_object(value));
}
g_error("gtk2hs_value_as_haskellobj: unable to handle GValue with type %s\n"
"please report this as a bug to [email protected]",
g_type_name(G_VALUE_TYPE(value)));
}
/*
* 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();
}
static HaskellObj
#ifdef GHC_RTS_USES_CAPABILITY
gtk2hs_value_as_haskellobj(Capability *cap, const GValue *value) {
#else
gtk2hs_value_as_haskellobj(const GValue *value) {
#endif
switch (G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(value))) {
case G_TYPE_INTERFACE:
if (g_type_is_a(G_VALUE_TYPE(value), G_TYPE_OBJECT))
return rts_mkPtr(CAP g_value_get_object(value));
else
break;
case G_TYPE_CHAR:
return rts_mkChar(CAP g_value_get_schar(value));
case G_TYPE_UCHAR:
return rts_mkChar(CAP g_value_get_uchar(value));
case G_TYPE_BOOLEAN:
return rts_mkBool(CAP g_value_get_boolean(value));
case G_TYPE_INT:
return rts_mkInt(CAP g_value_get_int(value));
case G_TYPE_UINT:
return rts_mkWord(CAP g_value_get_uint(value));
case G_TYPE_LONG:
return rts_mkInt(CAP g_value_get_long(value));
case G_TYPE_ULONG:
return rts_mkWord(CAP g_value_get_ulong(value));
/* case G_TYPE_INT64:
return rts_mkInt64(CAP g_value_get_int64(value));
case G_TYPE_UINT64:
return rts_mkWord64(CAP g_value_get_uint64(value)); */
case G_TYPE_ENUM:
return rts_mkInt(CAP g_value_get_enum(value));
case G_TYPE_FLAGS:
return rts_mkWord(CAP g_value_get_enum(value));
case G_TYPE_FLOAT:
return rts_mkFloat(CAP g_value_get_float(value));
case G_TYPE_DOUBLE:
return rts_mkDouble(CAP g_value_get_double(value));
case G_TYPE_STRING:
return rts_mkPtr(CAP (char *)g_value_get_string(value)); /* CHECKME: is the string freed? */
case G_TYPE_POINTER:
return rts_mkPtr(CAP g_value_get_pointer(value));
case G_TYPE_BOXED:
return rts_mkPtr(CAP g_value_get_boxed(value));
case G_TYPE_PARAM:
return rts_mkPtr(CAP g_value_get_param(value));
case G_TYPE_OBJECT:
return rts_mkPtr(CAP g_value_get_object(value));
}
g_error("gtk2hs_value_as_haskellobj: unable to handle GValue with type %s\n"
"please report this as a bug to [email protected]",
g_type_name(G_VALUE_TYPE(value)));
}
void
gtk2hs_value_from_haskellobj(GValue *value, HaskellObj obj) {
switch (G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(value))) {
case G_TYPE_INVALID:
case G_TYPE_NONE:
return;
case G_TYPE_INTERFACE:
/* we only handle interface types that have a GObject prereq */
if (g_type_is_a(G_VALUE_TYPE(value), G_TYPE_OBJECT)) {
g_value_set_object(value, rts_getPtr(obj));
} else {
break;
}
return;
case G_TYPE_CHAR:
g_value_set_schar(value, rts_getChar(obj));
return;
case G_TYPE_UCHAR:
g_value_set_schar(value, rts_getChar(obj));
return;
case G_TYPE_BOOLEAN:
g_value_set_boolean(value, rts_getBool(obj));
return;
case G_TYPE_INT:
g_value_set_int(value, rts_getInt(obj));
return;
case G_TYPE_UINT:
g_value_set_uint(value, rts_getWord(obj));
return;
case G_TYPE_LONG:
g_value_set_long(value, rts_getInt(obj));
return;
case G_TYPE_ULONG:
g_value_set_ulong(value, rts_getWord(obj));
return;
/* case G_TYPE_INT64:
g_value_set_int64(value, rts_getInt64(obj));
return;
case G_TYPE_UINT64:
g_value_set_uint64(value, rts_getWord64(obj));
return; */
case G_TYPE_ENUM:
g_value_set_enum(value, rts_getInt(obj));
return;
case G_TYPE_FLAGS:
g_value_set_flags(value, rts_getInt(obj));
return;
case G_TYPE_FLOAT:
g_value_set_float(value, rts_getFloat(obj));
return;
case G_TYPE_DOUBLE:
g_value_set_double(value, rts_getDouble(obj));
return;
case G_TYPE_STRING:
g_value_set_string(value, rts_getPtr(obj));
return;
case G_TYPE_POINTER:
g_value_set_pointer(value, rts_getPtr(obj));
return;
/* case G_TYPE_BOXED: {
g_value_set_boxed(value, obj);
break;
}
case G_TYPE_PARAM:
g_value_set_param(value, (obj));
break; */
case G_TYPE_OBJECT:
g_value_set_object(value, rts_getPtr(obj));
return;
}
g_error("gtk2hs_value_from_haskellobj: unable to handle GValue with type %s\n"
"please report this as a bug to [email protected]",
g_type_name(G_VALUE_TYPE(value)));
}
void
scheduleFinalizers(Capability *cap, StgWeak *list)
{
StgWeak *w;
StgTSO *t;
StgMutArrPtrs *arr;
StgWord size;
nat n, i;
Task *task;
task = myTask();
if (task != NULL) {
task->running_finalizers = rtsTrue;
}
// count number of finalizers, and kill all the weak pointers first...
n = 0;
for (w = list; w; w = w->link) {
StgArrWords *farr;
// Better not be a DEAD_WEAK at this stage; the garbage
// collector removes DEAD_WEAKs from the weak pointer list.
ASSERT(w->header.info != &stg_DEAD_WEAK_info);
if (w->finalizer != &stg_NO_FINALIZER_closure) {
n++;
}
farr = (StgArrWords *)UNTAG_CLOSURE(w->cfinalizer);
if ((StgClosure *)farr != &stg_NO_FINALIZER_closure)
runCFinalizer((void *)farr->payload[0],
(void *)farr->payload[1],
(void *)farr->payload[2],
farr->payload[3]);
#ifdef PROFILING
// A weak pointer is inherently used, so we do not need to call
// LDV_recordDead().
//
// Furthermore, when PROFILING is turned on, dead weak
// pointers are exactly as large as weak pointers, so there is
// no need to fill the slop, either. See stg_DEAD_WEAK_info
// in StgMiscClosures.hc.
#endif
SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs);
}
if (task != NULL) {
task->running_finalizers = rtsFalse;
}
// No finalizers to run?
if (n == 0) return;
debugTrace(DEBUG_weak, "weak: batching %d finalizers", n);
size = n + mutArrPtrsCardTableSize(n);
arr = (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + size);
TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0);
SET_HDR(arr, &stg_MUT_ARR_PTRS_FROZEN_info, CCS_SYSTEM);
arr->ptrs = n;
arr->size = size;
n = 0;
for (w = list; w; w = w->link) {
if (w->finalizer != &stg_NO_FINALIZER_closure) {
arr->payload[n] = w->finalizer;
n++;
}
}
// set all the cards to 1
for (i = n; i < size; i++) {
arr->payload[i] = (StgClosure *)(W_)(-1);
}
t = createIOThread(cap,
RtsFlags.GcFlags.initialStkSize,
rts_apply(cap,
rts_apply(cap,
(StgClosure *)runFinalizerBatch_closure,
rts_mkInt(cap,n)),
(StgClosure *)arr)
);
scheduleThread(cap,t);
}
