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

827 lines (612 sloc) 19.782 kb
/*
Copyright (C) 2005-2009, Parrot Foundation.
$Id$
=head1 Lua Table
=head2 Description
C<LuaTable> extends C<LuaBase> to provide a class with the behaviour of
the Lua C<Table> type.
This implementation is based on the Lua 4.0 one.
=head3 Overloaded Methods
=over 4
=cut
*/
#include "lua_private.h"
#define t_mt(pmc) (PARROT_LUATABLE(pmc))->mt
PMC *
_LuaTable_get_metatable(PARROT_INTERP, PMC *obj) {
return t_mt(obj);
}
#define LUA_ASSERT(c, s) assert(((void)(s), (c)))
#define MAX_INT (INT_MAX-2) /* maximum value of an int (-2 for safety) */
#define MINPOWER2 4 /* minimum size for "growing" vectors */
/******************************************************************************/
/*
** Implementation of tables (aka arrays, objects, or hash tables);
** uses a mix of chained scatter table with Brent's variation.
** A main invariant of these tables is that, if an element is not
** in its main position (i.e. the `original' position that its hash gives
** to it), then the colliding element is in its own main position.
** In other words, there are collisions only when two elements have the
** same main position (i.e. the same hash values for that table size).
** Because of that, the load factor of these tables can be 100% without
** performance penalties.
*/
typedef struct Node {
PMC *key;
PMC *val;
struct Node *next; /* for chaining */
} Node;
#define node(t, i) (&(t)->node[i])
/******************************************************************************/
static int lua_equalObj(PARROT_INTERP, PMC * const t1, PMC * const t2)
{
if (!t2)
return 0;
if (PMC_type(t1) != PMC_type(t2))
return 0;
if (PMC_type(t1) == dynpmc_LuaNumber)
return VTABLE_get_number(interp, t1) == VTABLE_get_number(interp, t2);
if (PMC_type(t1) == dynpmc_LuaBoolean)
return VTABLE_get_integer(interp, t1) == VTABLE_get_integer(interp, t2);
if (PMC_type(t1) == dynpmc_LuaString)
return 0 == Parrot_str_compare(interp, VTABLE_get_string(interp, t1),
VTABLE_get_string(interp, t2));
return PMC_data(t1) == PMC_data(t2);
}
/*
** returns the `main' position of an element in a table (that is, the index
** of its hash value)
*/
static Node *mainposition(PARROT_INTERP, const Parrot_LuaTable_attributes *t, PMC *key)
{
unsigned long h;
if (PMC_type(key) == dynpmc_LuaNil)
return NULL;
if (PMC_type(key) == dynpmc_LuaNumber) {
h = (unsigned long)(long)VTABLE_get_number(interp, key);
}
else if (PMC_type(key) == dynpmc_LuaBoolean) {
h = VTABLE_get_integer(interp, key);
}
else if (PMC_type(key) == dynpmc_LuaString) {
h = Parrot_str_to_hashval(interp, VTABLE_get_string(interp, key));
}
else {
h = (unsigned long)PMC_data(key);
h >>= 3;
}
LUA_ASSERT(h%(unsigned int)t->size == (h&((unsigned int)t->size-1)),
"a&(x-1) == a%x, for x power of 2");
return &t->node[h&(t->size-1)];
}
/* specialized version for strings */
static PMC** lua_getstr(PARROT_INTERP, const Parrot_LuaTable_attributes *t, STRING *key)
{
unsigned long h = Parrot_str_to_hashval(interp, key);
Node *n = &t->node[h&(t->size-1)];
do {
if (n->key
&& PMC_type(n->key) == dynpmc_LuaString
&& 0 == Parrot_str_compare(interp, VTABLE_get_string(interp, n->key), key))
return &n->val;
n = n->next;
} while (n);
/* key not found */
return NULL;
}
static PMC** lua_get(PARROT_INTERP, const Parrot_LuaTable_attributes *t, PMC *key)
{
Node *n = mainposition(interp, t, key);
if (!n)
return NULL;
do {
if (lua_equalObj(interp, key, n->key))
return &n->val;
n = n->next;
} while (n);
/* key not found */
return NULL;
}
static Node* lua_next(PARROT_INTERP, const Parrot_LuaTable_attributes *t, PMC *key)
{
int i;
/* first iteration */
if (key == NULL || PMC_type(key) == dynpmc_LuaNil)
i = 0;
else {
PMC **v = lua_get(interp, t, key);
if (!v || ! *v)
Parrot_ex_throw_from_c_args(interp, NULL, 1, "invalid key to 'next'");
i = (int)(((const char *)v -
(const char *)(&t->node[0].val)) / sizeof (Node)) + 1;
}
for (; i<t->size; i++) {
Node *n = node(t, i);
if (n->val)
return n;
}
/* no more elements */
return NULL;
}
static void rehash(PARROT_INTERP, Parrot_LuaTable_attributes *t);
/*
** inserts a key into a hash table; first, check whether key is
** already present; if not, check whether key's main position is free;
** if not, check whether colliding node is in its main position or not;
** if it is not, move colliding node to an empty place and put new key
** in its main position; otherwise (colliding node is in its main position),
** new key goes to an empty position.
*/
static PMC** lua_set(PARROT_INTERP, Parrot_LuaTable_attributes *t, PMC *key)
{
Node *mp = mainposition(interp, t, key);
Node *n = mp;
if (!mp)
Parrot_ex_throw_from_c_args(interp, NULL, 1, "table index is nil");
/* check whether `key' is somewhere in the chain */
do {
/* that's all */
if (lua_equalObj(interp, key, n->key))
return &n->val;
else
n = n->next;
} while (n);
/* `key' not found; must insert it */
/* main position is not free? */
if (mp->key) {
Node *othern; /* main position of colliding node */
/* get a free place */
n = t->firstfree;
/* is colliding node out of its main position? (can only happen if
its position is after "firstfree") */
if (mp > n && (othern=mainposition(interp, t, mp->key)) != mp) {
/* yes; move colliding node into free position */
while (othern->next != mp)
othern = othern->next; /* find previous */
/* redo the chain with `n' in place of `mp' */
othern->next = n;
/* copy colliding node into free pos. (mp->next also goes) */
*n = *mp;
/* now `mp' is free */
mp->next = NULL;
}
/* colliding node is in its own main position */
else {
/* new node will go into free position */
/* chain new position */
n->next = mp->next;
mp->next = n;
mp = n;
}
}
mp->key = key;
/* correct `firstfree' */
for (;;) {
/* OK; table still has a free place */
if (! t->firstfree->key)
return &mp->val;
else if (t->firstfree == t->node)
break; /* cannot decrement from here */
else
(t->firstfree)--;
}
/* no more free places */
rehash(interp, t);
/* `rehash' invalidates this insertion */
return lua_set(interp, t, key);
}
static void setnodevector(PARROT_INTERP, Parrot_LuaTable_attributes *t, int size)
{
if (size > MAX_INT)
Parrot_ex_throw_from_c_args(interp, NULL, 1, "table overflow");
t->node = mem_allocate_n_zeroed_typed(size, Node);
t->size = size;
/* first free position to be used */
t->firstfree = &t->node[size-1];
}
static int numuse(const Parrot_LuaTable_attributes *t)
{
Node *v = t->node;
int size = t->size;
int realuse = 0;
int i;
for (i = 0; i < size; i++) {
if (v[i].val)
realuse++;
}
return realuse;
}
static void rehash(PARROT_INTERP, Parrot_LuaTable_attributes *t)
{
int oldsize = t->size;
Node *nold = t->node;
int nelems = numuse(t);
int i;
LUA_ASSERT(nelems<=oldsize, "wrong count");
Parrot_block_GC_mark(interp);
/* using more than 3/4? */
if (nelems >= oldsize-oldsize/4)
setnodevector(interp, t, oldsize*2);
/* less than 1/4? */
else if (nelems <= oldsize/4 && oldsize > MINPOWER2)
setnodevector(interp, t, oldsize/2);
else
setnodevector(interp, t, oldsize);
for (i = 0; i < oldsize; i++) {
Node *old = nold + i;
if (old->val)
*lua_set(interp, t, old->key) = old->val;
}
Parrot_unblock_GC_mark(interp);
/* free old array */
mem_sys_free(nold);
}
static void lua_new_table(PARROT_INTERP, Parrot_LuaTable_attributes *t)
{
setnodevector(interp, t, MINPOWER2);
}
static void lua_destroy_table(PARROT_INTERP, Parrot_LuaTable_attributes *t)
{
mem_sys_free(t->node);
}
static void lua_mark_table(PARROT_INTERP, Parrot_LuaTable_attributes *t, STRING *mode)
{
Node *v = t->node;
int mark_key = 1;
int mark_val = 1;
int i;
if (mode) {
mark_key = Parrot_str_find_index(interp, mode,
Parrot_str_new_constant(interp, "k"), 0) < 0;
mark_val = Parrot_str_find_index(interp, mode,
Parrot_str_new_constant(interp, "v"), 0) < 0;
}
for (i = 0; i < t->size; i++) {
if (mark_val && v[i].val)
Parrot_gc_mark_PMC_alive(interp, v[i].val);
if (mark_key && v[i].key)
Parrot_gc_mark_PMC_alive(interp, v[i].key);
}
}
pmclass LuaTable
extends LuaAny
provides hash
auto_attrs
dynpmc
group lua_group
hll Lua {
ATTR struct Node *node;
ATTR struct Node *firstfree; /* this position is free; all positions after it are full */
ATTR INTVAL size;
ATTR PMC *mt;
/*
=item C<void init()>
Initializes the instance.
=cut
*/
VTABLE void init() {
lua_new_table(INTERP, PARROT_LUATABLE(SELF));
t_mt(SELF) = PMCNULL;
PObj_custom_mark_destroy_SETALL(SELF);
}
/*
=item C<void mark()>
Marks the hash as live.
=cut
*/
VTABLE void mark() {
STRING *mode = NULL;
PMC * const meta = t_mt(SELF);
if (!PMC_IS_NULL(meta)) {
PMC **m;
#if 0
PMC * const key = Parrot_pmc_new(INTERP, dynpmc_LuaString);
VTABLE_set_string_native(INTERP, key,
Parrot_str_new_constant(INTERP, "__mode"));
m = lua_get(INTERP, PARROT_LUATABLE(meta), key);
#else
m = lua_getstr(INTERP, PARROT_LUATABLE(meta),
Parrot_str_new_constant(INTERP, "__mode"));
#endif
if (m && *m)
mode = VTABLE_get_string(INTERP, *m);
}
lua_mark_table(INTERP, PARROT_LUATABLE(SELF), mode);
if (!PMC_IS_NULL(meta))
Parrot_gc_mark_PMC_alive(INTERP, meta);
}
/*
=item C<void destroy()>
Free hash structure.
=cut
*/
VTABLE void destroy() {
lua_destroy_table(INTERP, PARROT_LUATABLE(SELF));
}
/*
=item C<STRING* name()>
Return the string "table".
=cut
*/
VTABLE STRING* name() {
return Parrot_str_new_constant(INTERP, "table");
}
/*
=item C<PMC* clone()>
PMCs are always handled by-reference in Parrot. So, copying register contents
only copies the reference to the PMC. For LuaString, LuaNumber, LuaBoolean,
this is not correct, as Lua has by-value semantics for these types. In order
to be able to handle register "move" instructions, this should be implemented
using clone(). However, LuaTable and LuaFunction do have by-reference
semantics. As you don't know the type during compile-time of an object, just
always use clone() to copy register contents. LuaTable and LuaFunction should
therefore only clone the reference to themselves, not make a deep copy.
=cut
*/
VTABLE PMC* clone() {
return SELF;
}
/*
=item C<STRING* get_string()>
=cut
*/
VTABLE STRING* get_string() {
return Parrot_sprintf_c(INTERP, "table: %08X", SELF);
}
/*
=item C<void assign_pmc(PMC *value)>
=cut
*/
VTABLE void assign_pmc(PMC *value) {
lua_destroy_table(INTERP, PARROT_LUATABLE(SELF));
SUPER(value);
}
/*
=item C<PMC* get_pmc_keyed (PMC *key)>
C<table> accessor.
=cut
*/
VTABLE PMC* get_pmc_keyed(PMC *key) {
PMC *value = NULL;
PMC **pvalue = lua_get(INTERP, PARROT_LUATABLE(SELF), key);
if (pvalue)
value = *pvalue;
else {
PMC * const meth = _LuaAny_find_meth(INTERP, SELF, "__index");
if (!PMC_IS_NULL(meth)) {
if (dynpmc_LuaFunction == PMC_type(meth))
Parrot_ext_call(INTERP, meth, "PiP->P", SELF, key, &value);
else
return VTABLE_get_pmc_keyed(INTERP, meth, key);
}
}
if (value)
return value;
return Parrot_pmc_new(INTERP, dynpmc_LuaNil);
}
/*
=item C<void set_pmc_keyed(PMC *key, PMC *value)>
C<table> mutator.
=cut
*/
VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
if (! lua_get(INTERP, PARROT_LUATABLE(SELF), key)) {
PMC * const meth = _LuaAny_find_meth(INTERP, SELF, "__newindex");
if (!PMC_IS_NULL(meth)) {
if (dynpmc_LuaFunction == PMC_type(meth))
Parrot_ext_call(INTERP, meth, "PiPP->", SELF, key, value);
else
VTABLE_set_pmc_keyed(INTERP, meth, key, value);
return;
}
}
if (dynpmc_LuaNil == PMC_type(value)) {
value = NULL;
}
else {
value = VTABLE_clone(INTERP, value);
key = VTABLE_clone(INTERP, key);
}
*lua_set(INTERP, PARROT_LUATABLE(SELF), key) = value;
}
/*
=item C<void set_pmc_keyed_str(STRING *key, PMC *value)>
Need by NameSpace.export_to().
=cut
*/
VTABLE void set_pmc_keyed_str(STRING *key, PMC *value) {
PMC * const pmc_key = Parrot_pmc_new(INTERP, dynpmc_LuaString);
VTABLE_set_string_native(INTERP, pmc_key, key);
value = VTABLE_clone(INTERP, value);
*lua_set(INTERP, PARROT_LUATABLE(SELF), pmc_key) = value;
}
/*
=item C<INTVAL elements()>
Returns the number of elements in the table.
=cut
*/
VTABLE INTVAL elements() {
return numuse(PARROT_LUATABLE(SELF));
}
/*
=back
=head3 non-Vtable Methods
=over 4
=item C<INTVAL is_equal(PMC *value)>
The C<==> operation. Compares reference (not in depth).
=cut
*/
MULTI INTVAL is_equal(LuaTable value) {
PMC * const meth = _LuaAny_find_meth(INTERP, SELF, "__eq");
if (!PMC_IS_NULL(meth)) {
PMC * retval = PMCNULL;
Parrot_ext_call(INTERP, meth, "PiP->P", SELF, value, &retval);
if (PMC_IS_NULL(retval))
return (INTVAL)0;
return VTABLE_get_bool(INTERP, retval);
}
return (SELF == value) ? (INTVAL)1 : (INTVAL)0;
}
MULTI INTVAL is_equal(DEFAULT value) {
return (INTVAL)0;
}
/*
=item C<INTVAL cmp(PMC *value)>
=cut
*/
MULTI INTVAL cmp(LuaTable value) {
#if 0
PMC * const meth = _LuaAny_find_meth(INTERP, SELF, "__cmp");
if (!PMC_IS_NULL(meth)) {
PMC * retval = PMCNULL;
Parrot_ext_call(INTERP, meth, "PiP->P", SELF, value, &retval);
if (!PMC_IS_NULL(retval))
return (INTVAL)VTABLE_get_number(INTERP, retval);
}
#else
PMC * const _lt = _LuaAny_find_meth(INTERP, SELF, "__lt");
if (!PMC_IS_NULL(_lt)) {
INTVAL r;
PMC * retval = PMCNULL;
Parrot_ext_call(INTERP, _lt, "PiP->P", SELF, value, &retval);
r = PMC_IS_NULL(retval)
? (INTVAL)0
: VTABLE_get_bool(INTERP, retval);
if (r)
return (INTVAL)-1;
else {
PMC * const _le = _LuaAny_find_meth(INTERP, SELF, "__le");
if (!PMC_IS_NULL(_le)) {
retval = PMCNULL;
Parrot_ext_call(INTERP, _le, "PiP->P", SELF, value, &retval);
r = PMC_IS_NULL(retval)
? (INTVAL)0
: VTABLE_get_bool(INTERP, retval);
return (r) ? (INTVAL)0 : (INTVAL)1;
}
else {
retval = PMCNULL;
Parrot_ext_call(INTERP, _lt, "PiP->P", value, SELF, &retval);
r = PMC_IS_NULL(retval)
? (INTVAL)0
: VTABLE_get_bool(INTERP, retval);
return (r) ? (INTVAL)1 : (INTVAL)0;
}
}
}
#endif
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
"attempt to compare two table values");
}
MULTI INTVAL cmp(DEFAULT value) {
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ILL_INHERIT,
"attempt to compare table with %Ss",
VTABLE_name(INTERP, value));
}
/*
=back
=head3 Specific Methods
=over 4
=item C<PMC *get_metatable()>
=cut
*/
METHOD PMC* get_metatable() {
PMC *retval = _LuaTable_get_metatable(INTERP, SELF);
if (PMC_IS_NULL(retval))
retval = Parrot_pmc_new(INTERP, dynpmc_LuaNil);
RETURN(PMC *retval);
}
/*
=item C<PMC* len()>
=cut
*/
METHOD PMC* len() {
PMC **pvalue;
PMC * const key = Parrot_pmc_new(INTERP, dynpmc_LuaNumber);
INTVAL idx = 1;
VTABLE_set_integer_native(INTERP, key, idx);
pvalue = lua_get(INTERP, PARROT_LUATABLE(SELF), key);
while (pvalue && *pvalue) {
idx++;
VTABLE_set_integer_native(INTERP, key, idx);
pvalue = lua_get(INTERP, PARROT_LUATABLE(SELF), key);
}
VTABLE_set_integer_native(INTERP, key, idx - 1);
RETURN(PMC *key);
}
/*
=item C<PMC* next(PMC *index)>
=cut
*/
METHOD PMC* next(PMC* index) {
Node * const n = lua_next(INTERP, PARROT_LUATABLE(SELF), index);
if (n) {
PMC * const retval = Parrot_pmc_new(INTERP, enum_class_FixedPMCArray);
VTABLE_set_integer_native(INTERP, retval, 2);
VTABLE_set_pmc_keyed_int(INTERP, retval, 0, n->key);
VTABLE_set_pmc_keyed_int(INTERP, retval, 1, n->val);
RETURN(PMC *retval);
}
else {
PMC * const retval = Parrot_pmc_new(INTERP, dynpmc_LuaNil);
RETURN(PMC *retval);
}
}
/*
=item C<PMC* rawequal(PMC* value)>
=cut
*/
METHOD PMC* rawequal(PMC *value) {
const INTVAL b = (SELF == value) ? 1 : 0;
PMC * const retval = Parrot_pmc_new(INTERP, dynpmc_LuaBoolean);
VTABLE_set_integer_native(INTERP, retval, b);
RETURN(PMC *retval);
}
/*
=item C<PMC* rawget(PMC *key)>
=cut
*/
METHOD PMC* rawget(PMC *key) {
PMC **pvalue = lua_get(INTERP, PARROT_LUATABLE(SELF), key);
PMC *retval;
if (! pvalue || ! *pvalue)
retval = Parrot_pmc_new(INTERP, dynpmc_LuaNil);
else
retval = *pvalue;
RETURN(PMC *retval);
}
/*
=item C<void rawset(PMC *key, PMC *value)>
=cut
*/
METHOD void rawset(PMC *key, PMC *value) {
if (dynpmc_LuaNil == PMC_type(value)) {
value = NULL;
}
else {
value = VTABLE_clone(INTERP, value);
key = VTABLE_clone(INTERP, key);
}
*lua_set(INTERP, PARROT_LUATABLE(SELF), key) = value;
}
/*
=item C<void set_metatable(PMC *meta)>
=cut
*/
METHOD void set_metatable(PMC *meta) {
if (dynpmc_LuaNil == PMC_type(meta))
t_mt(SELF) = PMCNULL;
else
t_mt(SELF) = meta;
}
}
/*
=back
=cut
*/
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4:
*/
Jump to Line
Something went wrong with that request. Please try again.