src/ops/core.ops

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