src/ops/core.ops

   1 /*
   2  * $Id$
   3 ** core.ops
   4 */
   5
   6 #include "parrot/dynext.h"
   7 #include "parrot/embed.h"
   8 #include "../interp_guts.h"
   9
  10 VERSION = PARROT_VERSION;
  11
  12 =head1 NAME
  13
  14 core.ops - Parrot Core Ops
  15
  16 =cut
  17
  18 =head1 DESCRIPTION
  19
  20 Parrot's core library of ops.
  21
  22 Core operations are primarily flow control and interpreter
  23 introspection.
  24
  25 =cut
  26
  27 # ' for emacs
  28
  29 ###############################################################################
  30
  31 =head2 Basic ops
  32
  33 These are the fundamental operations.
  34 Please note: These opcodes must not be moved; they must have
  35 exactly these opcode numbers. Opcodes ending with underscores are for
  36 internal use only; don't emit these opcodes.
  37
  38 =over 4
  39
  40 =cut
  41
  42 ########################################
  43
  44 =item B<end>()
  45
  46 Halts the interpreter. (Must be op #0, CORE_OPS_end). See also B<exit>.
  47
  48 =cut
  49
  50 inline op end() :base_core :check_event :flow {
  51     HALT();
  52 }
  53
  54
  55 ########################################
  56
  57 =item B<noop>()
  58
  59 Does nothing other than waste an iota of time and 32 bits of bytecode space.
  60 (Must be op #1, CORE_OPS_noop)
  61
  62 =item B<cpu_ret>()
  63
  64 Emit a cpu return instruction. This is used to return from CGP core
  65 to JIT code. Note: Do B<not> use this opcode. It is for internal use only.
  66 (Must be op #2, CORE_OPS_cpu_ret)
  67
  68 =item B<check_events>()
  69
  70 Check the event queue and run event handlers if there are unhandled events.
  71 Note: This opcode is mainly for testing. It should not be necessary to ever
  72 use it explicitly.
  73 (Must be op #3, CORE_OPS_check_events).
  74
  75 =item B<check_events__>()
  76
  77 Check the event queue and run event handlers if there are unhandled events.
  78 Note: Do B<not> use this opcode. It is for internal use only.
  79 (Must be op #4, CORE_OPS_check_events__).
  80
  81 =item B<wrapper__>()
  82
  83 Internal opcode to wrap unknown ops from loaded opcode libs.
  84 Don't use.
  85 (Must be op #5, CORE_OPS_wrapper__).
  86
  87 =item B<prederef__>()
  88
  89 Internal opcode to prederef opcodes on the fly.
  90 Don't use.
  91 (Must be op #6, CORE_OPS_prederef__).
  92
  93 =item B<reserved>(inconst INT)
  94
  95 Reserve 1 more fix entry.
  96
  97 =item B<load_bytecode>(in STR)
  98
  99 Load Parrot bytecode from file $1, and
 100 RT#42381 search the library path to locate the file.
 101
 102 =cut
 103
 104 inline op noop() :base_core {
 105 }
 106
 107 inline op cpu_ret() {
 108 #ifdef __GNUC__
 109 #  ifdef I386
 110     __asm__("ret");
 111 #  endif
 112 #endif
 113 }
 114
 115 inline op check_events() :base_core :flow {
 116     opcode_t *next = expr NEXT();
 117     Parrot_cx_check_tasks(interp, interp->scheduler);
 118     goto ADDRESS(next);   /* force this being a branch op */
 119 }
 120
 121 inline op check_events__() :internal :flow {
 122     opcode_t *_this = CUR_OPCODE;
 123     /* Restore op_func_table. */
 124     disable_event_checking(interp);
 125     Parrot_cx_handle_tasks(interp, interp->scheduler);
 126     goto ADDRESS(_this);   /* force this being a branch op */
 127 }
 128
 129 inline op wrapper__() :internal :flow {
 130     opcode_t *pc = CUR_OPCODE;
 131     DO_OP(pc, interp);
 132     goto ADDRESS(pc);
 133 }
 134
 135 inline op prederef__() :internal :flow {
 136     opcode_t *_this = CUR_OPCODE;
 137     if (interp->run_core & PARROT_CGOTO_CORE) {
 138         /* must be CGP then - check for events in not yet prederefed code */
 139         Parrot_cx_runloop_wake(interp, interp->scheduler);
 140     /*    _this = CHECK_EVENTS(interp, _this); */
 141     }
 142     do_prederef((void**)cur_opcode, interp, op_lib.core_type);
 143     goto ADDRESS(_this); /* force this being a branch op */
 144 }
 145
 146 inline op reserved(inconst INT) {
 147     /* reserve 1 entries */
 148 }
 149
 150 inline op load_bytecode(in STR) :load_file {
 151     Parrot_load_bytecode(interp, $1);
 152 }
 153
 154 =back
 155
 156 =cut
 157
 158 ###############################################################################
 159
 160 =head2 Control flow
 161
 162 The control flow opcodes check conditions and manage program flow.
 163
 164 =over 4
 165
 166 =cut
 167
 168 ########################################
 169
 170 =item B<branch>(in LABEL)
 171
 172 Branch forward or backward by the amount in $1.
 173
 174 =cut
 175
 176 inline op branch(in LABEL) :base_loop :flow {
 177     goto OFFSET($1);
 178 }
 179
 180
 181 =item B<branch_cs>(in STR)
 182
 183 Intersegment branch to location in fixup table named $1.
 184
 185 =cut
 186
 187 inline op branch_cs(in STR) :base_loop :check_event :flow {
 188     char * const         label = string_to_cstring(interp, $1);
 189     PackFile_FixupEntry * const fe =
 190         PackFile_find_fixup_entry(interp, enum_fixup_label, label);
 191
 192     if (!fe) {
 193         string_cstring_free(label);
 194         real_exception(interp, NULL, 1, "branch_cs: fixup for '%Ss' not found",
 195             $1);
 196     }
 197     else {
 198         interp->resume_offset = fe->offset;
 199         Parrot_switch_to_cs(interp, fe->seg, 1);
 200     }
 201     mem_sys_free(fe);
 202     string_cstring_free(label);
 203     interp->resume_flag = 2;
 204     goto ADDRESS(0);
 205 }
 206
 207 ########################################
 208
 209 =item B<bsr>(in LABEL)
 210
 211 Branch to the location specified by $1. Push the current location onto the call
 212 stack for later returning.
 213
 214 =cut
 215
 216 inline op bsr(in LABEL) :base_core :check_event :flow {
 217     stack_push(interp, &interp->dynamic_env,
 218              expr NEXT(),  STACK_ENTRY_DESTINATION, STACK_CLEANUP_NULL);
 219     goto OFFSET($1);
 220 }
 221
 222 =item B<ret>()
 223
 224 Pop the location off the top of the call stack and go there.
 225
 226 =cut
 227
 228 inline op ret() :flow {
 229     goto POP();
 230 }
 231
 232
 233 ########################################
 234
 235 =item B<jsr>(in LABEL)
 236
 237 Jump to the location specified by register $1. Push the current
 238 location onto the call stack for later returning.
 239
 240 =cut
 241
 242 inline op jsr(in LABEL) :base_core :check_event :flow {
 243     opcode_t * loc;
 244     stack_push(interp, &interp->dynamic_env,
 245              expr NEXT(),  STACK_ENTRY_DESTINATION, STACK_CLEANUP_NULL);
 246     loc = INTVAL2PTR(opcode_t *, $1);
 247     goto ADDRESS(loc);
 248 }
 249
 250
 251 ########################################
 252
 253 =item B<jump>(in LABEL)
 254
 255 Jump to the address held in register $1.
 256
 257 =cut
 258
 259 inline op jump(in LABEL) :base_loop :flow {
 260     opcode_t * const loc = INTVAL2PTR(opcode_t *, $1);
 261     goto ADDRESS(loc);
 262 }
 263
 264 ########################################
 265
 266 =item B<enternative>()
 267
 268 Internal opcode used to jump from normal bytecode into a JITted version.
 269
 270 =cut
 271
 272 op enternative() :flow {
 273     opcode_t * const addr = run_native(interp, CUR_OPCODE,
 274             interp->code->base.data);
 275     goto ADDRESS(addr);
 276 }
 277
 278 =back
 279
 280 =cut
 281
 282 ###############################################################################
 283
 284 =head2 Conditional branch operations
 285
 286 These operations perform a conditional relative branch. If the condition is
 287 met, the branch happens.  Otherwise control falls to the next operation.
 288
 289 =over 4
 290
 291 =cut
 292
 293 ########################################
 294
 295 =item B<if>(invar INT, inconst LABEL)
 296
 297 =item B<if>(invar NUM, inconst LABEL)
 298
 299 =item B<if>(invar PMC, inconst LABEL)
 300
 301 =item B<if>(invar STR, inconst LABEL)
 302
 303 Check register $1. If true, branch by $2.
 304
 305 =cut
 306
 307 inline op if(invar INT, inconst LABEL) {
 308     if ($1 != 0)
 309         goto OFFSET($2);
 310 }
 311
 312 inline op if(invar NUM, inconst LABEL) {
 313     if (!FLOAT_IS_ZERO($1))
 314         goto OFFSET($2);
 315 }
 316
 317 op if (invar STR, inconst LABEL) {
 318     if (string_bool(interp, $1))
 319         goto OFFSET($2);
 320 }
 321
 322 op if(invar PMC, inconst LABEL) {
 323     if (VTABLE_get_bool(interp, $1))
 324         goto OFFSET($2);
 325 }
 326
 327 ########################################
 328
 329 =item B<unless>(invar INT, inconst LABEL)
 330
 331 =item B<unless>(invar NUM, inconst LABEL)
 332
 333 =item B<unless>(invar PMC, inconst LABEL)
 334
 335 =item B<unless>(invar STR, inconst LABEL)
 336
 337 Check register $1. If false, branch by $2.
 338
 339 =cut
 340
 341 inline op unless(invar INT, inconst LABEL) {
 342     if ($1 == 0)
 343         goto OFFSET($2);
 344 }
 345
 346 inline op unless(invar NUM, inconst LABEL) {
 347     if (FLOAT_IS_ZERO($1))
 348         goto OFFSET($2);
 349 }
 350
 351 op unless(invar STR, inconst LABEL) {
 352     if (!string_bool(interp, $1))
 353         goto OFFSET($2);
 354 }
 355
 356 op unless(invar PMC, inconst LABEL) {
 357     if (!VTABLE_get_bool(interp, $1))
 358         goto OFFSET($2);
 359 }
 360
 361 =back
 362
 363 =cut
 364
 365 ###############################################################################
 366
 367 =head2 Subroutine operations
 368
 369 These operations are used to generate and call subroutines and
 370 continuations.
 371
 372 =over 4
 373
 374 =cut
 375
 376 ########################################
 377
 378 =item B<invokecc>(invar PMC)
 379
 380 Call the subroutine in $1 and generate a new return continuation, if needed.
 381 For example, a NCI subroutine which executes code in some C library will not
 382 create a continuation, nor will anything but the first call to a coroutine.
 383
 384 =item B<invoke>(invar PMC, invar PMC)
 385
 386 Call the subroutine in $1 and use continuation $2.
 387
 388 =item B<yield>()
 389
 390 Yield results from a coroutine.
 391
 392 =item B<tailcall>(invar PMC)
 393
 394 Call the subroutine in $1 and use the current continuation as the subs
 395 continuation.
 396
 397 =item B<returncc>()
 398
 399 Return from the sub or method via the current continuation.
 400
 401 =item B<newclosure>(out PMC, invar PMC)
 402
 403 Create a closure of the given subroutine PMC by cloning the sub's state.
 404
 405 =cut
 406
 407 inline op invokecc(invar PMC) :flow {
 408     PMC      * const p     = $1;
 409     opcode_t *dest         = expr NEXT();
 410
 411     interp->current_object = NULL;
 412     interp->current_cont   = NEED_CONTINUATION;
 413     dest                   = (opcode_t *)p->vtable->invoke(interp, p, dest);
 414
 415     goto ADDRESS(dest);
 416 }
 417
 418 inline op invoke(invar PMC, invar PMC) :flow {
 419     opcode_t *dest;
 420     PMC * const p = $1;
 421
 422     interp->current_object = NULL;
 423     interp->current_cont = $2;
 424     dest = (opcode_t *)p->vtable->invoke(interp, p, expr NEXT());
 425     goto ADDRESS(dest);
 426 }
 427
 428 inline op yield() :flow {
 429     opcode_t *dest = expr NEXT();
 430     PMC * const p = CONTEXT(interp)->current_sub;
 431     dest = (opcode_t *)p->vtable->invoke(interp, p, dest);
 432     goto ADDRESS(dest);
 433 }
 434
 435 inline op tailcall(invar PMC) :flow {
 436     opcode_t *dest;
 437     PMC * const p = $1;
 438     dest = expr NEXT();
 439     interp->current_cont = CONTEXT(interp)->current_cont;
 440     PObj_get_FLAGS(interp->current_cont) |= SUB_FLAG_TAILCALL;
 441     dest = (opcode_t *)p->vtable->invoke(interp, p, dest);
 442     goto ADDRESS(dest);
 443 }
 444
 445 inline op returncc() :flow {
 446     PMC * const p = CONTEXT(interp)->current_cont;
 447     opcode_t * const dest = (opcode_t *)p->vtable->invoke(interp,
 448             p, expr NEXT());
 449     goto ADDRESS(dest);
 450 }
 451
 452 inline op newclosure(out PMC, invar PMC) {
 453     $1 = parrot_new_closure(interp, $2);
 454 }
 455
 456 =back
 457
 458 =head2 Function argument opcode
 459
 460 Implementations of function argument and params handling
 461
 462 =over 4
 463
 464 =item B<set_args>(inconst PMC /* , ... */)
 465
 466 Define arguments for the next function call.
 467
 468 =item B<get_results>(inconst PMC /* , ... */)
 469
 470 Define return values for the next function call.
 471
 472 =item B<get_params>(inconst PMC /* , ... */)
 473
 474 Define function parameters for this subroutine.
 475
 476 =item B<set_returns>(inconst PMC /* , ... */)
 477
 478 Define return results for the subroutine return statement.
 479
 480 For all of these opcodes the passed invar PMC constant is the string
 481 representation of a FixedIntegerArray with one flag word per argument.
 482 The flags are documented currently in F<include/parrot/enum.h> only.
 483
 484 After this argument a variable amount of arguments must follow according
 485 to the elements of the signature array.
 486
 487 =cut
 488
 489
 490 op set_args(inconst PMC) :flow {
 491     opcode_t * const _this = CUR_OPCODE;
 492     PMC * const signature = $1;
 493     INTVAL argc;
 494
 495     /* for now just point to the opcode */
 496     interp->current_args = _this;
 497     argc = SIG_ELEMS(signature);
 498     goto OFFSET(argc + 2);
 499 }
 500
 501 op get_results(inconst PMC) :flow {
 502     opcode_t * const _this = CUR_OPCODE;
 503     PMC * const signature = $1;
 504     INTVAL argc;
 505
 506     CONTEXT(interp)->current_results = _this;
 507     argc = SIG_ELEMS(signature);
 508     goto OFFSET(argc + 2);
 509 }
 510
 511 op get_params(inconst PMC) :flow {
 512     opcode_t * const _this = CUR_OPCODE;
 513     parrot_context_t *caller_ctx, *ctx;
 514     PMC * ccont;
 515     PMC * const signature = $1;
 516     INTVAL argc;
 517     opcode_t *src_indexes, *dst_indexes;
 518
 519     interp->current_params = _this;
 520     ctx = CONTEXT(interp);
 521     ccont = ctx->current_cont;
 522
 523     caller_ctx = ctx->caller_ctx;
 524
 525     src_indexes = interp->current_args;
 526     dst_indexes = interp->current_params;
 527     /* the args and params are now 'used.' */
 528     interp->current_args = NULL;
 529     interp->current_params = NULL;
 530
 531     parrot_pass_args(interp, caller_ctx, ctx, src_indexes, dst_indexes, PARROT_PASS_PARAMS);
 532     if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL) {
 533         PObj_get_FLAGS(ccont) &= ~SUB_FLAG_TAILCALL;
 534         --ctx->recursion_depth;
 535         ctx->caller_ctx = caller_ctx->caller_ctx;
 536         /* ordinarily, this will free the context immediately, but not if the
 537            sub created a closure (or continuation, or . . .).  */
 538         Parrot_free_context(interp, caller_ctx, 0);
 539         interp->current_args = NULL;
 540     }
 541     argc = SIG_ELEMS(signature);
 542     goto OFFSET(argc + 2);
 543 }
 544
 545 op set_returns(inconst PMC) :flow {
 546     opcode_t * const _this = CUR_OPCODE;
 547     parrot_context_t *ctx;
 548     PMC *ccont;
 549     PMC *signature = $1;
 550     INTVAL argc;
 551     opcode_t *src_indexes, *dest_indexes;
 552
 553     interp->current_returns = _this;
 554     ctx = CONTEXT(interp);
 555     ccont = ctx->current_cont;
 556
 557     if (PMC_cont(ccont)->address) {
 558         /* else it's from runops_fromc */
 559         parrot_context_t * const caller_ctx = PMC_cont(ccont)->to_ctx;
 560         if (! caller_ctx) {
 561             /* there is no point calling real_exception here, because
 562                PDB_backtrace can't deal with a missing to_ctx either. */
 563             internal_exception(1, "No caller_ctx for continuation %p.", ccont);
 564         }
 565
 566         src_indexes = interp->current_returns;
 567         dest_indexes = caller_ctx->current_results;
 568         interp->current_returns = NULL;
 569         /* does this need to be here */
 570         interp->current_args = NULL;
 571
 572         parrot_pass_args(interp, ctx, caller_ctx, src_indexes, dest_indexes, PARROT_PASS_RESULTS);
 573     }
 574     argc = SIG_ELEMS(signature);
 575     goto OFFSET(argc + 2);
 576 }
 577
 578 =item B<result_info>(out PMC)
 579
 580 Returns the get_results signature PMC of the caller. This PMC is a
 581 FixedIntegerPMCArray. The number of elements of this PMC is equal to the number
 582 of return values that are expected.  The individual bits per entry are
 583 specified in F<docs/pdds/pdd03_calling_conventions.pod>.
 584
 585 =cut
 586
 587 inline op result_info(out PMC) {
 588     /* Get context of callee from return continuation. */
 589     PMC * const cc = CONTEXT(interp)->current_cont;
 590     PMC *sig = NULL;
 591     if (cc && PMC_cont(cc)->to_ctx) {
 592         /* caller context has results */
 593         opcode_t * const results = PMC_cont(cc)->to_ctx->current_results;
 594         if (results) {
 595             /* get results PMC index and get PMC. */
 596             sig = PF_CONST(PMC_cont(cc)->seg, results[1])->u.key;
 597         }
 598     }
 599
 600     /* If no elements, hand back empty array; otherwise PMC. */
 601     if (!sig)
 602         $1 = pmc_new(interp, enum_class_FixedIntegerArray);
 603     else
 604         $1 = sig;
 605 }
 606
 607 =back
 608
 609 =head2 Address manipulation
 610
 611 =for clarity
 612
 613 =cut
 614
 615 =over 4
 616
 617 =item B<set_addr>(out INT, inconst LABEL)
 618
 619 Sets register $1 to the current address plus the offset $2.
 620
 621 =item B<set_addr>(invar PMC, inconst LABEL)
 622
 623 Sets PMC in register $1 to the current address plus the offset $2.
 624
 625 =item B<set_addr>(invar PMC, invar LABEL)
 626
 627 Sets PMC in register $1 to the absolute address $2 obtained from B<get_addr>.
 628
 629 =item B<get_addr>(out INT, invar PMC)
 630
 631 Sets $1 to the absolute address of the Sub PMC $2.
 632
 633 =cut
 634
 635 inline op set_addr(out INT, inconst LABEL) {
 636     $1 = PTR2OPCODE_T(CUR_OPCODE + $2);
 637 }
 638
 639 inline op set_addr(invar PMC, inconst LABEL) {
 640     VTABLE_set_pointer(interp, $1, (CUR_OPCODE + $2));
 641 }
 642
 643 inline op set_addr(invar PMC, invar LABEL) {
 644     VTABLE_set_pointer(interp, $1, (void*)$2);
 645 }
 646
 647 inline op get_addr(out INT, invar PMC) {
 648     void *ptr = VTABLE_get_pointer(interp, $2);
 649     $1        = (INTVAL)ptr;
 650 }
 651
 652 =back
 653
 654 =cut
 655
 656 ########################################
 657
 658 =head2 Concurrency operations
 659
 660 =over 4
 661
 662 =item B<schedule>(invar PMC)
 663
 664 Register a task with the concurrency scheduler. Details about the task are
 665 stored within the task PMC.
 666
 667 inline op schedule(invar PMC) {
 668     Parrot_cx_schedule_task(interp, $1);
 669 }
 670
 671 =item B<addhandler>(invar PMC)
 672
 673 Add an event or exception handler to the concurrency scheduler. Details about
 674 the handler are stored within the handler PMC.
 675
 676 inline op addhandler(invar PMC) {
 677     Parrot_cx_add_handler(interp, $1);
 678 }
 679
 680 =back
 681
 682 =cut
 683
 684 ########################################
 685
 686 =head2 Exception handling
 687
 688 =over 4
 689
 690 =item B<push_eh>(inconst LABEL)
 691
 692 Create an exception handler for the given catch label and push it onto
 693 the exception handler stack.
 694
 695 =item B<push_eh>(invar PMC)
 696
 697 Push an invokable PMC onto the exception handler stack.
 698
 699 =item B<pop_eh>()
 700
 701 Pop the most recently placed exception off the handler stack.
 702
 703 =item B<throw>(invar PMC)
 704
 705 Throw the exception in $1.
 706
 707 =item B<throwcc>(invar PMC)
 708
 709 Throw the exception in $1 with current continuation. Identical to
 710 B<throw> in its one-argument form.
 711
 712 =item B<throwcc>(invar PMC, invar PMC)
 713
 714 Throw the exception in $1 with continuation from $2.
 715
 716 =item B<rethrow>(invar PMC)
 717
 718 Only valid inside an exception handler. Rethrow the exception $1.
 719
 720 =item B<count_eh>(out INT)
 721
 722 Get a count of currently active exception handlers on the stack.
 723
 724 =item B<get_eh>(out PMC, in INT)
 725
 726 Return the exception handler at I<index>. The index is an offset from the top
 727 of the stack, with '0' being the top.
 728
 729 =item B<get_all_eh>(out PMC)
 730
 731 Return an array of all current exception handlers.
 732
 733 =item B<die>(in STR)
 734 =item B<die>(in PMC)
 735
 736 Die with message $1
 737
 738 =item B<die>(in INT, in INT)
 739
 740 Die with severity $1 and error $2. If severity is .EXCEPT_DOOMED,
 741 call _exit($2). The latter isn't catchable.
 742
 743 =item B<exit>(in INT)
 744
 745 Exit the interpreter with exit_status $1. If you want to communicate an
 746 extended exit status, create an exception with severity B<EXCEPT_exit>
 747 and throw it.
 748
 749 =item B<pushmark>(in INT)
 750
 751 Push a mark labeled $1 onto the dynamic environment.
 752
 753 =item B<popmark>(in INT)
 754
 755 Pop all items off the dynamic environment to the given mark.
 756
 757 =item B<pushaction>(invar PMC)
 758
 759 Push the given Sub PMC $1 onto the dynamic environment.  If the dynamic
 760 environment is unwound due to a C<popmark>, subroutine return, or an exception,
 761 the subroutine will be invoked with an integer argument: C<0> means a normal
 762 return; C<1> means an exception has been raised.
 763
 764 =cut
 765
 766 inline op push_eh(inconst LABEL) {
 767     PMC * const eh = pmc_new(interp, enum_class_Exception_Handler);
 768     VTABLE_set_pointer(interp, eh, CUR_OPCODE + $1);
 769     push_exception(interp, eh);
 770 }
 771
 772 inline op push_eh(invar PMC) {
 773     push_exception(interp, $1);
 774 }
 775
 776 inline op pop_eh() {
 777     pop_exception(interp);
 778 }
 779
 780 inline op throw(invar PMC) :flow {
 781     opcode_t * const ret = expr NEXT();
 782     opcode_t * const dest = (opcode_t *)throw_exception(interp, $1, ret);
 783     goto ADDRESS(dest);
 784 }
 785
 786 inline op throwcc(invar PMC) :flow {
 787     opcode_t * const ret = expr NEXT();
 788     opcode_t * const dest = (opcode_t *)throw_exception(interp, $1, ret);
 789     goto ADDRESS(dest);
 790 }
 791
 792 inline op throwcc(invar PMC, invar PMC) :flow {
 793     opcode_t * const dest = (opcode_t *)throw_exception(interp, $1, $2);
 794     goto ADDRESS(dest);
 795 }
 796
 797 inline op rethrow(invar PMC) :flow {
 798     opcode_t * const dest = (opcode_t *)rethrow_exception(interp, $1);
 799     goto ADDRESS(dest);
 800 }
 801
 802 inline op count_eh(out INT) {
 803     $1 = count_exception_handlers(interp);
 804 }
 805
 806 inline op get_eh(out PMC, in INT) {
 807     $1 = get_exception_handler(interp, $2);
 808 }
 809
 810 inline op get_all_eh(out PMC) {
 811     $1 = get_all_exception_handlers(interp);
 812 }
 813
 814
 815 inline op die(in STR) :flow {
 816     do_str_exception(interp, $1);
 817 }
 818
 819 inline op die(in PMC) :flow {
 820     do_pmc_exception(interp, $1);
 821 }
 822
 823 inline op die(in INT, in INT) :flow {
 824     if ($1 == EXCEPT_doomed)
 825         _exit($2);
 826     do_exception(interp, $1, $2);
 827 }
 828
 829 inline op exit(in INT) :flow {
 830     do_exception(interp, EXCEPT_exit, $1);
 831 }
 832
 833 inline op pushmark(in INT) {
 834     Parrot_push_mark(interp, $1);
 835 }
 836
 837 inline op popmark(in INT) {
 838     Parrot_pop_mark(interp, $1);
 839 }
 840
 841 inline op pushaction(invar PMC) {
 842     Parrot_push_action(interp, $1);
 843 }
 844
 845 =back
 846
 847 =cut
 848
 849 ###############################################################################
 850
 851 =head2 Interpreter operations
 852
 853 These operations inspect or modify the interpreter itself, possibly
 854 affecting its subsequent operation.
 855
 856 =over 4
 857
 858 =cut
 859
 860 ########################################
 861
 862 =item B<debug>(in INT)
 863
 864 If $1 is zero, turn off debugging. Otherwise turn debug flag $1 on.
 865
 866 =cut
 867
 868 inline op debug(in INT) :flow {
 869     if ($1 != 0) { Interp_debug_SET(interp,   $1); }
 870     else         { Interp_debug_CLEAR(interp, PARROT_ALL_DEBUG_FLAGS); }
 871     restart NEXT();
 872 }
 873
 874
 875 ########################################
 876
 877 =item B<bounds>(in INT)
 878
 879 If $1 is zero, turn off byte code bounds checking. Otherwise turn it on.
 880
 881 =cut
 882
 883 inline op bounds(in INT) :flow {
 884     if ($1 != 0) { Parrot_set_flag(interp,   PARROT_BOUNDS_FLAG); }
 885     else         { Interp_flags_CLEAR(interp, PARROT_BOUNDS_FLAG); }
 886     restart NEXT();
 887 }
 888
 889
 890 ########################################
 891
 892 =item B<profile>(in INT)
 893
 894 If $1 is zero, turn off profiling. Otherwise turn it on.
 895
 896 =cut
 897
 898 inline op profile(in INT) :flow {
 899     if ($1 != 0) { Parrot_set_flag(interp,   PARROT_PROFILE_FLAG); }
 900     else         { Interp_flags_CLEAR(interp, PARROT_PROFILE_FLAG); }
 901     restart NEXT();
 902 }
 903
 904
 905 ########################################
 906
 907 =item B<trace>(in INT)
 908
 909 If $1 is zero, turn off tracing. Otherwise turn trace flag $1 on.
 910
 911 =cut
 912
 913 inline op trace(in INT) :flow {
 914     if ($1 != 0) { Parrot_set_trace(interp,   $1); }
 915     else         { Parrot_clear_trace(interp, PARROT_ALL_TRACE_FLAGS); }
 916     restart NEXT();
 917 }
 918
 919 ########################################
 920
 921 =item B<gc_debug>(in INT)
 922
 923 If $1 is zero, turn off GC_DEBUG. Otherwise turn it on.
 924
 925 =cut
 926
 927 inline op gc_debug(in INT) {
 928     if ($1 != 0) { Interp_flags_SET(interp,   PARROT_GC_DEBUG_FLAG); }
 929     else         { Interp_flags_CLEAR(interp, PARROT_GC_DEBUG_FLAG); }
 930 }
 931
 932 ########################################
 933
 934 =item B<interpinfo>
 935
 936 Fetch some piece of information about the interpreter and put it in $1.
 937 Possible values for $2 are defined in F<runtime/parrot/include/interpinfo.pasm>.
 938 The valid constants for each return value are:
 939
 940 =over 4
 941
 942 =item B<interpinfo>(out INT, in INT)
 943
 944 .TOTAL_MEM_ALLOC, .DOD_RUNS, .COLLECT_RUNS, .ACTIVE_PMCS, .ACTIVE_BUFFERS,
 945 .TOTAL_PMCS, .TOTAL_BUFFERS, .HEADER_ALLOCS_SINCE_COLLECT,
 946 .MEM_ALLOCS_SINCE_COLLECT, .TOTAL_COPIED, .IMPATIENT_PMCS, .LAZY_DOD_RUNS,
 947 .EXTENDED_PMCS, .RUNCORE
 948
 949 =item B<interpinfo>(out PMC, in INT)
 950
 951 .CURRENT_SUB, .CURRENT_CONT, .CURRENT_OBJECT, .CURRENT_LEXPAD
 952
 953 =item B<interpinfo>(out STR, in INT)
 954
 955 .EXECUTABLE_FULLNAME, .EXECUTABLE_BASENAME, .RUNTIME_PREFIX
 956
 957 =back
 958
 959 =cut
 960
 961 op interpinfo(out INT, in INT) {
 962     $1 = interpinfo(interp, $2);
 963 }
 964
 965 op interpinfo(out PMC, in INT) {
 966     $1 = interpinfo_p(interp, $2);
 967 }
 968
 969 op interpinfo(out STR, in INT) {
 970     $1 = interpinfo_s(interp, $2);
 971 }
 972
 973 =item B<warningson>(in INT)
 974
 975 Turns on warnings categories. Categories already turned on will stay on.
 976 Initial setting is currently all warnings off.  Include F<warnings.pasm> to
 977 access the categories. Refer to that file for the current list of warnings
 978 available.
 979
 980 =over 4
 981
 982 =back
 983
 984 To turn on multiple categories, OR the category numbers together.
 985
 986 =cut
 987
 988 inline op warningson(in INT) {
 989     PARROT_WARNINGS_on(interp, $1);
 990 }
 991
 992 =item B<warningsoff>(in INT)
 993
 994 Turns off warnings categories.  Categories already turned off will
 995 stay off.  See the documentation for B<warningson> for category
 996 numbers.
 997
 998 =cut
 999
1000 inline op warningsoff(in INT) {
1001     PARROT_WARNINGS_off(interp, $1);
1002 }
1003
1004 =item B<errorson>(in INT)
1005
1006 Turns on error categories. Categories already turned on will stay on.  To
1007 access these from PASM, include F<errors.pasm>.  The current categories are:
1008
1009 =over 4
1010
1011 =item .PARROT_ERRORS_GLOBALS_FLAG
1012
1013 Throw an exception if global doesn't exist.  Default: on.
1014
1015 =item .PARROT_ERRORS_OVERFLOW_FLAG
1016
1017 Throw math overflow instead of promoting to BigInt.  Default: off.
1018
1019 =item .PARROT_ERRORS_PARAM_COUNT_FLAG
1020
1021 Throw exception on argument <-> param count mismatch.  Default: off.
1022
1023 =item .PARROT_ERRORS_RESULT_COUNT_FLAG
1024
1025 Throw exception on return <-> result count mismatch.  Default: off.
1026
1027 =item .PARROT_ERRORS_ALL_FLAG
1028
1029 =back
1030
1031 To turn on multiple categories, OR the category numbers together.
1032
1033 =cut
1034
1035 inline op errorson(in INT) {
1036     PARROT_ERRORS_on(interp, $1);
1037 }
1038
1039 =item B<errorsoff>(in INT)
1040
1041 Turns off errors categories.  Categories already turned off will
1042 stay off.  See the documentation for B<errorson> for category
1043 numbers.
1044
1045 =cut
1046
1047 inline op errorsoff(in INT) {
1048     PARROT_ERRORS_off(interp, $1);
1049 }
1050
1051 ########################################
1052
1053 =item B<runinterp>(invar PMC, in LABEL)
1054
1055 Run the code starting at offset $2 within interpreter $1.
1056
1057 =item B<getinterp>(out PMC)
1058
1059 Get the current ParrotInterpreter.
1060
1061 =cut
1062
1063 op runinterp(invar PMC, in LABEL) {
1064     Interp * const new_interp = (Interp *)PMC_data($1);
1065     Interp_flags_SET(new_interp, PARROT_EXTERN_CODE_FLAG);
1066     new_interp->code = interp->code;
1067     runops(new_interp, REL_PC + $2);
1068 }
1069
1070 op getinterp(out PMC) {
1071     $1 = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
1072            IGLOBALS_INTERPRETER);
1073 }
1074
1075 #######################################
1076
1077
1078
1079 =back
1080
1081 =cut
1082
1083 ###############################################################################
1084
1085 =head2 Dead Object Detection/Garbage Collection
1086
1087 Opcodes that interact with the DOD and GC subsystems.
1088
1089 =over 4
1090
1091 =cut
1092
1093 ########################################
1094
1095 =item B<sweep>(inconst INT)
1096
1097 Triggers a DOD run, based on the value of $1, where:
1098
1099 =over
1100
1101 =item * 0
1102
1103 Trigger a DOD run only if there are things that have flagged themselves as
1104 really needing to be collected.
1105
1106 =item * 1
1107
1108 Trigger a dead object detection (DOD) sweep unconditionally.
1109
1110 =back
1111
1112 =cut
1113
1114 op sweep(inconst INT) {
1115     if ($1)
1116         Parrot_do_dod_run(interp, 0);
1117     else
1118         if (interp->arena_base->num_early_DOD_PMCs)
1119             Parrot_do_dod_run(interp, GC_lazy_FLAG);
1120 }
1121
1122 =item B<collect>()
1123
1124 Trigger a garbage collection.
1125
1126 =cut
1127
1128 op collect() {
1129     Parrot_go_collect(interp);
1130 }
1131
1132 =item B<sweepoff>()
1133
1134 Disable DOD sweeps. (Nestable)
1135
1136 =cut
1137
1138 op sweepoff() {
1139     Parrot_block_GC_mark(interp);
1140 }
1141
1142 =item B<sweepon>()
1143
1144 Re-enable DOD sweeps.
1145
1146 =cut
1147
1148 op sweepon() {
1149     Parrot_unblock_GC_mark(interp);
1150 }
1151
1152 =item B<collectoff>()
1153
1154 Disable GC runs (nestable).
1155
1156 =cut
1157
1158 op collectoff() {
1159     Parrot_block_GC_sweep(interp);
1160 }
1161
1162 =item B<collecton>()
1163
1164 Re-enable GC.
1165
1166 =cut
1167
1168 op collecton() {
1169     Parrot_unblock_GC_sweep(interp);
1170 }
1171
1172 =item B<needs_destroy>(invar PMC)
1173
1174 Mark the PMC wanting destruction as soon as possible, for example
1175 when unused during the lazy sweep, triggered by C<sweep 0>.
1176
1177 =cut
1178
1179 op needs_destroy(invar PMC) {
1180      PObj_needs_early_DOD_SET($1);
1181      ++interp->arena_base->num_early_DOD_PMCs;
1182 }
1183
1184 =back
1185
1186 =head2 Native Call Interface
1187
1188 Opcodes for interfacing with C functions in shared libraries.
1189
1190 =over 4
1191
1192 =cut
1193
1194 ########################################
1195
1196 =item B<loadlib>(out PMC, in STR)
1197
1198 Load a dynamic link library named $2 and store it in $1.
1199
1200 =item B<dlfunc>(out PMC, invar PMC, in STR, in STR)
1201
1202 Look up symbol $3 in library $2 with signature $4, and put the
1203 corresponding sub object in $1. Note that you need the signature so we
1204 can build or find an appropriate thunking function.
1205
1206 =item B<dlvar>(out PMC, invar PMC, in STR)
1207
1208 Look up symbol $3 in library $2. We assume that this is actually a
1209 variable address rather than a function address, and build an
1210 UnManagedStruct PMC and stick the address into its data pointer.
1211
1212 =item B<compreg>(out PMC, in STR)
1213
1214 Get the compiler object for source type $2.  The returned compiler
1215 object should provide a C<compile> method for translating code
1216 in the source type.  However, some Parrot compilers such as
1217 C<PIR> and C<PASM> currently return a sub that is to be
1218 invoked directly on the source.
1219
1220 =item B<compreg>(in STR, invar PMC)
1221
1222 Register $2 as the compiler object for source type $1.
1223
1224 =item B<new_callback>(out PMC, invar PMC, invar PMC, in STR)
1225
1226 Create a callback stub $1 for PASM subroutine $2 with userdata $3 and
1227 callback function signature $4. Only 2 argument signatures with
1228 signature chars I<U[1iscpt]> or I<[1iscpt]U>  are handled currently.
1229 But these cover a lot of callback signatures. Please note that the
1230 userdata PMC I<U> has to be handled transparently by the caller of
1231 the callback function.
1232
1233 =cut
1234
1235 inline op loadlib(out PMC, in STR) {
1236     $1 = Parrot_load_lib(interp, $2, NULL);
1237 }
1238
1239 op dlfunc(out PMC, invar PMC, in STR, in STR) {
1240     char * const name = string_to_cstring(interp, ($3));
1241     void *ptr         = Parrot_dlsym(
1242                             PMC_IS_NULL($2) ? NULL :
1243                             VTABLE_defined(interp, $2) ? PMC_data($2) :
1244                             NULL,
1245                             name);
1246
1247     funcptr_t p = D2FPTR(ptr);
1248
1249     if (p == NULLfunc) {
1250         const char * err = Parrot_dlerror();
1251         Parrot_warn(interp, PARROT_WARNINGS_UNDEF_FLAG,
1252                 "Symbol '%s' not found: %s\n", name, err ? err : "unknown reason");
1253         $1 = pmc_new(interp, enum_class_Undef);
1254     }
1255     else {
1256         $1 = pmc_new(interp, enum_class_NCI);
1257         VTABLE_set_pointer_keyed_str(interp, $1, $4, F2DPTR(p));
1258         PObj_get_FLAGS($1) |= PObj_private1_FLAG;
1259     }
1260     string_cstring_free(name);
1261 }
1262
1263 op dlvar(out PMC, invar PMC, in STR) {
1264     char * const name = string_to_cstring(interp, ($3));
1265     void * const p = Parrot_dlsym(PMC_IS_NULL($2) ? NULL : PMC_data($2), name);
1266     string_cstring_free(name);
1267     if (p == NULL) {
1268         const char * const err = Parrot_dlerror();
1269         Parrot_warn(interp, PARROT_WARNINGS_UNDEF_FLAG,
1270                 "Symbol '%s' not found: %s\n", name, err ? err : "unknown reason");
1271         $1 = pmc_new(interp, enum_class_Undef);
1272     }
1273     else {
1274         /* At this point we have the symbol's address. We just need to build
1275            a PMC with it so we can get and set the value */
1276         $1 = pmc_new(interp, enum_class_UnManagedStruct);
1277         PMC_data($1) = p;
1278     }
1279 }
1280
1281 inline op compreg(in STR, invar PMC) {
1282     PMC * const compreg_hash = VTABLE_get_pmc_keyed_int(interp,
1283             interp->iglobals, IGLOBALS_COMPREG_HASH);
1284     VTABLE_set_pmc_keyed_str(interp, compreg_hash, $1, $2);
1285 }
1286
1287 inline op compreg(out PMC, in STR) {
1288     PMC * const compreg_hash = VTABLE_get_pmc_keyed_int(interp,
1289             interp->iglobals, IGLOBALS_COMPREG_HASH);
1290     $1 = VTABLE_get_pmc_keyed_str(interp, compreg_hash, $2);
1291 }
1292
1293 op new_callback(out PMC, invar PMC, invar PMC, in STR) {
1294     $1 = Parrot_make_cb(interp, $2, $3, $4);
1295 }
1296
1297 =back
1298
1299 =cut
1300
1301 ###############################################################################
1302
1303 =head1 COPYRIGHT
1304
1305 Copyright (C) 2001-2008, The Perl Foundation.
1306
1307 =head1 LICENSE
1308
1309 This program is free software. It is subject to the same license
1310 as the Parrot interpreter itself.
1311
1312 =cut
1313
1314 /*
1315  * Local variables:
1316  *   c-file-style: "parrot"
1317  * End:
1318  * vim: expandtab shiftwidth=4:
1319  */