cotorra.c

/*
Copyright (C) 2009-2010, Parrot Foundation.

=head1 NAME

cotorra - A parrot embedding test

=head1 SYNOPSIS

cotorra file.pbc

=head1 DESCRIPTION

A test of parrot embedding in a C program.

Is a simplified form of the parrot main executable, with just a few
options and able to run only pbc files.

=cut

*/


#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include "parrot/parrot.h"
#include "parrot/extend.h"

/**********************************************************************/

void fail(const char *msg);
unsigned int getuintval(const char *s);
Parrot_Run_core_t getruncore(const char *name);

Parrot_String create_string(Parrot_Interp interp, const char *name);
int cotorra_main(Parrot_Interp interp, int argc, const char **argv);

/**********************************************************************/

/*

=head2 Functions

=over 4

=cut

*/

/* Auxiliary generic functions */

/*

=item C<void fail(const char *msg)>

Fatal error, print the msg to stderr and exit.

=cut

*/

void fail(const char *msg)
{
    fprintf(stderr, "cotorra failed: %s\n", msg);
    exit(EXIT_FAILURE);
}

/*

=item C<unsigned int getuintval(const char *s)>

Get an unsigned int value from a C string.
Fails on invalid argument.

=cut

*/

unsigned int getuintval(const char *s)
{
    char *aux;
    unsigned long int n = strtoul(s, &aux, 0);
    if (*aux != '\0')
        fail("Invalid number");
    return n;
}

struct runcoreinfo {
    Parrot_Run_core_t id;
    const char *name;
};

/*

=item C<Parrot_Run_core_t getruncore(const char *name)>

Get a runcore id from his name.
Fails on invalid argument.

=cut

*/

Parrot_Run_core_t getruncore(const char *name)
{
    static const struct runcoreinfo cores [] = {
        { PARROT_SLOW_CORE,     "slow" },
        { PARROT_GC_DEBUG_CORE, "gcdebug" },
    };
    static const unsigned int n = sizeof (cores)/sizeof (struct runcoreinfo);
    unsigned int i;
    for (i= 0; i < n; ++i) {
        if (strcmp(name, cores[i].name) == 0)
            break;
    }
    if (i >= n)
        fail("Invalid runcore");
    return cores[i].id;
}

/**********************************************************************/

/* Auxiliary parrot functions */

/*

=item C<Parrot_String create_string(Parrot_Interp interp, const char *name)>

Auxiliary function to shorten Parrot String creation,

=cut

*/

Parrot_String create_string(Parrot_Interp interp, const char *name)
{
    return Parrot_str_new_init(interp, name, strlen(name), (const char *) NULL, 0);
}

/**********************************************************************/

/*

=item C<int cotorra_main(Parrot_Interp interp, int argc, const char **argv)>

Auxiliary function to minimize the size of main.

=cut

*/

int cotorra_main(Parrot_Interp interp, int argc, const char **argv)
{
    const char *source;
    Parrot_PackFile pf;
    const char *stname = NULL;
    const char *exec = NULL;
    const char *module = NULL;
    int i;

    /* Incompatible options are not checked yet */
    for (i = 1; i < argc; ++i) {
        if (strcmp(argv[i], "--trace") == 0) {
            ++i;
            if (i >= argc)
                fail("Option needs argument");
            Parrot_set_trace(interp, getuintval(argv[i]));
        }
        else if (strcmp(argv[i], "--warnings") == 0) {
            ++i;
            if (i >= argc)
                fail("Option needs argument");
            Parrot_setwarnings(interp, getuintval(argv[i]));
        }
        else if (strcmp(argv[i], "-e") == 0) {
            ++i;
            if (i >= argc)
                fail("Option needs argument");
            exec = argv[i];
        }
        else if (strcmp(argv[i], "--start") == 0) {
            ++i;
            if (i >= argc)
                fail("Option needs argument");
            stname = argv[i];
        }
        else if (strcmp(argv[i], "--load") == 0) {
            ++i;
            if (i >= argc)
                fail("Option needs argument");
            module = argv[i];
        }
        else if (strcmp(argv[i], "--runcore") == 0) {
            ++i;
            if (i >= argc)
                fail("Option needs argument");
            Parrot_set_run_core(interp, getruncore(argv[i]));
        }
        else
            break;
    }
    if (module)
        Parrot_load_bytecode(interp, create_string(interp, module));

    if (exec) {
        Parrot_String compiler = create_string(interp, "PIR");
        Parrot_String errstr;
        Parrot_PMC code = Parrot_compile_string(interp, compiler, exec, &errstr);
        Parrot_ext_call(interp, code, "->");
        return 0;
    }

    if (i >= argc && ! (module && stname))
        fail("No file to load");
    source = argv[i];
    if (source && ! stname) {
        pf = Parrot_pbc_read(interp, source, 0);
        if (! pf)
            fail("Cannot load file");
        Parrot_pbc_load(interp, pf);
        Parrot_pbc_fixup_loaded(interp);
    }

    if (stname) {
        Parrot_PMC rootns = Parrot_ns_get_root_namespace(interp);
        Parrot_String parrotname = create_string(interp, "parrot");
        Parrot_PMC parrotns = Parrot_PMC_get_pmc_keyed_str(interp, rootns, parrotname);
        Parrot_String name = create_string(interp, stname);
        Parrot_PMC start = Parrot_PMC_get_pmc_keyed_str(interp, parrotns, name);
        if (Parrot_pmc_is_null(interp, start))
            fail("start sub not found");
        if (i < argc) {
            int pos;
            Parrot_PMC arg = Parrot_pmc_new(interp,
                    Parrot_pmc_get_type_str(interp,
                        Parrot_str_new(interp, "FixedStringArray", 0)));

            Parrot_PMC_set_integer_native(interp, arg, argc - i);
            for (pos = 0; i < argc; ++i, ++pos) {
                Parrot_PMC_set_string_keyed_int(interp, arg, pos, create_string(interp, argv[i]));
            }
            Parrot_ext_call(interp, start, "P->", arg);
        }
        else
            Parrot_ext_call(interp, start, "->");
    }
    else {
        Parrot_runcode(interp, argc - i, argv + i);
    }

    return 0;
}

/*

=item C<int main(int argc, const char **argv)>

Main function. Create the parrot interpreter and call cotorra_main.

=cut

*/

int main(int argc, const char **argv)
{
    Parrot_Interp interp;
    int r;

    Parrot_set_config_hash();
    interp = Parrot_new(NULL);
    if (! interp)
        fail("Cannot create parrot interpreter");

    Parrot_set_executable_name(interp, create_string(interp, argv[0]));

    r = cotorra_main(interp, argc, argv);

    Parrot_destroy(interp);
    return r;
}

/*

=back

=cut

*/

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