Sophie

Sophie

distrib > Mandriva > 2010.0 > i586 > media > contrib-release > by-pkgid > cd14cddf3b3ceaf1193157472227757a > files > 601

parrot-doc-1.6.0-1mdv2010.0.i586.rpm

/*
Copyright (C) 2009, Parrot Foundation.
$Id: cotorra.c 40726 2009-08-23 01:18:17Z whiteknight $

=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/embed.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, 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_FAST_CORE,     "fast" },
        { PARROT_CGOTO_CORE,    "cgoto" },
        { PARROT_JIT_CORE,      "jit" },
        { PARROT_GC_DEBUG_CORE, "gcdebug" },
        { PARROT_SWITCH_CORE,   "switch" }
    };
    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_new_string(interp, name, strlen(name), (const char *) NULL, 0);
}

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

/*

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

Auxiliary function to minimize the size of main.

=cut

*/

int cotorra_main(Parrot_Interp interp, int argc, char **argv)
{
    char *source;
    Parrot_PackFile pf;
    const char *stname = NULL;
    const char *exec = 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]));
        }
        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], "--runcore") == 0) {
            ++i;
            if (i >= argc)
                fail("Option needs argument");
            Parrot_set_run_core(interp, getruncore(argv[i]));
        }
        else
            break;
    }

    if (exec) {
        Parrot_String compiler = create_string(interp, "PIR");
        Parrot_String errstr;
        Parrot_PMC code = Parrot_compile_string(interp, compiler, exec, &errstr);
        void *discard = Parrot_call_sub(interp, code, "v");
        return 0;
    }

    if (i >= argc)
        fail("No file to load");
    source = argv[i];

    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_get_root_namespace(interp);
        Parrot_String parrotname = create_string(interp, "parrot");
        Parrot_PMC parrotns = Parrot_PMC_get_pmc_strkey(interp, rootns, parrotname);
        Parrot_String name = create_string(interp, stname);
        Parrot_PMC start = Parrot_PMC_get_pmc_strkey(interp, parrotns, name);
        void *discard;
        discard = Parrot_call_sub(interp, start, "v");
    }
    else {
        Parrot_runcode(interp, argc - i, argv + i);
    }

    return 0;
}

/*

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

Main function. Create the parrot interpreter and call cotorra_main.

=cut

*/

int main(int argc, 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:
 */