src/pmc/sub.pmc

   1 /*
   2 Copyright (C) 2001-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/pmc/sub.pmc - Subroutine
   8
   9 =head1 DESCRIPTION
  10
  11 These are the vtable functions for the Sub (subroutine) base class
  12
  13 =head2 Functions
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 #include "parrot/parrot.h"
  22 #include "parrot/oplib/ops.h"
  23 #include "sub.str"
  24
  25 static void
  26 print_sub_name(PARROT_INTERP, PMC *sub)
  27 {
  28     Interp * const tracer = interp->debugger ? interp->debugger : interp;
  29
  30     /* sub was located via globals */
  31     PIO_eprintf(tracer, "# Calling sub '%Ss'\n# ",
  32         Parrot_full_sub_name(interp, sub));
  33
  34     print_pbc_location(interp);
  35 }
  36
  37 /*
  38  * A sub now contains more data like namespace, which makes it
  39  * effectively a container. Therefore need_ext has to be set
  40  */
  41 pmclass Sub need_ext {
  42
  43 /*
  44
  45 =item C<void init()>
  46
  47 Initializes the subroutine.
  48
  49 =cut
  50
  51 */
  52
  53     /*
  54      * Sub PMC's flags usage:
  55      * - private0 ... Coroutine flip/flop - C exception handler
  56      * - private1 ... _IS_OUTER - have to preserve context
  57      *                as some other sub has :outer(this)
  58      * - private2 ... tailcall invoked this Sub
  59      * - private3 ... pythonic coroutine generator flag
  60      * - private4 ... :main (originally @MAIN)
  61      * - private5 ... :load (originally @LOAD)
  62      * - private6 ... :immediate (originally @IMMEDIATE)
  63      * - private7 ... :postcomp (originally @POSTCOMP)
  64      *
  65      * see also the enum in include/parrot/sub.h
  66      *
  67      * Data used:
  68      *   PMC_struct_val ... Parrot_sub structure
  69      *   PMC_pmc_val    ... unused / bound object in Bound_Meth PMC
  70      */
  71     VTABLE void init() {
  72         PMC_struct_val(SELF) = new_sub(INTERP);
  73         PMC_pmc_val(SELF)    = NULL;
  74         PObj_custom_mark_destroy_SETALL(SELF);
  75     }
  76
  77 /*
  78
  79 =item C<void destroy()>
  80
  81 Destroys the subroutine.
  82
  83 =cut
  84
  85 */
  86
  87     VTABLE void destroy() {
  88         Parrot_sub * const sub = PMC_sub(SELF);
  89
  90         if (!sub)
  91             return;
  92         if (sub->arg_info)
  93             mem_sys_free(sub->arg_info);
  94
  95         mem_sys_free(sub);
  96         PMC_struct_val(SELF) = NULL;
  97     }
  98
  99 /*
 100
 101 =item C<STRING *get_string()>
 102
 103 Returns the name of the subroutine.
 104
 105 =item C<void set_string_native(STRING *subname)>
 106
 107 Sets the name of the subroutine.
 108
 109 =cut
 110
 111 */
 112
 113     VTABLE STRING *get_string() {
 114         const Parrot_sub * const sub = PMC_sub(SELF);
 115         return string_copy(INTERP, sub->name);
 116     }
 117
 118     VTABLE void set_string_native(STRING *subname) {
 119         Parrot_sub * const sub = PMC_sub(SELF);
 120         sub->name              = string_copy(INTERP, subname);
 121     }
 122
 123 /*
 124
 125 =item C<void set_pointer(void *value)>
 126
 127 Sets the pointer to the actual subroutine.
 128
 129 *** Don't use that - use .Sub constants instead ***
 130
 131 =cut
 132
 133 */
 134
 135     VTABLE void set_pointer(void *value) {
 136         Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
 137             "Don't set the address of a sub\nuse .Sub constants instead");
 138     }
 139
 140 /*
 141
 142 =item C<void *get_pointer()>
 143
 144 Returns the address of the actual subroutine.
 145
 146 =cut
 147
 148 */
 149
 150     VTABLE void *get_pointer() {
 151         const Parrot_sub * const sub = PMC_sub(SELF);
 152         return sub->seg->base.data + sub->start_offs;
 153     }
 154
 155 /*
 156
 157 =item C<INTVAL get_integer_keyed(PMC *key)>
 158
 159 I<This just unconditionally returns the start of bytecode. It's wrong,
 160 wrong, wrong, *WRONG*. And there's no other good way, so it's here for
 161 now.> -DRS
 162
 163 =cut
 164
 165 */
 166
 167     VTABLE INTVAL get_integer_keyed(PMC *key) {
 168         return (INTVAL) ((PMC_sub(SELF))->seg->base.data);
 169     }
 170
 171 /*
 172
 173 =item C<INTVAL defined()>
 174
 175 =item C<INTVAL get_bool()>
 176
 177 Returns True.
 178
 179 =cut
 180
 181 */
 182
 183     VTABLE INTVAL defined() {
 184         return 1;
 185     }
 186
 187     VTABLE INTVAL get_bool() {
 188         return 1;
 189     }
 190
 191 /*
 192
 193 =item C<opcode_t *invoke(void *next)>
 194
 195 Invokes the subroutine.
 196
 197 =cut
 198
 199 */
 200
 201     VTABLE opcode_t *invoke(void *next) {
 202         Parrot_sub     * const sub = PMC_sub(SELF);
 203         Parrot_Context        *caller_ctx;
 204         Parrot_Context        *context;
 205         PMC                   *ccont;
 206         opcode_t              *pc;
 207
 208         if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG))
 209             print_sub_name(INTERP, SELF);
 210
 211         /*
 212          * A remark WRT tail calls
 213          *
 214          * we have:
 215          * sub A:
 216          *    ...
 217          *    B()
 218          *    ...
 219          * sub B:
 220          *    ...
 221          *    .return C(...)
 222          *
 223          * that is the sub B() returns whatever C() returns.
 224          *
 225          * We are just calling the sub C().
 226          * If the private2 flag is set, this code is called by a
 227          * tailcall opcode.
 228          *
 229          * We allocate a new register frame and recycle it
 230          * immediately after argument passing.
 231          *
 232          */
 233         pc                   = sub->seg->base.data + sub->start_offs;
 234         caller_ctx           = CONTEXT(interp);
 235         ccont                = INTERP->current_cont;
 236         INTERP->current_cont = NULL;
 237
 238         if (ccont == NEED_CONTINUATION)
 239             ccont = new_ret_continuation_pmc(interp, (opcode_t *)next);
 240
 241         PARROT_ASSERT(!PMC_IS_NULL(ccont));
 242
 243         /*
 244          * plain subroutine call
 245          * create new context, place it in interpreter
 246          */
 247 #define PREMATURE_OPT
 248 #ifdef PREMATURE_OPT
 249         if (caller_ctx->current_sub == SELF)
 250             context = Parrot_dup_context(INTERP, caller_ctx);
 251         else
 252 #endif
 253         context               = Parrot_alloc_context(INTERP, sub->n_regs_used);
 254         context->current_sub  = SELF;
 255         context->caller_ctx   = caller_ctx;
 256         context->current_pc   = pc;
 257         context->current_cont = ccont;
 258
 259         /* check recursion/call depth */
 260         if (++context->recursion_depth > INTERP->recursion_limit)
 261             Parrot_ex_throw_from_c_args(INTERP, next, CONTROL_ERROR,
 262                     "maximum recursion depth exceeded");
 263
 264         /* and copy set context variables */
 265         PMC_cont(ccont)->from_ctx = context;
 266
 267         /* set context of the sub */
 268         sub->ctx = context;
 269
 270         /* don't destroy context */
 271         if (PObj_get_FLAGS(SELF) & SUB_FLAG_IS_OUTER)
 272             ccont->vtable = interp->vtables[enum_class_Continuation];
 273
 274         /* reference counting should work */
 275         context->ref_count++;
 276
 277         if (!PMC_IS_NULL(INTERP->current_object)) {
 278             context->current_object = INTERP->current_object;
 279             INTERP->current_object  = NULL;
 280         }
 281
 282         context->current_HLL       = sub->HLL_id;
 283         context->current_namespace = sub->namespace_stash;
 284
 285         /* create pad if needed
 286          * TODO move this up in front of argument passing
 287          *      and factor out common code with coroutine pmc
 288          */
 289         if (!PMC_IS_NULL(sub->lex_info)) {
 290             context->lex_pad = pmc_new_init(INTERP,
 291                     Parrot_get_ctx_HLL_type(interp,
 292                         enum_class_LexPad),
 293                     sub->lex_info);
 294             VTABLE_set_pointer(INTERP, context->lex_pad, context);
 295         }
 296
 297         /* switch code segment if needed */
 298         if (INTERP->code != sub->seg)
 299             Parrot_switch_to_cs(INTERP, sub->seg, 1);
 300
 301         if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL) {
 302             if (!(*pc == PARROT_OP_get_params_pc ||
 303                         (*pc == PARROT_OP_push_eh_ic &&
 304                          pc[2] == PARROT_OP_get_params_pc))) {
 305
 306                 /* TODO keep it or resize it */
 307                 --context->recursion_depth;
 308
 309                 PObj_get_FLAGS(ccont) &= ~SUB_FLAG_TAILCALL;
 310                 context->caller_ctx    = caller_ctx->caller_ctx;
 311
 312                 Parrot_free_context(INTERP, caller_ctx, 0);
 313             }
 314         }
 315
 316         return pc;
 317     }
 318
 319 /*
 320
 321 =item C<PMC *clone()>
 322
 323 Creates and returns a clone of the subroutine.
 324
 325 =cut
 326
 327 */
 328
 329     VTABLE PMC *clone() {
 330         Parrot_sub *sub = mem_allocate_typed(Parrot_sub);
 331         PMC * const ret = pmc_new_noinit(INTERP, SELF->vtable->base_type);
 332
 333         /* we have to mark it ourselves */
 334         PObj_custom_mark_destroy_SETALL(ret);
 335
 336         /* first set the sub struct, string_copy may cause GC */
 337         PMC_struct_val(ret) = sub;
 338         PMC_pmc_val(ret)    = NULL;
 339         memcpy(sub, PMC_sub(SELF), sizeof (Parrot_sub));
 340         sub->name           = string_copy(INTERP, sub->name);
 341
 342         return ret;
 343     }
 344
 345 /*
 346
 347 =item C<void assign_pmc(PMC *other)>
 348
 349 Set SELF to the data in other.
 350
 351 =cut
 352
 353 */
 354
 355     VTABLE void set_pmc(PMC *other) {
 356         SELF.assign_pmc(other);
 357     }
 358
 359     VTABLE void assign_pmc(PMC *other) {
 360         /* only handle the case where the other PMC is the same type */
 361         if (other->vtable->base_type == SELF->vtable->base_type) {
 362             /* copy the sub struct */
 363             memcpy(PMC_sub(SELF), PMC_sub(other), sizeof (struct Parrot_sub));
 364
 365             /* copy the name so it's a different string in memory */
 366             PMC_sub(SELF)->name = string_copy(INTERP, PMC_sub(SELF)->name);
 367         }
 368         else
 369             Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
 370                 "Can't assign a non-Sub type to a Sub");
 371     }
 372
 373 /*
 374
 375 =item C<void mark()>
 376
 377 Marks the sub as live.
 378
 379 =cut
 380
 381 */
 382
 383     VTABLE void mark() {
 384         const Parrot_sub * const sub = PMC_sub(SELF);
 385
 386         if (!sub)
 387             return;
 388
 389         if (sub->name)
 390             pobject_lives(INTERP, (PObj *) sub->name);
 391         if (!PMC_IS_NULL(sub->namespace_name))
 392             pobject_lives(INTERP, (PObj *) sub->namespace_name);
 393         if (!PMC_IS_NULL(sub->multi_signature))
 394             pobject_lives(INTERP, (PObj *) sub->multi_signature);
 395         if (!PMC_IS_NULL(sub->lex_info))
 396             pobject_lives(INTERP, (PObj *) sub->lex_info);
 397         if (!PMC_IS_NULL(sub->outer_sub))
 398             pobject_lives(INTERP, (PObj *) sub->outer_sub);
 399         if (!PMC_IS_NULL(sub->eval_pmc))
 400             pobject_lives(INTERP, (PObj *) sub->eval_pmc);
 401         if (sub->lexid)
 402             pobject_lives(INTERP, (PObj *) sub->lexid);
 403         if (sub->ctx)
 404             mark_context(interp, sub->ctx);
 405     }
 406
 407 /*
 408
 409 =item C<INTVAL is_equal(PMC *value)>
 410
 411 Returns whether the two subroutines are equal.
 412
 413 =cut
 414
 415 */
 416
 417     VTABLE INTVAL is_equal(PMC *value) {
 418         return SELF->vtable == value->vtable &&
 419             (PMC_sub(SELF))->start_offs == (PMC_sub(value))->start_offs &&
 420             (PMC_sub(SELF))->seg == (PMC_sub(value))->seg;
 421     }
 422
 423 /*
 424
 425 =item C<void visit(visit_info *info)>
 426
 427 This is used by freeze/thaw to visit the contents of the sub.
 428
 429 =item C<void freeze(visit_info *info)>
 430
 431 Archives the subroutine.
 432
 433 =cut
 434
 435 */
 436
 437     VTABLE void visit(visit_info *info) {
 438         Parrot_sub * const sub = PMC_sub(SELF);
 439
 440         info->thaw_ptr = &sub->namespace_name;
 441         (info->visit_pmc_now)(INTERP, sub->namespace_name, info);
 442
 443         info->thaw_ptr = &sub->multi_signature;
 444         (info->visit_pmc_now)(INTERP, sub->multi_signature, info);
 445
 446         info->thaw_ptr = &sub->outer_sub;
 447         (info->visit_pmc_now)(INTERP, sub->outer_sub, info);
 448
 449         /*
 450          * XXX visit_pmc_now is wrong, because it breaks
 451          *     depth-first visit inside the todo list
 452          * TODO change all user visit functions to use
 453          *    visit_pmc (the todo renamed visit_pm_later)
 454          *
 455          * Therefore the hash must be last during visit for now.
 456          */
 457         info->thaw_ptr = &sub->lex_info;
 458         (info->visit_pmc_now)(INTERP, sub->lex_info, info);
 459         SUPER(info);
 460     }
 461
 462     VTABLE void freeze(visit_info *info) {
 463         IMAGE_IO   * const io  = info->image_io;
 464         Parrot_sub * const sub = PMC_sub(SELF);
 465         STRING            *hll_name;
 466         int i;
 467
 468         SUPER(info);
 469         /*
 470          * we currently need to write these items:
 471          * - start offset in byte-code segment
 472          * - end   offset in byte-code segment
 473          * - segment TODO ???
 474          * - flags  (i.e. :load pragma and such)
 475          * - name of the sub's label
 476          * - namespace
 477          * - HLL_id
 478          * - multi_signature
 479          * - n_regs_used[i]
 480          * - lex_info
 481          * - vtable_index
 482          * - lexid
 483          */
 484
 485         VTABLE_push_integer(INTERP, io, (INTVAL) sub->start_offs);
 486         VTABLE_push_integer(INTERP, io, (INTVAL) sub->end_offs);
 487         VTABLE_push_integer(INTERP, io,
 488             PObj_get_FLAGS(pmc) & SUB_FLAG_PF_MASK);
 489
 490         VTABLE_push_string(INTERP, io, sub->name);
 491
 492         hll_name = Parrot_get_HLL_name(INTERP, sub->HLL_id);
 493         if (!hll_name)
 494             hll_name = CONST_STRING(INTERP, "");
 495
 496         VTABLE_push_string(INTERP, io, hll_name);
 497
 498         VTABLE_push_integer(INTERP, io, sub->comp_flags);
 499         VTABLE_push_integer(INTERP, io, sub->vtable_index);
 500
 501         for (i = 0; i < 4; ++i)
 502             VTABLE_push_integer(INTERP, io, sub->n_regs_used[i]);
 503
 504         if (!sub->lexid)
 505             sub->lexid = CONST_STRING(INTERP, "");
 506         VTABLE_push_string(INTERP, io, sub->lexid);
 507     }
 508
 509 /*
 510
 511 =item C<void thaw(visit_info *info)>
 512
 513 Unarchives the subroutine.
 514
 515 =cut
 516
 517 */
 518
 519     VTABLE void thaw(visit_info *info) {
 520         IMAGE_IO * const io = info->image_io;
 521         SUPER(info);
 522
 523         if (info->extra_flags == EXTRA_IS_NULL) {
 524             Parrot_sub * const sub = PMC_sub(SELF);
 525             INTVAL flags;
 526             int    i;
 527
 528             /* we get relative offsets */
 529             sub->start_offs   = (size_t) VTABLE_shift_integer(INTERP, io);
 530             sub->end_offs     = (size_t) VTABLE_shift_integer(INTERP, io);
 531             flags             = VTABLE_shift_integer(INTERP, io);
 532
 533             PObj_get_FLAGS(SELF) |= flags & SUB_FLAG_PF_MASK;
 534
 535             sub->name         = VTABLE_shift_string(INTERP, io);
 536             sub->HLL_id       = Parrot_get_HLL_id(INTERP,
 537                 VTABLE_shift_string(INTERP, io));
 538             sub->comp_flags   = VTABLE_shift_integer(INTERP, io);
 539             sub->vtable_index = VTABLE_shift_integer(INTERP, io);
 540
 541             for (i = 0; i < 4; ++i)
 542                 sub->n_regs_used[i] = VTABLE_shift_integer(INTERP, io);
 543
 544             sub->lexid        = VTABLE_shift_string(INTERP, io);
 545         }
 546     }
 547
 548 /*
 549
 550 =item C<PMC *inspect()>
 551
 552 Returns the full set of meta-data about the sub.
 553
 554 =cut
 555
 556 */
 557
 558     PMC *inspect()
 559     {
 560         /* Create a hash, then use inspect_str to get all of the data to
 561          * fill it up with. */
 562         PMC    * const metadata    = pmc_new(interp, enum_class_Hash);
 563         STRING * const pos_required_str    = CONST_STRING(interp, "pos_required");
 564         STRING * const pos_optional_str      = CONST_STRING(interp, "pos_optional");
 565         STRING * const named_required_str   = CONST_STRING(interp, "named_required");
 566         STRING * const named_optional_str   = CONST_STRING(interp, "named_optional");
 567         STRING * const pos_slurpy_str = CONST_STRING(interp, "pos_slurpy");
 568         STRING * const named_slurpy_str   = CONST_STRING(interp, "named_slurpy");
 569
 570         VTABLE_set_pmc_keyed_str(interp, metadata, pos_required_str,
 571             VTABLE_inspect_str(interp, SELF, pos_required_str));
 572
 573         VTABLE_set_pmc_keyed_str(interp, metadata, pos_optional_str,
 574             VTABLE_inspect_str(interp, SELF, pos_optional_str));
 575
 576         VTABLE_set_pmc_keyed_str(interp, metadata, named_required_str,
 577             VTABLE_inspect_str(interp, SELF, named_required_str));
 578
 579         VTABLE_set_pmc_keyed_str(interp, metadata, named_optional_str,
 580             VTABLE_inspect_str(interp, SELF, named_optional_str));
 581
 582         VTABLE_set_pmc_keyed_str(interp, metadata, pos_slurpy_str,
 583             VTABLE_inspect_str(interp, SELF, pos_slurpy_str));
 584
 585         VTABLE_set_pmc_keyed_str(interp, metadata, named_slurpy_str,
 586             VTABLE_inspect_str(interp, SELF, named_slurpy_str));
 587
 588         return metadata;
 589     }
 590
 591 /*
 592
 593 =item C<PMC *inspect_str(STRING *what)>
 594
 595 Returns the specified item of metadata about the sub. Allowable
 596 values are:
 597
 598 =over 4
 599
 600 =item pos_required
 601
 602 The number of required positional arguments
 603
 604 =item pos_optional
 605
 606 The number of optional positional arguments
 607
 608 =item named_required
 609
 610 The number of required named arguments
 611
 612 =item named_optional
 613
 614 The number of optional named arguments
 615
 616 =item pos_slurpy
 617
 618 1 if it takes slurpy positional arguments, 0 if not
 619
 620 =item named_slurpy
 621
 622 1 if it takes slurpy named arguments, 0 if not
 623
 624 =back
 625
 626 =cut
 627
 628 */
 629
 630     PMC *inspect_str(STRING *what)
 631     {
 632         Parrot_sub * const sub = PMC_sub(SELF);
 633         INTVAL count_found = -1;
 634         PMC *retval;
 635
 636         /* If the argument info hasn't been generated yet, generate it. */
 637         if (sub->arg_info == NULL)
 638         {
 639             /* Get pointer into the bytecode where this sub starts. */
 640             opcode_t *pc = sub->seg->base.data + sub->start_offs;
 641
 642             /* Allocate structure to store argument information in. */
 643             sub->arg_info = mem_allocate_zeroed_typed(Parrot_sub_arginfo);
 644
 645             /* If the first instruction is a get_params... */
 646             if (*pc == PARROT_OP_get_params_pc) {
 647                 int i, sig_length;
 648                 PMC *sig;
 649
 650                 /* Get the signature (the next thing in the bytecode). */
 651                 pc++;
 652                 sig = PF_CONST(sub->seg, *pc)->u.key;
 653                 ASSERT_SIG_PMC(sig);
 654
 655                 /* Iterate over the signature and compute argument counts. */
 656                 sig_length = SIG_ELEMS(sig);
 657                 for (i = 0; i < sig_length; i++)
 658                 {
 659                     int sig_item = SIG_ITEM(sig, i);
 660                     if (PARROT_ARG_SLURPY_ARRAY_ISSET(sig_item)){
 661                         if (PARROT_ARG_NAME_ISSET(sig_item))
 662                             sub->arg_info->named_slurpy = 1;
 663                         else
 664                             sub->arg_info->pos_slurpy = 1;
 665                     }
 666                     else if (PARROT_ARG_OPTIONAL_ISSET(sig_item)) {
 667                         if (PARROT_ARG_NAME_ISSET(sig_item))
 668                             sub->arg_info->named_optional++;
 669                         else
 670                             sub->arg_info->pos_optional++;
 671                     }
 672                     else if (!PARROT_ARG_OPT_FLAG_ISSET(sig_item)) {
 673                         if (PARROT_ARG_NAME_ISSET(sig_item))
 674                             sub->arg_info->named_required++;
 675                         else
 676                             sub->arg_info->pos_required++;
 677                     }
 678                 }
 679             }
 680         }
 681
 682         /* Return the argument information that was requested. */
 683         if (string_equal(interp, what, CONST_STRING(interp, "pos_required")) == 0) {
 684             count_found = (INTVAL)sub->arg_info->pos_required;
 685         }
 686         else if (string_equal(interp, what, CONST_STRING(interp, "pos_optional")) == 0) {
 687             count_found = (INTVAL)sub->arg_info->pos_optional;
 688         }
 689         else if (string_equal(interp, what, CONST_STRING(interp, "pos_slurpy")) == 0) {
 690             count_found = (INTVAL)sub->arg_info->pos_slurpy;
 691         }
 692         else if (string_equal(interp, what, CONST_STRING(interp, "named_required")) == 0) {
 693             count_found = (INTVAL)sub->arg_info->named_required;
 694         }
 695         else if (string_equal(interp, what, CONST_STRING(interp, "named_optional")) == 0) {
 696             count_found = (INTVAL)sub->arg_info->named_optional;
 697         }
 698         else if (string_equal(interp, what, CONST_STRING(interp, "named_slurpy")) == 0) {
 699             count_found = (INTVAL)sub->arg_info->named_slurpy;
 700         }
 701         else {
 702             Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
 703                 "Unknown introspection value '%S'", what);
 704         }
 705
 706         retval = pmc_new(INTERP, enum_class_Integer);
 707         VTABLE_set_integer_native(INTERP, retval, count_found);
 708         return retval;
 709     }
 710
 711 /*
 712
 713 =back
 714
 715 =head2 METHODS
 716
 717 =over 4
 718
 719 =item C<PMC *get_namespace()>
 720
 721 Return the namespace PMC, where the Sub is defined.
 722
 723 TODO return C<namespace_stash> instead.
 724
 725 =item C<INTVAL __get_regs_used(char *kind)>
 726
 727 Return amount of used registers for register kinds "I", "S", "P", "N".
 728
 729 =item C<PMC *get_lexinfo()>
 730
 731 Return the LexInfo PMC, if any or a Null PMC.
 732
 733 =item C<PMC *get_multisig()>
 734
 735 Return the MMD signature PMC, if any or a Null PMC.
 736
 737 =item C<PMC *get_outer()>
 738
 739 Gets the sub that is the outer of this one, if any or a Null PMC.
 740
 741 =item C<void set_outer(PMC *outer)>
 742
 743 Sets the sub that is the outer of this one.
 744
 745 =item C<INTVAL arity()>
 746
 747 Return the arity of the Sub (the number of arugments, excluding optional and
 748 slurpy arguments).
 749
 750 =cut
 751
 752 */
 753
 754     METHOD get_namespace() {
 755         Parrot_sub * const sub = PMC_sub(SELF);
 756         PMC *_namespace = sub->namespace_stash;
 757         RETURN(PMC *_namespace);
 758     }
 759
 760     METHOD __get_regs_used(STRING *reg) {
 761         Parrot_sub * const sub  = PMC_sub(SELF);
 762         char              *kind = string_to_cstring(interp, reg);
 763         INTVAL             regs_used;
 764
 765         /* TODO switch to canonical NiSP order
 766          * see also imcc/reg_alloc.c */
 767         static const char types[] = "INSP";
 768         char *p;
 769
 770         PARROT_ASSERT(sub->n_regs_used);
 771
 772         if (!*kind || kind[1]) {
 773             string_cstring_free(kind);
 774             Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
 775                 "illegal register kind '%Ss'", reg);
 776         }
 777
 778         p = strchr(types, *kind);
 779         string_cstring_free(kind);
 780
 781         if (!p)
 782             Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
 783                 "illegal register kind '%Ss'", reg);
 784
 785         regs_used = sub->n_regs_used[p - types];
 786         RETURN(INTVAL regs_used);
 787     }
 788
 789     METHOD get_lexinfo() {
 790         const Parrot_sub * const sub = PMC_sub(SELF);
 791         PMC *lexinfo = sub->lex_info ? sub->lex_info : PMCNULL;
 792         RETURN(PMC *lexinfo);
 793     }
 794
 795     METHOD get_outer() {
 796         const Parrot_sub * const sub = PMC_sub(SELF);
 797         PMC *outersub = sub->outer_sub ? sub->outer_sub : PMCNULL;
 798         RETURN(PMC *outersub);
 799     }
 800
 801     METHOD set_outer(PMC *outer) {
 802         /* Set outer sub. */
 803         Parrot_sub * const sub = PMC_sub(SELF);
 804         sub->outer_sub = outer;
 805
 806         /* Make sure outer flag of that sub is set. */
 807         PObj_get_FLAGS(outer) |= SUB_FLAG_IS_OUTER;
 808
 809         /* Ensure we have lex info. */
 810         if (PMC_IS_NULL(sub->lex_info)) {
 811             const INTVAL lex_info_id = Parrot_get_ctx_HLL_type(interp,
 812                                            enum_class_LexInfo);
 813             sub->lex_info = pmc_new_init(interp, lex_info_id, SELF);
 814         }
 815
 816         /* Finally, this sub needs to become a closure. Safe since
 817          * they both use the same underlying structure. */
 818         SELF->vtable = interp->vtables[enum_class_Closure];
 819     }
 820
 821     METHOD get_multisig() {
 822         const Parrot_sub * const sub = PMC_sub(SELF);
 823         PMC *multisig = sub->multi_signature ? sub->multi_signature : PMCNULL;
 824         RETURN(PMC *multisig);
 825     }
 826
 827     METHOD arity() {
 828         PMC *pos_required =
 829             VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "pos_required"));
 830         PMC *named_required =
 831             VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "named_required"));
 832         INTVAL arity = VTABLE_get_integer(INTERP, pos_required) +
 833             VTABLE_get_integer(INTERP, named_required);
 834
 835         RETURN(INTVAL arity);
 836     }
 837 }
 838
 839 /*
 840  * Local variables:
 841  *   c-file-style: "parrot"
 842  * End:
 843  * vim: expandtab shiftwidth=4:
 844  */