core.ops

/*
** core.ops
*/

BEGIN_OPS_PREAMBLE

#include "parrot/dynext.h"
#include "parrot/embed.h"
#include "parrot/runcore_api.h"
#include "pmc/pmc_continuation.h"
#include "pmc/pmc_fixedintegerarray.h"
#include "pmc/pmc_parrotlibrary.h"

END_OPS_PREAMBLE

=head1 NAME

core.ops - Core Opcodes

=cut

=head1 DESCRIPTION

Parrot's core library of ops.

Core operations are primarily flow control and interpreter
introspection.

When making changes to any ops file, run C<make bootstrap-ops> to regenerate
all generated ops files.

=cut

# ' for emacs

###############################################################################

=head2 Basic ops

These are the fundamental operations.
Please note: These opcodes must not be moved; they must have
exactly these opcode numbers. Opcodes ending with underscores are for
internal use only; don't emit these opcodes.

=over 4

=cut

########################################

=item B<end>()

Halts the interpreter. See also B<exit>.

=cut

inline op end() :base_core :check_event :flow {
    goto ADDRESS(0);
}


########################################

=item B<noop>()

Does nothing other than waste an iota of time and 32 bits of bytecode space.

=item B<check_events>()

Check the event queue and run event handlers if there are unhandled events.
Note: This opcode is mainly for testing. It should not be necessary to ever
use it explicitly.

=item B<check_events__>()

Check the event queue and run event handlers if there are unhandled events.
Note: Do B<not> use this opcode. It is for internal use only.

=item B<load_bytecode>(in STR)

Load Parrot bytecode from file $1, and search the library path to locate the
file.

=cut

inline op noop() :base_core {
}

inline op check_events() :base_core :flow {
    opcode_t * const next = expr NEXT();
    Parrot_cx_check_tasks(interp, interp->scheduler);
    goto ADDRESS(next);   /* force this being a branch op */
}

inline op check_events__() :internal :flow {
    opcode_t * const _this = CUR_OPCODE;
    /* Restore op_func_table. */
    disable_event_checking(interp);
    Parrot_cx_handle_tasks(interp, interp->scheduler);
    goto ADDRESS(_this);   /* force this being a branch op */
}

inline op load_bytecode(in STR) :load_file {
    Parrot_load_bytecode(interp, $1);
}

=item B<load_language>(in STR)

Load the compiler libraries for a language $1. Search the library path to
locate the main compiler file in the standard locations.

=cut

inline op load_language(in STR) :load_file {
    Parrot_load_language(interp, $1);
}

=back

=cut

###############################################################################

=head2 Control flow

The control flow opcodes check conditions and manage program flow.

=over 4

=cut

########################################

=item B<branch>(in LABEL)

Branch forward or backward by the amount in $1.

=cut

inline op branch(in LABEL) :base_loop :flow {
    goto OFFSET($1);
}


########################################

=item B<local_branch>(invar PMC, in LABEL)

Go to the location specified by the label in $2. Push the current location onto
the stack passed in $1 for later returning.

=cut

inline op local_branch(invar PMC, in LABEL) :base_core :check_event :flow {
    INTVAL return_addr;
    opcode_t * const dest = expr NEXT();

    if (PMC_IS_NULL($1) || $1->vtable->base_type != enum_class_ResizableIntegerArray) {
        opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, dest,
            EXCEPTION_INVALID_OPERATION,
            "Must pass a valid integer array to 'local_branch'");
        goto ADDRESS(handler);
    }

    return_addr = PTR2INTVAL(dest);
    VTABLE_push_integer(interp, $1, return_addr);

    goto OFFSET($2);
}

=item B<local_return>(invar PMC)

Pop the location off the top of the call stack and go there.

=cut

inline op local_return(invar PMC) :flow {
    INTVAL return_addr;
    opcode_t *next;
    opcode_t * const dest = expr NEXT();

    if (PMC_IS_NULL($1) || $1->vtable->base_type != enum_class_ResizableIntegerArray) {
        opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, dest,
            EXCEPTION_INVALID_OPERATION,
            "Must pass a valid integer array to 'local_return'");
        goto ADDRESS(handler);
    }

    return_addr = VTABLE_pop_integer(interp, $1);
    next = INTVAL2PTR(opcode_t *, return_addr);

    /* The return address must be within the current code segment. */
    if (! (next >= interp->code->base.data
           && next < (interp->code->base.data + interp->code->base.size))) {
        opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, dest,
            EXCEPTION_INVALID_OPERATION,
            "Address for 'local_return' must be within the current code segment");
        goto ADDRESS(handler);
    }

    goto ADDRESS(next);
}

########################################

=item B<jump>(in LABEL)

Jump to the address held in register $1.

=cut

inline op jump(in LABEL) :base_loop :flow {
    opcode_t * const loc = INTVAL2PTR(opcode_t *, $1);
    goto ADDRESS(loc);
}

=back

=cut

###############################################################################

=head2 Conditional branch operations

These operations perform a conditional relative branch. If the condition is
met, the branch happens.  Otherwise control falls to the next operation.

=over 4

=cut

########################################

=item B<if>(invar INT, inconst LABEL)

=item B<if>(invar NUM, inconst LABEL)

=item B<if>(invar PMC, inconst LABEL)

=item B<if>(invar STR, inconst LABEL)

Check register $1. If true, branch by $2.

=cut

inline op if (invar INT, inconst LABEL) {
    if ($1 != 0)
        goto OFFSET($2);
}

inline op if (invar NUM, inconst LABEL) {
    if (!FLOAT_IS_ZERO($1))
        goto OFFSET($2);
}

op if (invar STR, inconst LABEL) {
    if (Parrot_str_boolean(interp, $1))
        goto OFFSET($2);
}

op if (invar PMC, inconst LABEL) {
    if (VTABLE_get_bool(interp, $1))
        goto OFFSET($2);
}

########################################

=item B<unless>(invar INT, inconst LABEL)

=item B<unless>(invar NUM, inconst LABEL)

=item B<unless>(invar PMC, inconst LABEL)

=item B<unless>(invar STR, inconst LABEL)

Check register $1. If false, branch by $2.

=cut

inline op unless(invar INT, inconst LABEL) {
    if ($1 == 0)
        goto OFFSET($2);
}

inline op unless(invar NUM, inconst LABEL) {
    if (FLOAT_IS_ZERO($1))
        goto OFFSET($2);
}

op unless(invar STR, inconst LABEL) {
    if (!Parrot_str_boolean(interp, $1))
        goto OFFSET($2);
}

op unless(invar PMC, inconst LABEL) {
    if (!VTABLE_get_bool(interp, $1))
        goto OFFSET($2);
}

=back

=cut

###############################################################################

=head2 Subroutine operations

These operations are used to generate and call subroutines and
continuations.

=over 4

=cut

########################################

=item B<invokecc>(invar PMC)

Call the subroutine in $1 and generate a new return continuation, if needed.
For example, a NCI subroutine which executes code in some C library will not
create a continuation, nor will anything but the first call to a coroutine.

=item B<invoke>(invar PMC, invar PMC)

Call the subroutine in $1 and use continuation $2.

=item B<yield>()

Yield results from a coroutine.

=item B<tailcall>(invar PMC)

Call the subroutine in $1 and use the current continuation as the subs
continuation.

=item B<returncc>()

Return from the sub or method via the current continuation.

=item B<capture_lex>(invar PMC)

Capture the current lexical state of the inner subroutine PMC.

=item B<newclosure>(out PMC, invar PMC)

Create a closure of the given subroutine PMC by cloning the sub's state.

=cut

inline op invokecc(invar PMC) :flow {
    PMC      * const p     = $1;
    opcode_t *dest         = expr NEXT();
    PMC      * const signature = Parrot_pcc_get_signature(interp,
                                    CURRENT_CONTEXT(interp));

    Parrot_pcc_set_pc(interp, CURRENT_CONTEXT(interp), dest);

    if (!PMC_IS_NULL(signature))
        Parrot_pcc_set_object(interp, signature, NULL);
    interp->current_cont   = NEED_CONTINUATION;
    dest                   = VTABLE_invoke(interp, p, dest);

    goto ADDRESS(dest);
}

inline op invoke(invar PMC, invar PMC) :flow {
    opcode_t   *dest       = expr NEXT();
    PMC * const p          = $1;
    PMC * const signature  = Parrot_pcc_get_signature(interp,
                                    CURRENT_CONTEXT(interp));

    Parrot_pcc_set_pc(interp, CURRENT_CONTEXT(interp), dest);

    if (!PMC_IS_NULL(signature))
        Parrot_pcc_set_object(interp, signature, NULL);
    interp->current_cont   = $2;

    dest = VTABLE_invoke(interp, p, dest);
    goto ADDRESS(dest);
}

inline op yield() :flow {
    opcode_t   *dest = expr NEXT();
    PMC * const p    = Parrot_pcc_get_sub(interp, CURRENT_CONTEXT(interp));

    VTABLE_increment(interp, p);
    dest = VTABLE_invoke(interp, p, dest);

    goto ADDRESS(dest);
}

inline op tailcall(invar PMC) :flow {
    PMC * const p               = $1;
    opcode_t   *dest            = expr NEXT();
    PMC * const ctx             = CURRENT_CONTEXT(interp);
    PMC * const parent_ctx      = Parrot_pcc_get_caller_ctx(interp, ctx);
    PMC * const this_call_sig   = Parrot_pcc_get_signature(interp, ctx);
    PMC * const parent_call_sig = Parrot_pcc_get_signature(interp, parent_ctx);
    interp->current_cont        = Parrot_pcc_get_continuation(interp, ctx);

    Parrot_pcc_merge_signature_for_tailcall(interp, parent_call_sig, this_call_sig);

    SUB_FLAG_TAILCALL_SET(interp->current_cont);
    dest = VTABLE_invoke(interp, p, dest);
    goto ADDRESS(dest);
}

inline op returncc() :flow {
    PMC * const p = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp));
    opcode_t * const dest = VTABLE_invoke(interp, p, expr NEXT());
    goto ADDRESS(dest);
}

inline op capture_lex(invar PMC) {
    Parrot_sub_capture_lex(interp, $1);
}

inline op newclosure(out PMC, invar PMC) {
    $1 = Parrot_sub_new_closure(interp, $2);
}

=back

=head2 Function argument opcode

Implementations of function argument and params handling

=over 4

=item B<set_args>(inconst PMC /* , ... */)

Define arguments for the next function call.

=item B<get_results>(inconst PMC /* , ... */)

Define return values for the next function call.

=item B<get_params>(inconst PMC /* , ... */)

Define function parameters for this subroutine.

=item B<set_returns>(inconst PMC /* , ... */)

Define return results for the subroutine return statement.

For all of these opcodes the passed invar PMC constant is the string
representation of a FixedIntegerArray with one flag word per argument.
The flags are documented currently in F<include/parrot/enums.h> only.

After this argument a variable amount of arguments must follow according
to the elements of the signature array.

=cut


op set_args(inconst PMC) :flow {
    opcode_t * const raw_args = CUR_OPCODE;
    PMC * const signature = $1;
    PMC * const call_sig = Parrot_pcc_build_sig_object_from_op(interp,
            PMCNULL, signature, raw_args);
    INTVAL argc;
    GETATTR_FixedIntegerArray_size(interp, signature, argc);
    Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), call_sig);
    goto OFFSET(argc + 2);
}

op get_params(inconst PMC) :flow {
    opcode_t * const raw_params  = CUR_OPCODE;
    PMC      * const signature   = $1;
    PMC      * const ctx         = CURRENT_CONTEXT(interp);
    PMC      * const ccont       = Parrot_pcc_get_continuation(interp, ctx);
    PMC      * const caller_ctx  = Parrot_pcc_get_caller_ctx(interp, ctx);
    PMC      * const call_object = Parrot_pcc_get_signature(interp, caller_ctx);
    INTVAL argc;

    Parrot_pcc_fill_params_from_op(interp, call_object, signature, raw_params,
            PARROT_ERRORS_PARAM_COUNT_FLAG);

    /* TODO Factor out with Sub.invoke */
    if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL) {
        PObj_get_FLAGS(ccont) &= ~SUB_FLAG_TAILCALL;
        Parrot_pcc_dec_recursion_depth(interp, ctx);
        Parrot_pcc_set_caller_ctx(interp, ctx, Parrot_pcc_get_caller_ctx(interp, caller_ctx));
    }
    GETATTR_FixedIntegerArray_size(interp, signature, argc);
    goto OFFSET(argc + 2);
}

op set_returns(inconst PMC) :flow {
    opcode_t * const raw_args  = CUR_OPCODE;
    PMC      * const signature = $1;
    PMC      * const call_sig  = Parrot_pcc_build_sig_object_from_op(interp,
                Parrot_pcc_get_signature(interp,
                Parrot_pcc_get_caller_ctx(interp, CURRENT_CONTEXT(interp))),
                    signature, raw_args);
    INTVAL argc;

    Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), call_sig);

    GETATTR_FixedIntegerArray_size(interp, signature, argc);
    goto OFFSET(argc + 2);
}

op get_results(inconst PMC) :flow {
    opcode_t * const raw_params  = CUR_OPCODE;
    PMC      * const signature   = $1;
    PMC             *ctx         = CURRENT_CONTEXT(interp);
    PMC             *call_object = Parrot_pcc_get_signature(interp, ctx);

    INTVAL argc;

    Parrot_pcc_fill_params_from_op(interp, call_object, signature, raw_params,
            PARROT_ERRORS_RESULT_COUNT_FLAG);

    GETATTR_FixedIntegerArray_size(interp, signature, argc);
    Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), PMCNULL);
    goto OFFSET(argc + 2);
}

=item B<set_result_info>(in PMC)

Set result_info. See also C<result_info>.

=cut

inline op set_result_info(in PMC) {
    PMC * const ctx = CURRENT_CONTEXT(interp);

    VTABLE_set_attr_str(interp, ctx,
            Parrot_str_new_constant(interp, "return_flags"),
            $1);
}

=item B<result_info>(out PMC)

Returns the get_results signature PMC of the caller. This PMC is a
FixedIntegerPMCArray. The number of elements of this PMC is equal to the number
of return values that are expected.  The individual bits per entry are
specified in F<docs/pdds/pdd03_calling_conventions.pod>.

=cut

inline op result_info(out PMC) {
    PMC * const caller_ctx = Parrot_pcc_get_caller_ctx(interp, CURRENT_CONTEXT(interp));
    PMC * const sig        = VTABLE_get_attr_str(interp, caller_ctx,
            Parrot_str_new_constant(interp, "return_flags"));

    /* If no elements, hand back empty array; otherwise PMC. */
    if (!sig)
        $1 = Parrot_pmc_new(interp, enum_class_FixedIntegerArray);
    else
        $1 = sig;
}

=back

=head2 Address manipulation

=for clarity

=cut

=over 4

=item B<set_addr>(out INT, inconst LABEL)

Sets register $1 to the current address plus the offset $2.

=item B<set_addr>(invar PMC, inconst LABEL)

Sets PMC in register $1 to the current address plus the offset $2.

=item B<set_addr>(invar PMC, invar LABEL)

Sets PMC in register $1 to the absolute address $2 obtained from B<get_addr>.

=item B<get_addr>(out INT, invar PMC)

Sets $1 to the absolute address of the Sub PMC $2.

=cut

inline op set_addr(out INT, inconst LABEL) {
    $1 = PTR2INTVAL(CUR_OPCODE + $2);
}

inline op set_addr(invar PMC, inconst LABEL) {
    VTABLE_set_pointer(interp, $1, (CUR_OPCODE + $2));
}

inline op set_addr(invar PMC, invar LABEL) {
    VTABLE_set_pointer(interp, $1, (void*)$2);
}

inline op get_addr(out INT, invar PMC) {
    void * const ptr = VTABLE_get_pointer(interp, $2);
    $1 = (INTVAL)ptr;
}

=back

=cut

########################################

=head2 Concurrency operations

=over 4

=item B<schedule>(invar PMC)

Register a task with the concurrency scheduler. Details about the task are
stored within the task PMC.

=cut

inline op schedule(invar PMC) {
    Parrot_cx_schedule_task(interp, $1);
}

=item B<addhandler>(invar PMC)

Add an event or exception handler to the concurrency scheduler. Details about
the handler are stored within the handler PMC.

=cut

inline op addhandler(invar PMC) {
    Parrot_cx_add_handler(interp, $1);
}

=back

=cut

########################################

=head2 Exception handling

=over 4

=item B<push_eh>(inconst LABEL)

Create an exception handler for the given catch label and push it onto
the exception handler stack.

=item B<push_eh>(invar PMC)

Push an invokable PMC onto the exception handler stack.

=item B<pop_eh>()

Pop the most recently placed exception off the handler stack.

=item B<throw>(invar PMC)

Throw the exception in $1 with current continuation.

=item B<throw>(invar PMC, invar PMC)

Throw the exception in $1 with continuation from $2.

=item B<rethrow>(invar PMC)

Only valid inside an exception handler. Rethrow the exception $1.

=item B<count_eh>(out INT)

Get a count of currently active exception handlers on the stack.

=item B<die>(in STR)

=item B<die>(in PMC)

Die with message $1

=item B<die>(in INT, in INT)

Die with severity $1 and error $2. If severity is .EXCEPT_DOOMED,
call _exit($2). The latter isn't catchable.

=item B<exit>(in INT)

Exit the interpreter with exit_status $1. If you want to communicate an
extended exit status, create an exception with severity B<EXCEPT_exit>
and throw it.

=item B<finalize>(in PMC)

Finalize exception handling, freeing any information needed to resume
the handled exception, like inner runloops.
$1 is the Exception handled or the ExceptionHandler that is handling it.

=cut

inline op push_eh(inconst LABEL) {
    PMC * const eh = Parrot_pmc_new(interp, enum_class_ExceptionHandler);
    VTABLE_set_pointer(interp, eh, CUR_OPCODE + $1);
    Parrot_cx_add_handler_local(interp, eh);
}

inline op push_eh(invar PMC) {
    Parrot_cx_add_handler_local(interp, $1);
}

inline op pop_eh() {
    Parrot_cx_delete_handler_local(interp,
            Parrot_str_new_constant(interp, "exception"));
}

inline op throw(invar PMC) :flow {
    PMC * except = $1;
    opcode_t *dest;
    opcode_t * const ret    = expr NEXT();
    PMC      * const resume = pmc_new(interp, enum_class_Continuation);
    STRING * const exception_str = Parrot_str_new_constant(interp, "Exception");

    VTABLE_set_pointer(interp, resume, ret);

    if (PMC_IS_NULL(except) || !VTABLE_does(interp, except, exception_str))
        except = Parrot_ex_build_exception(interp, EXCEPT_fatal,
                EXCEPTION_UNIMPLEMENTED,
                Parrot_str_new_constant(interp, "Not a throwable object"));

    VTABLE_set_attr_str(interp, except, Parrot_str_new_constant(interp, "resume"), resume);
    dest = Parrot_ex_throw_from_op(interp, except, ret);
    goto ADDRESS(dest);
}

inline op throw(invar PMC, invar PMC) :flow {
    opcode_t * dest;
    PMC * except = $1;
    STRING * const exception_str = Parrot_str_new_constant(interp, "Exception");

    if (PMC_IS_NULL(except) || !VTABLE_does(interp, except, exception_str))
        except = Parrot_ex_build_exception(interp, EXCEPT_fatal,
                EXCEPTION_UNIMPLEMENTED,
                Parrot_str_new_constant(interp, "Not a throwable object"));
    dest = Parrot_ex_throw_from_op(interp, $1,
                                VTABLE_get_pointer(interp, $2));
    goto ADDRESS(dest);
}

inline op rethrow(invar PMC) :flow {
    opcode_t * dest;
    PMC * except = $1;
    STRING * const exception_str = Parrot_str_new_constant(interp, "Exception");

    if (PMC_IS_NULL(except) || !VTABLE_does(interp, except, exception_str)) {
        opcode_t * const ret    = expr NEXT();
        except = Parrot_ex_build_exception(interp, EXCEPT_fatal,
                EXCEPTION_UNIMPLEMENTED,
                Parrot_str_new_constant(interp, "Not a throwable object"));
        dest = Parrot_ex_throw_from_op(interp, except, ret);
        goto ADDRESS(dest);
    }
    dest = Parrot_ex_rethrow_from_op(interp, except);
    goto ADDRESS(dest);
}

inline op count_eh(out INT) {
    $1 = Parrot_cx_count_handlers_local(interp,
            Parrot_str_new_constant(interp, "exception"));
}

inline op die(in STR) :flow {
    opcode_t        *dest;
    opcode_t * const ret       = expr NEXT();
    PMC      * const resume    = pmc_new(interp, enum_class_Continuation);
    PMC      * const exception = Parrot_ex_build_exception(interp, EXCEPT_error,
                                    CONTROL_ERROR, $1);

    VTABLE_set_pointer(interp, resume, ret);

    VTABLE_set_attr_str(interp, exception,
                        Parrot_str_new_constant(interp, "resume"), resume);
    dest = Parrot_ex_throw_from_op(interp, exception, ret);
    goto ADDRESS(dest);
}

inline op die(in PMC) :flow {
    opcode_t        *dest;
    opcode_t * const ret       = expr NEXT();
    PMC      * const resume    = pmc_new(interp, enum_class_Continuation);
    STRING   * const msg       = PMC_IS_NULL($1) ? NULL : VTABLE_get_string(interp, $1);
    PMC      * const exception =
        Parrot_ex_build_exception(interp, EXCEPT_error, CONTROL_ERROR, msg);

    VTABLE_set_pointer(interp, resume, ret);

    VTABLE_set_attr_str(interp, exception,
                        Parrot_str_new_constant(interp, "resume"), resume);
    dest = Parrot_ex_throw_from_op(interp, exception, ret);
    goto ADDRESS(dest);
}

inline op die(in INT, in INT) :flow {
    if ($1 == EXCEPT_doomed)
        _exit($2);
    else {
        opcode_t * const ret       = expr NEXT();
        PMC      * const exception = Parrot_ex_build_exception(interp, $1, $2, NULL);
        opcode_t * const dest      = Parrot_ex_throw_from_op(interp, exception, ret);

        goto ADDRESS(dest);
    }
}

inline op exit(in INT) :flow {
    opcode_t        *dest;
    opcode_t * const ret       = expr NEXT();
    PMC      * const resume    = pmc_new(interp, enum_class_Continuation);
    PMC      * const exception = Parrot_ex_build_exception(interp, EXCEPT_exit,
                                                           CONTROL_EXIT, NULL);

    VTABLE_set_pointer(interp, resume, ret);

    VTABLE_set_attr_str(interp, exception,
                        Parrot_str_new_constant(interp, "resume"), resume);
    VTABLE_set_integer_keyed_str(interp, exception,
        Parrot_str_new_constant(interp, "exit_code"), $1);
    dest = Parrot_ex_throw_from_op(interp, exception, ret);
    goto ADDRESS(dest);
}

op finalize(in PMC) {
    /* Go to the next op after loop unrolling */
    opcode_t * const dest = expr NEXT();
    PMC *eh = PMCNULL;
    if (!PMC_IS_NULL($1)) {
        /* If isa ExceptionHandler, use it. If isa Exception, get its active handler */
        if (VTABLE_isa(interp, $1, Parrot_str_new_constant(interp, "ExceptionHandler")))
            eh = $1;
        else if (VTABLE_isa(interp, $1, Parrot_str_new_constant(interp, "Exception"))) {
            PMC * const iter = VTABLE_get_attr_str(interp,
                                            $1, Parrot_str_new_constant(interp, "handler_iter"));
            if (!PMC_IS_NULL(iter))
                eh = VTABLE_get_pmc_keyed_int(interp, iter, -1);
        }
    }
    if (!PMC_IS_NULL(eh)) {
        /* Get the runloop_id from the continuation and jump to it. */
        Parrot_runloop *rl = interp->current_runloop;
        INTVAL rid;
        Parrot_pcc_invoke_method_from_c_args(interp,
                                             eh, Parrot_str_new_constant(interp, "rid"),
                                             "->I", &rid);
        while (rl && rl->id != rid)
            rl = rl->prev;
        if (rl) {
            if (rl != interp->current_runloop) {
                rl->handler_start = dest;
                longjmp(rl->resume, 3);
            }
        }
        else
            Parrot_ex_throw_from_c_args(interp, NULL,
                    EXCEPTION_INVALID_OPERATION, "missing runloop");
    }
}


=back

=cut

###############################################################################

=head2 Interpreter operations

These operations inspect or modify the interpreter itself, possibly
affecting its subsequent operation.

=over 4

=cut

########################################

=item B<debug>(in INT)

If $1 is zero, turn off debugging. Otherwise turn debug flag $1 on.

=cut

inline op debug(in INT) :flow {
    if ($1 != 0) { Interp_debug_SET(interp,   $1); }
    else         { Interp_debug_CLEAR(interp, PARROT_ALL_DEBUG_FLAGS); }
    restart NEXT();
}


########################################

=item B<bounds>(in INT)

If $1 is zero, turn off byte code bounds checking. Otherwise turn it on.

=cut

inline op bounds(in INT) :flow {
    if ($1 != 0) { Parrot_set_flag(interp,   PARROT_BOUNDS_FLAG); }
    else         { Interp_flags_CLEAR(interp, PARROT_BOUNDS_FLAG); }
    restart NEXT();
}


########################################

=item B<profile>(in INT)

If $1 is zero, turn off profiling. Otherwise turn it on.

=cut

inline op profile(in INT) :flow {
    if ($1 != 0) { Parrot_set_flag(interp,   PARROT_PROFILE_FLAG); }
    else         { Interp_flags_CLEAR(interp, PARROT_PROFILE_FLAG); }
    restart NEXT();
}


########################################

=item B<trace>(in INT)

If $1 is zero, turn off tracing. Otherwise turn trace flag $1 on.

=cut

inline op trace(in INT) :flow {
    if ($1 != 0) { Parrot_set_trace(interp,   $1); }
    else         { Parrot_clear_trace(interp, PARROT_ALL_TRACE_FLAGS); }
    restart NEXT();
}

########################################

=item B<gc_debug>(in INT)

If $1 is zero, turn off GC_DEBUG. Otherwise turn it on.

=cut

inline op gc_debug(in INT) {
    if ($1 != 0) { Interp_flags_SET(interp,   PARROT_GC_DEBUG_FLAG); }
    else         { Interp_flags_CLEAR(interp, PARROT_GC_DEBUG_FLAG); }
}

########################################

=item B<interpinfo>

Fetch some piece of information about the interpreter and put it in $1.
Possible values for $2 are defined in F<runtime/parrot/include/interpinfo.pasm>.
The valid constants for each return value are (excluding the the .INTERPINFO_
prefix):

=over 4

=item B<interpinfo>(out INT, in INT)

TOTAL_MEM_ALLOC, TOTAL_MEM_USED, GC_MARK_RUNS, GC_COLLECT_RUNS, ACTIVE_PMCS,
ACTIVE_BUFFERS, TOTAL_PMCS, TOTAL_BUFFERS, HEADER_ALLOCS_SINCE_COLLECT,
MEM_ALLOCS_SINCE_COLLECT, TOTAL_COPIED, IMPATIENT_PMCS, GC_LAZY_MARK_RUNS,
EXTENDED_PMCS, CURRENT_RUNCORE

=item B<interpinfo>(out PMC, in INT)

CURRENT_SUB, CURRENT_CONT, CURRENT_OBJECT, CURRENT_LEXPAD

=item B<interpinfo>(out STR, in INT)

EXECUTABLE_FULLNAME, EXECUTABLE_BASENAME, RUNTIME_PREFIX

=back

=cut

op interpinfo(out INT, in INT) {
    $1 = interpinfo(interp, $2);
}

op interpinfo(out PMC, in INT) {
    $1 = interpinfo_p(interp, $2);
}

op interpinfo(out STR, in INT) {
    STRING * const s = interpinfo_s(interp, $2);
    $1 = s;
}

=item B<warningson>(in INT)

Turns on warnings categories. Categories already turned on will stay on.
Initial setting is currently all warnings off.  Include F<warnings.pasm> to
access the categories. Refer to that file for the current list of warnings
available.

=over 4

=back

To turn on multiple categories, OR the category numbers together.

=cut

inline op warningson(in INT) {
    PARROT_WARNINGS_on(interp, $1);
}

=item B<warningsoff>(in INT)

Turns off warnings categories.  Categories already turned off will
stay off.  See the documentation for B<warningson> for category
numbers.

=cut

inline op warningsoff(in INT) {
    PARROT_WARNINGS_off(interp, $1);
}

=item B<errorson>(in INT)

Turns on error categories. Categories already turned on will stay on.  To
access these from PASM, include F<errors.pasm>.  The current categories are:

=over 4

=item .PARROT_ERRORS_OVERFLOW_FLAG

When performing arithmetic on Integer PMCs, throw a math overflow exception
instead of promoting to BigInt. This flag does not pertain to native integers,
which are never promoted. Default: off.

=item .PARROT_ERRORS_PARAM_COUNT_FLAG

Throw an exception on an argument versus parameter count mismatch. Default: on.

=item .PARROT_ERRORS_RESULT_COUNT_FLAG

Throw an exception on a return versus result count mismatch. Default: off.

=item .PARROT_ERRORS_ALL_FLAG

=back

To turn on multiple categories, OR the category numbers together.

=cut

inline op errorson(in INT) {
    PARROT_ERRORS_on(interp, $1);
}

=item B<errorsoff>(in INT)

Turns off errors categories.  Categories already turned off will
stay off.  See the documentation for B<errorson> for category
numbers.

=cut

inline op errorsoff(in INT) {
    PARROT_ERRORS_off(interp, $1);
}

########################################

=item B<runinterp>(invar PMC, in LABEL)

Run the code starting at offset $2 within interpreter $1.

=item B<getinterp>(out PMC)

Get the current ParrotInterpreter.

=cut

op runinterp(invar PMC, in LABEL) {
    Interp * const new_interp = (Interp *)VTABLE_get_pointer(interp, $1);
    Interp_flags_SET(new_interp, PARROT_EXTERN_CODE_FLAG);
    Parrot_switch_to_cs(new_interp, interp->code, 1);
    runops(new_interp, REL_PC + $2);
}

op getinterp(out PMC) {
    $1 = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
           IGLOBALS_INTERPRETER);
}

#######################################



=back

=cut

###############################################################################

=head2 Garbage Collection

Opcodes that interact with the GC subsystem.

=over 4

=cut

########################################

=item B<sweep>(inconst INT)

Triggers a GC run, based on the value of $1, where:

=over

=item * 0

Trigger a GC run only if there are things that have flagged themselves as
really needing to be collected.

=item * 1

Trigger a GC run unconditionally.

=back

=cut

op sweep(inconst INT) {
    if ($1)
        Parrot_gc_mark_and_sweep(interp, GC_trace_normal_FLAG);
    else
        if (Parrot_gc_impatient_pmcs(interp))
            Parrot_gc_mark_and_sweep(interp, GC_lazy_FLAG);
}

=item B<collect>()

Trigger a garbage collection.

=cut

op collect() {
    Parrot_gc_compact_memory_pool(interp);
}

=item B<sweepoff>()

Disable GC runs. (Nestable)

=cut

op sweepoff() {
    Parrot_block_GC_mark(interp);
}

=item B<sweepon>()

Re-enable GC runs.

=cut

op sweepon() {
    Parrot_unblock_GC_mark(interp);
}

=item B<collectoff>()

Disable GC runs (nestable).

=cut

op collectoff() {
    Parrot_block_GC_sweep(interp);
}

=item B<collecton>()

Re-enable GC.

=cut

op collecton() {
    Parrot_unblock_GC_sweep(interp);
}

=item B<needs_destroy>(invar PMC)

Mark the PMC wanting destruction as soon as possible, for example
when unused during the lazy sweep, triggered by C<sweep 0>.

=cut

op needs_destroy(invar PMC) {
    Parrot_gc_pmc_needs_early_collection(interp, $1);
}

=back

=head2 Native Call Interface

Opcodes for interfacing with C functions in shared libraries.

=over 4

=cut

########################################

=item B<loadlib>(out PMC, in STR)

=item B<loadlib>(out PMC, in STR, in PMC)

Load a dynamic link library named $2 and store it in $1. $3, if
provided, controls library loading and initialization; currently,
we expect a bitmask accessible as an integer.  Bit definitions are
accessible from PASM if F<dlopenflags.pasm> is included.  The current
bits are:

=over 4

=item PARROT_DLOPEN_GLOBAL

Make any symbols in the library accessible to other libraries loaded.

=back

=item B<dlfunc>(out PMC, invar PMC, in STR, in STR)

=item B<dlfunc>(out PMC, invar PMC, in STR, invar PMC)

Look up symbol $3 in library $2 with signature $4, and put the
corresponding sub object in $1. Note that you need the signature so we
can build or find an appropriate thunking function.

=item B<dlvar>(out PMC, invar PMC, in STR)

Look up symbol $3 in library $2. We assume that this is actually a
variable address rather than a function address, and build an
UnManagedStruct PMC and stick the address into its data pointer.

=item B<compreg>(out PMC, in STR)

Get the compiler object for source type $2.  The returned compiler
object should provide a C<compile> method for translating code
in the source type.  However, some Parrot compilers such as
C<PIR> and C<PASM> currently return a sub that is to be
invoked directly on the source.

=item B<compreg>(in STR, invar PMC)

Register $2 as the compiler object for source type $1.

=item B<new_callback>(out PMC, invar PMC, invar PMC, in STR)

Create a callback stub $1 for PASM subroutine $2 with userdata $3 and
callback function signature $4. Only 2 argument signatures with
signature chars I<U[1iscpt]> or I<[1iscpt]U>  are handled currently.
But these cover a lot of callback signatures. Please note that the
userdata PMC I<U> has to be handled transparently by the caller of
the callback function.

=cut

inline op loadlib(out PMC, in STR) {
    $1 = Parrot_dyn_load_lib(interp, $2, NULL);
}

inline op loadlib(out PMC, in STR, in PMC) {
    $1 = Parrot_dyn_load_lib(interp, $2, $3);
}

op dlfunc(out PMC, invar PMC, in STR, in STR) {
    void         *dl_handle = NULL;
    void         *ptr       = NULL;
    funcptr_t     p;

    if (!PMC_IS_NULL($2)
    && $2->vtable->base_type == enum_class_ParrotLibrary
    && VTABLE_defined(interp, $2)) {
        dl_handle = ((Parrot_ParrotLibrary_attributes*)PMC_data($2))->dl_handle;
    }

    ptr = Parrot_dyn_dlsym_str(interp, dl_handle, $3);
    p = D2FPTR(ptr);

    if (p == NULLfunc) {
        const char * err = Parrot_dlerror();
        Parrot_warn(interp, PARROT_WARNINGS_UNDEF_FLAG,
                "Symbol '%Ss' not found: %s\n", $3, err ? err : "unknown reason");
        $1 = Parrot_pmc_new(interp, enum_class_Undef);
    }
    else {
        $1 = Parrot_pmc_new(interp, enum_class_NCI);
        VTABLE_set_pointer_keyed_str(interp, $1, $4, F2DPTR(p));
    }
}

op dlfunc(out PMC, invar PMC, in STR, invar PMC) {
    void         *dl_handle = NULL;
    void         *ptr       = NULL;
    funcptr_t     p;

    if (!PMC_IS_NULL($2)
    && $2->vtable->base_type == enum_class_ParrotLibrary
    && VTABLE_defined(interp, $2)) {
        dl_handle = ((Parrot_ParrotLibrary_attributes*)PMC_data($2))->dl_handle;
    }

    ptr = Parrot_dyn_dlsym_str(interp, dl_handle, $3);
    p = D2FPTR(ptr);

    if (p == NULLfunc) {
        const char * err = Parrot_dlerror();
        Parrot_warn(interp, PARROT_WARNINGS_UNDEF_FLAG,
                "Symbol '%Ss' not found: %s\n", $3, err ? err : "unknown reason");
        $1 = Parrot_pmc_new(interp, enum_class_Undef);
    }
    else {
        $1 = Parrot_pmc_new(interp, enum_class_NCI);
        VTABLE_set_pointer_keyed(interp, $1, $4, F2DPTR(p));
    }
}

op dlvar(out PMC, invar PMC, in STR) {
    void *        dl_handle = NULL;
    void *        p         = NULL;

    if (!PMC_IS_NULL($2)
    && $2->vtable->base_type == enum_class_ParrotLibrary
    && VTABLE_defined(interp, $2)) {
        dl_handle = ((Parrot_ParrotLibrary_attributes*)PMC_data($2))->dl_handle;
    }

    p = Parrot_dyn_dlsym_str(interp, dl_handle, $3);

    if (p == NULL) {
        const char * const err = Parrot_dlerror();
        Parrot_warn(interp, PARROT_WARNINGS_UNDEF_FLAG,
                "Symbol '%Ss' not found: %s\n", $3, err ? err : "unknown reason");
        $1 = Parrot_pmc_new(interp, enum_class_Undef);
    }
    else {
        /* At this point we have the symbol's address. We just need to build
           a PMC with it so we can get and set the value */
        $1 = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
        VTABLE_set_pointer(interp, $1, p);
    }
}

inline op compreg(in STR, invar PMC) {
    PMC * const compreg_hash = VTABLE_get_pmc_keyed_int(interp,
            interp->iglobals, IGLOBALS_COMPREG_HASH);
    VTABLE_set_pmc_keyed_str(interp, compreg_hash, $1, $2);
}

inline op compreg(out PMC, in STR) {
    PMC * const compreg_hash = VTABLE_get_pmc_keyed_int(interp,
            interp->iglobals, IGLOBALS_COMPREG_HASH);
    $1 = VTABLE_get_pmc_keyed_str(interp, compreg_hash, $2);
}

op new_callback(out PMC, invar PMC, invar PMC, in STR) {
    $1 = Parrot_make_cb(interp, $2, $3, $4);
}

=back

=cut

###############################################################################

=head2 Annotations operations

These operations relate to bytecode annotations.

=over 4

=cut

########################################

=item B<annotations>(out PMC)

Gets all bytecode annotations in effect at the current point, in a Hash.
If there are none, returns an empty Hash.

=cut

inline op annotations(out PMC) {
    if (interp->code->annotations) {
        const opcode_t cur_pos = (expr NEXT()) - interp->code->base.data;
        $1 = PackFile_Annotations_lookup(interp, interp->code->annotations,
                cur_pos, NULL);
    }
    else {
        $1 = Parrot_pmc_new(interp, enum_class_Hash);
    }
}

=item B<annotations>(out PMC, in STR)

Gets the bytecode annotation with the given name that is in effect at the
current point. Returns PMCNULL if there is none.

=cut

inline op annotations(out PMC, in STR) {
    if (interp->code->annotations) {
        const opcode_t cur_pos = (expr NEXT()) - interp->code->base.data;
        $1 = PackFile_Annotations_lookup(interp, interp->code->annotations,
                cur_pos, $2);
    }
    else {
        $1 = PMCNULL;
    }
}

=back

=cut

###############################################################################

=head1 COPYRIGHT

Copyright (C) 2001-2011, Parrot Foundation.

=head1 LICENSE

This program is free software. It is subject to the same license
as the Parrot interpreter itself.

=cut

/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
 */