[svn:parrot] r41860 - in branches/pcc_reapply: src/call src/pmc t/pmc
allison at svn.parrot.org
allison at svn.parrot.org
Wed Oct 14 22:01:57 UTC 2009
Author: allison
Date: Wed Oct 14 22:01:55 2009
New Revision: 41860
URL: https://trac.parrot.org/parrot/changeset/41860
Log:
[pcc] Merge in the fast new internals of CallSignature PMC from
pcc_optimize_sig, with relevant changes to argument handling and additional
tests.
Modified:
branches/pcc_reapply/src/call/args.c
branches/pcc_reapply/src/pmc/callsignature.pmc
branches/pcc_reapply/t/pmc/callsignature.t
Modified: branches/pcc_reapply/src/call/args.c
==============================================================================
--- branches/pcc_reapply/src/call/args.c Wed Oct 14 21:59:40 2009 (r41859)
+++ branches/pcc_reapply/src/call/args.c Wed Oct 14 22:01:55 2009 (r41860)
@@ -1189,26 +1189,21 @@
if (!PMC_IS_NULL(named_arg_list)) {
INTVAL named_arg_count = VTABLE_elements(interp, named_arg_list);
INTVAL named_arg_index;
- PMC *named_key = pmc_new(interp, enum_class_Key);
- VTABLE_set_integer_native(interp, named_key, 0);
- SETATTR_Key_next_key(interp, named_key, (PMC *)INITBucketIndex);
- /* Low-level hash iteration. */
+ /* Named argument iteration. */
for (named_arg_index = 0; named_arg_index < named_arg_count; named_arg_index++) {
- if (!PMC_IS_NULL(named_key)) {
- STRING *name = (STRING *)parrot_hash_get_idx(interp,
- (Hash *)VTABLE_get_pointer(interp, named_arg_list), named_key);
- PARROT_ASSERT(name);
- if ((PMC_IS_NULL(named_used_list)) ||
- !VTABLE_exists_keyed_str(interp, named_used_list, name)) {
- VTABLE_set_pmc_keyed_str(interp, collect_named, name,
- VTABLE_get_pmc_keyed_str(interp, call_object, name));
- /* Mark the name as used, cannot be filled again. */
- if (PMC_IS_NULL(named_used_list)) /* Only created if needed. */
- named_used_list = pmc_new(interp, enum_class_Hash);
- VTABLE_set_integer_keyed_str(interp, named_used_list, name, 1);
- named_count++;
- }
+ STRING *name = VTABLE_get_string_keyed_int( interp,
+ named_arg_list, named_arg_index);
+
+ if ((PMC_IS_NULL(named_used_list)) ||
+ !VTABLE_exists_keyed_str(interp, named_used_list, name)) {
+ VTABLE_set_pmc_keyed_str(interp, collect_named, name,
+ VTABLE_get_pmc_keyed_str(interp, call_object, name));
+ /* Mark the name as used, cannot be filled again. */
+ if (PMC_IS_NULL(named_used_list)) /* Only created if needed. */
+ named_used_list = pmc_new(interp, enum_class_Hash);
+ VTABLE_set_integer_keyed_str(interp, named_used_list, name, 1);
+ named_count++;
}
}
}
@@ -1329,22 +1324,17 @@
* anyway, so spend a little extra effort to tell the user *which*
* named argument is extra. */
INTVAL named_arg_index;
- PMC *named_key = pmc_new(interp, enum_class_Key);
- VTABLE_set_integer_native(interp, named_key, 0);
- SETATTR_Key_next_key(interp, named_key, (PMC *)INITBucketIndex);
- /* Low-level hash iteration. */
+ /* Named argument iteration. */
for (named_arg_index = 0; named_arg_index < named_arg_count; named_arg_index++) {
- if (!PMC_IS_NULL(named_key)) {
- STRING *name = (STRING *)parrot_hash_get_idx(interp,
- (Hash *)VTABLE_get_pointer(interp, named_arg_list), named_key);
- PARROT_ASSERT(name);
- if (!VTABLE_exists_keyed_str(interp, named_used_list, name)) {
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "too many named arguments: '%S' not used",
- name);
- }
+ STRING *name = VTABLE_get_string_keyed_int(interp,
+ named_arg_list, named_arg_index);
+
+ if (!VTABLE_exists_keyed_str(interp, named_used_list, name)) {
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "too many named arguments: '%S' not used",
+ name);
}
}
}
Modified: branches/pcc_reapply/src/pmc/callsignature.pmc
==============================================================================
--- branches/pcc_reapply/src/pmc/callsignature.pmc Wed Oct 14 21:59:40 2009 (r41859)
+++ branches/pcc_reapply/src/pmc/callsignature.pmc Wed Oct 14 22:01:55 2009 (r41860)
@@ -19,20 +19,339 @@
*/
-#define CAPTURE_DATA_SIZE 2
-#define CAPTURE_array_CREATE(i, obj) \
- if (!PARROT_CAPTURE(obj)->array) \
- PARROT_CAPTURE(obj)->array = pmc_new((i), enum_class_ResizablePMCArray);
-#define CAPTURE_hash_CREATE(i, obj) \
- if (!PARROT_CAPTURE(obj)->hash) \
- PARROT_CAPTURE(obj)->hash = pmc_new((i), enum_class_Hash);
-
-pmclass CallSignature extends Capture auto_attrs provides array provides hash {
- ATTR PMC *results; /* Storage for return arguments */
- ATTR PMC *type_tuple; /* Cached argument types for multiple dispatch */
- ATTR STRING *short_sig; /* Simple string signature args & returns */
- ATTR PMC *arg_flags; /* Integer array of argument flags */
- ATTR PMC *return_flags; /* Integer array of return argument flags */
+typedef struct Pcc_cell
+{
+ union u {
+ PMC *p;
+ STRING *s;
+ INTVAL i;
+ FLOATVAL n;
+ } u;
+ struct Pcc_cell *next;
+} Pcc_cell;
+
+/* mask off lower three bits for pointer tag */
+#define UNTAG_CELL(c) INTVAL2PTR(Pcc_cell *, (PTR2INTVAL(c)) & ~3)
+
+#define CELL_INT(c) UNTAG_CELL(c)->u.i
+#define CELL_FLOAT(c) UNTAG_CELL(c)->u.n
+#define CELL_STRING(c) UNTAG_CELL(c)->u.s
+#define CELL_PMC(c) UNTAG_CELL(c)->u.p
+
+#define NEXT_CELL(c) UNTAG_CELL(c)->next
+#define FREE_CELL(c) mem_sys_free(UNTAG_CELL(c))
+
+#define CELL_TYPE_MASK(c) (PTR2INTVAL(c)) & 3
+#define INTCELL 0
+#define FLOATCELL 1
+#define STRINGCELL 2
+#define PMCCELL 3
+
+#define SET_CELL_INT(c) \
+ INTVAL2PTR(Pcc_cell *, PTR2INTVAL(UNTAG_CELL(c)) | INTCELL)
+
+#define SET_CELL_FLOAT(c) \
+ INTVAL2PTR(Pcc_cell *, PTR2INTVAL(UNTAG_CELL(c)) | FLOATCELL)
+
+#define SET_CELL_STRING(c) \
+ INTVAL2PTR(Pcc_cell *, PTR2INTVAL(UNTAG_CELL(c)) | STRINGCELL)
+
+#define SET_CELL_PMC(c) \
+ INTVAL2PTR(Pcc_cell *, PTR2INTVAL(UNTAG_CELL(c)) | PMCCELL)
+
+#define CREATE_INTVAL_CELL SET_CELL_INT(mem_allocate_zeroed_typed(Pcc_cell))
+
+#define CREATE_FLOATVAL_CELL SET_CELL_FLOAT(mem_allocate_zeroed_typed(Pcc_cell))
+
+#define CREATE_STRING_CELL SET_CELL_STRING(mem_allocate_zeroed_typed(Pcc_cell))
+
+#define CREATE_PMC_CELL SET_CELL_PMC(mem_allocate_zeroed_typed(Pcc_cell))
+
+#define APPEND_CELL(SELF, cell) \
+ do { \
+ Parrot_CallSignature_attributes * const a = PARROT_CALLSIGNATURE(SELF);\
+ (a)->num_positionals++; \
+ if ((a)->positionals) { \
+ Pcc_cell *c = (a)->positionals; \
+ while (NEXT_CELL(c)) { \
+ c = NEXT_CELL(c); \
+ } \
+ NEXT_CELL(c) = cell; \
+ } \
+ else \
+ (a)->positionals = cell; \
+ } while (0)
+
+#define PREPEND_CELL(SELF, cell) \
+ do { \
+ Parrot_CallSignature_attributes * const a = PARROT_CALLSIGNATURE(SELF);\
+ a->num_positionals++; \
+ NEXT_CELL(cell) = a->positionals; \
+ a->positionals = cell; \
+ } while (0)
+
+/* TODO: could use get_cell_at */
+static Pcc_cell *
+pop_cell(PARROT_INTERP, ARGIN(PMC *SELF))
+{
+ Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
+ Pcc_cell *cell = attrs->positionals;
+ Pcc_cell *prev = NULL;
+
+ /* no cells */
+ if (!cell)
+ return NULL;
+
+ attrs->num_positionals--;
+
+ /* one cell */
+ if (!NEXT_CELL(cell)) {
+ attrs->positionals = NULL;
+ return cell;
+ }
+
+ while (cell) {
+ if (!NEXT_CELL(cell)) {
+ NEXT_CELL(prev) = NULL;
+ return cell;
+ }
+
+ prev = cell;
+ cell = NEXT_CELL(cell);
+ }
+
+ /* should abort here */
+ attrs->num_positionals++;
+ return NULL;
+}
+
+static Pcc_cell *
+shift_cell(PARROT_INTERP, ARGIN(PMC *SELF))
+{
+ Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
+ Pcc_cell *cell = attrs->positionals;
+
+ /* no cells */
+ if (!cell)
+ return NULL;
+
+ attrs->num_positionals--;
+
+ /* one cell */
+ if (!NEXT_CELL(cell))
+ attrs->positionals = NULL;
+ else
+ attrs->positionals = NEXT_CELL(cell);
+
+ return cell;
+}
+
+static Pcc_cell *
+get_cell_at(PARROT_INTERP, ARGIN(PMC *SELF), INTVAL key)
+{
+ Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
+ Pcc_cell *cell = attrs->positionals;
+ INTVAL i;
+
+ if (key > attrs->num_positionals)
+ return NULL;
+
+ while (key) {
+ /* XXX: shouldn't happen */
+ if (!NEXT_CELL(cell))
+ return NULL;
+
+ cell = NEXT_CELL(cell);
+ key--;
+ }
+
+ return cell;
+
+}
+
+static INTVAL
+autobox_intval(PARROT_INTERP, Pcc_cell *cell)
+{
+ switch (CELL_TYPE_MASK(cell)) {
+ case INTCELL:
+ return CELL_INT(cell);
+ case FLOATCELL:
+ return (INTVAL)CELL_FLOAT(cell);
+ case STRINGCELL:
+ return CELL_STRING(cell) ? Parrot_str_to_int(interp, CELL_STRING(cell)) : 0;
+ case PMCCELL:
+ return PMC_IS_NULL(CELL_PMC(cell))
+ ? 0
+ : VTABLE_get_integer(interp, CELL_PMC(cell));
+ default:
+ break;
+ }
+
+ /* exception */
+ return 0;
+}
+
+static FLOATVAL
+autobox_floatval(PARROT_INTERP, Pcc_cell *cell)
+{
+ switch (CELL_TYPE_MASK(cell)) {
+ case INTCELL:
+ return (FLOATVAL)CELL_INT(cell);
+ case FLOATCELL:
+ return CELL_FLOAT(cell);
+ case STRINGCELL:
+ return CELL_STRING(cell) ? Parrot_str_to_num(interp, CELL_STRING(cell)) : 0.0;
+ case PMCCELL:
+ return PMC_IS_NULL(CELL_PMC(cell))
+ ? 0.0
+ : VTABLE_get_number(interp, CELL_PMC(cell));
+ default:
+ break;
+ }
+
+ /* exception */
+ return 0.0;
+}
+
+static STRING *
+autobox_string(PARROT_INTERP, Pcc_cell *cell)
+{
+ switch (CELL_TYPE_MASK(cell)) {
+ case INTCELL:
+ return Parrot_str_from_int(interp, CELL_INT(cell));
+ case FLOATCELL:
+ return Parrot_str_from_num(interp, CELL_FLOAT(cell));
+ case STRINGCELL:
+ return CELL_STRING(cell);
+ case PMCCELL:
+ return PMC_IS_NULL(CELL_PMC(cell))
+ ? NULL
+ : VTABLE_get_string(interp, CELL_PMC(cell));
+ default:
+ break;
+ }
+
+ /* exception */
+ return NULL;
+}
+
+static PMC *
+autobox_pmc(PARROT_INTERP, Pcc_cell *cell)
+{
+ PMC *result = PMCNULL;
+
+ /* TODO: respect HLL types? */
+ switch (CELL_TYPE_MASK(cell)) {
+ case INTCELL:
+ result = pmc_new(interp, enum_class_Integer);
+ VTABLE_set_integer_native(interp, result, CELL_INT(cell));
+ break;
+ case FLOATCELL:
+ result = pmc_new(interp, enum_class_Float);
+ VTABLE_set_number_native(interp, result, CELL_FLOAT(cell));
+ break;
+ case STRINGCELL:
+ result = pmc_new(interp, enum_class_String);
+ VTABLE_set_string_native(interp, result, CELL_STRING(cell));
+ break;
+ case PMCCELL:
+ return CELL_PMC(cell);
+ default:
+ /* exception */
+ break;
+ }
+
+ return result;
+}
+
+static Hash *
+get_hash(PARROT_INTERP, ARGIN(PMC *SELF))
+{
+ Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
+
+ if (!attrs->hash)
+ attrs->hash = parrot_new_hash(interp);
+
+ return attrs->hash;
+}
+
+static void
+mark_positionals(PARROT_INTERP, ARGIN(Pcc_cell *c))
+{
+ while (c) {
+ switch (CELL_TYPE_MASK(c)) {
+ case STRINGCELL:
+ if (CELL_STRING(c))
+ Parrot_gc_mark_STRING_alive(interp, CELL_STRING(c));
+ break;
+ case PMCCELL:
+ if (!PMC_IS_NULL(CELL_PMC(c)))
+ Parrot_gc_mark_PMC_alive(interp, CELL_PMC(c));
+ break;
+ case INTCELL:
+ case FLOATCELL:
+ default:
+ break;
+ }
+
+ c = NEXT_CELL(c);
+ }
+}
+
+/* don't look now, but here goes encapsulation.... */
+static void
+mark_hash(PARROT_INTERP, ARGIN(Hash *h))
+{
+ UINTVAL entries = h->entries;
+ INTVAL i;
+
+ for (i = h->mask; i >= 0; --i) {
+ HashBucket *b = h->bi[i];
+
+ while (b) {
+ Parrot_gc_mark_PObj_alive(interp, (PObj *)b->key);
+ mark_positionals(interp, (Pcc_cell *)b->value);
+ b = b->next;
+ }
+
+ }
+}
+
+static PMC *
+get_named_names(PARROT_INTERP, ARGIN(PMC *SELF))
+{
+ Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
+ PMC *result = PMCNULL;
+
+ /* yes, this *looks* risky, but it's a Parrot STRING hash internally */
+ if (attrs->hash && attrs->hash->entries) {
+ UINTVAL i, j = 0;
+ result = pmc_new(interp, enum_class_FixedStringArray);
+ VTABLE_set_integer_native(interp, result, attrs->hash->entries);
+
+ for (i = 0; i <= attrs->hash->mask; i++) {
+ HashBucket *b = attrs->hash->bi[i];
+
+ while (b) {
+ VTABLE_set_string_keyed_int(interp, result,
+ j++, (STRING *)b->key);
+ b = b->next;
+ }
+ }
+ }
+
+ return result;
+}
+
+pmclass CallSignature auto_attrs provides array provides hash {
+ ATTR struct Pcc_cell *positionals; /* linked list of positionals */
+ ATTR PMC *results; /* Storage for return arguments */
+ ATTR PMC *type_tuple; /* Cached argument types for MDD */
+ ATTR STRING *short_sig; /* Simple string sig args & returns */
+ ATTR PMC *arg_flags; /* Integer array of argument flags */
+ ATTR PMC *return_flags; /* Integer array of return flags */
+ ATTR Hash *hash; /* Hash of named arguments */
+ ATTR INTVAL num_positionals; /* count of positionals */
/*
@@ -45,11 +364,14 @@
*/
VTABLE void init() {
- Parrot_CallSignature_attributes * const sig_struct =
- (Parrot_CallSignature_attributes *) PMC_data(SELF);
+ Parrot_CallSignature_attributes * const attrs =
+ PMC_data_typed(SELF, Parrot_CallSignature_attributes *);
SUPER();
- sig_struct->type_tuple = PMCNULL;
- sig_struct->results = PMCNULL;
+ attrs->type_tuple = PMCNULL;
+ attrs->results = PMCNULL;
+ attrs->positionals = NULL;
+ attrs->num_positionals = 0;
+ PObj_custom_mark_destroy_SETALL(SELF);
}
/*
@@ -63,8 +385,8 @@
*/
VTABLE void set_string_native(STRING *value) {
- Parrot_CallSignature_attributes * const sig_struct = PARROT_CALLSIGNATURE(SELF);
- sig_struct->short_sig = value;
+ Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
+ attrs->short_sig = value;
}
/*
@@ -78,8 +400,8 @@
*/
VTABLE STRING *get_string() {
- Parrot_CallSignature_attributes * const sig_struct = PARROT_CALLSIGNATURE(SELF);
- return sig_struct->short_sig;
+ Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
+ return attrs->short_sig;
}
/*
@@ -93,8 +415,8 @@
*/
VTABLE void set_pmc(PMC *value) {
- Parrot_CallSignature_attributes * const sig_struct = PARROT_CALLSIGNATURE(SELF);
- sig_struct->type_tuple = value;
+ Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
+ attrs->type_tuple = value;
}
/*
@@ -219,7 +541,7 @@
GET_ATTR_return_flags(interp, SELF, value);
}
else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "named"))) {
- GET_ATTR_hash(interp, SELF, value);
+ value = get_named_names(INTERP, SELF);
}
else {
/* If unknown attribute name, throw an exception. */
@@ -241,7 +563,6 @@
*/
VTABLE void mark() {
Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
-
if (!attrs)
return;
@@ -250,9 +571,528 @@
Parrot_gc_mark_STRING_alive(interp, attrs->short_sig);
Parrot_gc_mark_PMC_alive(interp, attrs->arg_flags);
Parrot_gc_mark_PMC_alive(interp, attrs->return_flags);
- SUPER();
+
+ if (attrs->num_positionals)
+ mark_positionals(interp, attrs->positionals);
+
+ if (attrs->hash)
+ mark_hash(interp, attrs->hash);
+ }
+
+ VTABLE void destroy() {
+ Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
+ if (!attrs)
+ return;
+
+ if (attrs->num_positionals) {
+ Pcc_cell *c = attrs->positionals;
+
+ while (c) {
+ Pcc_cell *to_free = c;
+ c = NEXT_CELL(c);
+ FREE_CELL(to_free);
+ }
+ }
+
+ if (attrs->hash) {
+ UINTVAL i;
+
+ for (i = 0; i <= attrs->hash->mask; i++) {
+ HashBucket *b = attrs->hash->bi[i];
+
+ while (b) {
+ FREE_CELL((Pcc_cell *)b->value);
+ b = b->next;
+ }
+ }
+
+ parrot_hash_destroy(interp, attrs->hash);
+ }
+ }
+
+ VTABLE INTVAL elements () {
+ Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
+ if (!attrs)
+ return 0;
+
+ return attrs->num_positionals;
+ }
+
+ VTABLE void push_integer(INTVAL value) {
+ Pcc_cell *cell = CREATE_INTVAL_CELL;
+ APPEND_CELL(SELF, cell);
+ CELL_INT(cell) = value;
+ }
+
+ VTABLE void push_float(FLOATVAL value) {
+ Pcc_cell *cell = CREATE_FLOATVAL_CELL;
+ APPEND_CELL(SELF, cell);
+ CELL_FLOAT(cell) = value;
+ }
+
+ VTABLE void push_string(STRING *value) {
+ Pcc_cell *cell = CREATE_STRING_CELL;
+ APPEND_CELL(SELF, cell);
+ CELL_STRING(cell) = value;
+ }
+
+ VTABLE void push_pmc(PMC *value) {
+ Pcc_cell *cell = CREATE_PMC_CELL;
+ APPEND_CELL(SELF, cell);
+ CELL_PMC(cell) = value;
+ }
+
+ VTABLE INTVAL pop_integer() {
+ Pcc_cell *cell = pop_cell(interp, SELF);
+
+ if (cell) {
+ INTVAL result = autobox_intval(interp, cell);
+ FREE_CELL(cell);
+ return result;
+ }
+
+ return 0;
+ }
+
+ VTABLE FLOATVAL pop_float() {
+ Pcc_cell *cell = pop_cell(interp, SELF);
+
+ if (cell) {
+ FLOATVAL result = autobox_floatval(interp, cell);
+ FREE_CELL(cell);
+ return result;
+ }
+
+ return 0.0;
+ }
+
+ VTABLE PMC * pop_pmc() {
+ Pcc_cell *cell = pop_cell(interp, SELF);
+
+ if (cell) {
+ PMC *result = autobox_pmc(interp, cell);
+ FREE_CELL(cell);
+ return result;
+ }
+
+ return PMCNULL;
+ }
+
+ VTABLE STRING * pop_string() {
+ Pcc_cell *cell = pop_cell(interp, SELF);
+
+ if (cell) {
+ STRING *result = autobox_string(interp, cell);
+ FREE_CELL(cell);
+ return result;
+ }
+
+ return NULL;
+ }
+
+ VTABLE INTVAL get_integer_keyed_int(INTVAL key) {
+ Pcc_cell *cell = get_cell_at(interp, SELF, key);
+
+ if (!cell)
+ return 0;
+
+ return autobox_intval(interp, cell);
+ }
+
+ VTABLE FLOATVAL get_number_keyed_int(INTVAL key) {
+ Pcc_cell *cell = get_cell_at(interp, SELF, key);
+
+ if (!cell)
+ return 0.0;
+
+ return autobox_floatval(interp, cell);
+ }
+
+ VTABLE STRING * get_string_keyed_int(INTVAL key) {
+ Pcc_cell *cell = get_cell_at(interp, SELF, key);
+
+ if (!cell)
+ return NULL;
+
+ return autobox_string(interp, cell);
+ }
+
+ VTABLE PMC * get_pmc_keyed_int(INTVAL key) {
+ Pcc_cell *cell = get_cell_at(interp, SELF, key);
+
+ if (!cell)
+ return PMCNULL;
+
+ return autobox_pmc(interp, cell);
+ }
+
+ VTABLE void unshift_integer(INTVAL value) {
+ Pcc_cell *cell = CREATE_INTVAL_CELL;
+ PREPEND_CELL(SELF, cell);
+ CELL_INT(cell) = value;
+ }
+
+ VTABLE void unshift_float(FLOATVAL value) {
+ Pcc_cell *cell = CREATE_FLOATVAL_CELL;
+ PREPEND_CELL(SELF, cell);
+ CELL_FLOAT(cell) = value;
}
+ VTABLE void unshift_string(STRING *value) {
+ Pcc_cell *cell = CREATE_STRING_CELL;
+ PREPEND_CELL(SELF, cell);
+ CELL_STRING(cell) = value;
+ }
+
+ VTABLE void unshift_pmc(PMC *value) {
+ Parrot_CallSignature_attributes * const a = PARROT_CALLSIGNATURE(SELF);
+ Pcc_cell *cell = CREATE_PMC_CELL;
+ PREPEND_CELL(SELF, cell);
+ CELL_PMC(cell) = value;
+ }
+
+ VTABLE INTVAL shift_integer() {
+ Pcc_cell *cell = shift_cell(interp, SELF);
+
+ if (cell) {
+ INTVAL result = autobox_intval(interp, cell);
+ FREE_CELL(cell);
+ return result;
+ }
+
+ return 0;
+ }
+
+ VTABLE FLOATVAL shift_float() {
+ Pcc_cell *cell = shift_cell(interp, SELF);
+
+ if (cell) {
+ FLOATVAL result = autobox_floatval(interp, cell);
+ FREE_CELL(cell);
+ return result;
+ }
+
+ return 0.0;
+ }
+
+ VTABLE STRING * shift_string() {
+ Pcc_cell *cell = shift_cell(interp, SELF);
+
+ if (cell) {
+ STRING *result = autobox_string(interp, cell);
+ FREE_CELL(cell);
+ return result;
+ }
+
+ return NULL;
+ }
+
+ VTABLE PMC * shift_pmc() {
+ Pcc_cell *cell = shift_cell(interp, SELF);
+
+ if (cell) {
+ PMC *result = autobox_pmc(interp, cell);
+ FREE_CELL(cell);
+ return result;
+ }
+
+ return PMCNULL;
+ }
+
+ VTABLE void set_integer_keyed_int(INTVAL key, INTVAL value) {
+ Pcc_cell *cell = get_cell_at(interp, SELF, key);
+
+ if (!cell) {
+ Parrot_CallSignature_attributes * const a =
+ PARROT_CALLSIGNATURE(SELF);
+ if (key == a->num_positionals)
+ VTABLE_push_integer(interp, SELF, value);
+
+ /* XXX: else throw exception? */
+ return;
+ }
+
+ CELL_INT(cell) = value;
+ }
+
+ VTABLE void set_number_keyed_int(INTVAL key, FLOATVAL value) {
+ Pcc_cell *cell = get_cell_at(interp, SELF, key);
+
+ if (!cell) {
+ Parrot_CallSignature_attributes * const a =
+ PARROT_CALLSIGNATURE(SELF);
+ if (key == a->num_positionals)
+ VTABLE_push_float(interp, SELF, value);
+
+ /* XXX: else throw exception? */
+ return;
+ }
+
+ CELL_FLOAT(cell) = value;
+ }
+
+ VTABLE void set_string_keyed_int(INTVAL key, STRING *value) {
+ Pcc_cell *cell = get_cell_at(interp, SELF, key);
+
+ if (!cell) {
+ Parrot_CallSignature_attributes * const a =
+ PARROT_CALLSIGNATURE(SELF);
+ if (key == a->num_positionals)
+ VTABLE_push_string(interp, SELF, value);
+
+ /* XXX: else throw exception? */
+ return;
+ }
+
+ CELL_STRING(cell) = value;
+ }
+
+ VTABLE void set_pmc_keyed_int(INTVAL key, PMC *value) {
+ Pcc_cell *cell = get_cell_at(interp, SELF, key);
+
+ if (!cell) {
+ Parrot_CallSignature_attributes * const a =
+ PARROT_CALLSIGNATURE(SELF);
+ if (key == a->num_positionals)
+ VTABLE_push_pmc(interp, SELF, value);
+
+ /* XXX: else throw exception? */
+ return;
+ }
+
+ CELL_PMC(cell) = value;
+ }
+
+ VTABLE void set_integer_keyed_str(STRING *key, INTVAL value) {
+ Hash *hash = get_hash(interp, SELF);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, (void *)key);
+
+ if (!cell) {
+ cell = CREATE_INTVAL_CELL;
+ parrot_hash_put(interp, hash, (void *)key, (void *)cell);
+ }
+ else
+ SET_CELL_INT(cell);
+
+ CELL_INT(cell) = value;
+ }
+
+ VTABLE void set_number_keyed_str(STRING *key, FLOATVAL value) {
+ Hash *hash = get_hash(interp, SELF);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, (void *)key);
+
+ if (!cell) {
+ cell = CREATE_FLOATVAL_CELL;
+ parrot_hash_put(interp, hash, (void *)key, (void *)cell);
+ }
+ else
+ SET_CELL_FLOAT(cell);
+
+ CELL_FLOAT(cell) = value;
+ }
+
+ VTABLE void set_string_keyed_str(STRING *key, STRING *value) {
+ Hash *hash = get_hash(interp, SELF);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, (void *)key);
+
+ if (!cell) {
+ cell = CREATE_STRING_CELL;
+ parrot_hash_put(interp, hash, (void *)key, (void *)cell);
+ }
+ else
+ SET_CELL_STRING(cell);
+
+ CELL_STRING(cell) = value;
+ }
+
+ VTABLE void set_pmc_keyed_str(STRING *key, PMC *value) {
+ Hash *hash = get_hash(interp, SELF);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, (void *)key);
+
+ if (!cell) {
+ cell = CREATE_PMC_CELL;
+ parrot_hash_put(interp, hash, (void *)key, (void *)cell);
+ }
+ else
+ SET_CELL_PMC(cell);
+
+ CELL_PMC(cell) = value;
+ }
+
+ VTABLE void set_integer_keyed(PMC *key, INTVAL value) {
+ Hash *hash = get_hash(interp, SELF);
+ void *k = hash_key_from_pmc(interp, hash, key);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, k);
+
+ if (!cell) {
+ cell = CREATE_INTVAL_CELL;
+ parrot_hash_put(interp, hash, k, (void *)cell);
+ }
+ else
+ SET_CELL_INT(cell);
+
+ CELL_INT(cell) = value;
+ }
+
+ VTABLE void set_number_keyed(PMC *key, FLOATVAL value) {
+ Hash *hash = get_hash(interp, SELF);
+ void *k = hash_key_from_pmc(interp, hash, key);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, k);
+
+ if (!cell) {
+ cell = CREATE_FLOATVAL_CELL;
+ parrot_hash_put(interp, hash, k, (void *)cell);
+ }
+ else
+ SET_CELL_FLOAT(cell);
+
+ CELL_FLOAT(cell) = value;
+ }
+
+ VTABLE void set_string_keyed(PMC *key, STRING *value) {
+ Hash *hash = get_hash(interp, SELF);
+ void *k = hash_key_from_pmc(interp, hash, key);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, k);
+
+ if (!cell) {
+ cell = CREATE_STRING_CELL;
+ parrot_hash_put(interp, hash, k, (void *)cell);
+ }
+ else
+ SET_CELL_STRING(cell);
+
+ CELL_STRING(cell) = value;
+ }
+
+ VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
+ Hash *hash = get_hash(interp, SELF);
+ void *k = hash_key_from_pmc(interp, hash, key);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, k);
+
+ if (!cell) {
+ cell = CREATE_PMC_CELL;
+ parrot_hash_put(interp, hash, k, (void *)cell);
+ }
+ else
+ SET_CELL_PMC(cell);
+
+ CELL_PMC(cell) = value;
+ }
+
+ VTABLE INTVAL get_integer_keyed(PMC *key) {
+ Hash *hash = get_hash(interp, SELF);
+
+ if (hash) {
+ void *k = hash_key_from_pmc(interp, hash, key);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, k);
+
+ if (cell)
+ return autobox_intval(interp, cell);
+ }
+
+ return 0;
+ }
+
+ VTABLE INTVAL get_integer_keyed_str(STRING *key) {
+ Hash *hash = get_hash(interp, SELF);
+
+ if (hash) {
+ void *k = hash_key_from_string(interp, hash, key);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, k);
+
+ if (cell)
+ return autobox_intval(interp, cell);
+ }
+
+ return 0;
+ }
+
+ VTABLE FLOATVAL get_number_keyed(PMC *key) {
+ Hash *hash = get_hash(interp, SELF);
+
+ if (hash) {
+ void *k = hash_key_from_pmc(interp, hash, key);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, k);
+
+ if (cell)
+ return autobox_floatval(interp, cell);
+ }
+
+ return 0.0;
+ }
+
+ VTABLE STRING * get_string_keyed(PMC *key) {
+ Hash *hash = get_hash(interp, SELF);
+
+ if (hash) {
+ void *k = hash_key_from_pmc(interp, hash, key);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, k);
+
+ if (cell)
+ return autobox_string(interp, cell);
+ }
+
+ return NULL;
+ }
+
+ VTABLE PMC * get_pmc_keyed(PMC *key) {
+ Hash *hash = get_hash(interp, SELF);
+
+ if (hash) {
+ void *k = hash_key_from_pmc(interp, hash, key);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, k);
+
+ if (cell)
+ return autobox_pmc(interp, cell);
+ }
+
+ return PMCNULL;
+ }
+
+ VTABLE PMC * get_pmc_keyed_str(STRING *key) {
+ Hash *hash = get_hash(interp, SELF);
+
+ if (hash) {
+ void *k = hash_key_from_string(interp, hash, key);
+ Pcc_cell *cell = (Pcc_cell *)parrot_hash_get(interp, hash, k);
+
+ if (cell)
+ return autobox_pmc(interp, cell);
+ }
+
+ return PMCNULL;
+ }
+
+ VTABLE INTVAL exists_keyed(PMC *key) {
+ Hash *hash = get_hash(interp, SELF);
+
+ if (hash) {
+ void *k = hash_key_from_pmc(interp, hash, key);
+ return parrot_hash_exists(interp, hash, k);
+ }
+
+ return 0;
+ }
+
+ VTABLE INTVAL exists_keyed_str(STRING *key) {
+ Hash *hash = get_hash(interp, SELF);
+
+ if (hash) {
+ void *k = hash_key_from_string(interp, hash, key);
+ return parrot_hash_exists(interp, hash, k);
+ }
+
+ return 0;
+ }
+
+ VTABLE INTVAL exists_keyed_int(INTVAL key) {
+ Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
+
+ if (attrs->num_positionals)
+ return key < attrs->num_positionals;
+
+ return 0;
+ }
/*
Modified: branches/pcc_reapply/t/pmc/callsignature.t
==============================================================================
--- branches/pcc_reapply/t/pmc/callsignature.t Wed Oct 14 21:59:40 2009 (r41859)
+++ branches/pcc_reapply/t/pmc/callsignature.t Wed Oct 14 22:01:55 2009 (r41860)
@@ -1,5 +1,5 @@
#! parrot
-# Copyright (C) 2006-2008, Parrot Foundation.
+# Copyright (C) 2006-2009, Parrot Foundation.
# $Id$
=head1 NAME
@@ -16,36 +16,27 @@
=cut
-.sub main :main
+.sub 'main' :main
.include 'test_more.pir'
- plan(8)
+ plan(65)
test_instantiate()
- test_get_pmc()
test_get_set_attrs()
+ test_push_pop_indexed_access()
+ test_shift_unshift_indexed_access()
+ test_indexed_access()
+ test_indexed_boxing()
+ test_keyed_access()
+ test_exists()
.end
-
-.sub test_instantiate
- $P0 = new ['CallSignature']
- isa_ok($P0,'CallSignature', 'Instantiated CallSignature')
-.end
-
-.sub test_get_pmc
+.sub 'test_instantiate'
$P0 = new ['CallSignature']
- $P5 = new 'String'
-
- $P5 = 'foobar'
- setattribute $P0, 'returns', $P5
- $P5 = 'cheese'
- setattribute $P0, 'arg_flags', $P5
-
- $P2 = $P0
- isa_ok( $P2, 'CallSignature')
+ ok(1, 'Instantiated CallSignature')
.end
-.sub test_get_set_attrs
+.sub 'test_get_set_attrs'
$P0 = new ['CallSignature']
$P5 = new 'String'
@@ -59,15 +50,240 @@
setattribute $P0, 'return_flags', $P5
ok(1, 'set return_flags attribute')
getattribute $P1, $P0, 'return_flags'
- is($P1,'moonbomb', 'got return_flags attribute')
+ is($P5,'moonbomb', 'got return_flags attribute')
$P5 = 'cheese'
setattribute $P0, 'arg_flags', $P5
ok(1, 'set arg_flags attribute')
getattribute $P1, $P0, 'arg_flags'
- is($P1,'cheese', 'got arg_flags attribute')
+ is($P5,'cheese', 'got arg_flags attribute')
+.end
+
+.sub 'test_push_pop_indexed_access'
+ $P0 = new [ 'CallSignature' ]
+ $P1 = new [ 'Integer' ]
+ $P1 = 100
+
+ push $P0, $P1
+ $I0 = elements $P0
+ is( $I0, 1, 'elements after push' )
+
+ $P2 = $P0[0]
+ is( $P2, 100, 'push_pmc/get_pmc_keyed_int pair' )
+ $P2 = pop $P0
+ is( $P2, 100, 'push_pmc/pop_pmc pair' )
+
+ $I0 = elements $P0
+ is( $I0, 0, 'elements after pop' )
+
+ push $P0, 200
+ $I0 = $P0[0]
+ is( $I0, 200, 'push_integer/get_integer_keyed_int pair' )
+ $I0 = pop $P0
+ is( $I0, 200, 'push_integer/pop_integer pair' )
+
+ push $P0, 3.03
+ $N0 = $P0[0]
+ is( $N0, 3.03, 'push_number/get_number_keyed_int pair' )
+ $N0 = pop $P0
+ is( $N0, 3.03, 'push_number/pop_number pair' )
+
+ push $P0, 'hello'
+ $S0 = $P0[0]
+ is( $S0, 'hello', 'push_string/get_string_keyed_int pair' )
+ $S0 = pop $P0
+ is( $S0, 'hello', 'push_string/pop_string pair' )
+
+ $I0 = elements $P0
+ is( $I0, 0, 'elements after push/pop' )
+.end
+
+.sub 'test_shift_unshift_indexed_access'
+ $P0 = new [ 'CallSignature' ]
+ $P1 = new [ 'Integer' ]
+ $P1 = 100
+
+ unshift $P0, $P1
+
+ $I0 = elements $P0
+ is( $I0, 1, 'elements after unshift' )
+
+ $P2 = $P0[0]
+ is( $P2, 100, 'unshift_pmc/get_pmc_keyed_int pair' )
+ $P2 = shift $P0
+ is( $P2, 100, 'unshift_pmc/shift_pmc pair' )
+
+ $I0 = elements $P0
+ is( $I0, 0, 'elements after unshift/shift' )
+
+ unshift $P0, 200
+ $I0 = $P0[0]
+ is( $I0, 200, 'unshift_integer/get_integer_keyed_int pair' )
+ $I0 = shift $P0
+ is( $I0, 200, 'unshift_integer/shift_integer pair' )
+
+ unshift $P0, 3.03
+ $N0 = $P0[0]
+ is( $N0, 3.03, 'unshift_number/get_number_keyed_int pair' )
+ $N0 = shift $P0
+ is( $N0, 3.03, 'unshift_number/shift_number pair' )
+
+ unshift $P0, 'hello'
+ $S0 = $P0[0]
+ is( $S0, 'hello', 'unshift_string/get_string_keyed_int pair' )
+ $S0 = shift $P0
+ is( $S0, 'hello', 'unshift_string/shift_string pair' )
+
+ $I0 = elements $P0
+ is( $I0, 0, 'elements after unshift/shift' )
+.end
+
+.sub 'test_indexed_access'
+ $P0 = new [ 'CallSignature' ]
+ $P0[0] = 100
+
+ $I0 = elements $P0
+ is( $I0, 1, 'elements after set_*_indexed' )
+
+ $P0[1] = 1.11
+
+ $I0 = elements $P0
+ is( $I0, 2, 'elements after set_*_indexed' )
+
+ $S0 = '2.22'
+ $P0[2] = $S0
+
+ $I0 = elements $P0
+ is( $I0, 3, 'elements after set_*_indexed' )
+
+ $P1 = new [ 'Float' ]
+ $P1 = 3.33
+ $P0[3] = $P1
+
+ $I0 = elements $P0
+ is( $I0, 4, 'elements after set_*_indexed' )
+
+ $I1 = $P0[0]
+ is( $I1, 100, 'set_integer_keyed_int/get_integer_keyed_int pair' )
+
+ $N1 = $P0[1]
+ is( $N1, 1.11, 'set_number_keyed_int/get_number_keyed_int pair' )
+
+ $S1 = $P0[2]
+ is( $S1, '2.22', 'set_string_keyed_int/get_string_keyed_int pair' )
+
+ $P1 = $P0[3]
+ is( $P1, 3.33, 'set_pmc_keyed_int/get_pmc_keyed_int pair' )
+
+ $I1 = shift $P0
+ is( $I1, 100, 'set_integer_keyed_int/shift_integer pair' )
+
+ $N1 = $P0[0]
+ is( $N1, 1.11, 'shift_* should remove elements from array' )
+
+ $N1 = shift $P0
+ is( $N1, 1.11, 'set_number_keyed_int/shift_number pair' )
+
+ $S1 = $P0[0]
+ is( $S1, '2.22', 'shift_* should remove elements from array' )
+
+ $S1 = shift $P0
+ is( $S1, '2.22', 'set_string_keyed_int/shift_string pair' )
+
+ $P1 = $P0[0]
+ is( $P1, 3.33, 'shift_* should remove elements from array' )
+
+ $P1 = shift $P0
+ is( $P1, 3.33, 'set_pmc_keyed_int/shift_pmc pair' )
.end
+.sub 'test_indexed_boxing'
+ $P0 = new [ 'CallSignature' ]
+ $P0[0] = 100
+ $P0[1] = 1.11
+
+ $S0 = '2.22'
+ $P0[2] = $S0
+
+ $P1 = new [ 'Float' ]
+ $P1 = 3.33
+ $P0[3] = $P1
+
+ $I0 = $P0[1]
+ is( $I0, 1, 'indexed float converted to int on get_integer_keyed_int' )
+ $I0 = $P0[2]
+ is( $I0, 2, 'indexed string converted to int on get_integer_keyed_int' )
+ $I0 = $P0[3]
+ is( $I0, 3, 'indexed PMC converted to int on get_integer_keyed_int' )
+
+ $N0 = $P0[0]
+ is( $N0, 100.0, 'indexed integer converted to num on get_number_keyed_int' )
+ $N0 = $P0[2]
+ is( $N0, 2.22, 'indexed string converted to num on get_number_keyed_int' )
+ $N0 = $P0[3]
+ is( $N0, 3.33, 'indexed PMC converted to int num get_number_keyed_int' )
+
+ $S0 = $P0[0]
+ is( $S0, '100', 'indexed int converted to string on get_string_keyed_int' )
+ $S0 = $P0[1]
+ is( $S0, '1.11', 'indexed num converted to string on get_string_keyed_int' )
+ $S0 = $P0[3]
+ is( $S0, '3.33', 'indexed PMC converted to string get_string_keyed_int' )
+
+ $P1 = $P0[0]
+ is( $P1, 100, 'indexed int converted to PMC on get_pmc_keyed_int' )
+ $P1 = $P0[1]
+ is( $P1, 1.11, 'indexed float converted to PMC on get_pmc_keyed_int' )
+ $P1 = $P0[2]
+ is( $P1, 2.22, 'indexed string converted to PMC on get_pmc_keyed_int' )
+.end
+
+.sub 'test_keyed_access'
+ $P0 = new [ 'CallSignature' ]
+
+ $P0['foo'] = 100
+ $P0['bar'] = 1.11
+ $P0['baz'] = '2.22'
+ $P1 = new [ 'Float' ]
+ $P1 = 3.33
+
+ $P0['qux'] = $P1
+
+ $I0 = $P0['foo']
+ is( $I0, 100, 'set/get_intval_keyed_str' )
+
+ $N0 = $P0['bar']
+ is( $N0, 1.11, 'set/get_number_keyed_str' )
+
+ $S0 = $P0['baz']
+ is( $S0, '2.22', 'set/get_string_keyed_str' )
+
+ $P2 = $P0['qux']
+ is( $P2, 3.33, 'set/get_pmc_keyed_str' )
+
+ $P1 = getattribute $P0, 'named'
+ $I0 = elements $P1
+ is( $I0, 4, 'elements after set_*_keyed' )
+.end
+
+.sub 'test_exists'
+ $P0 = new [ 'CallSignature' ]
+
+ $P0[0] = 111
+ $P0['foo'] = 100
+
+ $I0 = exists $P0[0]
+ ok( $I0, 'exists_keyed_int' )
+
+ $I0 = exists $P0['foo']
+ ok( $I0, 'exists_keyed_str' )
+
+ $I0 = exists $P0[100]
+ nok( $I0, 'exists_keyed_int -- non-existant' )
+
+ $I0 = exists $P0['bar']
+ nok( $I0, 'exists_keyed_str -- non-existant' )
+.end
# Local Variables:
# mode: pir
More information about the parrot-commits
mailing list