[svn:parrot] r41638 - branches/pcc_reapply/src/call
allison at svn.parrot.org
allison at svn.parrot.org
Sat Oct 3 16:31:37 UTC 2009
Author: allison
Date: Sat Oct 3 16:31:34 2009
New Revision: 41638
URL: https://trac.parrot.org/parrot/changeset/41638
Log:
[pcc] Add a new file for argument processing and move the return handling
functions into it.
Added:
branches/pcc_reapply/src/call/args.c
Added: branches/pcc_reapply/src/call/args.c
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pcc_reapply/src/call/args.c Sat Oct 3 16:31:34 2009 (r41638)
@@ -0,0 +1,388 @@
+/*
+Copyright (C) 2001-2009, Parrot Foundation.
+$Id: pcc.c 41637 2009-10-03 14:46:07Z jkeenan $
+
+=head1 Arguments and Returns
+
+=head1 Description
+
+Functions in this file handle argument/return value passing to and from
+subroutines following the Parrot Calling Conventions.
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include "parrot/oplib/ops.h"
+#include "parrot/runcore_api.h"
+#include "args.str"
+
+/* HEADERIZER HFILE: include/parrot/call.h */
+
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: static */
+
+
+/*
+
+=item C<void Parrot_pcc_fill_returns_from_op(PARROT_INTERP, PMC *call_object,
+PMC *raw_sig, opcode_t *raw_returns)>
+
+Sets return values for the current function call. First it sets the
+positional returns, then the named returns.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_fill_returns_from_op(PARROT_INTERP, ARGMOD_NULLOK(PMC *call_object),
+ ARGIN(PMC *raw_sig), ARGIN(opcode_t *raw_returns))
+{
+ ASSERT_ARGS(Parrot_pcc_fill_returns_from_op)
+ INTVAL return_list_elements;
+ PMC *ctx = CURRENT_CONTEXT(interp);
+ PMC *return_list;
+ PMC *caller_return_flags;
+ INTVAL raw_return_count = VTABLE_elements(interp, raw_sig);
+ INTVAL return_index = 0;
+ INTVAL return_list_index = 0;
+ INTVAL err_check = 0;
+
+ /* Check if we should be throwing errors. This is configured separately
+ * for parameters and return values. */
+ if (PARROT_ERRORS_test(interp, PARROT_ERRORS_RESULT_COUNT_FLAG))
+ err_check = 1;
+
+ /* A null call object is fine if there are no arguments and no returns. */
+ if (PMC_IS_NULL(call_object)) {
+ if (raw_return_count > 0) {
+ if (err_check)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "too many return values: %d passed, 0 expected",
+ raw_return_count);
+ return;
+ }
+ }
+
+ return_list = VTABLE_get_attr_str(interp, call_object, CONST_STRING(interp, "returns"));
+ if (PMC_IS_NULL(return_list)) {
+ if (raw_return_count > 0) {
+ if (err_check)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "too many return values: %d passed, 0 expected",
+ raw_return_count);
+ return;
+ }
+ }
+ else
+ return_list_elements = VTABLE_elements(interp, return_list);
+
+ caller_return_flags = VTABLE_get_attr_str(interp, call_object, CONST_STRING(interp, "return_flags"));
+
+
+ if (raw_return_count > return_list_elements) {
+ if (err_check)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "too many return values: %d passed, %d expected",
+ raw_return_count, return_list_elements);
+ }
+
+ for (return_index = 0; return_index < raw_return_count; return_index++) {
+ INTVAL return_flags = VTABLE_get_integer_keyed_int(interp,
+ raw_sig, return_index);
+ INTVAL result_flags;
+
+ const INTVAL constant = PARROT_ARG_CONSTANT_ISSET(return_flags);
+ const INTVAL raw_index = raw_returns[return_index + 2];
+ PMC *result_item = VTABLE_get_pmc_keyed_int(interp, return_list, return_list_index);
+ STRING *item_sig;
+
+ /* Gracefully ignore extra returns when error checking is off. */
+ if (PMC_IS_NULL(result_item))
+ continue; /* Go on to next return arg. */
+
+ result_flags = VTABLE_get_integer_keyed_int(interp, caller_return_flags, return_list_index);
+ item_sig = VTABLE_get_string_keyed_str(interp, result_item, CONST_STRING(interp, ''));
+
+ switch (PARROT_ARG_TYPE_MASK_MASK(return_flags)) {
+ case PARROT_ARG_INTVAL:
+ if (Parrot_str_equal(interp, item_sig, CONST_STRING(interp, "P"))) {
+ VTABLE_set_pmc(interp, result_item,
+ pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_Integer)));
+ }
+ if (constant)
+ VTABLE_set_integer_native(interp, result_item, raw_index);
+ else
+ VTABLE_set_integer_native(interp, result_item, CTX_REG_INT(ctx, raw_index));
+ return_list_index++;
+ break;
+ case PARROT_ARG_FLOATVAL:
+ if (Parrot_str_equal(interp, item_sig, CONST_STRING(interp, "P"))) {
+ VTABLE_set_pmc(interp, result_item,
+ pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_Float)));
+ }
+ if (constant)
+ VTABLE_set_number_native(interp, result_item,
+ Parrot_pcc_get_num_constant(interp, ctx, raw_index));
+ else
+ VTABLE_set_number_native(interp, result_item, CTX_REG_NUM(ctx, raw_index));
+ return_list_index++;
+ break;
+ case PARROT_ARG_STRING:
+ if (Parrot_str_equal(interp, item_sig, CONST_STRING(interp, "P"))) {
+ VTABLE_set_pmc(interp, result_item,
+ pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_String)));
+ }
+ if (constant)
+ VTABLE_set_string_native(interp, result_item, Parrot_str_new_COW(interp,
+ Parrot_pcc_get_string_constant(interp, ctx, raw_index)));
+ else
+ VTABLE_set_string_native(interp, result_item, CTX_REG_STR(ctx, raw_index));
+ return_list_index++;
+ break;
+ case PARROT_ARG_PMC:
+ if (constant)
+ VTABLE_set_pmc(interp, result_item,
+ Parrot_pcc_get_pmc_constant(interp, ctx, raw_index));
+ else
+ VTABLE_set_pmc(interp, result_item, CTX_REG_PMC(ctx, raw_index));
+ return_list_index++;
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION, "invalid parameter type");
+ break;
+ }
+ }
+}
+
+/*
+
+=item C<void Parrot_pcc_fill_returns_from_c_args(PARROT_INTERP, PMC
+*call_object, const char *signature, ...)>
+
+Sets return values for the current function call. First it sets the
+positional returns, then the named returns.
+
+The signature is a string in the format used for
+C<Parrot_pcc_invoke_from_sig_object>, but with only return arguments.
+The parameters are passed in as a list of INTVAL, FLOATVAL, STRING *, or
+PMC * variables.
+
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_fill_returns_from_c_args(PARROT_INTERP, ARGMOD(PMC *call_object),
+ ARGIN(const char *signature), ...)
+{
+ ASSERT_ARGS(Parrot_pcc_fill_returns_from_c_args)
+ va_list args;
+ INTVAL return_list_elements;
+ PMC *ctx = CURRENT_CONTEXT(interp);
+ PMC * const return_list = VTABLE_get_attr_str(interp, call_object, CONST_STRING(interp, "returns"));
+ INTVAL raw_return_count = 0;
+ INTVAL return_index = 0;
+ INTVAL return_list_index = 0;
+ INTVAL err_check = 0;
+
+ PMC *raw_sig = PMCNULL;
+ PMC *invalid_sig = PMCNULL;
+
+ parse_signature_string(interp, signature, &raw_sig, &invalid_sig);
+ if (!PMC_IS_NULL(invalid_sig))
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "parameters should not be included in the return signature");
+ raw_return_count = VTABLE_elements(interp, raw_sig);
+
+ /* Check if we should be throwing errors. This is configured separately
+ * for parameters and return values. */
+ if (PARROT_ERRORS_test(interp, PARROT_ERRORS_RESULT_COUNT_FLAG))
+ err_check = 1;
+
+ if (PMC_IS_NULL(return_list)) {
+ if (err_check)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "too many return values: %d passed, 0 expected",
+ raw_return_count, return_list_elements);
+ return;
+ }
+ else
+ return_list_elements = VTABLE_elements(interp, return_list);
+
+
+ if (raw_return_count > return_list_elements) {
+ if (err_check)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "too many return values: %d passed, %d expected",
+ raw_return_count, return_list_elements);
+ }
+
+ va_start(args, signature);
+ for (return_index = 0; return_index < raw_return_count; return_index++) {
+ STRING *item_sig;
+ INTVAL return_flags = VTABLE_get_integer_keyed_int(interp,
+ raw_sig, return_index);
+
+ PMC *result_item = VTABLE_get_pmc_keyed_int(interp, return_list, return_list_index);
+
+ /* Gracefully ignore extra returns when error checking is off. */
+ if (PMC_IS_NULL(result_item))
+ continue; /* Go on to next return arg. */
+
+ item_sig = VTABLE_get_string_keyed_str(interp, result_item, CONST_STRING(interp, ''));
+
+ switch (PARROT_ARG_TYPE_MASK_MASK(return_flags)) {
+ case PARROT_ARG_INTVAL:
+ if (Parrot_str_equal(interp, item_sig, CONST_STRING(interp, "P"))) {
+ VTABLE_set_pmc(interp, result_item, pmc_new(
+ interp, Parrot_get_ctx_HLL_type(interp, enum_class_Integer)));
+ }
+ VTABLE_set_integer_native(interp, result_item, va_arg(args, INTVAL));
+ return_list_index++;
+ break;
+ case PARROT_ARG_FLOATVAL:
+ if (Parrot_str_equal(interp, item_sig, CONST_STRING(interp, "P"))) {
+ VTABLE_set_pmc(interp, result_item, pmc_new(
+ interp, Parrot_get_ctx_HLL_type(interp, enum_class_Float)));
+ }
+ VTABLE_set_number_native(interp, result_item, va_arg(args, FLOATVAL));
+ return_list_index++;
+ break;
+ case PARROT_ARG_STRING:
+ if (Parrot_str_equal(interp, item_sig, CONST_STRING(interp, "P"))) {
+ VTABLE_set_pmc(interp, result_item, pmc_new(
+ interp, Parrot_get_ctx_HLL_type(interp, enum_class_String)));
+ }
+ VTABLE_set_string_native(interp, result_item,
+ Parrot_str_new_COW(interp, va_arg(args, STRING *)));
+ return_list_index++;
+ break;
+ case PARROT_ARG_PMC:
+ VTABLE_set_pmc(interp, result_item, va_arg(args, PMC *));
+ return_list_index++;
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION, "invalid parameter type");
+ break;
+ }
+ }
+ va_end(args);
+}
+
+/*
+
+=item C<static void parse_signature_string(PARROT_INTERP, const char *signature,
+PMC **arg_flags, PMC **return_flags)>
+
+Parses a signature string and creates call and return signature integer
+arrays. The two integer arrays should be passed in as references to a
+PMC.
+
+=cut
+
+*/
+
+PARROT_CAN_RETURN_NULL
+static void
+parse_signature_string(PARROT_INTERP, ARGIN(const char *signature),
+ ARGMOD(PMC **arg_flags), ARGMOD(PMC **return_flags))
+{
+ ASSERT_ARGS(parse_signature_string)
+ PMC *current_array;
+ const char *x;
+ INTVAL flags = 0;
+ INTVAL set = 0;
+
+ if (PMC_IS_NULL(*arg_flags))
+ *arg_flags = pmc_new(interp, enum_class_ResizableIntegerArray);
+ current_array = *arg_flags;
+
+ for (x = signature; *x != '\0'; x++) {
+
+ /* detect -> separator */
+ if (*x == '-') {
+ /* skip '>' */
+ x++;
+ /* Switch to the return argument flags. */
+ if (PMC_IS_NULL(*return_flags))
+ *return_flags = pmc_new(interp, enum_class_ResizableIntegerArray);
+ current_array = *return_flags;
+ }
+ /* parse arg type */
+ else if (isupper((unsigned char)*x)) {
+ /* Starting a new argument, so store the previous argument,
+ * if there was one. */
+ if (set) {
+ VTABLE_push_integer(interp, current_array, flags);
+ set = 0;
+ }
+
+ switch (*x) {
+ case 'I': flags = PARROT_ARG_INTVAL; set++; break;
+ case 'N': flags = PARROT_ARG_FLOATVAL; set++; break;
+ case 'S': flags = PARROT_ARG_STRING; set++; break;
+ case 'P': flags = PARROT_ARG_PMC; set++; break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "invalid signature string element %c!", *x);
+ }
+
+ }
+ /* parse arg adverbs */
+ else if (islower((unsigned char)*x)) {
+ switch (*x) {
+ case 'c': flags |= PARROT_ARG_CONSTANT; break;
+ case 'f': flags |= PARROT_ARG_FLATTEN; break;
+ case 'i': flags |= PARROT_ARG_INVOCANT; break;
+ case 'l': flags |= PARROT_ARG_LOOKAHEAD; break;
+ case 'n': flags |= PARROT_ARG_NAME; break;
+ case 'o': flags |= PARROT_ARG_OPTIONAL; break;
+ case 'p': flags |= PARROT_ARG_OPT_FLAG; break;
+ case 's': flags |= PARROT_ARG_SLURPY_ARRAY; break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "invalid signature string element %c!", *x);
+ }
+ }
+ }
+
+ /* Store the final argument, if there was one. */
+ if (set)
+ VTABLE_push_integer(interp, current_array, flags);
+}
+
+/*
+
+=back
+
+=head1 SEE ALSO
+
+F<include/parrot/call.h>, F<src/call/ops.c>, F<src/call/pcc.c>.
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
More information about the parrot-commits
mailing list