[svn:parrot] r42891 - in trunk: . include/parrot src src/call src/pmc t/native_pbc t/pmc
chromatic at svn.parrot.org
chromatic at svn.parrot.org
Fri Dec 4 19:55:06 UTC 2009
Author: chromatic
Date: Fri Dec 4 19:55:05 2009
New Revision: 42891
URL: https://trac.parrot.org/parrot/changeset/42891
Log:
Merged branch 'cs_csr_merge' into master.
Deleted:
trunk/src/pmc/callsignaturereturns.pmc
trunk/t/pmc/callsignaturereturns.t
Modified:
trunk/MANIFEST
trunk/PBC_COMPAT
trunk/include/parrot/call.h
trunk/include/parrot/extend.h
trunk/src/call/args.c
trunk/src/extend.c
trunk/src/pmc/callsignature.pmc
trunk/t/native_pbc/annotations.pbc
trunk/t/native_pbc/integer_1.pbc
trunk/t/native_pbc/number_1.pbc
trunk/t/native_pbc/string_1.pbc
trunk/t/pmc/callsignature.t
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST Fri Dec 4 19:28:43 2009 (r42890)
+++ trunk/MANIFEST Fri Dec 4 19:55:05 2009 (r42891)
@@ -1405,7 +1405,6 @@
src/pmc/bignum.pmc [devel]src
src/pmc/boolean.pmc [devel]src
src/pmc/callsignature.pmc [devel]src
-src/pmc/callsignaturereturns.pmc [devel]src
src/pmc/capture.pmc [devel]src
src/pmc/class.pmc [devel]src
src/pmc/codestring.pmc [devel]src
@@ -1869,7 +1868,6 @@
t/pmc/bignum.t [test]
t/pmc/boolean.t [test]
t/pmc/callsignature.t [test]
-t/pmc/callsignaturereturns.t [test]
t/pmc/capture.t [test]
t/pmc/class.t [test]
t/pmc/codestring.t [test]
Modified: trunk/PBC_COMPAT
==============================================================================
--- trunk/PBC_COMPAT Fri Dec 4 19:28:43 2009 (r42890)
+++ trunk/PBC_COMPAT Fri Dec 4 19:55:05 2009 (r42891)
@@ -27,6 +27,7 @@
# please insert tab separated entries at the top of the list
+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
5.2 2009.08.06 dukeleto remove Random PMC
Modified: trunk/include/parrot/call.h
==============================================================================
--- trunk/include/parrot/call.h Fri Dec 4 19:28:43 2009 (r42890)
+++ trunk/include/parrot/call.h Fri Dec 4 19:55:05 2009 (r42891)
@@ -154,6 +154,16 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_EXPORT
+void Parrot_pcc_append_result(PARROT_INTERP,
+ ARGIN(PMC *sig_object),
+ ARGIN(STRING *type),
+ ARGIN(void *result))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3)
+ __attribute__nonnull__(4);
+
+PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PMC* Parrot_pcc_build_sig_object_from_op(PARROT_INTERP,
@@ -253,6 +263,11 @@
FUNC_MODIFIES(*arg_flags)
FUNC_MODIFIES(*return_flags);
+#define ASSERT_ARGS_Parrot_pcc_append_result __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(sig_object) \
+ , PARROT_ASSERT_ARG(type) \
+ , PARROT_ASSERT_ARG(result))
#define ASSERT_ARGS_Parrot_pcc_build_sig_object_from_op \
__attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
Modified: trunk/include/parrot/extend.h
==============================================================================
--- trunk/include/parrot/extend.h Fri Dec 4 19:28:43 2009 (r42890)
+++ trunk/include/parrot/extend.h Fri Dec 4 19:55:05 2009 (r42891)
@@ -452,15 +452,6 @@
__attribute__nonnull__(2)
__attribute__nonnull__(3);
-void append_result(PARROT_INTERP,
- ARGIN(PMC *sig_object),
- ARGIN(Parrot_String type),
- ARGIN(void *result))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4);
-
#define ASSERT_ARGS_Parrot_call_method __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(signature))
@@ -604,11 +595,6 @@
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(pio) \
, PARROT_ASSERT_ARG(s))
-#define ASSERT_ARGS_append_result __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
- PARROT_ASSERT_ARG(interp) \
- , PARROT_ASSERT_ARG(sig_object) \
- , PARROT_ASSERT_ARG(type) \
- , PARROT_ASSERT_ARG(result))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: src/extend.c */
Modified: trunk/src/call/args.c
==============================================================================
--- trunk/src/call/args.c Fri Dec 4 19:28:43 2009 (r42890)
+++ trunk/src/call/args.c Fri Dec 4 19:55:05 2009 (r42891)
@@ -93,6 +93,74 @@
__attribute__nonnull__(2);
PARROT_CANNOT_RETURN_NULL
+static void ** csr_allocate_initial_values(PARROT_INTERP, ARGIN(PMC *self))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static INTVAL csr_elements(PARROT_INTERP, ARGIN(PMC *self))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_CANNOT_RETURN_NULL
+static void* csr_get_pointer_keyed_int(PARROT_INTERP,
+ ARGIN(PMC *self),
+ INTVAL key)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_CANNOT_RETURN_NULL
+static STRING* csr_get_string_keyed_int(PARROT_INTERP,
+ ARGIN(PMC *self),
+ INTVAL key)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void csr_push_integer(PARROT_INTERP, ARGIN(PMC *self), INTVAL type)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void csr_set_integer_keyed_int(PARROT_INTERP,
+ ARGIN(PMC *self),
+ INTVAL key,
+ INTVAL value)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void csr_set_integer_native(PARROT_INTERP,
+ ARGIN(PMC *self),
+ INTVAL size)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void csr_set_number_keyed_int(PARROT_INTERP,
+ ARGIN(PMC *self),
+ INTVAL key,
+ FLOATVAL value)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void csr_set_pmc_keyed_int(PARROT_INTERP,
+ ARGIN(PMC *self),
+ INTVAL key,
+ ARGIN_NULLOK(PMC *value))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void csr_set_pointer_keyed_int(PARROT_INTERP,
+ ARGIN(PMC *self),
+ INTVAL key,
+ ARGIN_NULLOK(void *value))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void csr_set_string_keyed_int(PARROT_INTERP,
+ ARGIN(PMC *self),
+ INTVAL key,
+ ARGIN_NULLOK(STRING *value))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_CANNOT_RETURN_NULL
static void dissect_aggregate_arg(PARROT_INTERP,
ARGMOD(PMC *call_object),
ARGIN(PMC *aggregate))
@@ -350,6 +418,39 @@
#define ASSERT_ARGS_clone_key_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(key))
+#define ASSERT_ARGS_csr_allocate_initial_values __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(self))
+#define ASSERT_ARGS_csr_elements __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(self))
+#define ASSERT_ARGS_csr_get_pointer_keyed_int __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(self))
+#define ASSERT_ARGS_csr_get_string_keyed_int __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(self))
+#define ASSERT_ARGS_csr_push_integer __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(self))
+#define ASSERT_ARGS_csr_set_integer_keyed_int __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(self))
+#define ASSERT_ARGS_csr_set_integer_native __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(self))
+#define ASSERT_ARGS_csr_set_number_keyed_int __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(self))
+#define ASSERT_ARGS_csr_set_pmc_keyed_int __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(self))
+#define ASSERT_ARGS_csr_set_pointer_keyed_int __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(self))
+#define ASSERT_ARGS_csr_set_string_keyed_int __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(self))
#define ASSERT_ARGS_dissect_aggregate_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(call_object) \
@@ -713,7 +814,6 @@
PMC *call_object;
INTVAL *int_array;
PMC *ctx = CURRENT_CONTEXT(interp);
- PMC *returns = pmc_new(interp, enum_class_CallSignatureReturns);
INTVAL returns_pos = 0;
INTVAL arg_index;
INTVAL arg_count;
@@ -735,7 +835,6 @@
/* a little encapsulation violation for great speed */
SETATTR_CallSignature_return_flags(interp, call_object, raw_sig);
- SETATTR_CallSignature_results(interp, call_object, returns);
GETATTR_FixedIntegerArray_size(interp, raw_sig, arg_count);
GETATTR_FixedIntegerArray_int_array(interp, raw_sig, int_array);
@@ -749,33 +848,33 @@
* the result back to the caller. */
switch (PARROT_ARG_TYPE_MASK_MASK(arg_flags)) {
case PARROT_ARG_INTVAL:
- VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+ csr_set_pointer_keyed_int(interp, call_object, returns_pos++,
&(CTX_REG_INT(ctx, raw_index)));
- VTABLE_push_integer(interp, returns, PARROT_ARG_INTVAL);
+ csr_push_integer(interp, call_object, PARROT_ARG_INTVAL);
break;
case PARROT_ARG_FLOATVAL:
- VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+ csr_set_pointer_keyed_int(interp, call_object, returns_pos++,
&(CTX_REG_NUM(ctx, raw_index)));
- VTABLE_push_integer(interp, returns, PARROT_ARG_FLOATVAL);
+ csr_push_integer(interp, call_object, PARROT_ARG_FLOATVAL);
break;
case PARROT_ARG_STRING:
if (arg_flags & PARROT_ARG_NAME) {
STRING * string_val = arg_flags & PARROT_ARG_CONSTANT
? Parrot_pcc_get_string_constant(interp, ctx, raw_index)
: CTX_REG_STR(ctx, raw_index);
- VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+ csr_set_pointer_keyed_int(interp, call_object, returns_pos++,
string_val);
}
else {
- VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+ csr_set_pointer_keyed_int(interp, call_object, returns_pos++,
&(CTX_REG_STR(ctx, raw_index)));
- VTABLE_push_integer(interp, returns, PARROT_ARG_STRING);
+ csr_push_integer(interp, call_object, PARROT_ARG_STRING);
}
break;
case PARROT_ARG_PMC:
- VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+ csr_set_pointer_keyed_int(interp, call_object, returns_pos++,
&(CTX_REG_PMC(ctx, raw_index)));
- VTABLE_push_integer(interp, returns, PARROT_ARG_PMC);
+ csr_push_integer(interp, call_object, PARROT_ARG_PMC);
break;
default:
break;
@@ -808,7 +907,6 @@
{
ASSERT_ARGS(Parrot_pcc_build_sig_object_from_varargs)
PMC *type_tuple = PMCNULL;
- PMC *returns = PMCNULL;
PMC *arg_flags = PMCNULL;
PMC *return_flags = PMCNULL;
PMC * const call_object = pmc_new(interp, enum_class_CallSignature);
@@ -829,36 +927,30 @@
for (i = 0; i < sig_len; ++i) {
const INTVAL type = sig[i];
- /* Only create the returns array if it's needed */
- if (in_return_sig && PMC_IS_NULL(returns)) {
- returns = pmc_new(interp, enum_class_CallSignatureReturns);
- VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "returns"), returns);
- }
-
if (in_return_sig) {
STRING * const signature = CONST_STRING(interp, "signature");
/* Returns store the original passed-in pointer so they can pass
* the result back to the caller. */
switch (type) {
case 'I':
- VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+ csr_set_pointer_keyed_int(interp, call_object, returns_pos++,
(void *)va_arg(args, INTVAL *));
- VTABLE_push_integer(interp, returns, PARROT_ARG_INTVAL);
+ csr_push_integer(interp, call_object, PARROT_ARG_INTVAL);
break;
case 'N':
- VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+ csr_set_pointer_keyed_int(interp, call_object, returns_pos++,
(void *)va_arg(args, FLOATVAL *));
- VTABLE_push_integer(interp, returns, PARROT_ARG_FLOATVAL);
+ csr_push_integer(interp, call_object, PARROT_ARG_FLOATVAL);
break;
case 'S':
- VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+ csr_set_pointer_keyed_int(interp, call_object, returns_pos++,
(void *)va_arg(args, STRING **));
- VTABLE_push_integer(interp, returns, PARROT_ARG_STRING);
+ csr_push_integer(interp, call_object, PARROT_ARG_STRING);
break;
case 'P':
- VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+ csr_set_pointer_keyed_int(interp, call_object, returns_pos++,
(void *)va_arg(args, PMC **));
- VTABLE_push_integer(interp, returns, PARROT_ARG_PMC);
+ csr_push_integer(interp, call_object, PARROT_ARG_PMC);
break;
default:
Parrot_ex_throw_from_c_args(interp, NULL,
@@ -1403,16 +1495,16 @@
ASSERT_ARGS(assign_default_result_value)
switch (PARROT_ARG_TYPE_MASK_MASK(result_flags)) {
case PARROT_ARG_INTVAL:
- VTABLE_set_integer_keyed_int(interp, results, index, 0);
+ csr_set_integer_keyed_int(interp, results, index, 0);
break;
case PARROT_ARG_FLOATVAL:
- VTABLE_set_number_keyed_int(interp, results, index, 0.0);
+ csr_set_number_keyed_int(interp, results, index, 0.0);
break;
case PARROT_ARG_STRING:
- VTABLE_set_string_keyed_int(interp, results, index, NULL);
+ csr_set_string_keyed_int(interp, results, index, NULL);
break;
case PARROT_ARG_PMC:
- VTABLE_set_pmc_keyed_int(interp, results, index, PMCNULL);
+ csr_set_pmc_keyed_int(interp, results, index, PMCNULL);
break;
default:
Parrot_ex_throw_from_c_args(interp, NULL,
@@ -1528,7 +1620,6 @@
ASSERT_ARGS(fill_results)
INTVAL *return_array;
INTVAL *result_array;
- PMC *result_list;
PMC *result_sig = NULL;
PMC *ctx = CURRENT_CONTEXT(interp);
PMC *named_used_list = PMCNULL;
@@ -1563,11 +1654,10 @@
return;
}
- GETATTR_CallSignature_results(interp, call_object, result_list);
GETATTR_CallSignature_return_flags(interp, call_object, result_sig);
- result_count = PMC_IS_NULL(result_list) ? 0 : VTABLE_elements(interp, result_list);
- PARROT_ASSERT(PMC_IS_NULL(result_list) || !PMC_IS_NULL(result_sig));
+ result_count = csr_elements(interp, call_object);
+ PARROT_ASSERT((result_count == 0) || !PMC_IS_NULL(result_sig));
GETATTR_FixedIntegerArray_int_array(interp, raw_sig, return_array);
if (!PMC_IS_NULL(result_sig))
@@ -1689,7 +1779,7 @@
}
return_index++;
}
- VTABLE_set_pmc_keyed_int(interp, result_list, result_index, collect_positional);
+ csr_set_pmc_keyed_int(interp, call_object, result_index, collect_positional);
result_index++;
break; /* Terminate the positional return loop. */
}
@@ -1705,7 +1795,7 @@
if (!(result_flags & PARROT_ARG_STRING))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"named results must have a name specified 1683");
- result_name = VTABLE_get_string_keyed_int(interp, result_list, result_index);
+ result_name = csr_get_string_keyed_int(interp, call_object, result_index);
named_count++;
result_index++;
if (result_index >= result_count)
@@ -1729,26 +1819,26 @@
switch (PARROT_ARG_TYPE_MASK_MASK(return_flags)) {
case PARROT_ARG_INTVAL:
if (constant)
- VTABLE_set_integer_keyed_int(interp, result_list, result_index,
+ csr_set_integer_keyed_int(interp, call_object, result_index,
accessor->intval_constant(interp, return_info, return_index));
else
- VTABLE_set_integer_keyed_int(interp, result_list, result_index,
+ csr_set_integer_keyed_int(interp, call_object, result_index,
accessor->intval(interp, return_info, return_index));
break;
case PARROT_ARG_FLOATVAL:
if (constant)
- VTABLE_set_number_keyed_int(interp, result_list, result_index,
+ csr_set_number_keyed_int(interp, call_object, result_index,
accessor->numval_constant(interp, return_info, return_index));
else
- VTABLE_set_number_keyed_int(interp, result_list, result_index,
+ csr_set_number_keyed_int(interp, call_object, result_index,
accessor->numval(interp, return_info, return_index));
break;
case PARROT_ARG_STRING:
if (constant)
- VTABLE_set_string_keyed_int(interp, result_list, result_index,
+ csr_set_string_keyed_int(interp, call_object, result_index,
accessor->string_constant(interp, return_info, return_index));
else
- VTABLE_set_string_keyed_int(interp, result_list, result_index,
+ csr_set_string_keyed_int(interp, call_object, result_index,
accessor->string(interp, return_info, return_index));
break;
case PARROT_ARG_PMC:
@@ -1781,7 +1871,7 @@
return_index--; /* we want to stay on the same item */
}
}
- VTABLE_set_pmc_keyed_int(interp, result_list, result_index, return_item);
+ csr_set_pmc_keyed_int(interp, call_object, result_index, return_item);
break;
}
default:
@@ -1798,7 +1888,7 @@
next_result_flags = result_array[result_index + 1];
if (next_result_flags & PARROT_ARG_OPT_FLAG) {
result_index++;
- VTABLE_set_integer_keyed_int(interp, result_list, result_index, 1);
+ csr_set_integer_keyed_int(interp, call_object, result_index, 1);
}
}
}
@@ -1813,7 +1903,7 @@
if (result_flags & PARROT_ARG_NAME)
break;
- assign_default_result_value(interp, result_list, result_index, result_flags);
+ assign_default_result_value(interp, call_object, result_index, result_flags);
/* Mark the option flag for the result to FALSE, it was filled
* with a default value. */
@@ -1821,7 +1911,7 @@
next_result_flags = result_array[result_index + 1];
if (next_result_flags & PARROT_ARG_OPT_FLAG) {
result_index++;
- VTABLE_set_integer_keyed_int(interp, result_list, result_index, 0);
+ csr_set_integer_keyed_int(interp, call_object, result_index, 0);
}
}
}
@@ -1940,7 +2030,7 @@
named_return_list = pmc_new(interp,
Parrot_get_ctx_HLL_type(interp, enum_class_Hash));
- VTABLE_set_pmc_keyed_int(interp, result_list, result_index, named_return_list);
+ csr_set_pmc_keyed_int(interp, call_object, result_index, named_return_list);
break; /* End of named results. */
}
@@ -1948,7 +2038,7 @@
if (!(result_flags & PARROT_ARG_STRING))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"named results must have a name specified 1926");
- result_name = VTABLE_get_string_keyed_int(interp, result_list, result_index);
+ result_name = csr_get_string_keyed_int(interp, call_object, result_index);
if (!STRING_IS_NULL(result_name)) {
/* The next result is the actual value. */
@@ -1964,19 +2054,19 @@
/* Fill the named result. */
switch (PARROT_ARG_TYPE_MASK_MASK(result_flags)) {
case PARROT_ARG_INTVAL:
- VTABLE_set_integer_keyed_int(interp, result_list, result_index,
+ csr_set_integer_keyed_int(interp, call_object, result_index,
VTABLE_get_integer_keyed_str(interp, named_return_list, result_name));
break;
case PARROT_ARG_FLOATVAL:
- VTABLE_set_number_keyed_int(interp, result_list, result_index,
+ csr_set_number_keyed_int(interp, call_object, result_index,
VTABLE_get_number_keyed_str(interp, named_return_list, result_name));
break;
case PARROT_ARG_STRING:
- VTABLE_set_string_keyed_int(interp, result_list, result_index,
+ csr_set_string_keyed_int(interp, call_object, result_index,
VTABLE_get_string_keyed_str(interp, named_return_list, result_name));
break;
case PARROT_ARG_PMC:
- VTABLE_set_pmc_keyed_int(interp, result_list, result_index,
+ csr_set_pmc_keyed_int(interp, call_object, result_index,
VTABLE_get_pmc_keyed_str(interp, named_return_list, result_name));
break;
default:
@@ -1994,7 +2084,7 @@
next_result_flags = return_array[result_index + 1];
if (next_result_flags & PARROT_ARG_OPT_FLAG) {
result_index++;
- VTABLE_set_integer_keyed_int(interp, result_list, result_index, 1);
+ csr_set_integer_keyed_int(interp, call_object, result_index, 1);
}
}
}
@@ -2002,7 +2092,7 @@
else if (result_flags & PARROT_ARG_OPTIONAL) {
INTVAL next_result_flags;
- assign_default_result_value(interp, result_list, result_index, result_flags);
+ assign_default_result_value(interp, call_object, result_index, result_flags);
/* Mark the option flag for the result to FALSE, it was filled
* with a default value. */
@@ -2010,7 +2100,7 @@
next_result_flags = result_array[result_index + 1];
if (next_result_flags & PARROT_ARG_OPT_FLAG) {
result_index++;
- VTABLE_set_integer_keyed_int(interp, result_list, result_index, 1);
+ csr_set_integer_keyed_int(interp, call_object, result_index, 1);
}
}
}
@@ -2351,16 +2441,29 @@
ARGMOD_NULLOK(PMC * parent), ARGMOD_NULLOK(PMC * tailcall))
{
ASSERT_ARGS(Parrot_pcc_merge_signature_for_tailcall)
- if (PMC_IS_NULL(parent) || PMC_IS_NULL(tailcall))
+ if (PMC_IS_NULL(parent) || PMC_IS_NULL(tailcall) || (parent == tailcall))
return;
else {
/* Broke encapuslation. Direct poking into CallSignature is much faster */
- PMC * results;
+ void ** returns_values;
+ void ** tailcall_returns_values;
+ INTVAL returns_size;
PMC * return_flags;
- GETATTR_CallSignature_results(interp, parent, results);
+
+ GETATTR_CallSignature_returns_size(interp, parent, returns_size);
+ GETATTR_CallSignature_returns_values(interp, parent, returns_values);
+
+ /* Resize tailcall.returns_values to new size */
+ csr_set_integer_native(interp, tailcall, returns_size);
+
+ /* And copy values over it */
+ GETATTR_CallSignature_returns_values(interp, tailcall, tailcall_returns_values);
+ mem_copy_n_typed(tailcall_returns_values, returns_values, returns_size, void**);
+
+ /* Store raw signature */
GETATTR_CallSignature_return_flags(interp, parent, return_flags);
- SETATTR_CallSignature_results(interp, tailcall, results);
SETATTR_CallSignature_return_flags(interp, tailcall, return_flags);
+
}
}
@@ -2748,6 +2851,435 @@
/*
+VTABLE functions from CallSignatureReturns. TODO Rename them appropriately.
+
+*/
+
+/* mask off lower two bits (1 + 2 = 3) for pointer tags */
+#define TAG_BITS 3
+#define UNTAG_CELL(c) INTVAL2PTR(void *, (PTR2INTVAL(c)) & ~TAG_BITS)
+#define CELL_TYPE_MASK(c) (PTR2INTVAL(c)) & TAG_BITS
+
+/*
+
+=item C<static void ** csr_allocate_initial_values(PARROT_INTERP, PMC *self)>
+
+Allocate initial storage for returns in CallSignature.
+
+=cut
+*/
+
+PARROT_CANNOT_RETURN_NULL
+static void **
+csr_allocate_initial_values(PARROT_INTERP, ARGIN(PMC *self))
+{
+ ASSERT_ARGS(csr_allocate_initial_values)
+ void **values = (void **)Parrot_gc_allocate_fixed_size_storage(interp,
+ 8 * sizeof (void *));
+
+ SETATTR_CallSignature_returns_resize_threshold(interp, self, 8);
+ return values;
+}
+
+/*
+
+=item C<static void csr_set_integer_native(PARROT_INTERP, PMC *self, INTVAL
+size)>
+
+Resizes the array to C<size> elements.
+
+=cut
+
+*/
+
+static void
+csr_set_integer_native(PARROT_INTERP, ARGIN(PMC *self), INTVAL size)
+{
+ ASSERT_ARGS(csr_set_integer_native)
+ void **values = NULL;
+ INTVAL resize_threshold;
+
+ GETATTR_CallSignature_returns_values(interp, self, values);
+ GETATTR_CallSignature_returns_resize_threshold(interp, self, resize_threshold);
+
+ /* Empty. Allocate 8 elements (arbitary number) */
+ if (!values) {
+ values = csr_allocate_initial_values(interp, self);
+ SETATTR_CallSignature_returns_values(interp, self, values);
+ SETATTR_CallSignature_returns_size(interp, self, size);
+ }
+ else if (size <= resize_threshold) {
+ SETATTR_CallSignature_returns_size(interp, self, size);
+ return;
+ }
+ else {
+ void *old_values;
+ INTVAL cur = resize_threshold;
+
+ /* Switch to system allocator */
+ if (cur == 8) {
+ old_values = values;
+ values = mem_allocate_n_typed(8, void *);
+ memcpy(values, old_values, 8 * sizeof (void *));
+ Parrot_gc_free_fixed_size_storage(interp,
+ 8 * sizeof (void *), old_values);
+ }
+
+ if (cur < 8192)
+ cur = size < 2 * cur ? 2 * cur : size;
+ else {
+ INTVAL needed = size - cur;
+ cur += needed + 4096;
+ cur &= ~0xfff;
+ }
+
+ mem_realloc_n_typed(values, cur, void *);
+
+ SETATTR_CallSignature_returns_values(interp, self, values);
+ SETATTR_CallSignature_returns_size(interp, self, size);
+ SETATTR_CallSignature_returns_resize_threshold(interp, self, cur);
+ }
+}
+
+/*
+
+=item C<static INTVAL csr_elements(PARROT_INTERP, PMC *self)>
+
+Returns the number of returns values.
+
+=cut
+
+*/
+
+static INTVAL
+csr_elements(PARROT_INTERP, ARGIN(PMC *self))
+{
+ ASSERT_ARGS(csr_elements)
+ INTVAL size;
+ GETATTR_CallSignature_returns_size(interp, self, size);
+ return size;
+}
+
+/*
+
+=item C<static void csr_set_pointer_keyed_int(PARROT_INTERP, PMC *self, INTVAL
+key, void *value)>
+
+Sets the pointer at position key. The pointer should point to a storage
+location for a return value -- it must be a pointer to an INTVAL, FLOATVAL,
+PMC, or STRING storage location.
+
+=cut
+
+*/
+
+static void
+csr_set_pointer_keyed_int(PARROT_INTERP, ARGIN(PMC *self), INTVAL key, ARGIN_NULLOK(void *value))
+{
+ ASSERT_ARGS(csr_set_pointer_keyed_int)
+ void **values;
+ INTVAL size;
+
+ GETATTR_CallSignature_returns_values(interp, self, values);
+ GETATTR_CallSignature_returns_size(interp, self, size);
+
+ if (!values) {
+ if (key < 8) {
+ values = csr_allocate_initial_values(interp, self);
+ SETATTR_CallSignature_returns_values(interp, self, values);
+ SETATTR_CallSignature_returns_size(interp, self, key + 1);
+ }
+ else {
+ csr_set_integer_native(interp, self, key + 1);
+ GETATTR_CallSignature_returns_values(interp, self, values);
+ }
+ }
+ else if (key >= size)
+ csr_set_integer_native(interp, self, key + 1);
+
+ values[key] = value;
+}
+
+/*
+
+=item C<static void csr_push_integer(PARROT_INTERP, PMC *self, INTVAL type)>
+
+Set type of last pushed pointer.
+
+=cut
+
+*/
+
+static void
+csr_push_integer(PARROT_INTERP, ARGIN(PMC *self), INTVAL type)
+{
+ ASSERT_ARGS(csr_push_integer)
+ void **values;
+ INTVAL idx;
+
+ GETATTR_CallSignature_returns_size(interp, self, idx);
+
+ /* last index is size - 1, of course */
+ idx--;
+
+ PARROT_ASSERT((type >= 0 && type < 4) || !"Wrong pointer type");
+
+ GETATTR_CallSignature_returns_values(interp, self, values);
+
+ values[idx] = INTVAL2PTR(void *,
+ PTR2INTVAL(UNTAG_CELL(values[idx])) | type);
+}
+
+
+/*
+
+=item C<static void csr_set_integer_keyed_int(PARROT_INTERP, PMC *self, INTVAL
+key, INTVAL value)>
+
+=item C<static void csr_set_number_keyed_int(PARROT_INTERP, PMC *self, INTVAL
+key, FLOATVAL value)>
+
+=item C<static void csr_set_string_keyed_int(PARROT_INTERP, PMC *self, INTVAL
+key, STRING *value)>
+
+=item C<static void csr_set_pmc_keyed_int(PARROT_INTERP, PMC *self, INTVAL key,
+PMC *value)>
+
+Sets the value of the element at index C<key> to C<value>, casting if
+necessary.
+
+=cut
+
+*/
+
+static void
+csr_set_integer_keyed_int(PARROT_INTERP, ARGIN(PMC *self), INTVAL key, INTVAL value)
+{
+ ASSERT_ARGS(csr_set_integer_keyed_int)
+ void *cell = csr_get_pointer_keyed_int(interp, self, key);
+ void *ptr = UNTAG_CELL(cell);
+
+ switch ((Call_bits_enum_t)CELL_TYPE_MASK(cell)) {
+ case PARROT_ARG_INTVAL:
+ *(INTVAL *)ptr = value;
+ break;
+ case PARROT_ARG_FLOATVAL:
+ *(FLOATVAL *)ptr = value;
+ break;
+ case PARROT_ARG_STRING:
+ *(STRING **)ptr = Parrot_str_from_int(interp, value);
+ break;
+ case PARROT_ARG_PMC:
+ *(PMC **)ptr = get_integer_pmc(interp, value);
+ break;
+ default:
+ PARROT_ASSERT(!"Impossible type");
+ }
+}
+
+static void
+csr_set_number_keyed_int(PARROT_INTERP, ARGIN(PMC *self), INTVAL key, FLOATVAL value)
+{
+ ASSERT_ARGS(csr_set_number_keyed_int)
+ void *cell = csr_get_pointer_keyed_int(interp, self, key);
+ void *ptr = UNTAG_CELL(cell);
+
+ switch ((Call_bits_enum_t)CELL_TYPE_MASK(cell)) {
+ case PARROT_ARG_INTVAL:
+ *(INTVAL *)ptr = value;
+ break;
+ case PARROT_ARG_FLOATVAL:
+ *(FLOATVAL *)ptr = value;
+ break;
+ case PARROT_ARG_STRING:
+ *(STRING **)ptr = Parrot_str_from_num(interp, value);
+ break;
+ case PARROT_ARG_PMC:
+ *(PMC **)ptr = get_number_pmc(interp, value);
+ break;
+ default:
+ PARROT_ASSERT(!"Impossible type");
+ }
+}
+
+static void
+csr_set_string_keyed_int(PARROT_INTERP, ARGIN(PMC *self), INTVAL key, ARGIN_NULLOK(STRING *value))
+{
+ ASSERT_ARGS(csr_set_string_keyed_int)
+ void *cell = csr_get_pointer_keyed_int(interp, self, key);
+ void *ptr = UNTAG_CELL(cell);
+
+ switch ((Call_bits_enum_t)CELL_TYPE_MASK(cell)) {
+ case PARROT_ARG_INTVAL:
+ *(INTVAL *)ptr = Parrot_str_to_int(interp, value);
+ break;
+ case PARROT_ARG_FLOATVAL:
+ *(FLOATVAL *)ptr = Parrot_str_to_num(interp, value);
+ break;
+ case PARROT_ARG_STRING:
+ *(STRING **)ptr = value;
+ break;
+ case PARROT_ARG_PMC:
+ *(PMC **)ptr = STRING_IS_NULL(value) ?
+ PMCNULL :
+ get_string_pmc(interp, value);
+ break;
+ default:
+ PARROT_ASSERT(!"Impossible type");
+ }
+}
+
+static void
+csr_set_pmc_keyed_int(PARROT_INTERP, ARGIN(PMC *self), INTVAL key, ARGIN_NULLOK(PMC *value))
+{
+ ASSERT_ARGS(csr_set_pmc_keyed_int)
+ void *cell = csr_get_pointer_keyed_int(interp, self, key);
+ void *ptr = UNTAG_CELL(cell);
+
+ switch ((Call_bits_enum_t)CELL_TYPE_MASK(cell)) {
+ case PARROT_ARG_INTVAL:
+ *(INTVAL *)ptr = VTABLE_get_integer(interp, value);
+ break;
+ case PARROT_ARG_FLOATVAL:
+ *(FLOATVAL *)ptr = VTABLE_get_number(interp, value);
+ break;
+ case PARROT_ARG_STRING:
+ *(STRING **)ptr = VTABLE_get_string(interp, value);
+ break;
+ case PARROT_ARG_PMC:
+ *(PMC **)ptr = value;
+ break;
+ default:
+ PARROT_ASSERT(!"Impossible type");
+ }
+}
+
+/*
+
+=item C<static STRING* csr_get_string_keyed_int(PARROT_INTERP, PMC *self, INTVAL
+key)>
+
+Gets raw pointer for result.
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+static STRING*
+csr_get_string_keyed_int(PARROT_INTERP, ARGIN(PMC *self), INTVAL key)
+{
+ ASSERT_ARGS(csr_get_string_keyed_int)
+ void *cell = csr_get_pointer_keyed_int(interp, self, key);
+ void *ptr = UNTAG_CELL(cell);
+ return (STRING *)ptr;
+}
+
+
+/*
+
+=item C<static void* csr_get_pointer_keyed_int(PARROT_INTERP, PMC *self, INTVAL
+key)>
+
+Gets raw pointer for result.
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+static void*
+csr_get_pointer_keyed_int(PARROT_INTERP, ARGIN(PMC *self), INTVAL key)
+{
+ ASSERT_ARGS(csr_get_pointer_keyed_int)
+ void **values;
+ INTVAL size;
+
+ GETATTR_CallSignature_returns_size(interp, self, size);
+ PARROT_ASSERT((key < size) || !"Wrong index");
+
+ GETATTR_CallSignature_returns_values(interp, self, values);
+ return values[key];
+}
+
+/*
+
+=item C<void Parrot_pcc_append_result(PARROT_INTERP, PMC *sig_object, STRING
+*type, void *result)>
+
+Helper function between old and new style PCC to append return pointer to signature.
+
+To be removed with deprecated functions.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_append_result(PARROT_INTERP, ARGIN(PMC *sig_object), ARGIN(STRING *type),
+ ARGIN(void *result))
+{
+ ASSERT_ARGS(Parrot_pcc_append_result)
+ STRING *full_sig;
+ PMC *return_flags;
+ INTVAL return_flags_size;
+
+ Parrot_String return_flags_name = Parrot_str_new_constant(interp, "return_flags");
+ Parrot_String sig_name = Parrot_str_new_constant(interp, "signature");
+
+ full_sig = VTABLE_get_string(interp, sig_object);
+ /* Append ->[T] */
+ Parrot_str_concat(interp, full_sig, Parrot_str_new_constant(interp, "->"), 0);
+ Parrot_str_concat(interp, full_sig, type, 0);
+
+ csr_set_pointer_keyed_int(interp, sig_object, csr_elements(interp, sig_object), result);
+
+ /* Update returns_flag */
+ return_flags = VTABLE_get_attr_str(interp, sig_object, return_flags_name);
+ if (PMC_IS_NULL(return_flags)) {
+ /* Create return_flags for single element */
+ return_flags = pmc_new(interp, enum_class_FixedIntegerArray);
+ return_flags_size = 0;
+ VTABLE_set_integer_native(interp, return_flags, 1);
+ VTABLE_set_attr_str(interp, sig_object, return_flags_name, return_flags);
+ }
+ else {
+ /* Extend return_flags by one element */
+ return_flags_size = VTABLE_elements(interp, return_flags);
+ VTABLE_set_integer_native(interp, return_flags, return_flags_size + 1);
+ }
+ switch (Parrot_str_indexed(interp, type, 0)) {
+ case 'I':
+ VTABLE_set_integer_keyed_int(interp, return_flags, return_flags_size,
+ PARROT_ARG_INTVAL);
+ csr_push_integer(interp, sig_object, PARROT_ARG_INTVAL);
+ break;
+ case 'N':
+ VTABLE_set_integer_keyed_int(interp, return_flags, return_flags_size,
+ PARROT_ARG_FLOATVAL);
+ csr_push_integer(interp, sig_object, PARROT_ARG_FLOATVAL);
+ break;
+ case 'S':
+ VTABLE_set_integer_keyed_int(interp, return_flags, return_flags_size,
+ PARROT_ARG_STRING);
+ csr_push_integer(interp, sig_object, PARROT_ARG_STRING);
+ break;
+ case 'P':
+ VTABLE_set_integer_keyed_int(interp, return_flags, return_flags_size,
+ PARROT_ARG_PMC);
+ csr_push_integer(interp, sig_object, PARROT_ARG_PMC);
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "invalid signature string element!");
+ }
+
+}
+
+/*
+
=back
=head1 SEE ALSO
Modified: trunk/src/extend.c
==============================================================================
--- trunk/src/extend.c Fri Dec 4 19:28:43 2009 (r42890)
+++ trunk/src/extend.c Fri Dec 4 19:55:05 2009 (r42891)
@@ -1011,87 +1011,6 @@
/*
-=item C<void append_result(PARROT_INTERP, PMC *sig_object, Parrot_String type,
-void *result)>
-
-Helper function between old and new style PCC to append return pointer to signature.
-
-To be removed with deprecated functions.
-
-=cut
-
-*/
-
-void
-append_result(PARROT_INTERP, ARGIN(PMC *sig_object), ARGIN(Parrot_String type), ARGIN(void *result))
-{
- ASSERT_ARGS(append_result)
- Parrot_String full_sig;
- Parrot_PMC returns;
- Parrot_PMC return_flags;
- Parrot_Int return_flags_size;
-
- Parrot_String return_name = Parrot_str_new_constant(interp, "returns");
- Parrot_String return_flags_name = Parrot_str_new_constant(interp, "return_flags");
- Parrot_String sig_name = Parrot_str_new_constant(interp, "signature");
-
- full_sig = VTABLE_get_string(interp, sig_object);
- /* Append ->[T] */
- Parrot_str_concat(interp, full_sig, Parrot_str_new_constant(interp, "->"), 0);
- Parrot_str_concat(interp, full_sig, type, 0);
-
- returns = VTABLE_get_attr_str(interp, sig_object, return_name);
- if (PMC_IS_NULL(returns)) {
- returns = pmc_new(interp, enum_class_CallSignatureReturns);
- VTABLE_set_attr_str(interp, sig_object, return_name, returns);
- }
- VTABLE_set_pointer_keyed_int(interp, returns, VTABLE_elements(interp, returns), result);
-
- /* Update returns_flag */
- return_flags = VTABLE_get_attr_str(interp, sig_object, return_flags_name);
- if (PMC_IS_NULL(return_flags)) {
- /* Create return_flags for single element */
- return_flags = pmc_new(interp, enum_class_FixedIntegerArray);
- return_flags_size = 0;
- VTABLE_set_integer_native(interp, return_flags, 1);
- VTABLE_set_attr_str(interp, sig_object, return_flags_name, return_flags);
- }
- else {
- /* Extend return_flags by one element */
- return_flags_size = VTABLE_elements(interp, return_flags);
- VTABLE_set_integer_native(interp, return_flags, return_flags_size + 1);
- }
- switch (Parrot_str_indexed(interp, type, 0)) {
- case 'I':
- VTABLE_set_integer_keyed_int(interp, return_flags, return_flags_size,
- PARROT_ARG_INTVAL);
- VTABLE_push_integer(interp, returns, PARROT_ARG_INTVAL);
- break;
- case 'N':
- VTABLE_set_integer_keyed_int(interp, return_flags, return_flags_size,
- PARROT_ARG_FLOATVAL);
- VTABLE_push_integer(interp, returns, PARROT_ARG_FLOATVAL);
- break;
- case 'S':
- VTABLE_set_integer_keyed_int(interp, return_flags, return_flags_size,
- PARROT_ARG_STRING);
- VTABLE_push_integer(interp, returns, PARROT_ARG_STRING);
- break;
- case 'P':
- VTABLE_set_integer_keyed_int(interp, return_flags, return_flags_size,
- PARROT_ARG_PMC);
- VTABLE_push_integer(interp, returns, PARROT_ARG_PMC);
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "invalid signature string element!");
- }
-
-}
-
-/*
-
=item C<void Parrot_ext_call(PARROT_INTERP, Parrot_PMC sub_pmc, const char
*signature, ...)>
@@ -1194,7 +1113,8 @@
case 'V':
case 'P':
{
- append_result(interp, sig_object, Parrot_str_new_constant(interp, "P"), &result);
+ Parrot_pcc_append_result(interp, sig_object, Parrot_str_new_constant(interp, "P"),
+ &result);
break;
}
default:
@@ -1244,7 +1164,7 @@
/* Add the return argument onto the call signature object (a bit
* hackish, added for backward compatibility in deprecated API function,
* see TT #1145). */
- append_result(interp, sig_object, Parrot_str_new_constant(interp, "I"), &result);
+ Parrot_pcc_append_result(interp, sig_object, Parrot_str_new_constant(interp, "I"), &result);
Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, sig_object);
return result;
@@ -1282,7 +1202,7 @@
/* Add the return argument onto the call signature object (a bit
* hackish, added for backward compatibility in deprecated API function,
* see TT #1145). */
- append_result(interp, sig_object, Parrot_str_new_constant(interp, "N"), &result);
+ Parrot_pcc_append_result(interp, sig_object, Parrot_str_new_constant(interp, "N"), &result);
PMC_get_sub(interp, sub_pmc, sub);
Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp), sub->seg->const_table->constants);
Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, sig_object);
@@ -1342,7 +1262,8 @@
case 'V':
case 'P':
{
- append_result(interp, sig_object, Parrot_str_new_constant(interp, "P"), &result);
+ Parrot_pcc_append_result(interp, sig_object, Parrot_str_new_constant(interp, "P"),
+ &result);
break;
}
default:
@@ -1393,7 +1314,7 @@
va_end(args);
free(arg_sig);
- append_result(interp, sig_object, Parrot_str_new_constant(interp, "I"), &result);
+ Parrot_pcc_append_result(interp, sig_object, Parrot_str_new_constant(interp, "I"), &result);
PMC_get_sub(interp, sub_pmc, sub);
Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp), sub->seg->const_table->constants);
Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, sig_object);
@@ -1434,7 +1355,7 @@
va_end(args);
free(arg_sig);
- append_result(interp, sig_object, Parrot_str_new_constant(interp, "N"), &result);
+ Parrot_pcc_append_result(interp, sig_object, Parrot_str_new_constant(interp, "N"), &result);
PMC_get_sub(interp, sub_pmc, sub);
Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp), sub->seg->const_table->constants);
Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, sig_object);
Modified: trunk/src/pmc/callsignature.pmc
==============================================================================
--- trunk/src/pmc/callsignature.pmc Fri Dec 4 19:28:43 2009 (r42890)
+++ trunk/src/pmc/callsignature.pmc Fri Dec 4 19:55:05 2009 (r42891)
@@ -360,7 +360,6 @@
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 */
@@ -368,6 +367,10 @@
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()>
@@ -383,14 +386,82 @@
PMC_data_typed(SELF, Parrot_CallSignature_attributes *);
SUPER();
attrs->type_tuple = PMCNULL;
- attrs->results = PMCNULL;
attrs->positionals = NULL;
attrs->num_positionals = 0;
+ attrs->returns_values = NULL;
+ attrs->returns_size = 0;
+ attrs->returns_resize_threshold = 0;
PObj_custom_mark_destroy_SETALL(SELF);
}
/*
+=item C<void mark()>
+
+Mark any referenced strings and PMCs.
+
+=cut
+
+*/
+ VTABLE void mark() {
+ Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
+ if (!attrs)
+ return;
+
+ Parrot_gc_mark_PMC_alive(interp, attrs->type_tuple);
+ 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);
+
+ 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(interp, 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(interp, (Pcc_cell *)b->value);
+ b = b->next;
+ }
+ }
+
+ parrot_hash_destroy(interp, attrs->hash);
+ }
+
+ /* Destroy returns storage */
+ if (attrs->returns_values) {
+ if (attrs->returns_resize_threshold == 8)
+ Parrot_gc_free_fixed_size_storage(INTERP,
+ 8 * sizeof (void *), attrs->returns_values);
+ else
+ mem_sys_free(attrs->returns_values);
+ }
+ }
+
+/*
+
=item C<void set_string_native(STRING *value)>
Sets the short signature for the CallSignature.
@@ -522,13 +593,7 @@
VTABLE void set_attr_str(STRING *key, PMC *value) {
- if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "results"))) {
- SET_ATTR_results(interp, SELF, value);
- }
- else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "returns"))) {
- SET_ATTR_results(interp, SELF, value);
- }
- else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "arg_flags"))) {
+ 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"))) {
@@ -579,12 +644,6 @@
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, "results"))) {
- GET_ATTR_results(interp, SELF, value);
- }
- else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "returns"))) {
- GET_ATTR_results(interp, SELF, value);
- }
else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "arg_flags"))) {
GET_ATTR_arg_flags(interp, SELF, value);
}
@@ -600,64 +659,6 @@
return value;
}
-/*
-
-=item C<void mark()>
-
-Mark any referenced strings and PMCs.
-
-=cut
-
-*/
- VTABLE void mark() {
- Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
- if (!attrs)
- return;
-
- Parrot_gc_mark_PMC_alive(interp, attrs->results);
- Parrot_gc_mark_PMC_alive(interp, attrs->type_tuple);
- 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);
-
- 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(interp, 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(interp, (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)
@@ -1218,12 +1219,16 @@
cloned_cell = CREATE_PMC_CELL(INTERP);
CELL_PMC(cloned_cell) = CELL_PMC(cell);
break;
+ default:
+ break;
}
APPEND_CELL(dest, cloned_cell);
}
+ /* FIXME
if (!PMC_IS_NULL(sig->results))
dest_sig->results = VTABLE_clone(INTERP, sig->results);
+ */
if (!PMC_IS_NULL(sig->type_tuple))
dest_sig->type_tuple = VTABLE_clone(INTERP, sig->type_tuple);
Deleted: trunk/src/pmc/callsignaturereturns.pmc
==============================================================================
--- trunk/src/pmc/callsignaturereturns.pmc Fri Dec 4 19:55:05 2009 (r42890)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,416 +0,0 @@
-/*
-Copyright (C) 2009, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/pmc/callsignaturereturns.pmc - resizable array for typed pointers
-
-=head1 DESCRIPTION
-
-This class stores typed pointers used to fill results in CallSignature.
-
-
-=head1 SYNOPSIS
-
- # VTABLEs are too tight to implement something more beautiful
-
- # Create signature
- rets = new CallSignatureReturns
- rets.set_pointer_keyed_int(0, &intval);
- rest.push_integer(PARROT_ARG_INTVAL);
-
- rets.set_pointer_keyed_int(1, &floatval);
- rest.push_integer(PARROT_ARG_FLOATVAL);
-
- rets.set_pointer_keyed_int(2, &string);
- rest.push_integer(PARROT_ARG_STRING);
-
- rets.set_pointer_keyed_int(3, &pmc);
- rest.push_integer(PARROT_ARG_PMC);
-
- # Fill
- rets.set_integer_keyed_int(intval, 0);
- rets.set_number_keyed_int(floatval, 1);
- rets.set_string_keyed_int(string, 2);
- rets.set_pmc_keyed_int(pmc, 3);
-
-CallSignatureReturns will behave like CPointer with autocasting values.
-
-Up to 8 returns use FixedSizeAllocator. Switch to malloc/free after.
-
-=head2 Functions
-
-=over 4
-
-=cut
-
-*/
-
-static void **
-allocate_initial_values(PARROT_INTERP, ARGIN(PMC *SELF))
-{
- void **values = (void **)Parrot_gc_allocate_fixed_size_storage(interp,
- 8 * sizeof (void *));
-
- SETATTR_CallSignatureReturns_resize_threshold(interp, SELF, 8);
- return values;
-}
-
-
-/* mask off lower two bits (1 + 2 = 3) for pointer tags */
-#define TAG_BITS 3
-#define UNTAG_CELL(c) INTVAL2PTR(void *, (PTR2INTVAL(c)) & ~TAG_BITS)
-#define CELL_TYPE_MASK(c) (PTR2INTVAL(c)) & TAG_BITS
-
-pmclass CallSignatureReturns auto_attrs provides array {
- ATTR void **values; /* stored pointers */
- ATTR INTVAL size; /* number of stored elements */
- ATTR INTVAL resize_threshold; /* max size before resizing array */
-
-/*
-
-=item C<void init()>
-
-Initialize the CallSignatureReturns PMC.
-
-=cut
-
-*/
-
- VTABLE void init() {
- PObj_custom_destroy_SET(SELF);
- }
-
-
-/*
-
-=item C<void destroy()>
-
-Destroy CallSignatureReturns.
-
-=cut
-
-*/
-
- VTABLE void destroy() {
- void **values;
-
- GET_ATTR_values(INTERP, SELF, values);
-
- if (values) {
- INTVAL resize_threshold;
- GET_ATTR_resize_threshold(INTERP, SELF, resize_threshold);
-
- if (resize_threshold == 8)
- Parrot_gc_free_fixed_size_storage(INTERP,
- 8 * sizeof (void *), values);
- else
- mem_sys_free(values);
- }
- }
-
-
-/*
-
-=item C<void set_integer_native(INTVAL size)>
-
-Resizes the array to C<size> elements.
-
-=cut
-
-*/
-
- VTABLE void set_integer_native(INTVAL size) {
- void **values = NULL;
- INTVAL resize_threshold;
-
- GET_ATTR_values(INTERP, SELF, values);
- GET_ATTR_resize_threshold(INTERP, SELF, resize_threshold);
-
- /* Empty. Allocate 8 elements (arbitary number) */
- if (!values) {
- values = allocate_initial_values(INTERP, SELF);
- SET_ATTR_values(INTERP, SELF, values);
- SET_ATTR_size(INTERP, SELF, size);
- }
- else if (size <= resize_threshold) {
- SET_ATTR_size(INTERP, SELF, size);
- return;
- }
- else {
- void *old_values;
- INTVAL cur = resize_threshold;
-
- /* Switch to system allocator */
- if (cur == 8) {
- old_values = values;
- values = mem_allocate_n_typed(8, void *);
- memcpy(values, old_values, 8 * sizeof (void *));
- Parrot_gc_free_fixed_size_storage(INTERP,
- 8 * sizeof (void *), old_values);
- }
-
- if (cur < 8192)
- cur = size < 2 * cur ? 2 * cur : size;
- else {
- INTVAL needed = size - cur;
- cur += needed + 4096;
- cur &= ~0xfff;
- }
-
- mem_realloc_n_typed(values, cur, void *);
-
- SET_ATTR_values(INTERP, SELF, values);
- SET_ATTR_size(INTERP, SELF, size);
- SET_ATTR_resize_threshold(INTERP, SELF, cur);
- }
- }
-
-
-/*
-
-=item C<INTVAL elements()>
-
-Returns the number of elements in the array.
-
-=cut
-
-*/
-
- VTABLE INTVAL elements() {
- INTVAL size;
- GET_ATTR_size(INTERP, SELF, size);
- return size;
- }
-
-
-/*
-
-=item C<void set_pointer_keyed_int(INTVAL key, void *value)>
-
-Sets the pointer at position key. The pointer should point to a storage
-location for a return value -- it must be a pointer to an INTVAL, FLOATVAL,
-PMC, or STRING storage location.
-
-=cut
-
-*/
-
- VTABLE void set_pointer_keyed_int(INTVAL key, void *value) {
- void **values;
- INTVAL size;
-
- GET_ATTR_values(INTERP, SELF, values);
- GET_ATTR_size(INTERP, SELF, size);
-
- if (!values) {
- if (key < 8) {
- values = allocate_initial_values(INTERP, SELF);
- SET_ATTR_values(INTERP, SELF, values);
- SET_ATTR_size(INTERP, SELF, key + 1);
- }
- else {
- STATICSELF.set_integer_native(key + 1);
- GET_ATTR_values(INTERP, SELF, values);
- }
- }
- else if (key >= size)
- STATICSELF.set_integer_native(key + 1);
-
- values[key] = value;
- }
-
-/*
-
-=item C<void push_integer(INTVAL value)>
-
-Set type of last pushed pointer.
-
-=cut
-
-*/
-
- VTABLE void push_integer(INTVAL type) {
- void **values;
- INTVAL idx;
-
- GET_ATTR_size(INTERP, SELF, idx);
-
- /* last index is size - 1, of course */
- idx--;
-
- PARROT_ASSERT((type >= 0 && type < 4) || !"Wrong pointer type");
-
- GET_ATTR_values(INTERP, SELF, values);
-
- values[idx] = INTVAL2PTR(void *,
- PTR2INTVAL(UNTAG_CELL(values[idx])) | type);
- }
-
-
-/*
-
-=item C<void set_integer_keyed_int(INTVAL key, INTVAL value)>
-
-=item C<void set_number_keyed_int(INTVAL key, FLOATVAL value)>
-
-=item C<void set_string_keyed_int(INTVAL key, STRING *value)>
-
-=item C<void set_pmc_keyed_int(INTVAL key, PMC *value)>
-
-Sets the value of the element at index C<key> to C<value>, casting if
-necessary.
-
-=cut
-
-*/
-
- VTABLE void set_integer_keyed_int(INTVAL key, INTVAL value) {
- void *cell = STATICSELF.get_pointer_keyed_int(key);
- void *ptr = UNTAG_CELL(cell);
-
- switch ((Call_bits_enum_t)CELL_TYPE_MASK(cell)) {
- case PARROT_ARG_INTVAL:
- *(INTVAL *)ptr = value;
- break;
- case PARROT_ARG_FLOATVAL:
- *(FLOATVAL *)ptr = value;
- break;
- case PARROT_ARG_STRING:
- *(STRING **)ptr = Parrot_str_from_int(INTERP, value);
- break;
- case PARROT_ARG_PMC:
- *(PMC **)ptr = get_integer_pmc(INTERP, value);
- break;
- default:
- PARROT_ASSERT(!"Impossible type");
- }
- }
-
- VTABLE void set_number_keyed_int(INTVAL key, FLOATVAL value) {
- void *cell = STATICSELF.get_pointer_keyed_int(key);
- void *ptr = UNTAG_CELL(cell);
-
- switch ((Call_bits_enum_t)CELL_TYPE_MASK(cell)) {
- case PARROT_ARG_INTVAL:
- *(INTVAL *)ptr = value;
- break;
- case PARROT_ARG_FLOATVAL:
- *(FLOATVAL *)ptr = value;
- break;
- case PARROT_ARG_STRING:
- *(STRING **)ptr = Parrot_str_from_num(INTERP, value);
- break;
- case PARROT_ARG_PMC:
- *(PMC **)ptr = get_number_pmc(INTERP, value);
- break;
- default:
- PARROT_ASSERT(!"Impossible type");
- }
- }
-
- VTABLE void set_string_keyed_int(INTVAL key, STRING *value) {
- void *cell = STATICSELF.get_pointer_keyed_int(key);
- void *ptr = UNTAG_CELL(cell);
-
- switch ((Call_bits_enum_t)CELL_TYPE_MASK(cell)) {
- case PARROT_ARG_INTVAL:
- *(INTVAL *)ptr = Parrot_str_to_int(INTERP, value);
- break;
- case PARROT_ARG_FLOATVAL:
- *(FLOATVAL *)ptr = Parrot_str_to_num(INTERP, value);
- break;
- case PARROT_ARG_STRING:
- *(STRING **)ptr = value;
- break;
- case PARROT_ARG_PMC:
- *(PMC **)ptr = STRING_IS_NULL(value) ?
- PMCNULL :
- get_string_pmc(INTERP, value);
- break;
- default:
- PARROT_ASSERT(!"Impossible type");
- }
- }
-
- VTABLE void set_pmc_keyed_int(INTVAL key, PMC *value) {
- void *cell = STATICSELF.get_pointer_keyed_int(key);
- void *ptr = UNTAG_CELL(cell);
-
- switch ((Call_bits_enum_t)CELL_TYPE_MASK(cell)) {
- case PARROT_ARG_INTVAL:
- *(INTVAL *)ptr = VTABLE_get_integer(INTERP, value);
- break;
- case PARROT_ARG_FLOATVAL:
- *(FLOATVAL *)ptr = VTABLE_get_number(INTERP, value);
- break;
- case PARROT_ARG_STRING:
- *(STRING **)ptr = VTABLE_get_string(INTERP, value);
- break;
- case PARROT_ARG_PMC:
- *(PMC **)ptr = value;
- break;
- default:
- PARROT_ASSERT(!"Impossible type");
- }
- }
-
-/*
-
-=item C<void *get_string_keyed_int(INTVAL key)>
-
-Gets raw pointer for result.
-
-=cut
-
-*/
-
- VTABLE STRING *get_string_keyed_int(INTVAL key) {
- void *cell = STATICSELF.get_pointer_keyed_int(key);
- void *ptr = UNTAG_CELL(cell);
- return (STRING *)ptr;
- }
-
-
-/*
-
-=item C<void *get_pointer_keyed_int(INTVAL key)>
-
-Gets raw pointer for result.
-
-=cut
-
-*/
-
- VTABLE void *get_pointer_keyed_int(INTVAL key) {
- void **values;
- INTVAL size;
-
- GET_ATTR_size(INTERP, SELF, size);
- PARROT_ASSERT((key < size) || !"Wrong index");
-
- GET_ATTR_values(INTERP, SELF, values);
- return values[key];
- }
-}
-
-
-/*
-
-=back
-
-=head1 SEE ALSO
-
-F<docs/pdds/pdd03_calling_conventions.pod>.
-
-=cut
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: trunk/t/native_pbc/annotations.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: trunk/t/native_pbc/integer_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: trunk/t/native_pbc/number_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: trunk/t/native_pbc/string_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: trunk/t/pmc/callsignature.t
==============================================================================
--- trunk/t/pmc/callsignature.t Fri Dec 4 19:28:43 2009 (r42890)
+++ trunk/t/pmc/callsignature.t Fri Dec 4 19:55:05 2009 (r42891)
@@ -19,7 +19,7 @@
.sub 'main' :main
.include 'test_more.pir'
- plan(68)
+ plan(66)
test_instantiate()
test_get_set_attrs()
@@ -41,12 +41,6 @@
$P0 = new ['CallSignature']
$P5 = new 'String'
- $P5 = 'foobar'
- setattribute $P0, 'returns', $P5
- ok(1, 'set returns attribute')
- getattribute $P1, $P0, 'returns'
- is($P1,'foobar', 'got returns attribute')
-
$P5 = 'moonbomb'
setattribute $P0, 'return_flags', $P5
ok(1, 'set return_flags attribute')
Deleted: trunk/t/pmc/callsignaturereturns.t
==============================================================================
--- trunk/t/pmc/callsignaturereturns.t Fri Dec 4 19:55:05 2009 (r42890)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,53 +0,0 @@
-#! parrot
-# Copyright (C) 2009, Parrot Foundation.
-# $Id$
-
-=head1 NAME
-
-t/pmc/callsignaturereturns.t - test CallSignatureReturns PMC
-
-=head1 SYNOPSIS
-
- % prove t/pmc/callsignaturereturns.t
-
-=head1 DESCRIPTION
-
-Tests the CallSignatureReturns PMC.
-
-=cut
-
-.sub main :main
- .include 'test_more.pir'
-
- plan(2)
-
- instantiate()
- switch_storage()
-.end
-
-
-.sub instantiate
- $P0 = new ['CallSignatureReturns']
- ok(1, 'Instantiated CallSignatureReturns')
-.end
-
-# Check that internal switching of storage works.
-.sub switch_storage
- .local pmc r
- (r :slurpy) = 'return_many'()
- sweep 1
- $S0 = join '', r
- is($S0, "This is very long string to return as characters", "Internal storage switched")
-.end
-
-.sub return_many
- .local pmc res
- res = split '', "This is very long string to return as characters"
- .return (res :flat)
-.end
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
More information about the parrot-commits
mailing list