p5interpreter.pmc

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

This file is distributed under the same terms as Parrot itself; see the
file LICENSE in the source root for details.

=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"

/* slightly evil */
#define char const char
#include "init_with_xs.h"
#undef char

/* 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 auto_attrs {
    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_s[][3] = { "", "-e", "0" };
        char *embedding[] = { embedding_s[0], embedding_s[1],
            embedding_s[2] };

        /* Set up the underlying structure. */
        PObj_custom_destroy_SET(SELF);

        /* Inited before? */
        if (!inited) {
            int   fake_argc   = 1;
            char *fake_argv[] = { embedding_s[0] };
            char *fake_env[]  = { NULL };
            char **fake_argv_p = fake_argv;
            char **fake_env_p  = fake_env;
            PERL_SYS_INIT3(&fake_argc, &fake_argv_p, &fake_env_p);
            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();*/
    }

/*

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

Run the Perl 5 code.

=cut

*/

    VTABLE opcode_t *invoke(void *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 *ns = Parrot_pmc_new_noinit(interp, pmc_type(interp,
                    string_from_literal(interp, "P5Namespace")));
        /* Set up the underlying structure. */
        PObj_custom_mark_SET(ns);
        SETATTR_P5Namespace_p5i(interp, ns, SELF);
        SETATTR_P5Namespace_ns_name(interp, ns, name);

        RETURN(PMC *ns);
    }
}

/*

=back

=cut

*/

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