develooper Front page | perl.cvs.parrot | Postings from January 2009

[svn:parrot] r35367 - in trunk: include/parrot src

From:
allison
Date:
January 10, 2009 16:08
Subject:
[svn:parrot] r35367 - in trunk: include/parrot src
Message ID:
20090111000754.CECF9CB9F9@x12.develooper.com
Author: allison
Date: Sat Jan 10 16:07:53 2009
New Revision: 35367

Modified:
   trunk/include/parrot/enums.h
   trunk/include/parrot/inter_call.h
   trunk/include/parrot/multidispatch.h
   trunk/src/inter_call.c
   trunk/src/multidispatch.c

Log:
[pdd27mmd] Merging the calling conventions branch into trunk for r33976 to r35366.


Modified: trunk/include/parrot/enums.h
==============================================================================
--- trunk/include/parrot/enums.h	(original)
+++ trunk/include/parrot/enums.h	Sat Jan 10 16:07:53 2009
@@ -58,7 +58,8 @@
     /* unused - 0x040 */
     PARROT_ARG_OPTIONAL         = 0x080, /* 128 */
     PARROT_ARG_OPT_FLAG         = 0x100, /* 256 prev optional was set */
-    PARROT_ARG_NAME             = 0x200 /* 512 this String is an arg name */
+    PARROT_ARG_NAME             = 0x200, /* 512 this String is an arg name */
+    PARROT_ARG_INVOCANT         = 0x400  /* 1024 this PMC is an invocant */
     /* more to come soon */
 
 } Call_bits_enum_t;
@@ -77,6 +78,7 @@
 #define PARROT_ARG_OPTIONAL_ISSET(o)      ((o) & PARROT_ARG_OPTIONAL)
 #define PARROT_ARG_OPT_FLAG_ISSET(o)      ((o) & PARROT_ARG_OPT_FLAG)
 #define PARROT_ARG_NAME_ISSET(o)          ((o) & PARROT_ARG_NAME)
+#define PARROT_ARG_INVOCANT_ISSET(o)      ((o) & PARROT_ARG_INVOCANT)
 
 
 #endif /* PARROT_ENUMS_H_GUARD */

Modified: trunk/include/parrot/inter_call.h
==============================================================================
--- trunk/include/parrot/inter_call.h	(original)
+++ trunk/include/parrot/inter_call.h	Sat Jan 10 16:07:53 2009
@@ -173,18 +173,30 @@
         FUNC_MODIFIES(*dest_indexes);
 
 PARROT_EXPORT
-void Parrot_pcc_invoke_sub_from_c_args(PARROT_INTERP,
+void Parrot_pcc_invoke_from_sig_object(PARROT_INTERP,
     ARGIN(PMC *sub_obj),
-    ARGIN(const char *sig),
-    ...)
+    ARGIN(PMC *sig_obj))
         __attribute__nonnull__(1)
         __attribute__nonnull__(2)
         __attribute__nonnull__(3);
 
 PARROT_EXPORT
-void Parrot_pcc_invoke_sub_from_sig_object(PARROT_INTERP,
+void Parrot_pcc_invoke_method_from_c_args(PARROT_INTERP,
+    ARGIN(PMC* pmc),
+    ARGMOD(STRING *method_name),
+    ARGIN(const char *signature),
+    ...)
+        __attribute__nonnull__(1)
+        __attribute__nonnull__(2)
+        __attribute__nonnull__(3)
+        __attribute__nonnull__(4)
+        FUNC_MODIFIES(*method_name);
+
+PARROT_EXPORT
+void Parrot_pcc_invoke_sub_from_c_args(PARROT_INTERP,
     ARGIN(PMC *sub_obj),
-    ARGIN(PMC *sig_obj))
+    ARGIN(const char *sig),
+    ...)
         __attribute__nonnull__(1)
         __attribute__nonnull__(2)
         __attribute__nonnull__(3);

Modified: trunk/include/parrot/multidispatch.h
==============================================================================
--- trunk/include/parrot/multidispatch.h	(original)
+++ trunk/include/parrot/multidispatch.h	Sat Jan 10 16:07:53 2009
@@ -60,10 +60,11 @@
 PARROT_WARN_UNUSED_RESULT
 PARROT_CANNOT_RETURN_NULL
 PMC* Parrot_build_sig_object_from_varargs(PARROT_INTERP,
+    ARGIN_NULLOK(PMC* obj),
     ARGIN(const char *sig),
     va_list args)
         __attribute__nonnull__(1)
-        __attribute__nonnull__(2);
+        __attribute__nonnull__(3);
 
 PARROT_EXPORT
 void Parrot_mmd_add_multi_from_c_args(PARROT_INTERP,

Modified: trunk/src/inter_call.c
==============================================================================
--- trunk/src/inter_call.c	(original)
+++ trunk/src/inter_call.c	Sat Jan 10 16:07:53 2009
@@ -2130,13 +2130,23 @@
                 break;
             case 'P':
                 arg_ret_cnt[seen_arrow]++;
-                max_regs[seen_arrow * 4 + REGNO_PMC]++;
+                {
+                    /* Lookahead to see if PMC is marked as invocant */
+                    if (*(++x) == 'i') {
+                        max_regs[REGNO_PMC]++;
+                    }
+                    else {
+                        x--; /* Undo lookahead */
+                        max_regs[seen_arrow * 4 + REGNO_PMC]++;
+                    }
+                }
                 break;
             case 'f':
             case 'n':
             case 's':
             case 'o':
             case 'p':
+            case 'i':
                 break;
             default:
                 Parrot_ex_throw_from_c_args(interp, NULL,
@@ -2165,8 +2175,8 @@
 
 =item C<static void commit_last_arg_sig_object>
 
-Called by Parrot_pcc_invoke_sub_from_sig_object when it reaches the end of each
-arg in the arg signature.  See C<Parrot_pcc_invoke_sub_from_sig_object> for
+Called by Parrot_pcc_invoke_from_sig_object when it reaches the end of each
+arg in the arg signature.  See C<Parrot_pcc_invoke_from_sig_object> for
 signature syntax.
 
 =cut
@@ -2191,7 +2201,22 @@
         case PARROT_ARG_STRING:
             reg_offset = n_regs_used[seen_arrow * 4 + REGNO_STR]++; break;
         case PARROT_ARG_PMC :
-            reg_offset = n_regs_used[seen_arrow * 4 + REGNO_PMC]++; break;
+            if (cur & PARROT_ARG_INVOCANT) {
+                if (seen_arrow == 0 && index == 0) {
+                    n_regs_used[REGNO_PMC]++;
+                    reg_offset = 0;
+                }
+                else {
+                    Parrot_ex_throw_from_c_args(interp, NULL,
+                            EXCEPTION_INVALID_OPERATION,
+                            "Parrot_pcc_invoke: Only the first parameter can be an invocant %d, %d",
+                            seen_arrow, index);
+                }
+            }
+            else {
+                reg_offset = n_regs_used[seen_arrow * 4 + REGNO_PMC]++;
+            }
+            break;
         default:
             Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
                 "Parrot_PCCINVOKE: invalid reg type");
@@ -2218,11 +2243,14 @@
                 break;
             case PARROT_ARG_PMC:
                 CTX_REG_PMC(ctx, reg_offset) = VTABLE_get_pmc_keyed_int(interp, sig_obj, index);
+                if (cur & PARROT_ARG_INVOCANT) {
+                    interp->current_object = CTX_REG_PMC(ctx, reg_offset);
+                }
                 break;
             default:
                 Parrot_ex_throw_from_c_args(interp, NULL,
                     EXCEPTION_INVALID_OPERATION,
-                    "Parrot_pcc_invoke_sub_from_sig_object: invalid reg type");
+                    "Parrot_pcc_invoke_from_sig_object: invalid reg type");
         }
     }
 }
@@ -2282,7 +2310,7 @@
                 default:
                     Parrot_ex_throw_from_c_args(interp, NULL,
                         EXCEPTION_INVALID_OPERATION,
-                        "Parrot_pcc_invoke_sub_from_sig_object: invalid reg type %c!", *x);
+                        "Parrot_pcc_invoke_from_sig_object: invalid reg type %c!", *x);
             }
 
             /* invalidate the CPointer's pointers so that GC doesn't try to
@@ -2365,7 +2393,7 @@
 
 Sets the subroutine arguments in the C<ctx> context, according to the
 signature string C<signature>. Currently this function is only called
-from C<Parrot_pcc_invoke_sub_from_sig_object>, but eventually when
+from C<Parrot_pcc_invoke_from_sig_object>, but eventually when
 things are unified enough it should be called from C<Parrot_PCCINVOKE>
 as well. The only difference currently between the two implementations
 are the calls to C<commit_last_arg_sig_object> and C<commit_last_arg>.
@@ -2434,7 +2462,7 @@
                 default:
                   Parrot_ex_throw_from_c_args(interp, NULL,
                     EXCEPTION_INVALID_OPERATION,
-                    "Parrot_pcc_invoke_sub_from_sig_object: invalid reg type %c!", *x);
+                    "Parrot_pcc_invoke_from_sig_object: invalid reg type %c!", *x);
             }
 
         }
@@ -2446,10 +2474,11 @@
                 case 's': cur |= PARROT_ARG_SLURPY_ARRAY; break;
                 case 'o': cur |= PARROT_ARG_OPTIONAL;     break;
                 case 'p': cur |= PARROT_ARG_OPT_FLAG;     break;
+                case 'i': cur |= PARROT_ARG_INVOCANT;     break;
                 default:
                     Parrot_ex_throw_from_c_args(interp, NULL,
                         EXCEPTION_INVALID_OPERATION,
-                        "Parrot_pcc_invoke_sub_from_sig_object: invalid adverb type %c!", *x);
+                        "Parrot_pcc_invoke_from_sig_object: invalid adverb type %c!", *x);
             }
         }
     }
@@ -2486,10 +2515,10 @@
     PMC *sig_obj;
     va_list args;
     va_start(args, sig);
-    sig_obj = Parrot_build_sig_object_from_varargs(interp, sig, args);
+    sig_obj = Parrot_build_sig_object_from_varargs(interp, PMCNULL, sig, args);
     va_end(args);
 
-    Parrot_pcc_invoke_sub_from_sig_object(interp, sub_obj, sig_obj);
+    Parrot_pcc_invoke_from_sig_object(interp, sub_obj, sig_obj);
     dod_unregister_pmc(interp, sig_obj);
 }
 
@@ -2719,7 +2748,48 @@
 
 /*
 
-=item C<void Parrot_pcc_invoke_sub_from_sig_object>
+=item C<void Parrot_pcc_invoke_method_from_c_args>
+
+Makes a method call given the name of the method and the arguments as a
+C variadic argument list. C<pmc> is the invocant, C<method_name> is the
+string name of the method, C<signature> is a C string describing the
+signature of the invocation, according to the Parrot calling
+conventions.  The variadic argument list contains the input arguments
+followed by the output results in the same order that they appear in the
+function signature.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_invoke_method_from_c_args(PARROT_INTERP, ARGIN(PMC* pmc),
+        ARGMOD(STRING *method_name),
+        ARGIN(const char *signature), ...)
+{
+    PMC *sig_obj;
+    PMC *sub_obj;
+    va_list args;
+    va_start(args, signature);
+    sig_obj = Parrot_build_sig_object_from_varargs(interp, pmc, signature, args);
+    va_end(args);
+
+    /* Find the subroutine object as a named method on pmc */
+    sub_obj = VTABLE_find_method(interp, pmc, method_name);
+    if (PMC_IS_NULL(sub_obj))
+         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_METHOD_NOT_FOUND,
+             "Method '%Ss' not found", method_name);
+
+    /* Invoke the subroutine object with the given CallSignature object */
+    Parrot_pcc_invoke_from_sig_object(interp, sub_obj, sig_obj);
+    dod_unregister_pmc(interp, sig_obj);
+
+}
+
+/*
+
+=item C<void Parrot_pcc_invoke_from_sig_object>
 
 Follows the same conventions as C<Parrot_PCCINVOKE>, but the subroutine object
 to invoke is passed as an argument rather than looked up by name, and the
@@ -2731,7 +2801,7 @@
 
 PARROT_EXPORT
 void
-Parrot_pcc_invoke_sub_from_sig_object(PARROT_INTERP, ARGIN(PMC *sub_obj),
+Parrot_pcc_invoke_from_sig_object(PARROT_INTERP, ARGIN(PMC *sub_obj),
         ARGIN(PMC *sig_obj))
 {
     ASSERT_ARGS(Parrot_pcc_invoke_sub_from_sig_object)
@@ -2798,8 +2868,10 @@
     /* Invoke the function */
     dest = VTABLE_invoke(interp, sub_obj, NULL);
 
-    /* PIR Subs need runops to run their opcodes. */
-    if (sub_obj->vtable->base_type == enum_class_Sub) {
+    /* PIR Subs need runops to run their opcodes. Methods and NCI subs
+     * don't. */
+    if (sub_obj->vtable->base_type == enum_class_Sub
+            && PMC_IS_NULL(interp->current_object)) {
         INTVAL old_core  = interp->run_core;
         opcode_t offset  = dest - interp->code->base.data;
 

Modified: trunk/src/multidispatch.c
==============================================================================
--- trunk/src/multidispatch.c	(original)
+++ trunk/src/multidispatch.c	Sat Jan 10 16:07:53 2009
@@ -297,7 +297,8 @@
 PARROT_WARN_UNUSED_RESULT
 PARROT_CANNOT_RETURN_NULL
 PMC*
-Parrot_build_sig_object_from_varargs(PARROT_INTERP, ARGIN(const char *sig), va_list args)
+Parrot_build_sig_object_from_varargs(PARROT_INTERP, ARGIN_NULLOK(PMC* obj),
+        ARGIN(const char *sig), va_list args)
 {
     ASSERT_ARGS(Parrot_build_sig_object_from_varargs)
     PMC         *type_tuple    = PMCNULL;
@@ -313,6 +314,7 @@
 
     VTABLE_set_string_native(interp, call_object, string_sig);
 
+    /* Process the varargs list */
     for (i = 0; i < sig_len; ++i) {
         const INTVAL type = string_index(interp, string_sig, i);
 
@@ -382,8 +384,17 @@
         }
     }
 
+    /* Check if we have an invocant, and add it to the front of the arguments */
+    if (!PMC_IS_NULL(obj)) {
+        string_sig = string_concat(interp, CONST_STRING(interp, "Pi"), string_sig, 0);
+        VTABLE_set_string_native(interp, call_object, string_sig);
+        VTABLE_unshift_pmc(interp, call_object, obj);
+    }
+
+    /* Build a type_tuple for multiple dispatch */
     type_tuple = Parrot_mmd_build_type_tuple_from_sig_obj(interp, call_object);
     VTABLE_set_pmc(interp, call_object, type_tuple);
+
     return call_object;
 }
 
@@ -414,7 +425,7 @@
 
     va_list args;
     va_start(args, sig);
-    sig_object = Parrot_build_sig_object_from_varargs(interp, sig, args);
+    sig_object = Parrot_build_sig_object_from_varargs(interp, PMCNULL, sig, args);
     va_end(args);
 
     /* Check the cache. */
@@ -442,7 +453,7 @@
             VTABLE_name(interp, sub));
 #endif
 
-    Parrot_pcc_invoke_sub_from_sig_object(interp, sub, sig_object);
+    Parrot_pcc_invoke_from_sig_object(interp, sub, sig_object);
 }
 
 
@@ -862,13 +873,22 @@
                 break;
             case 'P':
             {
-                PMC *pmc_arg = VTABLE_get_pmc_keyed_int(interp, sig_obj, i);
-                if (PMC_IS_NULL(pmc_arg))
-                    VTABLE_set_integer_keyed_int(interp, type_tuple,
-                            i, enum_type_PMC);
-                else
-                    VTABLE_set_integer_keyed_int(interp, type_tuple, i,
-                            VTABLE_type(interp, pmc_arg));
+                INTVAL type_lookahead = string_index(interp, string_sig, (i + 1));
+                if (type_lookahead == 'i') {
+                    if (i != 0)
+                        Parrot_ex_throw_from_c_args(interp, NULL,
+                            EXCEPTION_INVALID_OPERATION,
+                            "Multiple Dispatch: only the first argument can be an invocant");
+                }
+                else {
+                    PMC *pmc_arg = VTABLE_get_pmc_keyed_int(interp, sig_obj, i);
+                    if (PMC_IS_NULL(pmc_arg))
+                        VTABLE_set_integer_keyed_int(interp, type_tuple,
+                                i, enum_type_PMC);
+                    else
+                        VTABLE_set_integer_keyed_int(interp, type_tuple, i,
+                                VTABLE_type(interp, pmc_arg));
+                }
 
                 break;
             }



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About