2 Copyright (C) 2001-2009, Parrot Foundation.
7 src/pmc/sub.pmc - Subroutine
11 These are the vtable functions for the Sub (subroutine) base class
21 #include "parrot/oplib/ops.h"
25 print_sub_name(PARROT_INTERP, ARGIN_NULLOK(PMC *sub))
27 Interp * const tracer = (interp->pdb && interp->pdb->debugger) ?
28 interp->pdb->debugger :
31 /* sub was located via globals */
32 Parrot_io_eprintf(tracer, "# Calling sub '%Ss'\n# ",
33 Parrot_full_sub_name(interp, sub));
35 print_pbc_location(interp);
38 pmclass Sub auto_attrs {
39 ATTR PackFile_ByteCode *seg; /* bytecode segment */
40 ATTR size_t start_offs; /* sub entry in ops from seg->base.data */
43 ATTR INTVAL HLL_id; /* see src/hll.c XXX or per segment? */
44 ATTR PMC *namespace_name; /* where this Sub is in - this is either
45 * a String or a [Key] and describes
46 * the relative path in the NameSpace
48 ATTR PMC *namespace_stash; /* the actual hash, HLL::namespace */
49 ATTR STRING *name; /* name of the sub */
50 ATTR STRING *method_name; /* method name of the sub */
51 ATTR STRING *ns_entry_name; /* ns entry name of the sub */
52 ATTR STRING *subid; /* The ID of the sub. */
53 ATTR INTVAL vtable_index; /* index in Parrot_vtable_slot_names */
54 ATTR PMC *multi_signature; /* list of types for MMD */
55 ATTR INTVAL n_regs_used[4]; /* INSP in PBC */
57 ATTR PMC *lex_info; /* LexInfo PMC */
58 ATTR PMC *outer_sub; /* :outer for closures */
59 ATTR PMC *eval_pmc; /* eval container / NULL */
60 ATTR PMC *ctx; /* the context this sub is in */
61 ATTR UINTVAL comp_flags; /* compile time and additional flags */
62 ATTR Parrot_sub_arginfo *arg_info;/* Argument counts and flags. */
65 ATTR PMC *outer_ctx; /* outer context, if a closure */
71 Initializes the subroutine.
78 * Sub PMC's flags usage:
79 * - private0 ... Coroutine flip/flop - C exception handler
80 * - private1 ... _IS_OUTER - have to preserve context
81 * as some other sub has :outer(this)
82 * - private2 ... tailcall invoked this Sub
83 * - private3 ... pythonic coroutine generator flag
84 * - private4 ... :main (originally @MAIN)
85 * - private5 ... :load (originally @LOAD)
86 * - private6 ... :immediate (originally @IMMEDIATE)
87 * - private7 ... :postcomp (originally @POSTCOMP)
89 * see also the enum in include/parrot/sub.h
92 Parrot_Sub_attributes * const attrs =
93 (Parrot_Sub_attributes *) PMC_data(SELF);
95 attrs->seg = INTERP->code;
97 PObj_custom_mark_destroy_SETALL(SELF);
102 =item C<void destroy()>
104 Destroys the subroutine.
110 VTABLE void destroy() {
111 Parrot_Sub_attributes *sub = PARROT_SUB(SELF);
115 mem_sys_free(sub->arg_info);
121 =item C<STRING *get_string()>
123 Returns the name of the subroutine.
125 =item C<void set_string_native(STRING *subname)>
127 Sets the name of the subroutine.
133 VTABLE STRING *get_string() {
135 Parrot_Sub_attributes *sub;
136 PMC_get_sub(INTERP, SELF, sub);
139 return Parrot_str_copy(INTERP, sub->name);
144 VTABLE void set_string_native(STRING *subname) {
145 Parrot_Sub_attributes *sub;
146 PMC_get_sub(INTERP, SELF, sub);
147 sub->name = Parrot_str_copy(INTERP, subname);
152 =item C<void set_pointer(void *value)>
154 Sets the pointer to the actual subroutine.
156 *** Don't use that - use C<.const 'Sub'> in PIR instead ***
162 VTABLE void set_pointer(void *value) {
164 Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
165 "Don't set the address of a sub\nuse .const 'Sub' instead");
170 =item C<void *get_pointer()>
172 Returns the address of the actual subroutine.
178 VTABLE void *get_pointer() {
179 Parrot_Sub_attributes *sub;
180 PMC_get_sub(INTERP, SELF, sub);
181 return sub->seg->base.data + sub->start_offs;
186 =item C<INTVAL get_integer_keyed(PMC *key)>
188 I<This just unconditionally returns the start of bytecode. It's wrong,
189 wrong, wrong, *WRONG*. And there's no other good way, so it's here for
196 VTABLE INTVAL get_integer_keyed(PMC *key) {
197 Parrot_Sub_attributes *sub;
199 PMC_get_sub(INTERP, SELF, sub);
201 return (INTVAL) (sub->seg->base.data);
206 =item C<INTVAL defined()>
208 =item C<INTVAL get_bool()>
216 VTABLE INTVAL defined() {
220 VTABLE INTVAL get_bool() {
226 =item C<opcode_t *invoke(void *next)>
228 Invokes the subroutine.
234 VTABLE opcode_t *invoke(void *next) {
235 Parrot_Sub_attributes *sub;
241 PMC_get_sub(INTERP, SELF, sub);
242 if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG))
243 print_sub_name(INTERP, SELF);
246 * A remark WRT tail calls
257 * that is the sub B() returns whatever C() returns.
259 * We are just calling the sub C().
260 * If the private2 flag is set, this code is called by a
263 * We allocate a new register frame and recycle it
264 * immediately after argument passing.
267 pc = sub->seg->base.data + sub->start_offs;
268 caller_ctx = CURRENT_CONTEXT(interp);
269 ccont = INTERP->current_cont;
270 INTERP->current_cont = NULL;
272 if (ccont == NEED_CONTINUATION)
273 ccont = new_ret_continuation_pmc(interp, (opcode_t *)next);
275 PARROT_ASSERT(!PMC_IS_NULL(ccont));
277 /* plain subroutine call
278 * create new context, place it in interpreter */
279 context = Parrot_set_new_context(INTERP, sub->n_regs_used);
280 Parrot_pcc_set_sub(interp, context, SELF);
281 Parrot_pcc_set_caller_ctx(interp, context, caller_ctx);
282 Parrot_pcc_set_pc(interp, context, pc);
283 Parrot_pcc_set_continuation(interp, context, ccont);
285 /* check recursion/call depth */
286 if (Parrot_pcc_inc_recursion_depth(INTERP, context) > INTERP->recursion_limit)
287 Parrot_ex_throw_from_c_args(INTERP, next, CONTROL_ERROR,
288 "maximum recursion depth exceeded");
290 /* and copy set context variables */
291 PARROT_CONTINUATION(ccont)->from_ctx = context;
293 /* if this is an outer sub, then we need to set sub->ctx
294 * to the new context (refcounted) and convert the
295 * retcontinuation to a normal continuation. */
296 if (PObj_get_FLAGS(SELF) & SUB_FLAG_IS_OUTER) {
298 /* convert retcontinuation to a continuation */
299 ccont->vtable = interp->vtables[enum_class_Continuation];
302 if (!PMC_IS_NULL(INTERP->current_object)) {
303 Parrot_pcc_set_object(interp, context, INTERP->current_object);
304 INTERP->current_object = NULL;
307 Parrot_pcc_set_HLL(interp, context, sub->HLL_id);
308 Parrot_pcc_set_namespace(interp, context, sub->namespace_stash);
310 /* create pad if needed
311 * TODO move this up in front of argument passing
312 * and factor out common code with coroutine pmc
314 if (!PMC_IS_NULL(sub->lex_info)) {
315 Parrot_pcc_set_lex_pad(interp, context, pmc_new_init(INTERP,
316 Parrot_get_ctx_HLL_type(interp, enum_class_LexPad),
318 VTABLE_set_pointer(INTERP, Parrot_pcc_get_lex_pad(interp, context), context);
321 if (!PMC_IS_NULL(sub->outer_ctx)) {
322 /* set outer context */
323 Parrot_pcc_set_outer_ctx(interp, context, sub->outer_ctx);
328 PMC *outer_c = Parrot_pcc_get_outer_ctx(interp, c);
329 for (c = context; PMC_IS_NULL(outer_c); c = outer_c) {
332 Parrot_Sub_attributes *current_sub, *outer_sub;
334 PMC_get_sub(INTERP, Parrot_pcc_get_sub(interp, c), current_sub);
335 outer_pmc = current_sub->outer_sub;
337 if (PMC_IS_NULL(outer_pmc))
340 PMC_get_sub(INTERP, outer_pmc, outer_sub);
342 if (PMC_IS_NULL(outer_sub->ctx)) {
343 PMC * const dummy = Parrot_alloc_context(INTERP,
344 outer_sub->n_regs_used, NULL);
345 Parrot_pcc_set_sub(interp, dummy, outer_pmc);
347 if (!PMC_IS_NULL(outer_sub->lex_info)) {
348 Parrot_pcc_set_lex_pad(interp, dummy, pmc_new_init(INTERP,
349 Parrot_get_ctx_HLL_type(interp, enum_class_LexPad),
350 outer_sub->lex_info));
351 VTABLE_set_pointer(INTERP, Parrot_pcc_get_lex_pad(interp, dummy), dummy);
354 if (!PMC_IS_NULL(outer_sub->outer_ctx))
355 Parrot_pcc_set_outer_ctx(interp, dummy, outer_sub->outer_ctx);
356 outer_sub->ctx = dummy;
359 Parrot_pcc_set_outer_ctx(interp, c, outer_sub->ctx);
360 outer_c = outer_sub->ctx;
364 /* switch code segment if needed */
365 if (INTERP->code != sub->seg)
366 Parrot_switch_to_cs(INTERP, sub->seg, 1);
368 if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL) {
369 if (!(*pc == PARROT_OP_get_params_pc
370 || (*pc == PARROT_OP_push_eh_ic
371 && pc[2] == PARROT_OP_get_params_pc))) {
373 /* TODO keep it or resize it */
374 Parrot_pcc_dec_recursion_depth(INTERP, context);
376 PObj_get_FLAGS(ccont) &= ~SUB_FLAG_TAILCALL;
377 Parrot_pcc_set_caller_ctx(interp, context,
378 Parrot_pcc_get_caller_ctx(interp, caller_ctx));
387 =item C<PMC *clone()>
389 Creates and returns a clone of the subroutine.
395 VTABLE PMC *clone() {
396 PMC * const ret = pmc_new(INTERP, SELF->vtable->base_type);
397 Parrot_Sub_attributes *dest_sub;
398 Parrot_Sub_attributes *sub;
401 /* we have to mark it ourselves */
402 PObj_custom_mark_destroy_SETALL(ret);
404 PMC_get_sub(INTERP, SELF, dest_sub);
405 PMC_get_sub(INTERP, ret, sub);
407 /* first set the sub struct, Parrot_str_copy may cause GC */
411 sub->name = Parrot_str_copy(INTERP, sub->name);
413 /* Be sure not to share arg_info. */
414 dest_sub->arg_info = NULL;
421 =item C<void assign_pmc(PMC *other)>
423 Set SELF to the data in other.
429 VTABLE void set_pmc(PMC *other) {
430 SELF.assign_pmc(other);
433 VTABLE void assign_pmc(PMC *other) {
434 /* only handle the case where the other PMC is the same type */
435 if (other->vtable->base_type == SELF->vtable->base_type) {
436 Parrot_Sub_attributes *my_sub;
437 Parrot_Sub_attributes *other_sub;
439 PMC_get_sub(INTERP, SELF, my_sub);
440 PMC_get_sub(INTERP, other, other_sub);
442 /* copy the sub struct */
443 memmove(my_sub, other_sub, sizeof (Parrot_Sub_attributes));
445 /* copy the name so it's a different string in memory */
447 my_sub->name = Parrot_str_copy(INTERP, my_sub->name);
450 Parrot_ex_throw_from_c_args(INTERP, NULL,
451 EXCEPTION_INVALID_OPERATION,
452 "Can't assign a non-Sub type to a Sub");
459 Marks the sub as live.
466 Parrot_Sub_attributes *sub = PARROT_SUB(SELF);
472 Parrot_gc_mark_PObj_alive(INTERP, (PObj *) sub->name);
473 if (sub->method_name)
474 Parrot_gc_mark_PObj_alive(INTERP, (PObj *) sub->method_name);
475 if (sub->ns_entry_name)
476 Parrot_gc_mark_PObj_alive(INTERP, (PObj *) sub->ns_entry_name);
477 if (!PMC_IS_NULL(sub->namespace_name))
478 Parrot_gc_mark_PObj_alive(INTERP, (PObj *) sub->namespace_name);
479 if (!PMC_IS_NULL(sub->namespace_stash))
480 Parrot_gc_mark_PObj_alive(INTERP, (PObj *) sub->namespace_stash);
481 if (!PMC_IS_NULL(sub->multi_signature))
482 Parrot_gc_mark_PObj_alive(INTERP, (PObj *) sub->multi_signature);
483 if (!PMC_IS_NULL(sub->lex_info))
484 Parrot_gc_mark_PObj_alive(INTERP, (PObj *) sub->lex_info);
485 if (!PMC_IS_NULL(sub->outer_sub))
486 Parrot_gc_mark_PObj_alive(INTERP, (PObj *) sub->outer_sub);
487 if (!PMC_IS_NULL(sub->eval_pmc))
488 Parrot_gc_mark_PObj_alive(INTERP, (PObj *) sub->eval_pmc);
490 Parrot_gc_mark_PObj_alive(INTERP, (PObj *) sub->subid);
492 Parrot_gc_mark_PObj_alive(interp, (PObj *) sub->ctx);
494 Parrot_gc_mark_PObj_alive(interp, (PObj *) sub->outer_ctx);
499 =item C<INTVAL is_equal(PMC *value)>
501 Returns whether the two subroutines are equal.
507 MULTI INTVAL is_equal(PMC *value) {
508 Parrot_Sub_attributes *my_sub;
509 Parrot_Sub_attributes *value_sub;
511 PMC_get_sub(INTERP, SELF, my_sub);
512 PMC_get_sub(INTERP, value, value_sub);
514 return SELF->vtable == value->vtable
515 && (my_sub)->start_offs == (value_sub)->start_offs
516 && (my_sub)->seg == (value_sub)->seg;
521 =item C<void visit(visit_info *info)>
523 This is used by freeze/thaw to visit the contents of the sub.
525 =item C<void freeze(visit_info *info)>
527 Archives the subroutine.
533 VTABLE void visit(visit_info *info) {
534 Parrot_Sub_attributes *sub;
536 PMC_get_sub(INTERP, SELF, sub);
538 info->thaw_ptr = &sub->namespace_name;
539 (info->visit_pmc_now)(INTERP, sub->namespace_name, info);
541 info->thaw_ptr = &sub->multi_signature;
542 (info->visit_pmc_now)(INTERP, sub->multi_signature, info);
544 info->thaw_ptr = &sub->outer_sub;
545 (info->visit_pmc_now)(INTERP, sub->outer_sub, info);
548 * XXX visit_pmc_now is wrong, because it breaks
549 * depth-first visit inside the todo list
550 * TODO change all user visit functions to use
551 * visit_pmc (the todo renamed visit_pm_later)
553 * Therefore the hash must be last during visit for now.
555 info->thaw_ptr = &sub->lex_info;
556 (info->visit_pmc_now)(INTERP, sub->lex_info, info);
560 VTABLE void freeze(visit_info *info) {
561 IMAGE_IO * const io = info->image_io;
562 Parrot_Sub_attributes *sub;
567 PMC_get_sub(INTERP, SELF, sub);
569 * we currently need to write these items:
570 * - start offset in byte-code segment
571 * - end offset in byte-code segment
573 * - flags (i.e. :load pragma and such)
574 * - name of the sub's label
586 VTABLE_push_integer(INTERP, io, (INTVAL) sub->start_offs);
587 VTABLE_push_integer(INTERP, io, (INTVAL) sub->end_offs);
588 VTABLE_push_integer(INTERP, io,
589 (INTVAL)(PObj_get_FLAGS(pmc) & SUB_FLAG_PF_MASK));
591 VTABLE_push_string(INTERP, io, sub->name);
593 if (!sub->method_name)
594 sub->method_name = CONST_STRING(INTERP, "");
595 VTABLE_push_string(INTERP, io, sub->method_name);
597 if (!sub->ns_entry_name)
598 sub->ns_entry_name = CONST_STRING(INTERP, "");
599 VTABLE_push_string(INTERP, io, sub->ns_entry_name);
601 hll_name = Parrot_get_HLL_name(INTERP, sub->HLL_id);
603 hll_name = CONST_STRING(INTERP, "");
604 VTABLE_push_string(INTERP, io, hll_name);
606 VTABLE_push_integer(INTERP, io, (INTVAL)sub->comp_flags);
607 VTABLE_push_integer(INTERP, io, sub->vtable_index);
609 for (i = 0; i < 4; ++i)
610 VTABLE_push_integer(INTERP, io, sub->n_regs_used[i]);
613 sub->subid = CONST_STRING(INTERP, "");
614 VTABLE_push_string(INTERP, io, sub->subid);
619 =item C<void thaw(visit_info *info)>
621 Unarchives the subroutine.
627 VTABLE void thaw(visit_info *info) {
628 IMAGE_IO * const io = info->image_io;
631 if (info->extra_flags == EXTRA_IS_NULL) {
632 Parrot_Sub_attributes *sub;
636 PMC_get_sub(INTERP, SELF, sub);
638 /* we get relative offsets */
639 sub->start_offs = (size_t) VTABLE_shift_integer(INTERP, io);
640 sub->end_offs = (size_t) VTABLE_shift_integer(INTERP, io);
641 flags = VTABLE_shift_integer(INTERP, io);
643 PObj_get_FLAGS(SELF) |= flags & SUB_FLAG_PF_MASK;
645 sub->name = VTABLE_shift_string(INTERP, io);
646 sub->method_name = VTABLE_shift_string(INTERP, io);
647 sub->ns_entry_name = VTABLE_shift_string(INTERP, io);
648 sub->HLL_id = Parrot_get_HLL_id(INTERP,
649 VTABLE_shift_string(INTERP, io));
650 sub->comp_flags = VTABLE_shift_integer(INTERP, io);
651 sub->vtable_index = VTABLE_shift_integer(INTERP, io);
653 for (i = 0; i < 4; ++i)
654 sub->n_regs_used[i] = VTABLE_shift_integer(INTERP, io);
656 sub->subid = VTABLE_shift_string(INTERP, io);
662 =item C<PMC *inspect()>
664 Returns the full set of meta-data about the sub.
670 VTABLE PMC *inspect()
672 /* Create a hash, then use inspect_str to get all of the data to
673 * fill it up with. */
674 PMC * const metadata = pmc_new(interp, enum_class_Hash);
675 STRING * const pos_required_str = CONST_STRING(interp, "pos_required");
676 STRING * const pos_optional_str = CONST_STRING(interp, "pos_optional");
677 STRING * const named_required_str = CONST_STRING(interp, "named_required");
678 STRING * const named_optional_str = CONST_STRING(interp, "named_optional");
679 STRING * const pos_slurpy_str = CONST_STRING(interp, "pos_slurpy");
680 STRING * const named_slurpy_str = CONST_STRING(interp, "named_slurpy");
682 VTABLE_set_pmc_keyed_str(interp, metadata, pos_required_str,
683 VTABLE_inspect_str(interp, SELF, pos_required_str));
685 VTABLE_set_pmc_keyed_str(interp, metadata, pos_optional_str,
686 VTABLE_inspect_str(interp, SELF, pos_optional_str));
688 VTABLE_set_pmc_keyed_str(interp, metadata, named_required_str,
689 VTABLE_inspect_str(interp, SELF, named_required_str));
691 VTABLE_set_pmc_keyed_str(interp, metadata, named_optional_str,
692 VTABLE_inspect_str(interp, SELF, named_optional_str));
694 VTABLE_set_pmc_keyed_str(interp, metadata, pos_slurpy_str,
695 VTABLE_inspect_str(interp, SELF, pos_slurpy_str));
697 VTABLE_set_pmc_keyed_str(interp, metadata, named_slurpy_str,
698 VTABLE_inspect_str(interp, SELF, named_slurpy_str));
705 =item C<PMC *inspect_str(STRING *what)>
707 Returns the specified item of metadata about the sub. Allowable
714 The number of required positional arguments
718 The number of optional positional arguments
722 The number of required named arguments
726 The number of optional named arguments
730 1 if it takes slurpy positional arguments, 0 if not
734 1 if it takes slurpy named arguments, 0 if not
742 VTABLE PMC *inspect_str(STRING *what)
744 Parrot_Sub_attributes *sub;
746 INTVAL count_found = -1;
748 PMC_get_sub(INTERP, SELF, sub);
750 /* If the argument info hasn't been generated yet, generate it. */
751 if (!sub->arg_info) {
752 /* Get pointer into the bytecode where this sub starts. */
753 const opcode_t *pc = sub->seg->base.data + sub->start_offs;
755 /* Allocate structure to store argument information in. */
756 sub->arg_info = mem_allocate_zeroed_typed(Parrot_sub_arginfo);
758 /* If the first instruction is a get_params... */
759 if (*pc == PARROT_OP_get_params_pc) {
763 /* Get the signature (the next thing in the bytecode). */
765 sig = PF_CONST(sub->seg, *pc)->u.key;
768 /* Iterate over the signature and compute argument counts. */
769 sig_length = VTABLE_elements(INTERP, sig);
771 for (i = 0; i < sig_length; i++) {
772 int sig_item = VTABLE_get_integer_keyed_int(INTERP, sig, i);;
773 if (PARROT_ARG_SLURPY_ARRAY_ISSET(sig_item)){
774 if (PARROT_ARG_NAME_ISSET(sig_item))
775 sub->arg_info->named_slurpy = 1;
777 sub->arg_info->pos_slurpy = 1;
779 else if (PARROT_ARG_NAME_ISSET(sig_item)) {
781 sig_item = VTABLE_get_integer_keyed_int(INTERP, sig, i);;
782 if (PARROT_ARG_OPTIONAL_ISSET(sig_item))
783 sub->arg_info->named_optional++;
785 sub->arg_info->named_required++;
787 else if (!PARROT_ARG_OPT_FLAG_ISSET(sig_item)) {
788 if (PARROT_ARG_OPTIONAL_ISSET(sig_item))
789 sub->arg_info->pos_optional++;
791 sub->arg_info->pos_required++;
797 /* Return the argument information that was requested. */
798 if (Parrot_str_equal(interp, what, CONST_STRING(interp, "pos_required"))) {
799 count_found = (INTVAL)sub->arg_info->pos_required;
801 else if (Parrot_str_equal(interp, what, CONST_STRING(interp, "pos_optional"))) {
802 count_found = (INTVAL)sub->arg_info->pos_optional;
804 else if (Parrot_str_equal(interp, what, CONST_STRING(interp, "pos_slurpy"))) {
805 count_found = (INTVAL)sub->arg_info->pos_slurpy;
807 else if (Parrot_str_equal(interp, what, CONST_STRING(interp, "named_required"))) {
808 count_found = (INTVAL)sub->arg_info->named_required;
810 else if (Parrot_str_equal(interp, what, CONST_STRING(interp, "named_optional"))) {
811 count_found = (INTVAL)sub->arg_info->named_optional;
813 else if (Parrot_str_equal(interp, what, CONST_STRING(interp, "named_slurpy"))) {
814 count_found = (INTVAL)sub->arg_info->named_slurpy;
817 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
818 "Unknown introspection value '%S'", what);
821 retval = pmc_new(INTERP, enum_class_Integer);
822 VTABLE_set_integer_native(INTERP, retval, count_found);
834 =item C<PMC *get_namespace()>
836 Return the namespace PMC, where the Sub is defined.
838 TODO return C<namespace_stash> instead.
840 =item C<INTVAL __get_regs_used(char *kind)>
842 Return amount of used registers for register kinds "I", "S", "P", "N".
844 =item C<PMC *get_lexinfo()>
846 Return the LexInfo PMC, if any or a Null PMC.
848 =item C<PMC *get_multisig()>
850 Return the MMD signature PMC, if any or a Null PMC.
852 =item C<PMC *get_outer()>
854 Gets the sub that is the outer of this one, if any or a Null PMC.
856 =item C<void set_outer(PMC *outer)>
858 Sets the sub that is the outer of this one.
860 =item C<INTVAL arity()>
862 Return the arity of the Sub (the number of arguments, excluding optional and
869 METHOD get_namespace() {
871 Parrot_Sub_attributes *sub;
872 PMC_get_sub(INTERP, SELF, sub);
874 XXX Rakudo's failing with with this code on ASSERT. Why???
875 GET_ATTR_namespace_stash(INTERP, SELF, _namespace);
876 PARROT_ASSERT(_namespace == sub->namespace_stash || !"consistency!!!");
878 _namespace = sub->namespace_stash;
879 RETURN(PMC *_namespace);
882 METHOD __get_regs_used(STRING *reg) {
884 /* TODO switch to canonical NiSP order
885 * see also imcc/reg_alloc.c */
886 static const char types[] = "INSP";
888 Parrot_Sub_attributes *sub;
889 char * const kind = Parrot_str_to_cstring(interp, reg);
892 PMC_get_sub(INTERP, SELF, sub);
893 PARROT_ASSERT(sub->n_regs_used);
895 if (!*kind || kind[1]) {
896 Parrot_str_free_cstring(kind);
897 Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
898 "illegal register kind '%Ss'", reg);
901 p = strchr(types, *kind);
902 Parrot_str_free_cstring(kind);
905 Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
906 "illegal register kind '%Ss'", reg);
908 regs_used = sub->n_regs_used[p - types];
909 RETURN(INTVAL regs_used);
912 METHOD get_lexinfo() {
914 Parrot_Sub_attributes *sub;
915 PMC_get_sub(INTERP, SELF, sub);
917 lexinfo = sub->lex_info ? sub->lex_info: PMCNULL;
919 RETURN(PMC *lexinfo);
924 Parrot_Sub_attributes *sub;
925 PMC_get_sub(INTERP, SELF, sub);
927 subid = sub->subid ? sub->subid : CONST_STRING(interp, "");
929 RETURN(STRING *subid);
934 Parrot_Sub_attributes *sub;
935 PMC_get_sub(INTERP, SELF, sub);
937 outersub = sub->outer_sub ? sub->outer_sub : PMCNULL;
939 RETURN(PMC *outersub);
942 METHOD set_outer(PMC *outer) {
944 Parrot_Sub_attributes *sub;
946 PMC_get_sub(INTERP, SELF, sub);
948 sub->outer_sub = outer;
950 /* Make sure outer flag of that sub is set. */
951 PObj_get_FLAGS(outer) |= SUB_FLAG_IS_OUTER;
953 /* Ensure we have lex info. */
954 if (PMC_IS_NULL(sub->lex_info)) {
955 const INTVAL lex_info_id = Parrot_get_ctx_HLL_type(interp,
957 sub->lex_info = pmc_new_init(interp, lex_info_id, SELF);
960 /* If we've got a context around for the outer sub, set it as the
963 /* XXX This code looks very suspicious. */
964 /* (CONTEXT(interp)->caller_ctx->caller_ctx->current_sub */
965 tmp1 = Parrot_pcc_get_caller_ctx(interp, CURRENT_CONTEXT(interp));
966 tmp2 = Parrot_pcc_get_caller_ctx(interp, tmp1);
967 if (Parrot_pcc_get_sub(interp, tmp2) == outer)
968 sub->outer_ctx = tmp2;
969 /* else if (CONTEXT(interp)->caller_ctx->current_sub == outer) */
970 else if (Parrot_pcc_get_sub(interp, tmp1) == outer)
971 sub->outer_ctx = tmp1;
974 METHOD get_multisig() {
976 Parrot_Sub_attributes *sub;
977 PMC_get_sub(INTERP, SELF, sub);
979 multisig = sub->multi_signature ? sub->multi_signature : PMCNULL;
981 RETURN(PMC *multisig);
985 PMC * const pos_required = VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "pos_required"));
986 PMC * const named_required = VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "named_required"));
988 const INTVAL arity = VTABLE_get_integer(INTERP, pos_required) +
989 VTABLE_get_integer(INTERP, named_required);
991 RETURN(INTVAL arity);
997 * c-file-style: "parrot"
999 * vim: expandtab shiftwidth=4: