lexpad.pmc

/*
Copyright (C) 2007-2014, Parrot Foundation.

=head1 NAME

src/pmc/lexpad.pmc - LexPad PMC

=head1 DESCRIPTION

These are the vtable functions for the lexpad PMC.

LexPad provides a Hash interface for lexical fetch/store
needed:

    struct_val ... Context *ctx
    pmc_val    ... LexInfo

=head2 Functions

=over 4

=cut

*/


/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */

PARROT_INLINE
PARROT_CAN_RETURN_NULL
static HashBucket * register_bucket(PARROT_INTERP,
    ARGMOD(PMC *info),
    ARGIN(STRING *name))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        __attribute__nonnull__(3)
        FUNC_MODIFIES(*info);

static INTVAL register_number_for_get(PARROT_INTERP,
    ARGMOD(PMC *info),
    ARGIN(STRING *name),
    INTVAL reg_type)
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        __attribute__nonnull__(3)
        FUNC_MODIFIES(*info);

static INTVAL register_number_for_set(PARROT_INTERP,
    ARGMOD(PMC *info),
    ARGMOD(STRING *name),
    INTVAL reg_type)
        __attribute__nonnull__(1)
        __attribute__nonnull__(2)
        __attribute__nonnull__(3)
        FUNC_MODIFIES(*info)
        FUNC_MODIFIES(*name);

PARROT_DOES_NOT_RETURN
static void throw_lexical_not_found(PARROT_INTERP, ARGIN(STRING *name))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2);

PARROT_DOES_NOT_RETURN
static void throw_wrong_register_type(PARROT_INTERP, ARGIN(STRING *name))
        __attribute__nonnull__(1)
        __attribute__nonnull__(2);

#define ASSERT_ARGS_register_bucket __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
       PARROT_ASSERT_ARG(interp) \
    , PARROT_ASSERT_ARG(info) \
    , PARROT_ASSERT_ARG(name))
#define ASSERT_ARGS_register_number_for_get __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
       PARROT_ASSERT_ARG(interp) \
    , PARROT_ASSERT_ARG(info) \
    , PARROT_ASSERT_ARG(name))
#define ASSERT_ARGS_register_number_for_set __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
       PARROT_ASSERT_ARG(interp) \
    , PARROT_ASSERT_ARG(info) \
    , PARROT_ASSERT_ARG(name))
#define ASSERT_ARGS_throw_lexical_not_found __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
       PARROT_ASSERT_ARG(interp) \
    , PARROT_ASSERT_ARG(name))
#define ASSERT_ARGS_throw_wrong_register_type __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
       PARROT_ASSERT_ARG(interp) \
    , PARROT_ASSERT_ARG(name))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
/* HEADERIZER END: static */


/*

=item C<static void throw_wrong_register_type(PARROT_INTERP, STRING *name)>

=item C<static void throw_lexical_not_found(PARROT_INTERP, STRING *name)>

Helper functions for common exceptions.

=cut

*/

PARROT_DOES_NOT_RETURN
static void
throw_wrong_register_type(PARROT_INTERP, ARGIN(STRING *name))
{
    ASSERT_ARGS(throw_wrong_register_type)
    Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LEX_NOT_FOUND,
            "Lexical '%Ss' is of wrong register type in lexical lookup", name);
}

PARROT_DOES_NOT_RETURN
static void
throw_lexical_not_found(PARROT_INTERP, ARGIN(STRING *name))
{
    ASSERT_ARGS(throw_lexical_not_found)
    Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LEX_NOT_FOUND,
            "Lexical '%Ss' not found", name);
}

/*

=item C<static HashBucket * register_bucket(PARROT_INTERP, PMC *info, STRING
*name)>

Helper for register_number_ functions.

=cut

*/

PARROT_INLINE
PARROT_CAN_RETURN_NULL
static HashBucket *
register_bucket(PARROT_INTERP, ARGMOD(PMC *info), ARGIN(STRING *name))
{
    ASSERT_ARGS(register_bucket)
    const Hash * const hash = (const Hash *)VTABLE_get_pointer(interp, info);
    return hash->entries ?
            Parrot_hash_get_bucket(interp, hash, name) :
            NULL;
}

/*

=item C<static INTVAL register_number_for_get(PARROT_INTERP, PMC *info, STRING
*name, INTVAL reg_type)>

Locates the register number for getting the specified name
and type of lexical.

=cut

*/

static INTVAL
register_number_for_get(PARROT_INTERP, ARGMOD(PMC *info), ARGIN(STRING *name),
        INTVAL reg_type)
{
    ASSERT_ARGS(register_number_for_get)

    const HashBucket * const b = register_bucket(interp, info, name);
    if (!b)
        return -1;
    if (((INTVAL)b->value & 3) != reg_type)
        throw_wrong_register_type(interp, name);

    return ((INTVAL)b->value) >> 2;
}

/*

=item C<static INTVAL register_number_for_set(PARROT_INTERP, PMC *info, STRING
*name, INTVAL reg_type)>

Locates the register number for setting the specified name
and type of lexical.

=cut

*/

static INTVAL
register_number_for_set(PARROT_INTERP, ARGMOD(PMC *info), ARGMOD(STRING *name),
        INTVAL reg_type)
{
    ASSERT_ARGS(register_number_for_set)

    const HashBucket * const b = register_bucket(interp, info, name);
    if (!b)
        throw_lexical_not_found(interp, name);
    if (((INTVAL)b->value & 3) != reg_type)
        throw_wrong_register_type(interp, name);

    return ((INTVAL)b->value) >> 2;
}


pmclass LexPad provides hash no_ro auto_attrs {
    ATTR PMC *lexinfo;
    ATTR PMC *ctx;

    VTABLE void init() :no_wb {
        Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
            "Cannot create a LexPad PMC without an initializer");
    }

/*

=item C<init_pmc(PMC *lexinfo)>

Initialize the LexPad PMC and remember the associate
lexinfo.

=item C<void set_pointer(void *)>

Initialize the LexPad PMC and remember the associate context.

=item C<INTVAL elements()>

Returns the number of elements in the hash.

=item C<INTVAL exists_keyed(PMC *name)>

=item C<INTVAL exists_keyed_str(STRING *name)>

Returns whether a lexical C<name> exists in the hash.

=item C<PMC *get_pmc_keyed_str(STRING *name)>

=item C<PMC *get_pmc_keyed(PMC *name)>

Return the lexical with the given name, or NULL (not PMCNULL), if the
lexical doesn't exist.

=item C<void set_pmc_keyed(PMC *name, PMC *value)>

=item C<void set_pmc_keyed_str(STRING *name, PMC *value)>

Set the lexical with the given name to value. If the lexical name
doesn't exist, it is created.

=item C<PMC *get_lexinfo()>

Return the LexInfo PMC, if any or a Null PMC.

=cut

*/
    VTABLE void init_pmc(PMC *lexinfo) {
        SET_ATTR_lexinfo(INTERP, SELF, lexinfo);
    }

    VTABLE void set_pointer(void *ctx) {
        SET_ATTR_ctx(INTERP, SELF, (PMC *)ctx);
    }

    VTABLE INTVAL elements() :no_wb {
        PMC *info;
        GET_ATTR_lexinfo(INTERP, SELF, info);
        return Parrot_hash_size(INTERP,
                (Hash *)VTABLE_get_pointer(INTERP, info));
    }

    VTABLE INTVAL exists_keyed_str(STRING *name) :no_wb {
        PMC  *info;
        const Hash *hash;
        GET_ATTR_lexinfo(INTERP, SELF, info);
        hash = (const Hash *)VTABLE_get_pointer(INTERP, info);

        return hash->entries
            ? (Parrot_hash_get_bucket(INTERP, hash, name) != 0)
            : 0;
    }

    VTABLE INTVAL exists_keyed(PMC *name) :no_wb {
        STRING * const s = VTABLE_get_string(INTERP, name);
        return SELF.exists_keyed_str(s);
    }

    VTABLE PMC *get_pmc_keyed_str(STRING *name) :no_wb {
        PMC    *info;
        PMC    *ctx;
        INTVAL  reg;

        GET_ATTR_lexinfo(INTERP, SELF, info);
        reg = register_number_for_get(INTERP, info, name, REGNO_PMC);
        if (reg < 0)
            return PMCNULL;

        GET_ATTR_ctx(INTERP, SELF, ctx);
        return CTX_REG_PMC(INTERP, ctx, reg);
    }

    VTABLE INTVAL get_integer_keyed_str(STRING *name) :no_wb {
        PMC    *info;
        PMC    *ctx;
        INTVAL  reg;

        GET_ATTR_lexinfo(INTERP, SELF, info);
        reg = register_number_for_get(INTERP, info, name, REGNO_INT);
        if (reg < 0)
            throw_lexical_not_found(INTERP, name);

        GET_ATTR_ctx(INTERP, SELF, ctx);
        return CTX_REG_INT(INTERP, ctx, reg);
    }

    VTABLE FLOATVAL get_number_keyed_str(STRING *name) :no_wb {
        PMC    *info;
        PMC    *ctx;
        INTVAL  reg;

        GET_ATTR_lexinfo(INTERP, SELF, info);
        reg = register_number_for_get(INTERP, info, name, REGNO_NUM);
        if (reg < 0)
            throw_lexical_not_found(INTERP, name);

        GET_ATTR_ctx(INTERP, SELF, ctx);
        return CTX_REG_NUM(INTERP, ctx, reg);
    }

    VTABLE STRING *get_string_keyed_str(STRING *name) :no_wb {
        PMC    *info;
        PMC    *ctx;
        INTVAL  reg;

        GET_ATTR_lexinfo(INTERP, SELF, info);
        reg = register_number_for_get(INTERP, info, name, REGNO_STR);
        if (reg < 0)
            throw_lexical_not_found(INTERP, name);

        GET_ATTR_ctx(INTERP, SELF, ctx);
        return CTX_REG_STR(INTERP, ctx, reg);
    }

    VTABLE PMC *get_pmc_keyed(PMC *name) :no_wb {
        STRING * const s = VTABLE_get_string(INTERP, name);
        return SELF.get_pmc_keyed_str(s);
    }

    VTABLE INTVAL get_integer_keyed(PMC *name) :no_wb {
        STRING * const s = VTABLE_get_string(INTERP, name);
        return SELF.get_integer_keyed_str(s);
    }

    VTABLE FLOATVAL get_number_keyed(PMC *name) :no_wb {
        STRING * const s = VTABLE_get_string(INTERP, name);
        return SELF.get_number_keyed_str(s);
    }

    VTABLE STRING *get_string_keyed(PMC *name) :no_wb {
        STRING * const s = VTABLE_get_string(INTERP, name);
        return SELF.get_string_keyed_str(s);
    }

    VTABLE void set_pmc_keyed_str(STRING *name, PMC *value) {
        PMC    *info;
        PMC    *ctx;
        INTVAL  reg;

        GET_ATTR_lexinfo(INTERP, SELF, info);
        reg = register_number_for_set(INTERP, info, name, REGNO_PMC);

        GET_ATTR_ctx(INTERP, SELF, ctx);
        CTX_REG_PMC(INTERP, ctx, reg) = value;
    }

    VTABLE void set_integer_keyed_str(STRING *name, INTVAL value) {
        PMC    *info;
        PMC    *ctx;
        INTVAL  reg;

        GET_ATTR_lexinfo(INTERP, SELF, info);
        reg = register_number_for_set(INTERP, info, name, REGNO_INT);

        GET_ATTR_ctx(INTERP, SELF, ctx);
        CTX_REG_INT(INTERP, ctx, reg) = value;
    }

    VTABLE void set_number_keyed_str(STRING *name, FLOATVAL value) {
        PMC    *info;
        PMC    *ctx;
        INTVAL  reg;

        GET_ATTR_lexinfo(INTERP, SELF, info);
        reg = register_number_for_set(INTERP, info, name, REGNO_NUM);

        GET_ATTR_ctx(INTERP, SELF, ctx);
        CTX_REG_NUM(INTERP, ctx, reg) = value;
    }

    VTABLE void set_string_keyed_str(STRING *name, STRING *value) {
        PMC    *info;
        PMC    *ctx;
        INTVAL  reg;

        GET_ATTR_lexinfo(INTERP, SELF, info);
        reg = register_number_for_set(INTERP, info, name, REGNO_STR);

        GET_ATTR_ctx(INTERP, SELF, ctx);
        CTX_REG_STR(INTERP, ctx, reg) = value;
    }

    VTABLE void set_pmc_keyed(PMC *name, PMC *value) :manual_wb {
        STRING * const s = VTABLE_get_string(INTERP, name);
        SELF.set_pmc_keyed_str(s, value);
    }

    VTABLE void set_integer_keyed(PMC *name, INTVAL value) :manual_wb {
        STRING * const s = VTABLE_get_string(INTERP, name);
        SELF.set_integer_keyed_str(s, value);
    }

    VTABLE void set_number_keyed(PMC *name, FLOATVAL value) :manual_wb {
        STRING * const s = VTABLE_get_string(INTERP, name);
        SELF.set_number_keyed_str(s, value);
    }

    VTABLE void set_string_keyed(PMC *name, STRING *value) :manual_wb {
        STRING * const s = VTABLE_get_string(INTERP, name);
        SELF.set_string_keyed_str(s, value);
    }

    METHOD get_lexinfo() :no_wb {
        PMC *lexinfo;
        GET_ATTR_lexinfo(INTERP, SELF, lexinfo);
        RETURN(PMC *lexinfo);
    }

/*

=item C<PMC *get_iter()>

Get iterator for declared lexicals.

=cut

*/
    VTABLE PMC *get_iter() :no_wb {
        PMC    *info;
        PMC    *ctx;
        PMC    *info_iter;
        PMC    *value_map = Parrot_pmc_new(INTERP, enum_class_Hash);
        Hash   *hash;
        PMC    *iter;

        GET_ATTR_lexinfo(INTERP, SELF, info);
        GET_ATTR_ctx(INTERP, SELF, ctx);

        info_iter = VTABLE_get_iter(INTERP, info);
        hash = (Hash *)VTABLE_get_pointer(interp, info);

        while (VTABLE_get_bool(INTERP, info_iter)) {
            STRING * const name = VTABLE_shift_string(INTERP, info_iter);
            HashBucket * const b = Parrot_hash_get_bucket(INTERP, hash, name);
            INTVAL reg_type = (INTVAL)b->value & 3;
            INTVAL reg_idx = ((INTVAL)b->value) >> 2;
            PMC * value;
            switch (reg_type) {
                case REGNO_PMC:
                    value = CTX_REG_PMC(INTERP, ctx, reg_idx);
                    VTABLE_set_pmc_keyed_str(INTERP, value_map, name, value);
                    break;
                case REGNO_INT: {
                    const INTVAL ivalue = CTX_REG_INT(INTERP, ctx, reg_idx);
                    value = Parrot_pmc_box_integer(INTERP, ivalue);
                    VTABLE_set_pmc_keyed_str(INTERP, value_map, name, value);
                    break;
                }
                case REGNO_STR: {
                    STRING * const svalue = CTX_REG_STR(INTERP, ctx, reg_idx);
                    value = Parrot_pmc_box_string(INTERP, svalue);
                    VTABLE_set_pmc_keyed_str(INTERP, value_map, name, value);
                    break;
                }
                case REGNO_NUM: {
                    FLOATVAL fvalue = CTX_REG_NUM(INTERP, ctx, reg_idx);
                    value = Parrot_pmc_box_number(INTERP, fvalue);
                    VTABLE_set_pmc_keyed_str(INTERP, value_map, name, value);
                    break;
                }
                default:
                    throw_wrong_register_type(INTERP, name);
            }
        }
        return VTABLE_get_iter(INTERP, value_map);
    }

/*

=item C<INTVAL register_type(STRING *name)>

Returns a number based on the type of the variable named name.

=over 4

=item * -1 = Not Found

=item * 0 = Integer

=item * 1 = Num

=item * 2 = String

=item * 3 = PMC

=back

=cut

*/

    METHOD INTVAL register_type(STRING *name) :no_wb {
        PMC *info;
        HashBucket *b;
        INTVAL ret = -1;

        GET_ATTR_lexinfo(INTERP, SELF, info);
        b = register_bucket(INTERP, info, name);
        if (b)
            ret = (INTVAL) b->value & 3;
        RETURN(INTVAL ret);
    }

}

/*

=back

=head1 SEE ALSO

F<docs/pdds/pdd20_lexical_vars.pod>, F<src/pmc/lexinfo.pmc>.

=cut

*/

/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
 */