Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Branch: master
Fetching contributors…

Cannot retrieve contributors at this time

565 lines (410 sloc) 13.717 kB
/*
Copyright (C) 2001-2014, Parrot Foundation.
=head1 NAME
src/pmc/key.pmc - Key PMC
=head1 DESCRIPTION
These are the vtable functions for the Key PMC class.
=head2 Methods
=over 4
=cut
*/
/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
/* HEADERIZER END: static */
pmclass Key auto_attrs {
ATTR PMC *next_key; /* Sometimes it's the next key, sometimes it's
not. The Key code is like that. */
ATTR INTVAL int_key; /* int value of this key, or something magical if
it's a hash iterator key */
ATTR STRING *str_key; /* STRING value of this key, if any */
/* Theoretically there'd also be a pmc_key here,
* but that code looks broken and unneeded. */
/*
=item C<void init()>
Initializes the key.
=cut
*/
VTABLE void init() {
PObj_custom_mark_SET(SELF);
}
/*
=item C<PMC *clone()>
Creates and returns a clone of the key.
=cut
*/
VTABLE PMC *clone() :no_wb {
PMC * const dest = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
PMC *dkey = dest;
PMC *key = SELF;
for (; key ;) {
switch (KEY_get_FLAGS(key)) {
case KEY_integer_FLAG:
case KEY_integer_FLAG | KEY_register_FLAG:
Parrot_key_set_integer(INTERP, dkey, Parrot_key_integer(INTERP, key));
break;
case KEY_string_FLAG:
case KEY_string_FLAG | KEY_register_FLAG:
Parrot_key_set_string(INTERP, dkey, VTABLE_get_string(INTERP, key));
break;
case KEY_pmc_FLAG:
case KEY_pmc_FLAG | KEY_register_FLAG:
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
"Key.clone of pmc is broken - see TT #1683");
default:
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
"Key: Unknown Key type %d", KEY_get_FLAGS(SELF));
break;
}
key = Parrot_key_next(INTERP, key);
if (key) {
PMC * const p = Parrot_key_new(INTERP);
Parrot_key_append(INTERP, dkey, p);
dkey = p;
}
}
return dest;
}
/*
=item C<void mark()>
Marks the key as live.
=cut
*/
VTABLE void mark() :no_wb {
Parrot_key_mark(INTERP, SELF);
}
/*
=item C<INTVAL get_integer()>
Returns the integer value of the key.
=cut
*/
VTABLE INTVAL get_integer() :no_wb {
return Parrot_key_integer(INTERP, SELF);
}
/*
=item C<STRING *get_string()>
Returns the Parrot string value of the key.
=cut
*/
VTABLE STRING *get_string() :no_wb {
/* Parrot_key_string() is only useful if this PMC has a key type */
if (KEY_get_FLAGS(SELF)) {
return Parrot_key_string(INTERP, SELF);
}
return CONST_STRING(INTERP, "");
}
/*
=item C<PMC *get_pmc()>
Returns the PMC value of the key.
=cut
*/
VTABLE PMC *get_pmc() :no_wb {
return Parrot_key_pmc(INTERP, SELF);
}
/*
=item C<void set_integer_native(INTVAL value)>
=cut
*/
VTABLE void set_integer_native(INTVAL value) {
Parrot_key_set_integer(INTERP, SELF, value);
}
/*
=item C<void set_string_native(STRING *value)>
=cut
*/
VTABLE void set_string_native(STRING *value) {
Parrot_key_set_string(INTERP, SELF, value);
}
/*
=item C<void set_pmc(PMC *value)>
Sets the value of the key to C<*value>.
=cut
*/
VTABLE void set_pmc(PMC *value) :no_wb {
UNUSED(SELF)
UNUSED(value)
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_UNIMPLEMENTED,
"Key.set_pmc is broken - see GH #499");
}
/*
=item C<void push_pmc(PMC *value)>
Appends C<*value> to the key.
=cut
*/
void push_pmc(PMC *value) {
if (value->vtable->base_type != enum_class_Key)
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_INVALID_OPERATION,
"Can only push another Key onto a Key PMC.");
Parrot_key_append(INTERP, SELF, value);
}
/*
=item C<PMC *shift_pmc()>
Returns the next key.
Actually doesn't remove the entry but might be useful to traverse a key
chain.
=cut
*/
VTABLE PMC *shift_pmc() :no_wb {
PMC *next_key;
GET_ATTR_next_key(INTERP, SELF, next_key);
return next_key;
}
/*
=back
=head2 Iterator Interface
=over 4
=item C<PMC *get_pmc_keyed(PMC *key)>
Returns the key itself.
=cut
*/
VTABLE PMC *get_pmc_keyed(PMC *key) :no_wb {
UNUSED(INTERP)
UNUSED(SELF)
return key;
}
/*
=item C<void freeze(PMC *info)>
Archives the Key.
=item C<void thaw(PMC *info)>
Unarchives the Key.
=item C<void thawfinish(PMC *info)>
Called after the Key has been thawed: convert last PMC_NULL key to NULL.
=cut
*/
void freeze(PMC *info) :no_wb {
int size;
PMC *k;
for (size = 0, k = SELF; k; size++)
GET_ATTR_next_key(interp, k, k);
VTABLE_push_integer(INTERP, info, size);
for (k = SELF; k;) {
const INTVAL flags = KEY_get_FLAGS(k);
VTABLE_push_integer(INTERP, info, flags);
switch (flags) {
case KEY_integer_FLAG | KEY_register_FLAG:
case KEY_string_FLAG | KEY_register_FLAG:
case KEY_pmc_FLAG | KEY_register_FLAG:
case KEY_integer_FLAG:
{
INTVAL i;
GET_ATTR_int_key(INTERP, k, i);
VTABLE_push_integer(INTERP, info, i);
}
break;
case KEY_string_FLAG:
{
STRING *s;
GET_ATTR_str_key(INTERP, k, s);
VTABLE_push_string(INTERP, info, s);
}
break;
default:
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_KEY_NOT_FOUND,
"Unsupported key type in Key.freeze");
break;
}
GET_ATTR_next_key(interp, k, k);
}
}
void thaw(PMC *info) {
int size;
PMC *k = SELF;
PObj_custom_mark_SET(SELF);
for (size = VTABLE_shift_integer(INTERP, info); size; size--) {
const INTVAL flags = VTABLE_shift_integer(INTERP, info) & KEY_type_FLAGS;
PObj_get_FLAGS(k) |= flags;
/* get contents */
switch (flags) {
case KEY_integer_FLAG | KEY_register_FLAG:
case KEY_string_FLAG | KEY_register_FLAG:
case KEY_pmc_FLAG | KEY_register_FLAG:
case KEY_integer_FLAG:
SET_ATTR_int_key(INTERP, k, VTABLE_shift_integer(INTERP, info));
break;
case KEY_string_FLAG:
VTABLE_set_string_native(INTERP, k, VTABLE_shift_string(INTERP, info));
break;
default:
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_KEY_NOT_FOUND,
"Unsupported key type in Key.thaw");
break;
}
if (size == 1) {
SET_ATTR_next_key(INTERP, k, NULL);
}
else {
SET_ATTR_next_key(INTERP, k, Parrot_pmc_new(INTERP, enum_class_Key));
GET_ATTR_next_key(INTERP, k, k);
}
}
}
VTABLE void thawfinish(PMC *info) {
UNUSED(info)
PMC *key = SELF;
while (1) {
PMC *next;
GET_ATTR_next_key(INTERP, key, next);
if (PMC_IS_NULL(next)) {
SET_ATTR_next_key(INTERP, key, NULL);
break;
}
key = next;
}
}
VTABLE STRING* get_repr() :no_wb {
return Parrot_key_set_to_string(INTERP, SELF);
}
/*
=item C<set_register(reg_no, type)>
Set key to hold particular register.
=cut
*/
METHOD set_register(INTVAL reg_no, INTVAL reg_type) {
Parrot_key_set_register(INTERP, SELF, reg_no, reg_type);
}
/*
=item C<INTVAL elements()>
=item C<INTVAL get_integer_keyed_int(INTVAL n)>
=item C<STRING *get_string_keyed_int(INTVAL n)>
=item C<PMC *get_pmc_keyed_init(INTVAL n)>
Aggregate interface.
=cut
*/
VTABLE INTVAL elements() :no_wb {
INTVAL n = 0;
UNUSED(INTERP)
for (; SELF; SELF = PARROT_KEY(SELF)->next_key)
n++;
return n;
}
VTABLE INTVAL get_integer_keyed_int(INTVAL n) :no_wb {
for (; SELF && n; SELF = PARROT_KEY(SELF)->next_key, n--);
if (n)
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
"Key access out of bounds");
return Parrot_key_integer(INTERP, SELF);
}
VTABLE STRING *get_string_keyed_int(INTVAL n) :no_wb {
for (; SELF && n; SELF = PARROT_KEY(SELF)->next_key, n--);
if (n)
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
"Key access out of bounds");
return Parrot_key_string(INTERP, SELF);
}
VTABLE PMC *get_pmc_keyed_int(INTVAL n) :no_wb {
for (; SELF && n; SELF = PARROT_KEY(SELF)->next_key, n--);
if (n)
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
"Key access out of bounds");
return Parrot_key_pmc(INTERP, SELF);
}
METHOD make_register_key(STRING * set, INTVAL idx) {
INTVAL first_char = Parrot_str_indexed(INTERP, set, 0);
KEY_flags key_type;
switch (first_char) {
case 'S':
key_type = KEY_string_FLAG;
break;
case 'I':
key_type = KEY_integer_FLAG;
break;
case 'P':
key_type = KEY_pmc_FLAG;
break;
default:
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_NULL_REG_ACCESS,
"Key: Unknown register set %Ss", set);
}
Parrot_key_set_register(INTERP, SELF, idx, (INTVAL)key_type);
}
METHOD is_register_reference() :no_wb {
INTVAL is_reg_ref = KEY_register_TEST(SELF) ? 1 : 0;
RETURN(INTVAL is_reg_ref);
}
METHOD get_register_idx() :no_wb {
if (!KEY_register_TEST(SELF))
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_KEY_NOT_FOUND,
"Key: Key is not a register reference");
else {
const INTVAL idx = Parrot_key_integer(INTERP, SELF);
RETURN(INTVAL idx);
}
}
METHOD get_register_contents(PMC *ctx :optional, INTVAL has_ctx :opt_flag) :no_wb {
INTVAL int_key;
if (!KEY_register_TEST(SELF))
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_KEY_NOT_FOUND,
"Key: Key is not a register reference");
GETATTR_Key_int_key(interp, SELF, int_key);
if (!has_ctx || PMC_IS_NULL(ctx)) {
switch (KEY_get_FLAGS(SELF)) {
case KEY_string_FLAG | KEY_register_FLAG: {
STRING * const str_val = REG_STR(interp, int_key);
RETURN(STRING *str_val);
}
case KEY_pmc_FLAG | KEY_register_FLAG: {
PMC * const pmc_val = REG_PMC(interp, int_key);
RETURN(PMC *pmc_val);
}
case KEY_integer_FLAG | KEY_register_FLAG: {
const INTVAL int_val = REG_INT(interp, int_key);
RETURN(INTVAL int_val);
}
default:
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_KEY_NOT_FOUND,
"Key: Unknown Key type %d", KEY_get_FLAGS(SELF));
}
}
else {
switch (KEY_get_FLAGS(SELF)) {
case KEY_string_FLAG | KEY_register_FLAG: {
STRING * const str_val = *Parrot_pcc_get_STRING_reg(INTERP, ctx, int_key);
RETURN(STRING *str_val);
}
case KEY_pmc_FLAG | KEY_register_FLAG: {
PMC * const pmc_val = *Parrot_pcc_get_PMC_reg(INTERP, ctx, int_key);
RETURN(PMC *pmc_val);
}
case KEY_integer_FLAG | KEY_register_FLAG: {
const INTVAL int_val = *Parrot_pcc_get_INTVAL_reg(INTERP, ctx, int_key);
RETURN(INTVAL int_val);
}
default:
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_KEY_NOT_FOUND,
"Key: Unknown Key type %d", KEY_get_FLAGS(SELF));
}
}
}
/* returns integer, values taken from PCC */
METHOD get_type() :no_wb {
INTVAL ret = 0;
switch (KEY_get_FLAGS(SELF)) {
#if 0
case KEY_integer_FLAG:
case KEY_integer_FLAG | KEY_register_FLAG:
ret = 0;
break;
#endif
case KEY_string_FLAG:
case KEY_string_FLAG | KEY_register_FLAG:
ret = 1;
break;
case KEY_pmc_FLAG:
case KEY_pmc_FLAG | KEY_register_FLAG:
ret = 2;
break;
default:
break;
}
RETURN(INTVAL ret);
}
}
/*
=back
=cut
*/
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
*/
Jump to Line
Something went wrong with that request. Please try again.