# New Ticket Created by Christoph Otto
# Please include the string: [perl #51062]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=51062 >
This patch adds an initial PHPArray PMC to Plumhead. After my earlier
question about licensing was ignored, I did the safe thing, stripping out and
rewriting all the code that was copied from Zend's code. Everything here is
now original and I am free to contribute it to Parrot.
Some things work and lots don't, but I thought I should start submitting
before I got too much further. I know that most of the keyed get/set methods
aren't exactly correct. They will be. If nothing else, the code compiles
without any warnings, has all (or most) mehtods documented and follows the
coding standards.
Christoph
Index: CREDITS
===================================================================
--- CREDITS (revision 25907)
+++ CREDITS (working copy)
@@ -139,6 +139,7 @@
N: Christoph Otto
D: Patch for key flags in pdd08
D: Range check in Env PMC
+D: PHPArray implementation
E: [EMAIL PROTECTED]
N: chromatic
Index: tools/dev/gen_class.pl
===================================================================
--- tools/dev/gen_class.pl (revision 25907)
+++ tools/dev/gen_class.pl (working copy)
@@ -20,6 +20,7 @@
it to C.
% perl tools/dev/gen_class.pl Foo > src/pmc/foo.pmc
+ % perl tools/build/pmc2c.pl --dump src/pmc/foo.pmc
% perl tools/build/pmc2c.pl -c src/pmc/foo.pmc
=head1 SEE ALSO
@@ -72,7 +73,7 @@
next if exists $skip_bodies{$methname};
next if $methname =~ /prop/;
- print " $retval $methname ($args) {\n";
+ print " $retval $methname($args) {\n";
if ( $retval ne 'void' ) {
print $retval eq 'PMC*'
Index: MANIFEST
===================================================================
--- MANIFEST (revision 25907)
+++ MANIFEST (working copy)
@@ -1903,6 +1903,7 @@
languages/plumhead/lib/Parrot/Test/Plumhead/Yacc.pm [plumhead]
languages/plumhead/past_xml.xsd [plumhead]
languages/plumhead/plumhead.pl [plumhead]
+languages/plumhead/pmc/phparray.pmc [plumhead]
languages/plumhead/src/antlr3/GenPastPir.g [plumhead]
languages/plumhead/src/antlr3/GenPastPir.java [plumhead]
languages/plumhead/src/antlr3/Plumhead.g [plumhead]
@@ -1931,6 +1932,7 @@
languages/plumhead/t/strings.t [plumhead]
languages/plumhead/t/superglobals.t [plumhead]
languages/plumhead/t/variables.t [plumhead]
+languages/plumhead/t/pmc/array.t [plumhead]
languages/pugs/config/makefiles/root.in [pugs]
languages/pugs/include/pugs_common.h [pugs]
languages/pugs/pmc/pugsany.pmc [pugs]
Index: languages/plumhead/config/makefiles/root.in
===================================================================
--- languages/plumhead/config/makefiles/root.in (revision 25907)
+++ languages/plumhead/config/makefiles/root.in (working copy)
@@ -1,17 +1,32 @@
# $Id$
+# Configuration settings
+LOAD_EXT = @load_ext@
+O = @o@
+
# Set up commands
PARROT = ../../[EMAIL PROTECTED]@
PERL = @perl@
RM_F = @rm_f@
RECONFIGURE = $(PERL) @build_dir@/tools/dev/reconfigure.pl
+PMCBUILD = $(PERL) @build_dir@/tools/build/dynpmc.pl
# Set up directories
BUILD_DIR = @build_dir@
TGE_DIR = ../../compilers/tge
LIBRARY_DIR = @build_dir@/runtime/parrot/library
+PMC_DIR = pmc
+PARROT_DYNEXT = @build_dir@/runtime/parrot/dynext
+# Set up PMCs
+PMCS = \
+ phparray
+
+PMC_FILES = \
+ $(PMC_DIR)/phparray.pmc
+
+
# default
all: build
@@ -91,6 +106,18 @@
@echo 'Be sure to have set CLASSPATH as laid out in docs/antlr3.pod'
javac src/antlr3/*.java
+pmc : pmc/php_group$(LOAD_EXT)
+
+pmc/php_group$(LOAD_EXT) : $(PMC_FILES)
+ @cd $(PMC_DIR) && $(PMCBUILD) generate $(PMCS)
+ @cd $(PMC_DIR) && $(PMCBUILD) compile $(PMCS)
+ @cd $(PMC_DIR) && $(PMCBUILD) linklibs $(PMCS)
+ @cd $(PMC_DIR) && $(PMCBUILD) copy "--destination=$(PARROT_DYNEXT)"
$(PMCS)
+
+
+pmc-test : pmc
+ $(PERL) -I../../lib t/pmc/array.t
+
src/common/plumheadlib.pbc: src/common/builtins.pir
$(PARROT) -o src/common/plumheadlib.pbc src/common/builtins.pir
@@ -128,7 +155,7 @@
test-yacc:
- cd .. && $(PERL) -I../lib -I plumhead/lib plumhead/t/harness
--with-yacc
-clean: clean-common clean-pct clean-antlr3 clean-test
+clean: clean-common clean-pct clean-antlr3 clean-test clean-pmc
clean-common:
$(RM_F) src/common/plumheadlib.pbc plumhead.pbc
@@ -142,5 +169,8 @@
clean-test:
$(RM_F) t/*.php t/*.pir t/*.out
+clean-pmc:
+ $(RM_F) pmc/*.c pmc/*.h pmc/*.o pmc/*.so pmc/*.dump
+
realclean: clean
$(RM_F) Makefile
#! perl
# Copyright (C) 2005-2007, The Perl Foundation.
# $Id: table.t 23241 2007-11-29 17:04:14Z coke $
=head1 NAME
t/pmc/array.t - PHP array
=head1 SYNOPSIS
% perl -I../../lib t/pmc/array.t
=head1 DESCRIPTION
Tests C<array> type
(implemented in F<languages/plumhead/pmc/phparray.pmc>).
=cut
use strict;
use warnings;
use Parrot::Test tests => 6;
use Test::More;
pir_output_is( << 'CODE', << 'OUTPUT', 'unkeyed get_string' );
.HLL 'PHP', 'php_group'
.sub _main
.local pmc p1
p1 = new 'PHPArray'
print p1
print "\n"
.end
CODE
Array
OUTPUT
pir_output_is( << 'CODE', << 'OUTPUT', 'int keyed set/get' );
.HLL 'PHP', 'php_group'
.sub _main
.local pmc ar, pmc_str
.local int i1
.local string s1
ar = new 'PHPArray'
ar[1] = 2746
i1 = ar[1]
print i1
print "\n"
.end
CODE
2746
OUTPUT
pir_output_is( << 'CODE', << 'OUTPUT', 'string keyed set/get' );
.HLL 'PHP', 'php_group'
.sub _main
.local pmc ar, pmc_str
.local int i1
.local string s1
ar = new 'PHPArray'
ar['x'] = 2746
i1 = ar['x']
print i1
print "\n"
.end
CODE
2746
OUTPUT
pir_output_is( << 'CODE', << 'OUTPUT', 'several sets/gets' );
.HLL 'PHP', 'php_group'
.sub _main
.local pmc ar, pmc_str
.local int i1
.local string s1
ar = new 'PHPArray'
ar[1] = 6
ar[2] = 746
ar[3] = 76
ar[4] = 27
ar[5] = 76
ar[6] = 2
ar[7] = 246
ar[8] = 274
ar[9] = 74
i1 = ar[6]
print i1
print "\n"
.end
CODE
2
OUTPUT
pir_output_is( << 'CODE', << 'OUTPUT', 'push/pop' );
.HLL 'PHP', 'php_group'
.sub _main
.local pmc ar, pmc_str
.local int i1
.local string s1
ar = new 'PHPArray'
push ar, 'foo'
push ar, 999
push ar, 'bar'
s1 = pop ar
print s1
s1 = pop ar
print s1
s1 = pop ar
print s1
print "\n"
.end
CODE
bar999foo
OUTPUT
pir_output_is( << 'CODE', << 'OUTPUT', 'unshift/shift' );
.HLL 'PHP', 'php_group'
.sub _main
.local pmc ar, pmc_str
.local int i1
.local string s1
ar = new 'PHPArray'
unshift ar, 'foo'
s1 = shift ar
print s1
print "\n"
.end
CODE
foo
OUTPUT
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
/*
Copyright (C) 2005-2007, The Perl Foundation.
$Id: luatable.pmc 22933 2007-11-21 19:40:01Z paultcochrane $
=head1 NAME
pmc/phparray.pmc - PHP array
=head1 DESCRIPTION
C<PHPAray> provides an implementation of PHP arrays. These so-called arrays
are actually hashes which use integer or string keys. Stored vaues may
arbitrarily types. The order of insertion is preserved and can be arbitrarily
reordered independently of keys and values.
=head2 Methods
=over 4
=cut
*/
#include "parrot/parrot.h"
#define HASH_SEED 12345
#define PMC_type(pmc) ((pmc)->vtable->base_type)
#if 0
# define dprintf(...) printf(__VA_ARGS__)
#else
# define dprintf(...)
#endif
#define PREPEND_TO_BUCKET_LIST(b, list) \
if (list == NULL) { \
list = b; \
b->bucketNext = NULL; \
b->bucketPrev = NULL; \
} \
else { \
list->bucketPrev = b; \
b->bucketNext = list; \
b->bucketPrev = NULL; \
list = b; \
}
#define PREPEND_TO_TABLE_LIST(b, list) \
if (list->tableHead == NULL) { \
list->internalPointer = b; \
list->tableHead = b; \
list->tableTail = b; \
} \
else { \
list->tableHead->tablePrev = b; \
b->tableNext = list->tableHead; \
b->tablePrev = NULL; \
list->tableHead = b; \
}
#define APPEND_TO_TABLE_LIST(b, list) \
if (list->tableHead == NULL) { \
list->internalPointer = b; \
list->tableHead = b; \
list->tableTail = b; \
} \
else { \
list->tableTail->tableNext = b; \
b->tablePrev = list->tableTail; \
b->tableNext = NULL; \
list->tableTail = b; \
}
/* XXX: temporary workaround until VTABLE_is_equal starts working in the
* context this code needs: see RT #50878 */
#define VTABLE_is_equal(a, b, c) mmd_dispatch_i_pp(a, b, c, MMD_EQ)
typedef enum {
APPEND,
PREPEND
} add_type;
typedef struct bucket {
struct bucket* tableNext;
struct bucket* tablePrev;
struct bucket* bucketNext;
struct bucket* bucketPrev;
PMC* key;
PMC* value;
INTVAL hash;
} Bucket;
typedef struct hashtable {
Bucket* internalPointer;
Bucket* tableHead;
Bucket* tableTail;
Bucket** buckets;
INTVAL elementCount;
INTVAL capacity;
INTVAL hashMask;
INTVAL nextIndex;
} HashTable;
void add_thing_to_hashtable(PARROT_INTERP, HashTable*, PMC*, PMC*, add_type);
PMC* get_thing_from_hashtable(PARROT_INTERP, HashTable*, PMC*);
PMC* delete_thing_from_hashtable(PARROT_INTERP, HashTable *, PMC*);
INTVAL find_thing_in_hashtable(PARROT_INTERP, HashTable*, PMC*);
INTVAL php_hash(PARROT_INTERP, PMC*);
INTVAL _key_compare(PARROT_INTERP, PMC*, PMC*);
void hash_check(PARROT_INTERP, HashTable*);
void renumber_hash(PARROT_INTERP, HashTable*);
void resize_and_rehash(PARROT_INTERP, HashTable*);
INTVAL php_hash(PARROT_INTERP, PMC* key) {
if (PMC_type(key) == enum_class_Integer) {
return VTABLE_get_integer(interp, key);
}
else if (PMC_type(key) == enum_class_String) {
STRING* key_str = VTABLE_get_string(interp, key);
return string_hash(interp, key_str, HASH_SEED);
}
else {
real_exception(interp, NULL, INVALID_OPERATION, "must use integer or
string keys in php_hash");
}
}
void add_thing_to_hashtable(PARROT_INTERP, HashTable *ht, PMC* key, PMC* value,
add_type type) {
INTVAL hash = php_hash(interp, key);
uint index;
Bucket *newB, *b;
char *key_str, *value_str;
index = ht->hashMask & hash;
b = ht->buckets[index];
if (PMC_type(key) == enum_class_Integer &&
VTABLE_get_integer(interp, key) >= ht->nextIndex) {
ht->nextIndex = VTABLE_get_integer(interp, key)+1;
dprintf("nextIndex changed to %d\n", (int)ht->nextIndex);
}
else if (PMC_type(key) == enum_class_Integer) {
dprintf("nextIndex is %d, inserted key is %d\n", (int)ht->nextIndex,
(int)VTABLE_get_integer(interp, key));
}
else {
dprintf("nextIndex doesn't care because key is a string\n");
}
dprintf("storing item with hash %X of type %d in bucket #%d of hashtable at
0x%X\n",
(uint)hash, (uint)PMC_type(value), index, (uint)ht);
key_str = string_to_cstring(interp, VTABLE_get_string(interp, key));
value_str = string_to_cstring(interp, VTABLE_get_string(interp, value));
dprintf("pair maps \"%s\" => \"%s\"\n", key_str, value_str);
string_cstring_free(key_str);
string_cstring_free(value_str);
while (b != NULL) {
if (b->hash == hash && VTABLE_is_equal(interp, key, b->key)) {
/*XXX: you may have to update some other pointers too
XXX: there may be some DOD marking of some kind
*/
b->value = value;
return;
}
b = b->bucketNext;
}
dprintf("key hasn't been used yet; making new bucket\n");
newB = (Bucket*) mem_allocate_zeroed_typed(Bucket);
newB->key = key;
newB->value = value;
newB->hash = hash;
PREPEND_TO_BUCKET_LIST(newB, ht->buckets[index]);
if (type == APPEND) {
APPEND_TO_TABLE_LIST(newB, ht);
} else if (type == PREPEND) {
PREPEND_TO_TABLE_LIST(newB, ht);
}
ht->elementCount++;
hash_check(interp, ht);
if (ht->elementCount <= ht->capacity)
return;
resize_and_rehash(interp, ht);
}
PMC* delete_thing_from_hashtable(PARROT_INTERP, HashTable *ht, PMC* key) {
INTVAL hash = php_hash(interp, key);
INTVAL index;
Bucket* b;
PMC* pmc;
index = ht->hashMask & hash;
b = ht->buckets[index];
while (b != NULL) {
if (b->hash == hash && VTABLE_is_equal(interp, key, b->key)) {
/*XXX: you may have to update some other pointers too
XXX: there may be some DOD marking of some kind
*/
/*do some stupid pointer juggling to delete the element*/
pmc = b->value;
return pmc;
}
b = b->bucketNext;
ht->elementCount--;
}
dprintf("the thing doesn't seem to be in the hash\n");
hash_check(interp, ht);
return PMCNULL;
}
PMC* get_thing_from_hashtable(PARROT_INTERP, HashTable* ht, PMC* key) {
INTVAL hash = php_hash(interp, key);
INTVAL index, i;
Bucket* b;
index = ht->hashMask & hash;
b = ht->buckets[index];
i = 0;
dprintf("getting thing with hash %X in hashtable\n", (uint)hash);
while (b != NULL) {
dprintf("searching bucket #%d with key at %X and b->key at %X\n",
(int)i, (uint)key, (uint)b->key);
i++;
if (b->hash == hash && VTABLE_is_equal(interp, key, b->key)) {
return b->value;
}
b = b->bucketNext;
}
return NULL;
}
INTVAL find_thing_in_hashtable(PARROT_INTERP, HashTable* ht, PMC* key) {
INTVAL hash = php_hash(interp, key);
INTVAL index, i;
Bucket* b;
index = ht->hashMask & hash;
b = ht->buckets[index];
i = 0;
dprintf("looking for thing with hash %X in hashtable\n", (uint)hash);
while (b != NULL) {
dprintf("searching bucket #%d with key at %X and b->key at %X\n",
(int)i, (uint)key, (uint)b->key);
i++;
if (b->hash == hash && VTABLE_is_equal(interp, key, b->key)) {
return 1;
}
b = b->bucketNext;
}
return 0;
}
void hash_check(PARROT_INTERP, HashTable* ht) {
INTVAL i, bucket_order_count, insert_order_count;
int key_type, value_type;
char *key_str, *value_str;
Bucket* b;
dprintf("checking hash at %X\n", (uint)ht);
dprintf("capacity = %d, mask = %d, elementCount = %d, nextIndex = %d\n",
(int)ht->capacity, (int)ht->hashMask, (int)ht->elementCount,
(int)ht->nextIndex);
bucket_order_count = 0;
for (i = 0; i < ht->capacity; i++) {
Bucket* b = ht->buckets[i];
dprintf("checking bucket #%d...", (int)i);
while (b != NULL) {
key_type = PMC_type(b->key);
value_type = PMC_type(b->value);
key_str = string_to_cstring(interp, VTABLE_get_string(interp,
b->key));
value_str = string_to_cstring(interp, VTABLE_get_string(interp,
b->value));
dprintf("\n bucket at 0x%X maps \"%s\"(%d) => \"%s\"(%d)",
(uint)b, key_str, (uint)key_type, value_str,
(uint)value_type);
string_cstring_free(key_str);
string_cstring_free(value_str);
b = b->bucketNext;
bucket_order_count++;
}
dprintf("\n");
}
dprintf("now checking by insertion order\n");
b = ht->tableHead;
insert_order_count = 0;
while (b != NULL) {
key_type = PMC_type(b->key);
value_type = PMC_type(b->value);
key_str = string_to_cstring(interp, VTABLE_get_string(interp,
b->key));
value_str = string_to_cstring(interp, VTABLE_get_string(interp,
b->value));
dprintf(" bucket at 0x%X maps \"%s\"(%d) => \"%s\"(%d)\n",
(uint)b, key_str, (uint)key_type, value_str, (uint)value_type);
string_cstring_free(key_str);
string_cstring_free(value_str);
b = b->tableNext;
insert_order_count++;
}
dprintf("%d buckets expected, %d found by bucket order, %d found by insert
order\n",
(int)ht->elementCount, (int)bucket_order_count,
(int)insert_order_count);
}
void renumber_hash(PARROT_INTERP, HashTable* ht) {
Bucket* b;
INTVAL index;
b = ht->tableHead;
dprintf("renumbering hash at %X\n", (uint)ht);
index = 0;
while (b != NULL) {
if (PMC_type(b->key) == enum_class_Integer) {
VTABLE_set_integer_native(interp, b->key, index);
index++;
}
b = b->bucketNext;
}
ht->nextIndex = ++index;
}
void resize_and_rehash(PARROT_INTERP, HashTable* ht) {
Bucket** buckets;
Bucket* b;
INTVAL index;
hash_check(interp, ht);
/* resize*/
mem_sys_free(ht->buckets);
ht->capacity <<= 1;
ht->hashMask = ht->capacity - 1;
ht->buckets = (Bucket**)mem_allocate_n_zeroed_typed(ht->capacity, Bucket);
/* rehash*/
b = ht->tableHead;
while (b != NULL) {
index = b->hash & ht->hashMask;
PREPEND_TO_BUCKET_LIST(b, ht->buckets[index]);
b = b->tableNext;
};
hash_check(interp, ht);
}
pmclass PHPArray
provides hash
provides array
need_ext
dynpmc
group php_group
hll PHP {
/*
=item C<PMC* add(PMC*, PMC*)>
=item C<PMC* i_add(PMC*, PMC*)>
Insert all key/value pairs from the second array into the first
=cut
*/
/*array + array -> combine elements */
PMC* add(PMC* value, PMC* dest) {
return PMCNULL;
}
void i_add(PMC* value) {
}
/*
=item C<PMC* is_equal(PMC*)>
Determine equality between this and another PMC. Two PHPArrays PMCs are equal
if they contain the same key/value pairs, regardless of order. This is the
same behavoir that is found in PHP.
=cut
*/
INTVAL is_equal(PMC* value) {
/*XXX: figure out what it's appropriate to compare this PMC to.
ATM I'm thinking soemthing like
VTABLE_does(hash) && VTABLE_does(array) && all key/value pairs match
*/
return (INTVAL)0;
}
/*
=item C<PMC* is_equal_num(PMC*)>
=item C<PMC* is_equal_string(PMC*)>
Determine equality between this PHPArray PMC and a string or number. According
to PHP an array is never equal to a string or number. If only everything were
that easy.
=cut
*/
INTVAL is_equal_num(PMC* value) {
return (INTVAL)0;
}
INTVAL is_equal_string(PMC* value) {
return (INTVAL)0;
}
/* not sure if this needs to be implemented
INTVAL cmp (PMC* value) {
return (INTVAL)0;
}
INTVAL cmp_num (PMC* value) {
return (INTVAL)0;
}
INTVAL cmp_string (PMC* value) {
return (INTVAL)0;
}*/
/*
=item C<void assign_pmc(PMC*)>
If the passed-in PMC is array-like and/or hash-like, copy all key/value pairs
into this PMC. If the PMC is a PHPArray, make a clone.
=cut
*/
void assign_pmc(PMC* value) {
Bucket *b1, *b2;
INTVAL new_size;
PMC *new_key, *new_value;
HashTable *orig_ht, *new_ht;
orig_ht = (HashTable*) PMC_struct_val(SELF);
new_size = orig_ht->elementCount;
if (PMC_type(value) == PMC_type(SELF)) {
new_ht = (HashTable*) PMC_struct_val(value);
/*XXX: do I need to delete the old value?*/
/*delete everything in value*/
/*free all buckets*/
b1 = new_ht->tableHead;
while (b1 != NULL) {
b2 = b1;
b1 = b1->tableNext;
mem_sys_free(b2);
}
if (new_size > new_ht->elementCount) {
/*resize it to this PMC*/
mem_sys_free(new_ht->buckets);
new_ht->buckets = (Bucket**)
mem_allocate_n_zeroed_typed(new_size, Bucket);
new_ht->elementCount = new_size;
new_ht->hashMask = orig_ht->hashMask;
}
b1 = orig_ht->tableHead;
/* XXX: it'd probably be better to implement COW here*/
while (b1 != NULL) {
/*XXX: implement: insert copies of key/value pairs*/
}
}
else {
/*do the Right Thing according to whether the passed-in PMC
* implements a hash-like and/or array-like interface*/
}
}
/*
=item C<PMC* clone()>
Return a clone of this PHPArray.
=cut
*/
PMC* clone() {
return PMCNULL;
}
/* nothing else implements this, so I won't either
PMC* clone_pmc (PMC* args) {
return PMCNULL;
}*/
/*
=item C<void delete_keyed(PMC*)>
=item C<void delete_keyed_int(INTVAL)>
=item C<void delete_keyed_str(STRING*)>
Remove the element at key.
=cut
*/
void delete_keyed(PMC* key) {
/*XXX: implement keyed code properly*/
delete_thing_from_hashtable(INTERP, (HashTable*)PMC_struct_val(SELF),
key);
}
void delete_keyed_int(INTVAL key) {
PMC* key_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, key_pmc, key);
SELF.delete_keyed(key_pmc);
}
void delete_keyed_str(STRING* key) {
PMC* key_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, key_pmc, key);
SELF.delete_keyed(key_pmc);
}
/*
=item C<void destroy()>
Free the memory associated with this PHPArray's underlying structs.
=cut
*/
void destroy() {
HashTable* ht = (HashTable*)PMC_struct_val(SELF);
Bucket *b1, *b2;
b1 = ht->tableHead;
while (b1 != NULL) {
b2 = b1;
b1 = b1->tableNext;
mem_sys_free(b2);
}
mem_sys_free(ht->buckets);
mem_sys_free(ht);
}
/*
=item C<INTVAL elements()>
Returns the number of elements in this PHPArray.
=cut
*/
INTVAL elements() {
HashTable* ht = (HashTable*)PMC_struct_val(SELF);
return (INTVAL) ht->elementCount;
}
/*
=item C<INTVAL exists_keyed(PMC*)>
=item C<INTVAL exists_keyed_int(INTVAL)>
=item C<INTVAL exists_keyed_string(STRING)>
Returns TRUE if the element at C<key> exists; otherwise returns false.
=cut
*/
INTVAL exists_keyed(PMC* key) {
/*XXX: implement keyed code properly*/
return find_thing_in_hashtable(INTERP,
(HashTable*)PMC_struct_val(SELF), key);
}
INTVAL exists_keyed_int(INTVAL key) {
PMC* key_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, key_pmc, key);
return SELF.exists_keyed(key_pmc);
}
INTVAL exists_keyed_str(STRING* key) {
PMC* key_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, key_pmc, key);
return SELF.exists_keyed(key_pmc);
}
/* XXX: probably need to implement
void freeze (visit_info* info) {
}*/
/*
=item C<INTVAL get_bool()>
Return TRUE if this PHPArray has one or more elements, return FALSE otherwise.
=cut
*/
INTVAL get_bool() {
return SELF.elements() == 1;
}
/*
=item C<INTVAL get_integer_keyed(PMC*)>
=item C<INTVAL get_integer_keyed_int(INTVAL)>
=item C<INTVAL get_integer_keyed_str(STRING*)>
Return the integer value of the elements a C<key>.
=cut
*/
INTVAL get_integer_keyed(PMC* key) {
PMC* value_pmc = get_thing_from_hashtable(INTERP,
(HashTable*)PMC_struct_val(SELF), key);
return VTABLE_get_integer(INTERP, value_pmc);
/*XXX: implement keyed code properly*/
}
INTVAL get_integer_keyed_int(INTVAL key) {
PMC* key_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, key_pmc, key);
return SELF.get_integer_keyed(key_pmc);
}
INTVAL get_integer_keyed_str(STRING* key) {
PMC* key_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, key_pmc, key);
return SELF.get_integer_keyed(key_pmc);
}
/*
=item C<PMC* get_iter()>
Return a new iterator for this PHPArray.
=cut
*/
PMC* get_iter() {
/*XXX: implement */
return PMCNULL;
}
/*
=item C<FLOATVAL get_number_keyed(PMC*)>
=item C<FLOATVAL get_number_keyed_int(INTVAL)>
=item C<FLOATVAL get_number_keyed_str(STRING*)>
Return the float value of the element at C<key>.
=cut
*/
FLOATVAL get_number_keyed(PMC* key) {
/*XXX: implement keyed code properly*/
PMC* value_pmc = get_thing_from_hashtable(INTERP,
(HashTable*)PMC_struct_val(SELF), key);
return VTABLE_get_number(INTERP, value_pmc);
}
FLOATVAL get_number_keyed_int(INTVAL key) {
PMC* key_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, key_pmc, key);
return SELF.get_number_keyed(key_pmc);
}
FLOATVAL get_number_keyed_str(STRING* key) {
PMC* key_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, key_pmc, key);
return SELF.get_number_keyed(key_pmc);
}
/* XXX: not sure if this is needed
PMC* get_pmc () {
return PMCNULL;
}*/
/*
=item C<PMC get_pmc_keyed(PMC*)>
=item C<PMC get_pmc_keyed_int(INTVAL)>
=item C<PMC get_pmc_keyed_str(STRING*)>
Return the string value of the element at C<key>.
=cut
*/
PMC* get_pmc_keyed(PMC* key) {
/*XXX: implement keyed code properly*/
return get_thing_from_hashtable(INTERP,
(HashTable*)PMC_struct_val(SELF), key);
}
PMC* get_pmc_keyed_int(INTVAL key) {
PMC* key_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, key_pmc, key);
return SELF.get_pmc_keyed(key_pmc);
}
PMC* get_pmc_keyed_str(STRING* key) {
PMC* key_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, key_pmc, key);
return SELF.get_pmc_keyed(key_pmc);
}
/*
=item C<STRING* get_string()>
Return the string representation of this array. This is simply the string
C<Array>.
=cut
*/
STRING* get_string() {
return const_string(INTERP, "Array");
}
/*
=item C<STRING* get_string_keyed(PMC*)>
=item C<STRING* get_string_keyed_int(INT)>
=item C<STRING* get_string_keyed_str(STRING*)>
Return the string value of the element at C<key>.
=cut
*/
STRING* get_string_keyed(PMC* key) {
/*XXX: implement keyed code properly*/
PMC* value_pmc = get_thing_from_hashtable(INTERP,
(HashTable*)PMC_struct_val(SELF), key);
return VTABLE_get_string(INTERP, value_pmc);
}
STRING* get_string_keyed_int(INTVAL key) {
PMC* key_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_integer_native(INTERP, key_pmc, key);
return SELF.get_string_keyed(key_pmc);
}
STRING* get_string_keyed_str(STRING* key) {
PMC* key_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, key_pmc, key);
return SELF.get_string_keyed(key_pmc);
}
/*
=item C<void init()>
Initialize this PHPArray's internal structures
=cut
*/
void init() {
HashTable *ht;
PObj_custom_mark_destroy_SETALL(SELF);
ht = mem_allocate_zeroed_typed(HashTable);
/*initialize the hash to contain 4 buckets*/
ht->capacity = 4;
ht->hashMask = ht->capacity - 1;
ht->buckets = (Bucket**)mem_allocate_n_zeroed_typed(ht->capacity,
Bucket);
PMC_struct_val(SELF) = ht;
}
/* not sure if I care about these
void init_pmc (PMC* initializer) {
}
PMC* inspect () {
return PMCNULL;
}
PMC* inspect_str (STRING* what) {
return PMCNULL;
}
PMC* instantiate (PMC* sig) {
return PMCNULL;
}
opcode_t* invoke (void* next) {
return (opcode_t*)0;
}*/
/*
=item C<INTVAL is_same(PMC*)>
Return TRUE if this PHPArray and the passed-in PMC refer to the same region in
memory.
=cut
*/
INTVAL is_same(PMC* other) {
return PMC_struct_val(other) == PMC_struct_val(SELF) &&
other->vtable == SELF->vtable;
}
/*
=item C<void mark()>
Mark the PHPArray and all contents as live.
=cut
*/
void mark() {
Bucket* b;
HashTable* ht;
INTVAL elementCount;
int i;
ht = (HashTable*) PMC_struct_val(SELF);
dprintf("marking hash at %X\n", (uint)ht);
elementCount = ht->elementCount;
i = 0;
for (i = 0; i < elementCount; i++) {
b = ht->buckets[i];
dprintf("marking bucket #%d\n", i);
while (b != NULL) {
/*XXX: I don't think I need to call pobject lives on a bucket
pobject_lives(INTERP, (PObj*)b);*/
pobject_lives(INTERP, (PObj*)b->key);
pobject_lives(INTERP, (PObj*)b->value);
b = b->bucketNext;
}
i++;
}
}
/*XXX: I'm pretty sure I don't need to implement these, but
I'm leaving them here until I understand the Iterator PMC
well enough to do otherwise.
PMC* nextkey_keyed (PMC* key, INTVAL what) {
return PMCNULL;
}
PMC* nextkey_keyed_int (INTVAL key, INTVAL what) {
return PMCNULL;
}
PMC* nextkey_keyed_str (STRING* key, INTVAL what) {
return PMCNULL;
}*/
/*
=item C<FLOATVAL pop_float()>
=item C<INTVAL pop_integer()>
=item C<PMC* pop_pmc()>
=item C<STRING* pop_string()>
Remove and return the last element in the list according to internal ordering.
After removing the element, the internal pointer is reset to the first element.
=cut
*/
FLOATVAL pop_float() {
PMC* p = SELF.pop_pmc();
return VTABLE_get_number(INTERP, p);
}
INTVAL pop_integer() {
PMC* p = SELF.pop_pmc();
return VTABLE_get_integer(INTERP, p);
}
PMC* pop_pmc() {
Bucket* new_tail;
struct bucket* tail;
HashTable* ht;
PMC* popped;
if (ht->tableHead == NULL) {
return PMCNULL;
}
ht = (HashTable*) PMC_struct_val(SELF);
if (ht->tableHead == ht->tableTail) {
popped = ht->tableHead->value;
mem_sys_free(ht->tableHead);
ht->internalPointer = NULL;
ht->tableHead = NULL;
ht->tableTail = NULL;
ht->elementCount = 0;
ht->nextIndex = 0;
}
else {
tail = ht->tableTail;
new_tail = ht->tableTail->tablePrev;
new_tail->tableNext = NULL;
ht->tableTail = new_tail;
ht->internalPointer = ht->tableHead;
popped = tail->value;
mem_sys_free(tail);
}
return popped;
}
STRING* pop_string() {
PMC* p = SELF.pop_pmc();
return VTABLE_get_string(INTERP, p);
}
/*
=item C<void push_float(FLOATVAL)>
=item C<void push_integer(INTVAL)>
=item C<void push_pmc(PMC*)>
=item C<void push_string(STRING*)>
Add C<value> to the end of the PHPArray according to internal ordering. This
does B<not> reset the internal pointer.
=cut
*/
void push_float(FLOATVAL value) {
PMC* value_pmc = pmc_new(INTERP, enum_class_Float);
VTABLE_set_number_native(INTERP, value_pmc, value);
SELF.push_pmc(value_pmc);
}
void push_integer(INTVAL value) {
PMC* value_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, value_pmc, value);
SELF.push_pmc(value_pmc);
}
void push_pmc(PMC* value) {
HashTable *ht = (HashTable*)PMC_struct_val(SELF);
INTVAL key = ht->nextIndex;
ht->nextIndex++;
VTABLE_set_pmc_keyed_int(INTERP, SELF, key, value);
}
void push_string(STRING* value) {
PMC* value_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, value_pmc, value);
SELF.push_pmc(value_pmc);
}
/*
=item C<void set_string_keyed_str (STRING*, STRING*)>
=item C<void set_string_keyed_int (INTVAL, STRING*)>
=item C<void set_string_keyed (PMC*, STRING*)>
=item C<void set_pointer_keyed_str (STRING*, void*)>
=item C<void set_pointer_keyed_int (INTVAL, void*)>
=item C<void set_pmc_keyed_str (STRING*, PMC*)>
=item C<void set_pmc_keyed_int (INTVAL, PMC*)>
=item C<void set_number_keyed_str (STRING*, FLOATVAL)>
=item C<void set_number_keyed_int (INTVAL, FLOATVAL)>
=item C<void set_integer_keyed_str (STRING*, INTVAL)>
=item C<void set_integer_keyed_int (INTVAL, INTVAL)>
Associate C<key> with C<value>.
=cut
*/
void set_integer_keyed_int(INTVAL key, INTVAL value) {
PMC* key_pmc, *value_pmc;
HashTable* ht;
key_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, key_pmc, key);
value_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, value_pmc, value);
ht = (HashTable*) PMC_struct_val(SELF);
add_thing_to_hashtable(INTERP, ht, key_pmc, value_pmc, APPEND);
}
void set_integer_keyed_str(STRING* key, INTVAL value) {
PMC* key_pmc, *value_pmc;
HashTable* ht;
key_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, key_pmc, key);
value_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, value_pmc, value);
ht = (HashTable*) PMC_struct_val(SELF);
add_thing_to_hashtable(INTERP, ht, key_pmc, value_pmc, APPEND);
}
void set_integer_keyed(PMC* key, INTVAL value) {
PMC* box, *next_key;
INTVAL index_i, key_t, next_key_t;
STRING *index_s;
char key_is_int;
/*if key is null*/
if (key == NULL) {
return;
}
key_t = key_type(INTERP, key);
/*figure out type of the key*/
if (key_t & KEY_integer_FLAG) {
index_i = key_integer(INTERP, key);
key_is_int = 1;
}
else if (key_t & KEY_string_FLAG) {
index_s = key_string(INTERP, key);
key_is_int = 0;
}
else {
real_exception(INTERP, NULL, E_KeyError, "must use integer or
string keys");
}
next_key = key_next(INTERP, key);
/*if this is the PMC being requested...*/
if (next_key == NULL && key_is_int) {
SELF.set_integer_keyed_int(index_i, value);
return;
}
else if (next_key == NULL && !key_is_int) {
SELF.set_integer_keyed_str(index_s, value);
return;
}
next_key_t = key_type(INTERP, next_key);
if (next_key_t & KEY_integer_FLAG) {
box = SELF.get_pmc_keyed_int(index_i);
}
else if (next_key_t & KEY_string_FLAG) {
box = SELF.get_pmc_keyed_str(index_s);
}
else {
real_exception(INTERP, NULL, E_KeyError, "must use integer or
string keys");
}
/*autovivify if needed*/
if (box == NULL) {
box = pmc_new(INTERP, DYNSELF.type());
}
return VTABLE_set_integer_keyed(INTERP, box, next_key, value);
}
void set_number_keyed_int(INTVAL key, FLOATVAL value) {
PMC* key_pmc, *value_pmc;
HashTable* ht;
key_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, key_pmc, key);
value_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, value_pmc, value);
ht = (HashTable*) PMC_struct_val(SELF);
add_thing_to_hashtable(INTERP, ht, key_pmc, value_pmc, APPEND);
}
void set_number_keyed_str(STRING* key, FLOATVAL value) {
PMC* key_pmc, *value_pmc;
HashTable* ht;
key_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, key_pmc, key);
value_pmc = pmc_new(INTERP, enum_class_Float);
VTABLE_set_number_native(INTERP, value_pmc, value);
ht = (HashTable*) PMC_struct_val(SELF);
add_thing_to_hashtable(INTERP, ht, key_pmc, value_pmc, APPEND);
}
void set_number_keyed(PMC* key, FLOATVAL value) {
/*XXX: implement keyed code properly*/
PMC* value_pmc;
HashTable* ht;
value_pmc = pmc_new(INTERP, enum_class_Float);
VTABLE_set_number_native(INTERP, value_pmc, value);
ht = (HashTable*) PMC_struct_val(SELF);
add_thing_to_hashtable(INTERP, ht, key, value_pmc, APPEND);
}
void set_pmc_keyed_int(INTVAL key, PMC* value) {
PMC* key_pmc;
HashTable* ht;
key_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, key_pmc, key);
ht = (HashTable*) PMC_struct_val(SELF);
add_thing_to_hashtable(INTERP, ht, key_pmc, value, APPEND);
}
void set_pmc_keyed_str(STRING* key, PMC* value) {
PMC* key_pmc;
HashTable* ht;
key_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, key_pmc, key);
ht = (HashTable*) PMC_struct_val(SELF);
add_thing_to_hashtable(INTERP, ht, key_pmc, value, APPEND);
}
void set_pmc_keyed(PMC* key, PMC* value) {
PMC* box, *next_key;
INTVAL index_i, key_t, next_key_t;
STRING *index_s;
char key_is_int;
/*if key is null*/
if (key == NULL) {
return;
}
key_t = key_type(INTERP, key);
/*figure out type of the key*/
if (key_t & KEY_integer_FLAG) {
index_i = key_integer(INTERP, key);
key_is_int = 1;
}
else if (key_t & KEY_string_FLAG) {
index_s = key_string(INTERP, key);
key_is_int = 0;
}
else {
real_exception(INTERP, NULL, E_KeyError, "must use integer or
string keys");
}
next_key = key_next(INTERP, key);
/*if this is the PMC being requested...*/
if (next_key == NULL && key_is_int) {
SELF.set_pmc_keyed_int(index_i, value);
return;
}
else if (next_key == NULL && !key_is_int) {
SELF.set_pmc_keyed_str(index_s, value);
return;
}
next_key_t = key_type(INTERP, next_key);
if (next_key_t & KEY_integer_FLAG) {
box = SELF.get_pmc_keyed_int(index_i);
}
else if (next_key_t & KEY_string_FLAG) {
box = SELF.get_pmc_keyed_str(index_s);
}
else {
real_exception(INTERP, NULL, E_KeyError, "must use integer or
string keys");
}
/*autovivify if needed*/
if (box == NULL) {
box = pmc_new(INTERP, DYNSELF.type());
}
return VTABLE_set_pmc_keyed(INTERP, box, next_key, value);
}
void set_pointer_keyed_int(INTVAL key, void* value) {
}
void set_pointer_keyed_str(STRING* key, void* value) {
}
void set_string_keyed_int(INTVAL key, STRING* value) {
PMC* key_pmc, *value_pmc;
HashTable* ht;
key_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, key_pmc, key);
value_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, value_pmc, value);
ht = (HashTable*) PMC_struct_val(SELF);
add_thing_to_hashtable(INTERP, ht, key_pmc, value_pmc, APPEND);
}
void set_string_keyed_str(STRING* key, STRING* value) {
PMC* key_pmc, *value_pmc;
HashTable* ht;
key_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, key_pmc, key);
value_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, value_pmc, value);
ht = (HashTable*) PMC_struct_val(SELF);
add_thing_to_hashtable(INTERP, ht, key_pmc, value_pmc, APPEND);
}
void set_string_keyed(PMC* key, STRING* value) {
/*XXX: implement keyed code properly*/
PMC* key_pmc, *value_pmc;
HashTable* ht;
value_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, value_pmc, value);
ht = (HashTable*) PMC_struct_val(SELF);
add_thing_to_hashtable(INTERP, ht, key, value_pmc, APPEND);
}
/*
=item C<PMC* share_ro()>
Mark the PHPArray as shared and read-only.
=cut
*/
PMC* share_ro() {
return PMCNULL;
}
/*
=item C<FLOATVAL shift_float()>
=item C<INTVAL shift_integer()>
=item C<PMC* shift_pmc()>
=item C<STRING* shift_string()>
Return the the first item on the list as the type specified, removing it from
this PHPArray. All remaining keys with numerical indicies are renumbered
according to their internal order in the PHPArray, starting from 0. After
shifting, the internal pointer is reset to the first element of the PHPArray.
=cut
*/
FLOATVAL shift_float() {
PMC* p = SELF.shift_pmc();
return VTABLE_get_number(INTERP, p);
}
INTVAL shift_integer() {
PMC* p = SELF.shift_pmc();
return VTABLE_get_integer(INTERP, p);
}
PMC* shift_pmc() {
Bucket* new_head;
struct bucket* head;
HashTable* ht;
PMC* shifted;
char* str;
if (ht->tableTail == NULL) {
return PMCNULL;
}
ht = (HashTable*) PMC_struct_val(SELF);
if (ht->tableHead == ht->tableTail) {
shifted = ht->tableTail->value;
mem_sys_free(ht->tableTail);
ht->internalPointer = NULL;
ht->tableHead = NULL;
ht->tableTail = NULL;
ht->elementCount = 0;
ht->nextIndex = 0;
}
else {
head = ht->tableHead;
new_head = ht->tableHead->tableNext;
new_head->tablePrev = NULL;
ht->tableHead = new_head;
ht->internalPointer = ht->tableHead;
shifted = head->value;
mem_sys_free(head);
}
return shifted;
}
STRING* shift_string() {
PMC* p = SELF.shift_pmc();
return VTABLE_get_string(INTERP, p);
}
/*
PMC* slice (PMC* key, INTVAL flag) {
return PMCNULL;
}
void splice (PMC* value, INTVAL offset, INTVAL count) {
}
void thaw (visit_info* info) {
}
void thawfinish (visit_info* info) {
} */
/*
=item C<FLOATVAL unshift_float()>
=item C<INTVAL unshift_integer()>
=item C<PMC* unshift_pmc()>
=item C<STRING* unshift_string()>
Add the passed value to the beginning of this PHPArray. The value is given an
integer key of 0 and is placed first in the PHPArray's internal ordering. All
integer keys are renumbered starting from 0, according to their internal order
in the PHPArray. After unshifting, the internal pointer is reset to point to
the newly inserted element.
=cut
*/
void unshift_float(FLOATVAL value) {
PMC* value_pmc = pmc_new(INTERP, enum_class_Float);
VTABLE_set_number_native(INTERP, value_pmc, value);
SELF.unshift_pmc(value_pmc);
}
void unshift_integer(INTVAL value) {
PMC* value_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, value_pmc, value);
SELF.unshift_pmc(value_pmc);
}
void unshift_pmc(PMC* value) {
PMC* key_pmc;
HashTable* ht;
ht = (HashTable*) PMC_struct_val(SELF);
key_pmc = pmc_new(INTERP, enum_class_Integer);
VTABLE_set_integer_native(INTERP, key_pmc, ht->nextIndex);
add_thing_to_hashtable(INTERP, ht, key_pmc, value, PREPEND);
renumber_hash(INTERP, ht);
ht->internalPointer = ht->tableHead;
}
void unshift_string(STRING* value) {
PMC* value_pmc = pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, value_pmc, value);
SELF.unshift_pmc(value_pmc);
}
/*
=item C<void visit(visit_info*)>
Used by freeze and thaw to visit the contents of the PMC.
=cut
*/
void visit(visit_info* info) {
}
}
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4:
*/
