/*
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/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, 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_new_string(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_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_typenum(interp, "FixedStringArray"));
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' :
*/
