Add in ops that allow for fast construction of low level signatures.

build/Makefile.in

@@ -189,7 +189,7 @@ CLEANUPS = \
   $(DYNEXT_DIR)/*$(LOAD_EXT) \
   src/gen_*.pir \
   src/gen_*.pm \
-  $(PMC_DIR)/*.h \
+  $(PMC_DIR)/pmc_*.h \
   $(PMC_DIR)/*.c \
   $(PMC_DIR)/*.dump \
   $(PMC_DIR)/*$(O) \
@@ -417,7 +417,7 @@ $(DYNEXT_TARGET): $(DYNPMC) $(DYNOPS)
 # spaces and some compilers/linkers forbid a (forced) space.
 # See RT #66558 and TT #700.
 
-$(DYNPMC): $(PMC_SOURCES)
+$(DYNPMC): $(PMC_SOURCES) src/pmc/sigguts.h
 	$(PMC2C) --no-lines --dump $(PMC2C_INCLUDES) src/pmc/objectref.pmc
 	$(PMC2C) --no-lines --dump $(PMC2C_INCLUDES) $(PMC_SOURCES)
 	$(PMC2C) --no-lines --c $(PMC2C_INCLUDES) $(PMC_SOURCES)
@@ -426,12 +426,12 @@ $(DYNPMC): $(PMC_SOURCES)
 	cd $(PMC_DIR) && $(CC) -c $(CINCLUDES) $(CFLAGS) *.c
 	$(LD) @ld_out@$(DYNPMC) $(GROUP)$(O) src/pmc/*$(O) $(LINKARGS)
 
-$(OPS_DIR)/$(OPS)$(LOAD_EXT): $(OPS_DIR)/$(OPS_SOURCE)
+$(OPS_DIR)/$(OPS)$(LOAD_EXT): $(OPS_DIR)/$(OPS_SOURCE) src/pmc/sigguts.h
 	cd $(OPS_DIR) && $(OPS2C) C --dynamic $(OPS_SOURCE)
 	cd $(OPS_DIR) && $(CC) -c @cc_o_out@$(OPS)$(O) $(CINCLUDES) $(CFLAGS) $(OPS).c
 	cd $(OPS_DIR) && $(LD) @ld_out@$(OPS)$(LOAD_EXT) $(OPS)$(O) $(LINKARGS)
 
-$(OPS_DIR)/$(OPS)_switch$(LOAD_EXT): $(OPS_DIR)/$(OPS_SOURCE)
+$(OPS_DIR)/$(OPS)_switch$(LOAD_EXT): $(OPS_DIR)/$(OPS_SOURCE) src/pmc/sigguts.h
 	cd $(OPS_DIR) && $(OPS2C) CSwitch --dynamic $(OPS_SOURCE)
 	cd $(OPS_DIR) && $(CC) -c @cc_o_out@$(OPS)_switch$(O) $(CINCLUDES) $(CFLAGS) $(OPS)_switch.c
 	cd $(OPS_DIR) && $(LD) @ld_out@$(OPS)_switch$(LOAD_EXT) $(OPS)_switch$(O) $(LINKARGS)

src/ops/perl6.ops

@@ -7,14 +7,17 @@ BEGIN_OPS_PREAMBLE
 
 #include "parrot/dynext.h"
 #include "pmc_object.h"
+#include "../pmc/pmc_p6lowlevelsig.h"
+#include "../pmc/sigguts.h"
 
 #if PARROT_HAS_ICU
 #  include <unicode/uchar.h>
 #endif
 
 /* We cache a couple of type IDs for an op that we hit on every method call. */
 static INTVAL p6s_id = 0;
-static INTVAL or_id = 0;
+static INTVAL or_id  = 0;
+static INTVAL lls_id = 0;
 
 END_OPS_PREAMBLE
 
@@ -377,6 +380,166 @@ inline op descalarref(out PMC, in PMC) :base_core {
     goto NEXT();
 }
 
+
+/*
+
+=item allocate_signature(out PMC, in INT)
+
+Sets $1 to be a P6LowLevelSig with $2 signature elements allocated.
+
+=cut
+
+*/
+inline op allocate_signature(out PMC, in INT) :base_core {
+    struct llsig_element **elements;
+    INTVAL i;
+
+    /* Create new low level signature PMC. */
+    if (!lls_id)
+        lls_id = pmc_type(interp, string_from_literal(interp, "P6LowLevelSig"));
+    $1 = pmc_new(interp, lls_id);
+
+    /* Allocate required amount of structs. */
+    elements = mem_sys_allocate(($2 + 1) * sizeof(llsig_element *));
+    for (i = 0; i < $2; i++)
+        elements[i] = mem_sys_allocate_zeroed(sizeof(llsig_element));
+    elements[$2] = NULL;
+    SETATTR_P6LowLevelSig_elements(interp, $1, elements);
+
+    /* Stash size. */
+    SETATTR_P6LowLevelSig_num_elements(interp, $1, $2);
+
+    goto NEXT();
+}
+
+
+/*
+
+=item get_signature_size(out INT, in PMC)
+
+Sets $1 to be the number of elements the P6LowLevelSig $2 has.
+
+=cut
+
+*/
+inline op get_signature_size(out INT, in PMC) :base_core {
+    if (!lls_id)
+        lls_id = pmc_type(interp, string_from_literal(interp, "P6LowLevelSig"));
+    if ($2->vtable->base_type == lls_id) {
+        INTVAL num_elements;
+        GETATTR_P6LowLevelSig_num_elements(interp, $2, num_elements);
+        $1 = num_elements;
+        goto NEXT();
+    }
+    else {
+        opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
+                EXCEPTION_INVALID_OPERATION, "get_signature_size only works on P6LowLevelSig PMCs");
+        goto ADDRESS(handler);
+    }
+}
+
+
+/*
+
+=item set_signature_elem(in PMC, in INT, in STR, in INT, inout PMC, inout PMC, inout PMC, inout PMC, inout PMC)
+
+Takes $1 (a P6LowLevelSig) and sets the contents of the signature element with
+index $2 as follows:
+
+  $3 = lexical name to bind to
+  $4 = flags
+  $5 = main (nominal) type
+  $6 = constraint type or junction of constraint types; null if none
+  $7 = array of names for a named parameter (non-null PMC for named slurpy)
+  $8 = array of type captures
+
+=cut
+
+*/
+inline op set_signature_elem(in PMC, in INT, in STR, in INT, inout PMC, inout PMC, inout PMC, inout PMC) :base_core {
+    if (!lls_id)
+        lls_id = pmc_type(interp, string_from_literal(interp, "P6LowLevelSig"));
+    if ($1->vtable->base_type == lls_id) {
+        struct llsig_element **elements;
+        INTVAL num_elements;
+
+        /* Check we're not out of range. */
+        GETATTR_P6LowLevelSig_elements(interp, $1, elements);
+        GETATTR_P6LowLevelSig_num_elements(interp, $1, num_elements);
+        if ($2 < num_elements) {
+            struct llsig_element *element = elements[$2];
+            element->variable_name    = $3;
+            element->flags            = $4;
+            element->nominal_type     = $5;
+            element->post_constraints = $6;
+            element->named_names      = $7;
+            element->type_captures    = $8;
+            goto NEXT();
+        }
+        else {
+            opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
+                    EXCEPTION_INVALID_OPERATION, "signature element out of range in set_signature_elem");
+            goto ADDRESS(handler);
+        }
+    }
+    else {
+        opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
+                EXCEPTION_INVALID_OPERATION, "set_signature_elem only works on P6LowLevelSig PMCs");
+        goto ADDRESS(handler);
+    }
+}
+
+
+/*
+
+=item get_signature_elem(in PMC, in INT, out STR, out INT, out PMC, out PMC, out PMC, out PMC, out PMC)
+
+Takes $1 (a P6LowLevelSig) and sets the registers with the contents of the
+signature element with index $2 as follows:
+
+  $3 = lexical name to bind to
+  $4 = flags
+  $5 = main (nominal) type
+  $6 = constraint type or junction of constraint types; null if none
+  $7 = array of names for a named parameter (non-null PMC for named slurpy)
+  $8 = array of type captures
+
+=cut
+
+*/
+inline op get_signature_elem(in PMC, in INT, out STR, out INT, out PMC, out PMC, out PMC, out PMC) :base_core {
+    if (!lls_id)
+        lls_id = pmc_type(interp, string_from_literal(interp, "P6LowLevelSig"));
+    if ($1->vtable->base_type == lls_id) {
+        struct llsig_element **elements;
+        INTVAL num_elements;
+
+        /* Check we're not out of range. */
+        GETATTR_P6LowLevelSig_elements(interp, $1, elements);
+        GETATTR_P6LowLevelSig_num_elements(interp, $1, num_elements);
+        if ($2 < num_elements) {
+            struct llsig_element *element = elements[$2];
+            $3 = element->variable_name;
+            $4 = element->flags;
+            $5 = element->nominal_type;
+            $6 = element->post_constraints;
+            $7 = element->named_names;
+            $8 = element->type_captures;
+            goto NEXT();
+        }
+        else {
+            opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
+                    EXCEPTION_INVALID_OPERATION, "signature element out of range in set_signature_elem");
+            goto ADDRESS(handler);
+        }
+    }
+    else {
+        opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
+                EXCEPTION_INVALID_OPERATION, "get_signature_elem only works on P6LowLevelSig PMCs");
+        goto ADDRESS(handler);
+    }
+}
+
 /*
  * Local variables:
  *   c-file-style: "parrot"

src/pmc/p6lowlevelsig.pmc

@@ -10,38 +10,6 @@ src/pmc/p6lowlevelsig.pmc - Perl 6 Low Level Signature PMC
 
 This PMC stores the low-level representation of a Perl 6 signature.
 
-*/
-
-
-/* Flags that can be set on a signature element. */
-#define SIG_ELEM_BIND_CAPTURE      1
-#define SIG_ELEM_BIND_PRIVATE_ATTR 2
-#define SIG_ELEM_BIND_PUBLIC_ATTR  4
-#define SIG_ELEM_SLURPY_POS        8
-#define SIG_ELEM_SLURPY_NAMED      16
-#define SIG_ELEM_SLURPY_BLOCK      32
-#define SIG_ELEM_INVOCANT          64
-#define SIG_ELEM_MULTI_INVOCANT    128
-#define SIG_ELEM_IS_RW             256
-#define SIG_ELEM_IS_COPY           512
-#define SIG_ELEM_IS_REF            1024
-
-
-/* Data structure to describe a single element in the signature. */
-typedef struct llsig_element {
-    STRING *variable_name;    /* The name in the lexpad to bind to, if any. */
-    PMC    *named_names;      /* List of the name(s) that a named parameter has,
-                               * or just non-null to mark a named slurpy. */
-    PMC    *type_captures;    /* Name(s) that we bind the type of a parameter to. */
-    INTVAL flags;             /* Various flags about the parameter. */
-    PMC    *nominal_type;     /* The nominal type of the parameter. */
-    PMC    *post_constraints; /* Junction of any extra constraints. */
-    PMC    *sub_signature;    /* Any nested signature. */
-} llsig_element;
-
-
-/*
-
 =back
 
 =head1 FUNCTIONS
@@ -53,7 +21,7 @@ from the outside.
 
 */
 
-
+#include "sigguts.h"
 
 /*
 

src/pmc/sigguts.h

@@ -0,0 +1,25 @@
+/* Flags that can be set on a signature element. */
+#define SIG_ELEM_BIND_CAPTURE      1
+#define SIG_ELEM_BIND_PRIVATE_ATTR 2
+#define SIG_ELEM_BIND_PUBLIC_ATTR  4
+#define SIG_ELEM_SLURPY_POS        8
+#define SIG_ELEM_SLURPY_NAMED      16
+#define SIG_ELEM_SLURPY_BLOCK      32
+#define SIG_ELEM_INVOCANT          64
+#define SIG_ELEM_MULTI_INVOCANT    128
+#define SIG_ELEM_IS_RW             256
+#define SIG_ELEM_IS_COPY           512
+#define SIG_ELEM_IS_REF            1024
+
+
+/* Data structure to describe a single element in the signature. */
+typedef struct llsig_element {
+    STRING *variable_name;    /* The name in the lexpad to bind to, if any. */
+    PMC    *named_names;      /* List of the name(s) that a named parameter has,
+                               * or just non-null to mark a named slurpy. */
+    PMC    *type_captures;    /* Name(s) that we bind the type of a parameter to. */
+    INTVAL flags;             /* Various flags about the parameter. */
+    PMC    *nominal_type;     /* The nominal type of the parameter. */
+    PMC    *post_constraints; /* Junction of any extra constraints. */
+    PMC    *sub_signature;    /* Any nested signature. */
+} llsig_element;