[svn:parrot] r42991 - in branches/context_unify3: . src/pmc
bacek at svn.parrot.org
bacek at svn.parrot.org
Fri Dec 11 21:28:57 UTC 2009
Author: bacek
Date: Fri Dec 11 21:28:54 2009
New Revision: 42991
URL: https://trac.parrot.org/parrot/changeset/42991
Log:
Rename CallSignature into CallContext
Added:
branches/context_unify3/src/pmc/callcontext.pmc
- copied, changed from r42990, branches/context_unify3/src/pmc/callsignature.pmc
Deleted:
branches/context_unify3/src/pmc/callsignature.pmc
Modified:
branches/context_unify3/MANIFEST
branches/context_unify3/PBC_COMPAT
Modified: branches/context_unify3/MANIFEST
==============================================================================
--- branches/context_unify3/MANIFEST Fri Dec 11 20:32:17 2009 (r42990)
+++ branches/context_unify3/MANIFEST Fri Dec 11 21:28:54 2009 (r42991)
@@ -1405,12 +1405,11 @@
src/pmc/bigint.pmc [devel]src
src/pmc/bignum.pmc [devel]src
src/pmc/boolean.pmc [devel]src
-src/pmc/callsignature.pmc [devel]src
+src/pmc/callcontext.pmc [devel]src
src/pmc/capture.pmc [devel]src
src/pmc/class.pmc [devel]src
src/pmc/codestring.pmc [devel]src
src/pmc/complex.pmc [devel]src
-src/pmc/context.pmc [devel]src
src/pmc/continuation.pmc [devel]src
src/pmc/coroutine.pmc [devel]src
src/pmc/cpointer.pmc [devel]src
@@ -1868,7 +1867,7 @@
t/pmc/bigint.t [test]
t/pmc/bignum.t [test]
t/pmc/boolean.t [test]
-t/pmc/callsignature.t [test]
+t/pmc/callcontext.t [test]
t/pmc/capture.t [test]
t/pmc/class.t [test]
t/pmc/codestring.t [test]
Modified: branches/context_unify3/PBC_COMPAT
==============================================================================
--- branches/context_unify3/PBC_COMPAT Fri Dec 11 20:32:17 2009 (r42990)
+++ branches/context_unify3/PBC_COMPAT Fri Dec 11 21:28:54 2009 (r42991)
@@ -27,6 +27,7 @@
# please insert tab separated entries at the top of the list
+5.6 2009.12.12 bacek merge CallSignature and Context
5.4 2009.12.02 bacek remove CallSignatureReturns
5.3 2009.10.23 bacek add CallSignatureReturns
5.2 2009.09.16 darbelo remove pic.ops
Copied and modified: branches/context_unify3/src/pmc/callcontext.pmc (from r42990, branches/context_unify3/src/pmc/callsignature.pmc)
==============================================================================
--- branches/context_unify3/src/pmc/callsignature.pmc Fri Dec 11 20:32:17 2009 (r42990, copy source)
+++ branches/context_unify3/src/pmc/callcontext.pmc Fri Dec 11 21:28:54 2009 (r42991)
@@ -4,11 +4,11 @@
=head1 NAME
-src/pmc/callsignature.pmc - CallSignature PMC
+src/pmc/callcontext.pmc - CallContext PMC
=head1 DESCRIPTION
-The CallSignature PMC is used to store the argument list and argument meta
+The CallContext PMC is used to store the argument list and argument meta
information for a multiple dispatch call.
=head2 Functions
@@ -380,7 +380,8 @@
return result;
}
-pmclass CallSignature provides array provides hash auto_attrs {
+pmclass CallContext provides array provides hash auto_attrs {
+ /* Storage for arguments */
ATTR struct Pcc_cell *positionals; /* linked list of positionals */
ATTR PMC *type_tuple; /* Cached argument types for MDD */
ATTR STRING *short_sig; /* Simple string sig args & returns */
Deleted: branches/context_unify3/src/pmc/callsignature.pmc
==============================================================================
--- branches/context_unify3/src/pmc/callsignature.pmc Fri Dec 11 21:28:54 2009 (r42990)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,1336 +0,0 @@
-/*
-Copyright (C) 2008-2009, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/pmc/callsignature.pmc - CallSignature PMC
-
-=head1 DESCRIPTION
-
-The CallSignature PMC is used to store the argument list and argument meta
-information for a multiple dispatch call.
-
-=head2 Functions
-
-=over 4
-
-=cut
-
-*/
-
-typedef struct Pcc_cell
-{
- union u {
- PMC *p;
- STRING *s;
- INTVAL i;
- FLOATVAL n;
- } u;
- struct Pcc_cell *next;
-} Pcc_cell;
-
-/* mask off lower two bits (1 + 2 = 3) for pointer tags */
-#define TAG_BITS 3
-#define UNTAG_CELL(c) INTVAL2PTR(Pcc_cell *, (PTR2INTVAL(c)) & ~TAG_BITS)
-
-#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(i, c) \
- Parrot_gc_free_fixed_size_storage((i), sizeof (Pcc_cell), (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 ALLOC_CELL(i) \
- (Pcc_cell *)Parrot_gc_allocate_fixed_size_storage((i), sizeof (Pcc_cell))
-
-#define INIT_CELL_INT(c) INTVAL2PTR(Pcc_cell *, PTR2INTVAL(c) | INTCELL)
-#define INIT_CELL_FLOAT(c) INTVAL2PTR(Pcc_cell *, PTR2INTVAL(c) | FLOATCELL)
-#define INIT_CELL_STRING(c) INTVAL2PTR(Pcc_cell *, PTR2INTVAL(c) | STRINGCELL)
-#define INIT_CELL_PMC(c) INTVAL2PTR(Pcc_cell *, PTR2INTVAL(c) | PMCCELL)
-
-#define CREATE_INTVAL_CELL(i) INIT_CELL_INT(ALLOC_CELL(i))
-
-#define CREATE_FLOATVAL_CELL(i) INIT_CELL_FLOAT(ALLOC_CELL(i))
-
-#define CREATE_STRING_CELL(i) INIT_CELL_STRING(ALLOC_CELL(i))
-
-#define CREATE_PMC_CELL(i) INIT_CELL_PMC(ALLOC_CELL(i))
-
-#define APPEND_CELL(i, obj, cell) \
- do { \
- INTVAL num_positionals; \
- Pcc_cell *positionals; \
- GETATTR_CallSignature_num_positionals((i), (obj), num_positionals); \
- GETATTR_CallSignature_positionals((i), (obj), positionals); \
- SETATTR_CallSignature_num_positionals((i), (obj), num_positionals+1); \
- NEXT_CELL(cell) = NULL; \
- if (positionals) { \
- while (NEXT_CELL(positionals)) { \
- positionals = NEXT_CELL(positionals); \
- } \
- NEXT_CELL(positionals) = (cell); \
- } \
- else \
- SETATTR_CallSignature_positionals((i), (obj), (cell)); \
- } while (0)
-
-#define PREPEND_CELL(i, obj, cell) \
- do { \
- INTVAL num_positionals; \
- Pcc_cell *positionals; \
- GETATTR_CallSignature_num_positionals((i), (obj), num_positionals); \
- GETATTR_CallSignature_positionals((i), (obj), positionals); \
- SETATTR_CallSignature_num_positionals((i), (obj), num_positionals+1); \
- NEXT_CELL(cell) = positionals; \
- SETATTR_CallSignature_positionals((i), (obj), (cell)); \
- } while (0)
-
-#define HLL_TYPE(i) Parrot_get_ctx_HLL_type(interp, (i))
-
-/* TODO: could use get_cell_at */
-static Pcc_cell *
-pop_cell(PARROT_INTERP, ARGIN(PMC *SELF))
-{
- INTVAL num_positionals;
- Pcc_cell *cell;
- Pcc_cell *prev = NULL;
-
- GETATTR_CallSignature_positionals(interp, SELF, cell);
-
- /* no cells */
- if (!cell)
- return NULL;
-
- GETATTR_CallSignature_num_positionals(interp, SELF, num_positionals);
- SETATTR_CallSignature_num_positionals(interp, SELF, num_positionals-1);
-
- /* one cell */
- if (!NEXT_CELL(cell)) {
- SETATTR_CallSignature_positionals(interp, SELF, NULL);
- return cell;
- }
-
- while (cell) {
- if (!NEXT_CELL(cell)) {
- NEXT_CELL(prev) = NULL;
- return cell;
- }
-
- prev = cell;
- cell = NEXT_CELL(cell);
- }
-
- /* should abort here */
- SETATTR_CallSignature_num_positionals(interp, SELF, num_positionals+1);
- return NULL;
-}
-
-static Pcc_cell *
-shift_cell(PARROT_INTERP, ARGIN(PMC *SELF))
-{
- INTVAL num_positionals;
- Pcc_cell *cell;
-
- GETATTR_CallSignature_positionals(interp, SELF, cell);
-
- /* no cells */
- if (!cell)
- return NULL;
-
- GETATTR_CallSignature_num_positionals(interp, SELF, num_positionals);
- SETATTR_CallSignature_num_positionals(interp, SELF, num_positionals-1);
-
- /* one cell */
- if (!NEXT_CELL(cell))
- SETATTR_CallSignature_positionals(interp, SELF, NULL);
- else
- SETATTR_CallSignature_positionals(interp, SELF, NEXT_CELL(cell));
-
- return cell;
-}
-
-static Pcc_cell *
-get_cell_at(PARROT_INTERP, ARGIN(PMC *SELF), INTVAL key)
-{
- INTVAL i, num_positionals;
- Pcc_cell *cell;
-
- GETATTR_CallSignature_num_positionals(interp, SELF, num_positionals);
-
- if (key > num_positionals)
- return NULL;
-
- GETATTR_CallSignature_positionals(interp, SELF, cell);
-
- 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;
-
- switch (CELL_TYPE_MASK(cell)) {
- case INTCELL:
- result = pmc_new(interp, HLL_TYPE(enum_class_Integer));
- VTABLE_set_integer_native(interp, result, CELL_INT(cell));
- break;
- case FLOATCELL:
- result = pmc_new(interp, HLL_TYPE(enum_class_Float));
- VTABLE_set_number_native(interp, result, CELL_FLOAT(cell));
- break;
- case STRINGCELL:
- result = pmc_new(interp, HLL_TYPE(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))
-{
- Hash *hash;
-
- GETATTR_CallSignature_hash(interp, SELF, hash);
-
- if (!hash) {
- hash = parrot_create_hash(interp,
- enum_type_ptr,
- Hash_key_type_STRING,
- STRING_compare,
- (hash_hash_key_fn)key_hash_STRING);
-
- SETATTR_CallSignature_hash(interp, SELF, hash);
- }
-
- return 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_STRING_alive(interp, (STRING *)b->key);
- mark_positionals(interp, (Pcc_cell *)b->value);
- b = b->next;
- }
-
- }
-}
-
-static PMC *
-get_named_names(PARROT_INTERP, ARGIN(PMC *SELF))
-{
- Hash *hash;
- PMC *result = PMCNULL;
-
- GETATTR_CallSignature_hash(interp, SELF, hash);
-
- /* yes, this *looks* risky, but it's a Parrot STRING hash internally */
- if (hash && hash->entries) {
- UINTVAL i, j = 0;
- result = pmc_new(interp, enum_class_FixedStringArray);
- VTABLE_set_integer_native(interp, result, hash->entries);
-
- for (i = 0; i <= hash->mask; i++) {
- HashBucket *b = hash->bi[i];
-
- while (b) {
- VTABLE_set_string_keyed_int(interp, result,
- j++, (STRING *)b->key);
- b = b->next;
- }
- }
- }
-
- return result;
-}
-
-pmclass CallSignature provides array provides hash auto_attrs {
- ATTR struct Pcc_cell *positionals; /* linked list of positionals */
- 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 */
-
- /* Storage for returns */
- ATTR void **returns_values; /* stored pointers */
- ATTR INTVAL returns_size; /* number of stored elements */
- ATTR INTVAL returns_resize_threshold; /* max size before resizing array */
-/*
-
-=item C<void init()>
-
-Initializes a newly created CallSignature object.
-
-=cut
-
-*/
-
- VTABLE void init() {
- SET_ATTR_type_tuple(INTERP, SELF, PMCNULL);
-
- SET_ATTR_positionals(INTERP, SELF, NULL);
- SET_ATTR_returns_values(INTERP, SELF, NULL);
-
- SET_ATTR_returns_size(INTERP, SELF, 0);
- SET_ATTR_num_positionals(INTERP, SELF, 0);
- SET_ATTR_returns_resize_threshold(INTERP, SELF, 0);
-
- PObj_custom_mark_destroy_SETALL(SELF);
- }
-
-/*
-
-=item C<void mark()>
-
-Mark any referenced strings and PMCs.
-
-=cut
-
-*/
- VTABLE void mark() {
- Hash *hash;
- STRING *short_sig;
- Pcc_cell *positionals;
- INTVAL num_positionals;
- PMC *arg_flags, *type_tuple, *return_flags;
-
- if (!PMC_data(SELF))
- return;
-
- GET_ATTR_type_tuple(INTERP, SELF, type_tuple);
- GET_ATTR_short_sig(INTERP, SELF, short_sig);
- GET_ATTR_arg_flags(INTERP, SELF, arg_flags);
- GET_ATTR_return_flags(INTERP, SELF, return_flags);
- GET_ATTR_num_positionals(INTERP, SELF, num_positionals);
- GET_ATTR_positionals(INTERP, SELF, positionals);
- GET_ATTR_hash(INTERP, SELF, hash);
-
- Parrot_gc_mark_PMC_alive(INTERP, type_tuple);
- Parrot_gc_mark_STRING_alive(INTERP, short_sig);
- Parrot_gc_mark_PMC_alive(INTERP, arg_flags);
- Parrot_gc_mark_PMC_alive(INTERP, return_flags);
-
- if (num_positionals)
- mark_positionals(INTERP, positionals);
-
- if (hash)
- mark_hash(INTERP, hash);
- }
-
- VTABLE void destroy() {
- INTVAL num_positionals, returns_resize_threshold;
- Hash *hash;
- void **returns_values;
-
- if (!PMC_data(SELF))
- return;
-
- GET_ATTR_hash(INTERP, SELF, hash);
- GET_ATTR_num_positionals(INTERP, SELF, num_positionals);
- GET_ATTR_returns_values(INTERP, SELF, returns_values);
- GET_ATTR_returns_resize_threshold(INTERP, SELF, returns_resize_threshold);
-
- if (num_positionals) {
- Pcc_cell *c;
-
- GET_ATTR_positionals(INTERP, SELF, c);
-
- while (c) {
- Pcc_cell *to_free = c;
- c = NEXT_CELL(c);
- FREE_CELL(INTERP, to_free);
- }
- }
-
- if (hash) {
- UINTVAL i;
-
- for (i = 0; i <= hash->mask; i++) {
- HashBucket *b = hash->bi[i];
-
- while (b) {
- FREE_CELL(INTERP, (Pcc_cell *)b->value);
- b = b->next;
- }
- }
-
- parrot_hash_destroy(INTERP, hash);
- }
-
- /* Destroy returns storage */
- if (returns_values) {
- if (returns_resize_threshold == 8)
- Parrot_gc_free_fixed_size_storage(INTERP,
- 8 * sizeof (void *), returns_values);
- else
- mem_sys_free(returns_values);
- }
- }
-
-/*
-
-=item C<void set_string_native(STRING *value)>
-
-Sets the short signature for the CallSignature.
-
-=cut
-
-*/
-
- VTABLE void set_string_native(STRING *value) {
- SET_ATTR_short_sig(INTERP, SELF, value);
- }
-
-/*
-
-=item C<STRING *get_string()>
-
-Returns the short signature for the CallSignature.
-
-=cut
-
-*/
-
- VTABLE STRING *get_string() {
- INTVAL num_positionals;
- STRING *res;
- Pcc_cell *c;
-
- GET_ATTR_short_sig(INTERP, SELF, res);
-
- if (res)
- return res;
-
- GET_ATTR_positionals(INTERP, SELF, c);
- GET_ATTR_num_positionals(INTERP, SELF, num_positionals);
-
- res = Parrot_str_new(INTERP, NULL, num_positionals);
-
- while (c) {
- switch (CELL_TYPE_MASK(c)) {
- case INTCELL:
- res = Parrot_str_append(INTERP, res, CONST_STRING(INTERP, "I"));
- break;
- case FLOATCELL:
- res = Parrot_str_append(INTERP, res, CONST_STRING(INTERP, "N"));
- break;
- case STRINGCELL:
- res = Parrot_str_append(INTERP, res, CONST_STRING(INTERP, "S"));
- break;
- case PMCCELL:
- res = Parrot_str_append(INTERP, res, CONST_STRING(INTERP, "P"));
- break;
- default:
- PARROT_ASSERT(!"Impossible flag");
- break;
- }
- c = NEXT_CELL(c);
- }
- /* TODO Add named args to signature */
- /* After fixind build_MMD_type_tuple to use raw arguments instead of signature */
-
- SET_ATTR_short_sig(INTERP, SELF, res);
-
- return res;
- }
-
-/*
-
-=item C<void set_pmc(PMC *value)>
-
-Sets a fixed-size array of integer types (a type tuple) for the CallSignature.
-
-=cut
-
-*/
-
- VTABLE void set_pmc(PMC *value) {
- SET_ATTR_type_tuple(INTERP, SELF, value);
- }
-
-/*
-
-=item C<PMC *get_pmc()>
-
-Returns a fixed-size array of integer types (a type tuple) for the
-CallSignature.
-
-=cut
-
-*/
-
- VTABLE PMC *get_pmc() {
- PMC *type_tuple;
-
- GET_ATTR_type_tuple(INTERP, SELF, type_tuple);
-
- if (PMC_IS_NULL(type_tuple)) {
- type_tuple = Parrot_mmd_build_type_tuple_from_sig_obj(INTERP, SELF);
- SET_ATTR_type_tuple(INTERP, SELF, type_tuple);
- }
-
- return type_tuple;
-
- }
-
-/*
-
-=item C<void set_attr_str(STRING *key, PMC *value)>
-
-Set a PMC value for an attribute by string name.
-
-=over
-
-=item results
-
-Stores the return signature, an array of PMCs.
-
-=item arg_flags
-
-Stores a set of flags for the call signature arguments, an array of
-integers.
-
-=item return_flags
-
-Stores a set of flags for the call signature return arguments, an array
-of integers.
-
-=back
-
-=cut
-
-*/
-
- VTABLE void set_attr_str(STRING *key, PMC *value) {
-
- if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "arg_flags"))) {
- SET_ATTR_arg_flags(INTERP, SELF, value);
- }
- else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "return_flags"))) {
- SET_ATTR_return_flags(INTERP, SELF, value);
- }
- else {
- /* If unknown attribute name, throw an exception. */
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
- "No such attribute '%S'", key);
- }
- }
-
-/*
-
-=item C<PMC *get_attr_str(STRING *key)>
-
-Get a PMC value for an attribute by string name.
-
-=over
-
-=item results
-
-Retrieves the return signature, an array of PMCs.
-
-=item arg_flags
-
-Retrieves the flags for the call signature arguments, an array of
-integers.
-
-=item return_flags
-
-Retrieves the flags for the call signature return arguments, an array of
-integers.
-
-=item named
-
-Retrieves the hash of named arguments.
-
-=back
-
-=cut
-
-*/
-
- VTABLE PMC *get_attr_str(STRING *key) {
- PMC *value = PMCNULL;
-
- if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "named"))) {
- value = get_named_names(INTERP, SELF);
- }
- else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "arg_flags"))) {
- GET_ATTR_arg_flags(INTERP, SELF, value);
- }
- else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "return_flags"))) {
- GET_ATTR_return_flags(INTERP, SELF, value);
- }
- else {
- /* If unknown attribute name, throw an exception. */
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
- "No such attribute '%S'", key);
- }
-
- return value;
- }
-
- VTABLE INTVAL elements() {
- INTVAL num_positionals;
-
- if (!PMC_data(SELF))
- return 0;
-
- GET_ATTR_num_positionals(INTERP, SELF, num_positionals);
-
- return num_positionals;
- }
-
- VTABLE void push_integer(INTVAL value) {
- Pcc_cell *cell = CREATE_INTVAL_CELL(INTERP);
- APPEND_CELL(INTERP, SELF, cell);
- CELL_INT(cell) = value;
- }
-
- VTABLE void push_float(FLOATVAL value) {
- Pcc_cell *cell = CREATE_FLOATVAL_CELL(INTERP);
- APPEND_CELL(INTERP, SELF, cell);
- CELL_FLOAT(cell) = value;
- }
-
- VTABLE void push_string(STRING *value) {
- Pcc_cell *cell = CREATE_STRING_CELL(INTERP);
- APPEND_CELL(INTERP, SELF, cell);
- CELL_STRING(cell) = value;
- }
-
- VTABLE void push_pmc(PMC *value) {
- Pcc_cell *cell = CREATE_PMC_CELL(INTERP);
- APPEND_CELL(INTERP, 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(INTERP, 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(INTERP, 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(INTERP, 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(INTERP, 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(INTERP);
- PREPEND_CELL(INTERP, SELF, cell);
- CELL_INT(cell) = value;
- }
-
- VTABLE void unshift_float(FLOATVAL value) {
- Pcc_cell *cell = CREATE_FLOATVAL_CELL(INTERP);
- PREPEND_CELL(INTERP, SELF, cell);
- CELL_FLOAT(cell) = value;
- }
-
- VTABLE void unshift_string(STRING *value) {
- Pcc_cell *cell = CREATE_STRING_CELL(INTERP);
- PREPEND_CELL(INTERP, SELF, cell);
- CELL_STRING(cell) = value;
- }
-
- VTABLE void unshift_pmc(PMC *value) {
- Pcc_cell *cell = CREATE_PMC_CELL(INTERP);
- PREPEND_CELL(INTERP, 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(INTERP, 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(INTERP, 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(INTERP, 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(INTERP, 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) {
- INTVAL num_positionals;
-
- GET_ATTR_num_positionals(INTERP, SELF, num_positionals);
-
- if (key == 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) {
- INTVAL num_positionals;
-
- GET_ATTR_num_positionals(INTERP, SELF, num_positionals);
-
- if (key == 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) {
- INTVAL num_positionals;
-
- GET_ATTR_num_positionals(INTERP, SELF, num_positionals);
-
- if (key == 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) {
- INTVAL num_positionals;
-
- GET_ATTR_num_positionals(INTERP, SELF, num_positionals);
-
- if (key == 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(INTERP);
- parrot_hash_put(INTERP, hash, (void *)key, (void *)cell);
- NEXT_CELL(cell) = NULL;
- }
- 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(INTERP);
- parrot_hash_put(INTERP, hash, (void *)key, (void *)cell);
- NEXT_CELL(cell) = NULL;
- }
- 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(INTERP);
- parrot_hash_put(INTERP, hash, (void *)key, (void *)cell);
- NEXT_CELL(cell) = NULL;
- }
- 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(INTERP);
- parrot_hash_put(INTERP, hash, (void *)key, (void *)cell);
- NEXT_CELL(cell) = NULL;
- }
- 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(INTERP);
- parrot_hash_put(INTERP, hash, k, (void *)cell);
- NEXT_CELL(cell) = NULL;
- }
- 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(INTERP);
- parrot_hash_put(INTERP, hash, k, (void *)cell);
- NEXT_CELL(cell) = NULL;
- }
- 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(INTERP);
- parrot_hash_put(INTERP, hash, k, (void *)cell);
- NEXT_CELL(cell) = NULL;
- }
- 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(INTERP);
- parrot_hash_put(INTERP, hash, k, (void *)cell);
- NEXT_CELL(cell) = NULL;
- }
- else
- SET_CELL_PMC(cell);
-
- CELL_PMC(cell) = value;
- }
-
- 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_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_floatval(INTERP, cell);
- }
-
- return 0.0;
- }
-
-
- VTABLE STRING * get_string_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_string(INTERP, cell);
- }
-
- return NULL;
- }
-
- 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 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 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 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) {
- INTVAL num_positionals;
-
- GET_ATTR_num_positionals(INTERP, SELF, num_positionals);
-
- if (num_positionals)
- return key < num_positionals;
-
- return 0;
- }
-
-/*
-
-=item C<PMC *clone()>
-
-Creates and returns a clone of the signature.
-
-=cut
-
-*/
- VTABLE PMC *clone() {
- Pcc_cell *cell;
- STRING *short_sig;
- PMC *type_tuple, *arg_flags, *return_flags;
- PMC * const dest = pmc_new(INTERP, SELF->vtable->base_type);
-
- GET_ATTR_positionals(INTERP, SELF, cell);
-
- /* Copy all positional cells (thanks to APPEND_CELL, this also
- * sets num_positionals). */
- for (; cell; cell = NEXT_CELL(cell)) {
- Pcc_cell *cloned_cell;
-
- switch (CELL_TYPE_MASK(cell)) {
- case INTCELL:
- cloned_cell = CREATE_INTVAL_CELL(INTERP);
- CELL_INT(cloned_cell) = CELL_INT(cell);
- break;
- case FLOATCELL:
- cloned_cell = CREATE_FLOATVAL_CELL(INTERP);
- CELL_FLOAT(cloned_cell) = CELL_FLOAT(cell);
- break;
- case STRINGCELL:
- cloned_cell = CREATE_STRING_CELL(INTERP);
- CELL_STRING(cloned_cell) = CELL_STRING(cell);
- break;
- case PMCCELL:
- cloned_cell = CREATE_PMC_CELL(INTERP);
- CELL_PMC(cloned_cell) = CELL_PMC(cell);
- break;
- default:
- break;
- }
- APPEND_CELL(INTERP, dest, cloned_cell);
- }
-
-
- GET_ATTR_type_tuple(INTERP, SELF, type_tuple);
- GET_ATTR_short_sig(INTERP, SELF, short_sig);
- GET_ATTR_arg_flags(INTERP, SELF, arg_flags);
- GET_ATTR_return_flags(INTERP, SELF, return_flags);
-
- /* FIXME
- PMC *results;
-
- GET_ATTR_results(INTERP, SELF, results);
-
- if (!PMC_IS_NULL(results))
- SET_ATTR_results(INTERP, dest, VTABLE_clone(INTERP, results));
- */
-
- if (!PMC_IS_NULL(type_tuple))
- SET_ATTR_type_tuple(INTERP, dest, VTABLE_clone(INTERP, type_tuple));
-
- if (short_sig)
- SET_ATTR_short_sig(INTERP, dest, Parrot_str_copy(INTERP, short_sig));
-
- if (!PMC_IS_NULL(arg_flags))
- SET_ATTR_arg_flags(INTERP, dest, VTABLE_clone(INTERP, arg_flags));
-
- if (!PMC_IS_NULL(return_flags))
- SET_ATTR_return_flags(INTERP, dest, VTABLE_clone(INTERP, return_flags));
-
- parrot_hash_clone(INTERP, get_hash(INTERP, SELF),
- get_hash(INTERP, dest));
-
- return dest;
- }
-
-/*
-
-=back
-
-=cut
-
-*/
-
-} /* end pmclass */
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
More information about the parrot-commits
mailing list