imccompiler.pmc

/*
Copyright (C) 2011-2014, Parrot Foundation.

=head1 NAME

src/pmc/imccompiler.pmc - IMCCompiler PMC

=head1 DESCRIPTION

A compiler object to wrap IMCC, the internal PIR and PASM compiler.

=head2 Functions

=cut

*/

#include "imcc/embed.h"
#include "imcc/yyscanner.h"
#include "pmc/pmc_sub.h"

/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */

/* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
/* HEADERIZER END: static */

#define BEGIN_IMCC_COMPILE(i) \
    do { \
        UINTVAL __regs_used[4] = {3, 3, 3, 3}; \
        PMC * const __newcontext = Parrot_push_context((i), __regs_used); \
        PackFile_ByteCode * const __old_bc = (i)->code; \
        Parrot_block_GC_mark((i)); \
        Parrot_pcc_set_HLL((i), __newcontext, 0); \
        Parrot_pcc_set_sub((i), __newcontext, 0); \

#define END_IMCC_COMPILE(i) \
        Parrot_pop_context((i)); \
        Parrot_unblock_GC_mark((i)); \
        (i)->code = __old_bc; \
    } while (0)

#define ERROR_IMCC_COMPILE(i) \
    Parrot_pop_context((i)); \
    Parrot_unblock_GC_mark((i)); \
    (i)->code = __old_bc; \

/* HEADERIZER HFILE: none */

pmclass IMCCompiler auto_attrs provides HLLCompiler provide invokable {
    ATTR void *imcc_info;
    ATTR INTVAL is_pasm; /* 0 = PIR, 1 = PASM */
    ATTR INTVAL current_eval;

    VTABLE void init() :no_wb {
        UNUSED(SELF)
        Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_INVALID_OPERATION,
            "IMCCompiler: Must initialize with an integer argument 0 (PIR) or 1 (PASM)");
    }

    VTABLE void init_pmc(PMC *init) :manual_wb {
        const INTVAL type = VTABLE_get_integer(INTERP, init);
        VTABLE_init_int(INTERP, SELF, type);
    }

    VTABLE void init_int(INTVAL is_pasm) {
        Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF);
        if (is_pasm != 0 && is_pasm != 1)
            Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_INVALID_OPERATION,
                "IMCCompiler: Must have type 0 (PIR) or 1 (PASM)");
        attrs->is_pasm = is_pasm;
        attrs->imcc_info = (void*) imcc_new(INTERP);
        attrs->current_eval = 0;
    }

    /* provided to emulate the current NCI compreg */
    /* DEPRECATED. See TT #1967 */
    VTABLE opcode_t* invoke(void* next) :no_wb {
        Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF);
        imc_info_t * const imcc = (imc_info_t*) attrs->imcc_info;
        PMC * const ctx = CURRENT_CONTEXT(INTERP);
        PMC * cont = INTERP->current_cont;
        PMC * const call_object = Parrot_pcc_get_signature(interp, ctx);
        PackFile_ByteCode * const cur_code = interp->code;
        STRING * code = STRINGNULL;
        PMC * result = PMCNULL;
        const UINTVAL regs_used[4] = {3, 3, 3, 3};
        PMC * const newcontext = Parrot_push_context(interp, regs_used);

        Parrot_block_GC_mark(interp);
        Parrot_pcc_set_sub(interp, newcontext, 0);

        Parrot_pcc_fill_params_from_c_args(INTERP, call_object, "S", &code);
        imcc_reset(imcc);
        result = imcc_compile_string(imcc, code, attrs->is_pasm);
        if (PMC_IS_NULL(result)) {
            STRING * const msg   = imcc_last_error_message(imcc);
            const INTVAL errcode = imcc_last_error_code(imcc);
            Parrot_unblock_GC_mark(interp);
            Parrot_ex_throw_from_c_args(INTERP, NULL, errcode, "%Ss", msg);
        }

        Parrot_pop_context(interp);
        Parrot_unblock_GC_mark(interp);

        /* Handle the case where we we've been tailcalled into. See NCI.invoke
           for more details */
        if (!PMC_IS_NULL(cont)
        && (PObj_get_FLAGS(cont) & SUB_FLAG_TAILCALL)) {
            cont = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp));
            next = VTABLE_invoke(INTERP, cont, next);
        }

        Parrot_pcc_set_call_from_c_args(INTERP, call_object, "P", result);
        interp->code = cur_code;
        return (opcode_t*)next;
    }

    VTABLE void *get_pointer() :no_wb {
        const Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF);
        UNUSED(INTERP)
        return attrs->imcc_info;
    }

    VTABLE INTVAL get_integer() :no_wb {
        const Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF);
        UNUSED(INTERP)
        return attrs->is_pasm;
    }

    VTABLE STRING *get_string() :no_wb {
        const Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF);
        if (attrs->is_pasm)
            return CONST_STRING(INTERP, "PASM");
        else
            return CONST_STRING(INTERP, "PIR");
    }

    VTABLE void destroy() :no_wb {
        Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF);
        UNUSED(INTERP)
        imcc_destroy((imc_info_t*)(attrs->imcc_info));
        attrs->imcc_info = NULL;
    }

    METHOD compile(STRING *source,
            STRING *path   :optional, INTVAL has_path   :opt_flag,
            STRING *target :named("target")    :optional, INTVAL has_target :opt_flag,
            PMC *outer_ctx :named("outer_ctx") :optional, INTVAL has_ctx    :opt_flag) :no_wb
    {
        Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF);
        PMC * pf;
        imc_info_t * const imcc = (imc_info_t*)attrs->imcc_info;

        if (has_target)
            Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_INVALID_OPERATION,
                "IMCCompiler: compiler does not support the target option");

        BEGIN_IMCC_COMPILE(interp);

        /* TODO: Handle outer_ctx */
        pf = imcc_compile_string(imcc, source, attrs->is_pasm);
        if (PMC_IS_NULL(pf)) {
            STRING * const msg = imcc_last_error_message(imcc);
            INTVAL code = imcc_last_error_code(imcc);
            ERROR_IMCC_COMPILE(interp);
            Parrot_ex_throw_from_c_args(INTERP, NULL, code, "%Ss", msg);
        }
        if (has_path)
            VTABLE_set_string_native(INTERP, pf, path);

        END_IMCC_COMPILE(interp);

        RETURN(PMC *pf);
    }

    METHOD compile_file(STRING *filename,
            STRING *path   :optional, INTVAL has_path   :opt_flag,
            STRING *target :named("target")    :optional, INTVAL has_target :opt_flag,
            PMC *outer_ctx :named("outer_ctx") :optional, INTVAL has_ctx    :opt_flag) :no_wb
    {
        Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF);
        PMC * pf = PMCNULL;
        imc_info_t * const imcc = (imc_info_t*)attrs->imcc_info;

        if (has_target)
            Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_INVALID_OPERATION,
                "IMCCompiler: compiler does not support the target option");

        BEGIN_IMCC_COMPILE(interp);

        /* TODO: Handle outer_ctx */
        pf = imcc_compile_file(imcc, filename, attrs->is_pasm);
        if (PMC_IS_NULL(pf)) {
            STRING * const msg = imcc_last_error_message(imcc);
            const INTVAL code = imcc_last_error_code(imcc);
            ERROR_IMCC_COMPILE(interp);
            Parrot_ex_throw_from_c_args(INTERP, NULL, code, "%Ss", msg);
        }

        if (has_path)
            VTABLE_set_string_native(INTERP, pf, path);

        END_IMCC_COMPILE(interp);

        RETURN(PMC *pf);
    }

    /*METHOD eval(STRING *source,
            STRING *target :named("target") :optional, INTVAL has_target :opt_flag,
            PMC *outer_ctx :named("outer_ctx") :optional, INTVAL has_ctx :opt_flag) :no_wb
    {
        Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF);
        PMC * pf = PMCNULL;
        imc_info_t * const imcc = (imc_info_t*)attrs->imcc_info;
        if (has_target)
            Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_INVALID_OPERATION,
                "IMCCompiler: compiler does not support the target option");
        pf = imcc_compile_string(imcc, source, attrs->is_pasm);
    }*/

    METHOD preprocess(STRING *code) :no_wb {
        const Parrot_IMCCompiler_attributes * const attrs = PARROT_IMCCOMPILER(SELF);
        imc_info_t * const imcc = (imc_info_t*)attrs->imcc_info;
        imcc_preprocess(imcc, code);
    }

    /*METHOD parse_name(STRING *name) :no_wb {
        Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_UNIMPLEMENTED,
                "IMCCompiler: parse_name is not supported");
    }*/

    /* TODO: This */
    /*METHOD load_module(STRING *name) :no_wb {

    }*/

    /* TODO: This */
    /*METHOD get_module(STRING *name) :no_wb {

    }*/

    /* TODO: This */
    /*METHOD get_exports(PMC *module) :no_wb {

    }*/
}

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