Exemple #1
0
opcode_t*
PF_store_string(opcode_t *cursor, STRING *s)
{
    opcode_t padded_size = s->bufused;
    char *charcursor;
    size_t i;

    if (padded_size % sizeof(opcode_t)) {
        padded_size += sizeof(opcode_t) - (padded_size % sizeof(opcode_t));
    }

    *cursor++ = PObj_get_FLAGS(s); /* only constant_FLAG */
    *cursor++ = s->encoding->index;
    *cursor++ = s->type->index;
    *cursor++ = s->bufused;

    /* Switch to char * since rest of string is addressed by
     * characters to ensure padding.  */
    charcursor = (char *)cursor;

    if (s->strstart) {
        mem_sys_memcopy(charcursor, s->strstart, s->bufused);
        charcursor += s->bufused;

        if (s->bufused % sizeof(opcode_t)) {
            for (i = 0; i < (sizeof(opcode_t) -
                        (s->bufused % sizeof(opcode_t))); i++) {
                *charcursor++ = 0;
            }
        }
    }
    assert( ((int)charcursor & 3) == 0);
    LVALUE_CAST(char *, cursor) = charcursor;
    return cursor;
}
Exemple #2
0
void
Parrot_gc_sweep_pool(PARROT_INTERP,
        ARGMOD(Memory_Pools *mem_pools),
        ARGMOD(Fixed_Size_Pool *pool))
{
    ASSERT_ARGS(Parrot_gc_sweep_pool)

    PObj               *b;
    Fixed_Size_Arena   *cur_arena;
    UINTVAL             total_used  = 0;
    const UINTVAL       object_size = pool->object_size;

    const gc_object_fn_type       gc_object       = pool->gc_object;
    const add_free_object_fn_type add_free_object = pool->add_free_object;

    /* Run through all the PObj header pools and mark */
    for (cur_arena = pool->last_Arena; cur_arena; cur_arena = cur_arena->prev) {
        const size_t objects_end = cur_arena->used;
        UINTVAL      i;
        b = (PObj *)cur_arena->start_objects;

        /* loop only while there are objects in the arena */
        for (i = objects_end; i; --i) {

            /* if it's on free list, do nothing */

            if (PObj_live_TEST(b)) {
                ++total_used;
                PObj_live_CLEAR(b);
                PObj_get_FLAGS(b) &= ~PObj_custom_GC_FLAG;
            }
            else if (!PObj_on_free_list_TEST(b)) {
                /* it must be dead */


                if (PObj_is_shared_TEST(b)) {
                    /* only mess with shared objects if we
                     * (and thus everyone) is suspended for
                     * a GC run.
                     * XXX wrong thing to do with "other" GCs
                     */
                    if (!(interp->thread_data
                    &&   (interp->thread_data->state & THREAD_STATE_SUSPENDED_GC))) {
                        ++total_used;
                        goto next;
                    }
                }

                if (gc_object)
                    gc_object(interp, mem_pools, pool, b);

                add_free_object(interp, mem_pools, pool, b);
            }
next:
            b = (PObj *)((char *)b + object_size);
        }
    }

    pool->num_free_objects = pool->total_objects - total_used;
}
Exemple #3
0
static void
pf_const_dump_str(PARROT_INTERP, ARGIN(const STRING *self))
{
    ASSERT_ARGS(pf_const_dump_str)

    Parrot_io_printf(interp, "    [ 'PFC_STRING', {\n");
    pobj_flag_dump(interp, (long)PObj_get_FLAGS(self));
    Parrot_io_printf(interp, "        ENCODING => %s,\n", self->encoding->name);
    Parrot_io_printf(interp, "        SIZE     => %ld,\n", self->bufused);
    Parrot_io_printf(interp, "        DATA     => \"%Ss\"\n",
            Parrot_str_escape(interp, self));
    Parrot_io_printf(interp, "    } ],\n");
}
Exemple #4
0
void
mark_special(PARROT_INTERP, ARGMOD(Memory_Pools *mem_pools), ARGIN(PMC *obj))
{
    ASSERT_ARGS(mark_special)

    PObj_get_FLAGS(obj) |= PObj_custom_GC_FLAG;

    /* clearing the flag is much more expensive then testing */
    if (!PObj_needs_early_gc_TEST(obj))
        PObj_high_priority_gc_CLEAR(obj);

    /* mark properties */
    Parrot_gc_mark_PMC_alive(interp, PMC_metadata(obj));

    if (PObj_custom_mark_TEST(obj)) {
        PARROT_ASSERT(!PObj_on_free_list_TEST(obj));
        VTABLE_mark(interp, obj);
    }
}
Exemple #5
0
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
opcode_t *
blizkost_return_from_invoke(PARROT_INTERP, void *next) {
    /* The following code is cargo culted from nci.pmc */
    PMC *cont = interp->current_cont;

    /*
     * If the NCI function was tailcalled, the return result
     * is already passed back to the caller of this frame
     * - see  Parrot_init_ret_nci(). We therefore invoke the
     * return continuation here, which gets rid of this frame
     * and returns the real return address
     */
    if (cont && cont != NEED_CONTINUATION
            && (PObj_get_FLAGS(cont) & SUB_FLAG_TAILCALL)) {
        cont = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp));
        next = VTABLE_invoke(interp, cont, next);
    }

    return (opcode_t *)next;
}
Exemple #6
0
static void
PackFile_Constant_dump(PARROT_INTERP, ARGIN(const PackFile_ConstTable *ct),
                       ARGIN(const PackFile_Constant *self))
{
    ASSERT_ARGS(PackFile_Constant_dump)
    PMC *key;
    size_t i;

    switch (self->type) {

    case PFC_NUMBER:
        Parrot_io_printf(interp, "    [ 'PFC_NUMBER', %g ],\n", self->u.number);
        break;

    case PFC_STRING:
        Parrot_io_printf(interp, "    [ 'PFC_STRING', {\n");
        pobj_flag_dump(interp, (long)PObj_get_FLAGS(self->u.string));
        Parrot_io_printf(interp, "        CHARSET  => %ld,\n",
                   self->u.string->charset);
        i = self->u.string->bufused;
        Parrot_io_printf(interp, "        SIZE     => %ld,\n",
                   (long)i);

        Parrot_io_printf(interp, "        DATA     => \"%Ss\"\n",
                       Parrot_str_escape(interp, self->u.string));
        Parrot_io_printf(interp, "    } ],\n");
        break;

    case PFC_KEY:
        for (i = 0, key = self->u.key; key; i++) {
            GETATTR_Key_next_key(interp, key, key);
        }
        /* number of key components */
        Parrot_io_printf(interp, "    [ 'PFC_KEY' (%ld items)\n", i);
        /* and now type / value per component */
        for (key = self->u.key; key;) {
            opcode_t type = PObj_get_FLAGS(key);

            Parrot_io_printf(interp, "       {\n");

            type &= KEY_type_FLAGS;
            pobj_flag_dump(interp, (long)PObj_get_FLAGS(key));
            switch (type) {
                case KEY_integer_FLAG:
                    Parrot_io_printf(interp, "        TYPE        => INTEGER\n");
                    Parrot_io_printf(interp, "        DATA        => %ld\n",
                            VTABLE_get_integer(interp, key));
                    Parrot_io_printf(interp, "       },\n");
                    break;
                case KEY_number_FLAG:
                    {
                    const PackFile_Constant *detail;
                    size_t ct_index;

                    Parrot_io_printf(interp, "        TYPE        => NUMBER\n");
                    ct_index = PackFile_find_in_const(interp, ct, key, PFC_NUMBER);
                    Parrot_io_printf(interp, "        PFC_OFFSET  => %ld\n", ct_index);
                    detail = ct->constants[ct_index];
                    Parrot_io_printf(interp, "        DATA        => %ld\n", detail->u.number);
                    Parrot_io_printf(interp, "       },\n");
                    }
                    break;
                case KEY_string_FLAG:
                    {
                    const PackFile_Constant *detail;
                    size_t ct_index;

                    Parrot_io_printf(interp, "        TYPE        => STRING\n");
                    ct_index = PackFile_find_in_const(interp, ct, key, PFC_STRING);
                    Parrot_io_printf(interp, "        PFC_OFFSET  => %ld\n", ct_index);
                    detail = ct->constants[ct_index];
                    Parrot_io_printf(interp, "        DATA        => '%Ss'\n",
                              detail->u.string);
                    Parrot_io_printf(interp, "       },\n");
                    }
                    break;
                case KEY_integer_FLAG | KEY_register_FLAG:
                    Parrot_io_printf(interp, "        TYPE        => I REGISTER\n");
                    Parrot_io_printf(interp, "        DATA        => %ld\n",
                            VTABLE_get_integer(interp, key));
                    Parrot_io_printf(interp, "       },\n");
                    break;
                case KEY_number_FLAG | KEY_register_FLAG:
                    Parrot_io_printf(interp, "        TYPE        => N REGISTER\n");
                    Parrot_io_printf(interp, "        DATA        => %ld\n",
                            VTABLE_get_integer(interp, key));
                    Parrot_io_printf(interp, "       },\n");
                    break;
                case KEY_string_FLAG | KEY_register_FLAG:
                    Parrot_io_printf(interp, "        TYPE        => S REGISTER\n");
                    Parrot_io_printf(interp, "        DATA        => %ld\n",
                            VTABLE_get_integer(interp, key));
                    Parrot_io_printf(interp, "       },\n");
                    break;
                case KEY_pmc_FLAG | KEY_register_FLAG:
                    Parrot_io_printf(interp, "        TYPE        => P REGISTER\n");
                    Parrot_io_printf(interp, "        DATA        => %ld\n",
                            VTABLE_get_integer(interp, key));
                    Parrot_io_printf(interp, "       },\n");
                    break;
                default:
                    Parrot_io_eprintf(NULL, "PackFile_Constant_pack: "
                            "unsupported constant type\n");
                    Parrot_exit(interp, 1);
            }
            GETATTR_Key_next_key(interp, key, key);
        }
        Parrot_io_printf(interp, "    ],\n");
        break;
    case PFC_PMC:
        Parrot_io_printf(interp, "    [ 'PFC_PMC', {\n");
        {
            PMC * const pmc = self->u.key;
            Parrot_Sub_attributes *sub;
            STRING * const null = Parrot_str_new_constant(interp, "(null)");
            STRING *namespace_description;

            pobj_flag_dump(interp, (long)PObj_get_FLAGS(pmc));
            switch (pmc->vtable->base_type) {
                case enum_class_FixedBooleanArray:
                case enum_class_FixedFloatArray:
                case enum_class_FixedPMCArray:
                case enum_class_FixedStringArray:
                case enum_class_ResizableBooleanArray:
                case enum_class_ResizableIntegerArray:
                case enum_class_ResizableFloatArray:
                case enum_class_ResizablePMCArray:
                case enum_class_ResizableStringArray:
                    {
                    const int n = VTABLE_get_integer(interp, pmc);
                    STRING* const out_buffer = VTABLE_get_repr(interp, pmc);
                    Parrot_io_printf(interp,
                            "\tclass => %Ss,\n"
                            "\telement count => %d,\n"
                            "\telements => %Ss,\n",
                            pmc->vtable->whoami,
                            n,
                            out_buffer);
                    }
                    break;
                case enum_class_Sub:
                case enum_class_Coroutine:
                    PMC_get_sub(interp, pmc, sub);
                    if (sub->namespace_name) {
                        switch (sub->namespace_name->vtable->base_type) {
                            case enum_class_String:
                                namespace_description = Parrot_str_new(interp, "'", 1);
                                namespace_description = Parrot_str_append(interp,
                                        namespace_description,
                                        VTABLE_get_string(interp, sub->namespace_name));
                                namespace_description = Parrot_str_append(interp,
                                        namespace_description,
                                        Parrot_str_new(interp, "'", 1));
                                break;
                            case enum_class_Key:
                                namespace_description =
                                    key_set_to_string(interp, sub->namespace_name);
                                break;
                            default:
                                namespace_description = sub->namespace_name->vtable->whoami;
                        }
                    }
                    else {
                        namespace_description = null;
                    }
                    Parrot_io_printf(interp,
                            "\tclass => %Ss,\n"
                            "\tstart_offs => %d,\n"
                            "\tend_offs => %d,\n"
                            "\tname    => '%Ss',\n"
                            "\tsubid   => '%Ss',\n"
                            "\tmethod  => '%Ss',\n"
                            "\tnsentry => '%Ss',\n"
                            "\tnamespace => %Ss\n"
                            "\tHLL_id => %d,\n",
                            pmc->vtable->whoami,
                            sub->start_offs,
                            sub->end_offs,
                            sub->name,
                            sub->subid,
                            sub->method_name,
                            sub->ns_entry_name,
                            namespace_description,
                            sub->HLL_id);
                    break;
                case enum_class_FixedIntegerArray:
                    Parrot_io_printf(interp,
                            "\tclass => %Ss,\n"
                            "\trepr => '%Ss'\n",
                            pmc->vtable->whoami,
                            VTABLE_get_repr(interp, pmc));
                    break;
                default:
                    Parrot_io_printf(interp, "\tno dump info for PMC %ld %Ss\n",
                            pmc->vtable->base_type, pmc->vtable->whoami);
                    Parrot_io_printf(interp, "\tclass => %Ss,\n", pmc->vtable->whoami);
            }
        }
        Parrot_io_printf(interp, "    } ],\n");
        break;
    default:
        Parrot_io_printf(interp, "    [ 'PFC_\?\?\?', type '0x%x' ],\n",
                self->type);
        break;
    }
}