rt_public void eif_log_call (int routine_id, EIF_SCP_PID p, call_data * a)
{
EIF_GET_CONTEXT
BODY_INDEX body_id;
EIF_REFERENCE t = eif_access (a -> target);
EIF_TYPED_VALUE * result = a -> result;
EIF_REFERENCE result_reference = NULL;
if (result) {
RT_GC_PROTECT (result_reference);
a -> result_address = &result_reference;
}
CHECK("Target attached", t);
CBodyId(body_id,routine_id,Dtype(t));
a -> body_index = body_id;
RTS_TCB(scoop_task_add_call,p,RTS_PID(t),a);
if (result) {
switch (result -> type & SK_HEAD) {
case SK_REF:
case SK_EXP:
/* Retrieve reference from the GC-protected storage. */
result -> it_ref = result_reference;
}
RT_GC_WEAN (result_reference);
}
}
rt_private EIF_REFERENCE spclone(EIF_REFERENCE source)
{
/* Clone an of Eiffel object `source'. Assumes that source
* is a special object.
*/
EIF_GET_CONTEXT
EIF_REFERENCE result; /* Clone pointer */
union overhead *zone; /* Pointer on source header */
uint16 flags; /* Source object flags */
EIF_TYPE_INDEX dtype, dftype;
if ((EIF_REFERENCE) 0 == source)
return (EIF_REFERENCE) 0; /* Void source */
RT_GC_PROTECT(source); /* Protection against GC */
zone = HEADER(source); /* Allocation of a new object */
flags = zone->ov_flags;
dtype = zone->ov_dtype;
dftype = zone->ov_dftype;
result = spmalloc(RT_SPECIAL_COUNT(source), RT_SPECIAL_ELEM_SIZE(source), EIF_TEST(!(flags & EO_REF)));
/* Keep the reference flag and the composite one and the type */
HEADER(result)->ov_flags |= flags & (EO_REF | EO_COMP);
HEADER(result)->ov_dtype = dtype;
HEADER(result)->ov_dftype = dftype;
/* Keep the count and the element size */
RT_SPECIAL_COUNT(result) = RT_SPECIAL_COUNT(source);
RT_SPECIAL_ELEM_SIZE(result) = RT_SPECIAL_ELEM_SIZE(source);
RT_SPECIAL_CAPACITY(result) = RT_SPECIAL_COUNT(source);
if (!egc_has_old_special_semantic) {
/* If by default allocation does not clear the data of a SPECIAL,
* we actually need to do clear it otherwise we end up with a SPECIAL
* object that is susceptible to be manipulated by the GC while waiting to
* be filled. */
memset(result, 0, RT_SPECIAL_VISIBLE_SIZE(result));
}
RT_GC_WEAN(source); /* Remove GC protection */
return result;
}
rt_public EIF_REFERENCE edclone(EIF_CONTEXT EIF_REFERENCE source)
{
/* Recursive Eiffel clone. This function recursively clones the source
* object and returns a pointer to the top of the new tree.
*/
RT_GET_CONTEXT
EIF_GET_CONTEXT
EIF_REFERENCE root = (EIF_REFERENCE) 0; /* Root of the deep cloned object */
jmp_buf exenv; /* Environment saving */
struct {
union overhead discard; /* Pseudo object header */
EIF_REFERENCE boot; /* Anchor point for cloning process */
} anchor;
struct rt_traversal_context traversal_context;
int volatile is_locked;
#ifdef DEBUG
int xobjs;
#endif
if (source == NULL) {
return NULL; /* Void source */
}
/* The deep clone of the source will be attached in the 'boot' entry from
* the anchor structure. It all happens as if we were in fact deep cloning
* the anchor pseudo-object.
*/
memset (&anchor, 0, sizeof(anchor)); /* Reset header */
anchor.boot = (EIF_REFERENCE) &root; /* To boostrap cloning process */
RT_GC_PROTECT(source); /* Protect source: allocation will occur */
#ifdef DEBUG
xobjs = nomark(source);
printf("Source has %x %d objects\n", source, xobjs);
#endif
/* Set up an exception trap. If any exception occurs, control will be
* transferred back here by the run-time to give us a chance to clean-up
* our structures.
*/
{
RTXDRH; /* Save stack contexts */
EIF_EO_STORE_LOCK; /* Because we perform a traversal that marks
objects, we need to be sure we are the
only one doing it. */
is_locked = 1;
excatch(&exenv); /* Record pseudo-execution vector */
if (setjmp(exenv)) {
RTXSCH; /* Restore stack contexts */
map_reset(1); /* Reset in emergency situation */
/* If we locked the EO_STORE_MUTEX, then we need to unmark objects
* and unlock it. */
if (is_locked) {
/* We are only concerned abount unmarking objects, so we do not perform any
* accounting. */
CHECK ("Not accounting", traversal_context.accounting == 0);
CHECK ("Not unmarking", traversal_context.is_unmarking == 0);
/* First we mark again all objects. */
traversal_context.is_unmarking = 0;
traversal(&traversal_context, source);
/* Then we unmark them. */
traversal_context.is_unmarking = 1;
traversal(&traversal_context, source);
/* Now we can unlock our mutex. */
EIF_EO_STORE_UNLOCK;
}
ereturn(MTC_NOARG); /* And propagate the exception */
}
/* Now start the traversal of the source, allocating all the objects as
* needed and stuffing them into a FIFO stack for later perusal by the
* cloning process.
*/
memset (&traversal_context, 0, sizeof(struct rt_traversal_context));
traversal_context.accounting = TR_MAP;
traversal(&traversal_context, source); /* Object traversal, mark with EO_STORE */
hash_malloc(&hclone, traversal_context.obj_nb); /* Hash table allocation */
map_start(); /* Restart at bottom of FIFO stack */
#ifdef DEBUG
printf("Computed %x %d objects\n\n", source, traversal_context.obj_nb);
#endif
/* Throughout the deep cloning process, we need to maintain the notion of
* enclosing object for GC aging tests. The enclosing object is defined as
* being the object to which the currently cloned tree will be attached.
*
* We need to initialize the cloning process by computing a valid reference
* into the root variable. That will be the enclosing object, and of course
* it cannot be void, ever, or something really really weird is happening.
*
* To get rid of code duplication, I am initially calling rdeepclone with
* an enclosing object address set to anchor.boot. The anchor structure
* represents a pseudo anchor object for the object hierarchy being cloned.
*/
rdeepclone(source, (EIF_REFERENCE) &anchor.boot, 0); /* Recursive clone */
hash_free(&hclone); /* Free hash table */
map_reset(0); /* And eif_free maping table */
/* Release all the hector pointers asked for during the map table
* construction (obj_nb exactly) */
CHECK("Has objects", traversal_context.obj_nb > 0);
eif_ostack_npop(&hec_stack, traversal_context.obj_nb);
#ifdef DEBUG
xobjs= nomark(source);
printf("Source now has %d objects\n", xobjs);
xobjs = nomark(anchor.boot);
printf("Result has %d objects\n", xobjs);
#endif
RT_GC_WEAN(source); /* Release GC protection */
expop(&eif_stack); /* Remove pseudo execution vector */
}
EIF_EO_STORE_UNLOCK; /* Free marking mutex */
is_locked = 0;
return anchor.boot; /* The cloned object tree */
}
