p5interpreter.pmc

/*
Copyright (C) 2009, Jonathan Worthington and friends

=head1 NAME

src/pmc/p5interpreter.pmc - Embeds a Perl 5 interpreter

=head1 DESCRIPTION

These are the vtable functions for the P5Interpreter class.

=cut

*/

#include "blizkost.h"

#include "init_with_xs.h"

/* Tracking of whether we've initialized or not. */
static int inited = 0;

/*

=head2 Helper functions

=over 4

=back

=head2 Methods

=over 4

=cut

*/

pmclass P5Interpreter group blizkost_group dynpmc {
    ATTR struct interpreter *my_perl;
    /* These fields are here so that the callin code can use P5Interpreter
       attribute blocks as a proxy.  Possibly a bit hackish. */
    ATTR Parrot_Interp parrot_interp;
    ATTR PMC *self;

/*

=item C<void init()>

Set up P5Interpreter PMC.

=cut

*/

    VTABLE void init() {
        struct interpreter *my_perl;
        char *embedding[] = { "", "-e", "0" };

        /* Set up the underlying structure. */
        PMC_data(SELF) = mem_allocate_zeroed_typed(Parrot_P5Interpreter_attributes);
        PObj_custom_destroy_SET(SELF);

        /* Inited before? */
        if (!inited) {
            int   fake_argc   = 1;
            char *fake_argv[] = { "" };
            char *fake_env[]  = { NULL };
            PERL_SYS_INIT3(&fake_argc, &fake_argv, &fake_env);
            inited = 1;
        }

        /* Allocate interpreter and stash it in struct. */
        my_perl = perl_alloc();
        perl_construct(my_perl);
        PL_origalen = 1;
        perl_parse(my_perl, xs_init, 3, embedding, NULL);
        PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
        perl_run(my_perl);
        SET_ATTR_my_perl(interp, SELF, my_perl);
        SET_ATTR_self(interp, SELF, SELF);
        SET_ATTR_parrot_interp(interp, SELF, interp);

        /* We turn on auto-flush to avoid oddness in interactions between
         * IO systems. */
        eval_pv("$| = 1", TRUE);
    }

/*

=item C<void destroy()>

Destructor for the P5Interpreter PMC.

=cut

*/
    VTABLE void destroy() {
        struct interpreter *my_perl;

        /* Destroy interpreter if it's got no more usage. */
        GET_ATTR_my_perl(interp, SELF, my_perl);
        perl_destruct(my_perl);
        perl_free(my_perl);

        /* XXX We should only call PERL_SYS_TERM right at the end, not per
         * interpreter destroy. Skip doing it for now at all, but need to
         * work out where to put this. */
        /*PERL_SYS_TERM();*/

        /* Free underlying struct. */
        mem_sys_free(PMC_data(SELF));
        PMC_data(SELF) = NULL;
    }

/*

=item C<opcode_t *invoke(opcode_t *next)>

Run the Perl 5 code.

=cut

*/

    VTABLE opcode_t *invoke(opcode_t *next) {
        struct interpreter *my_perl;
        PMC    *result;
        STRING *source;
        char   *c_source;
        PMC    *ctx = CURRENT_CONTEXT(INTERP);
        PMC    *call_object = Parrot_pcc_get_signature(INTERP, ctx);

        Parrot_pcc_fill_params_from_c_args(interp, call_object, "S", &source);

        /* Get source into a C string so we can give it to Perl 5.
         * XXX We'd best care about encodings and charset here some day. */
        c_source = Parrot_str_to_cstring(interp, source);

        /* Evaluate it. */
        GET_ATTR_my_perl(interp, SELF, my_perl);
        result = blizkost_wrap_sv(interp, SELF, eval_pv(c_source, TRUE));

        Parrot_pcc_build_call_from_c_args(interp, call_object, "P", result);

        return blizkost_return_from_invoke(interp, next);
    }

/*

=item C<PMC *get_namespace(const char *name)>

Acquire a namespace handle.

=cut

*/

    METHOD PMC *get_namespace(STRING *name) {
        PMC *pmc = Parrot_pmc_new_noinit(interp, pmc_type(interp,
                    string_from_literal(interp, "P5Namespace")));
        /* Set up the underlying structure. */
        PMC_data(pmc) = mem_allocate_zeroed_typed(Parrot_P5Namespace_attributes);
        PObj_custom_mark_SET(pmc);
        PObj_custom_destroy_SET(pmc);
        SETATTR_P5Namespace_p5i(interp, pmc, SELF);
        SETATTR_P5Namespace_ns_name(interp, pmc, name);

        return pmc;
    }
}

/*

=back

=cut

*/

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