diff --git a/build/Makefile.in b/build/Makefile.in index a57996f9175..b66a8d57102 100644 --- a/build/Makefile.in +++ b/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) diff --git a/src/ops/perl6.ops b/src/ops/perl6.ops index 1c88ba46fdd..300ec715829 100644 --- a/src/ops/perl6.ops +++ b/src/ops/perl6.ops @@ -7,6 +7,8 @@ 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 @@ -14,7 +16,8 @@ BEGIN_OPS_PREAMBLE /* 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" diff --git a/src/pmc/p6lowlevelsig.pmc b/src/pmc/p6lowlevelsig.pmc index e3c2306078f..09a8217dec7 100644 --- a/src/pmc/p6lowlevelsig.pmc +++ b/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" /* diff --git a/src/pmc/sigguts.h b/src/pmc/sigguts.h new file mode 100644 index 00000000000..a86fc803aae --- /dev/null +++ b/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;