opcode_t *
runops_cgoto_core(struct Parrot_Interp *interpreter, opcode_t *pc)
{
#ifdef HAVE_COMPUTED_GOTO
pc = cg_core(pc, interpreter);
return pc;
#else
PIO_eprintf(interpreter,
"Computed goto unavailable in this configuration.\n");
Parrot_exit(1);
return NULL;
#endif
}
PARROT_EXPORT
PARROT_DOES_NOT_RETURN
void
IMCC_fatal_standalone(PARROT_INTERP, int code, ARGIN(const char *fmt), ...)
{
ASSERT_ARGS(IMCC_fatal_standalone)
va_list ap;
va_start(ap, fmt);
imcc_vfprintf(interp, Parrot_io_STDERR(interp), fmt, ap);
va_end(ap);
Parrot_exit(interp, code);
}
int
main(int argc, const char *argv[])
{
int stacktop;
const char *sourcefile;
const char *execname;
Interp *interp;
int status;
int pir_argc;
const char **pir_argv;
Parrot_Run_core_t core = PARROT_SLOW_CORE;
Parrot_trace_flags trace = PARROT_NO_TRACE;
/* internationalization setup */
/* setlocale(LC_ALL, ""); */
PARROT_BINDTEXTDOMAIN(PACKAGE, LOCALEDIR);
PARROT_TEXTDOMAIN(PACKAGE);
Parrot_set_config_hash();
interp = allocate_interpreter(NULL, PARROT_NO_FLAGS);
/* We parse the arguments, but first store away the name of the Parrot
executable, since parsing destroys that and we want to make it
available. */
execname = argv[0];
/* Parse minimal subset of flags */
parseflags_minimal(interp, argc, argv);
/* Now initialize interpreter */
initialize_interpreter(interp, (void*)&stacktop);
/* Parse flags */
sourcefile = parseflags(interp, argc, argv, &pir_argc, &pir_argv, &core, &trace);
Parrot_set_trace(interp, trace);
Parrot_set_run_core(interp, (Parrot_Run_core_t) core);
Parrot_set_executable_name(interp, Parrot_str_new(interp, execname, 0));
status = imcc_run(interp, sourcefile, argc, argv);
if (status)
imcc_run_pbc(interp, interp->output_file, pir_argc, pir_argv);
/* Clean-up after ourselves */
Parrot_destroy(interp);
Parrot_exit(interp, 0);
}
int
main(int argc, char *argv[])
{
Parrot_Interp interpreter;
char *filename, *disassemble;
Parrot_PackFile pf;
interpreter = Parrot_new(NULL);
if (!interpreter) {
return 1;
}
interpreter->lo_var_ptr = &interpreter;
Parrot_init(interpreter);
if (argc != 2) {
fprintf(stderr, "Usage: disassemble programfile \n");
Parrot_exit(1);
}
filename = argv[1];
pf = Parrot_readbc(interpreter, filename);
if (!pf) {
return 1;
}
Parrot_loadbc(interpreter, pf);
do_dis(interpreter);
Parrot_exit(0);
return 0;
}
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static opcode_t *
runops_cgoto_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc))
{
ASSERT_ARGS(runops_cgoto_core)
/* disable pc */
Parrot_pcc_set_pc(interp, CURRENT_CONTEXT(interp), NULL);
#ifdef HAVE_COMPUTED_GOTO
pc = cg_core(pc, interp);
return pc;
#else
UNUSED(pc);
Parrot_io_eprintf(interp,
"Computed goto unavailable in this configuration.\n");
Parrot_exit(interp, 1);
#endif
}
static void
PackFile_Constant_dump(PARROT_INTERP, ARGIN(const PackFile_ConstTable *ct),
ARGIN(const PackFile_Constant *self))
{
ASSERT_ARGS(PackFile_Constant_dump)
PMC *key;
size_t i;
switch (self->type) {
case PFC_NUMBER:
Parrot_io_printf(interp, " [ 'PFC_NUMBER', %g ],\n", self->u.number);
break;
case PFC_STRING:
Parrot_io_printf(interp, " [ 'PFC_STRING', {\n");
pobj_flag_dump(interp, (long)PObj_get_FLAGS(self->u.string));
Parrot_io_printf(interp, " CHARSET => %ld,\n",
self->u.string->charset);
i = self->u.string->bufused;
Parrot_io_printf(interp, " SIZE => %ld,\n",
(long)i);
Parrot_io_printf(interp, " DATA => \"%Ss\"\n",
Parrot_str_escape(interp, self->u.string));
Parrot_io_printf(interp, " } ],\n");
break;
case PFC_KEY:
for (i = 0, key = self->u.key; key; i++) {
GETATTR_Key_next_key(interp, key, key);
}
/* number of key components */
Parrot_io_printf(interp, " [ 'PFC_KEY' (%ld items)\n", i);
/* and now type / value per component */
for (key = self->u.key; key;) {
opcode_t type = PObj_get_FLAGS(key);
Parrot_io_printf(interp, " {\n");
type &= KEY_type_FLAGS;
pobj_flag_dump(interp, (long)PObj_get_FLAGS(key));
switch (type) {
case KEY_integer_FLAG:
Parrot_io_printf(interp, " TYPE => INTEGER\n");
Parrot_io_printf(interp, " DATA => %ld\n",
VTABLE_get_integer(interp, key));
Parrot_io_printf(interp, " },\n");
break;
case KEY_number_FLAG:
{
const PackFile_Constant *detail;
size_t ct_index;
Parrot_io_printf(interp, " TYPE => NUMBER\n");
ct_index = PackFile_find_in_const(interp, ct, key, PFC_NUMBER);
Parrot_io_printf(interp, " PFC_OFFSET => %ld\n", ct_index);
detail = ct->constants[ct_index];
Parrot_io_printf(interp, " DATA => %ld\n", detail->u.number);
Parrot_io_printf(interp, " },\n");
}
break;
case KEY_string_FLAG:
{
const PackFile_Constant *detail;
size_t ct_index;
Parrot_io_printf(interp, " TYPE => STRING\n");
ct_index = PackFile_find_in_const(interp, ct, key, PFC_STRING);
Parrot_io_printf(interp, " PFC_OFFSET => %ld\n", ct_index);
detail = ct->constants[ct_index];
Parrot_io_printf(interp, " DATA => '%Ss'\n",
detail->u.string);
Parrot_io_printf(interp, " },\n");
}
break;
case KEY_integer_FLAG | KEY_register_FLAG:
Parrot_io_printf(interp, " TYPE => I REGISTER\n");
Parrot_io_printf(interp, " DATA => %ld\n",
VTABLE_get_integer(interp, key));
Parrot_io_printf(interp, " },\n");
break;
case KEY_number_FLAG | KEY_register_FLAG:
Parrot_io_printf(interp, " TYPE => N REGISTER\n");
Parrot_io_printf(interp, " DATA => %ld\n",
VTABLE_get_integer(interp, key));
Parrot_io_printf(interp, " },\n");
break;
case KEY_string_FLAG | KEY_register_FLAG:
Parrot_io_printf(interp, " TYPE => S REGISTER\n");
Parrot_io_printf(interp, " DATA => %ld\n",
VTABLE_get_integer(interp, key));
Parrot_io_printf(interp, " },\n");
break;
case KEY_pmc_FLAG | KEY_register_FLAG:
Parrot_io_printf(interp, " TYPE => P REGISTER\n");
Parrot_io_printf(interp, " DATA => %ld\n",
VTABLE_get_integer(interp, key));
Parrot_io_printf(interp, " },\n");
break;
default:
Parrot_io_eprintf(NULL, "PackFile_Constant_pack: "
"unsupported constant type\n");
Parrot_exit(interp, 1);
}
GETATTR_Key_next_key(interp, key, key);
}
Parrot_io_printf(interp, " ],\n");
break;
case PFC_PMC:
Parrot_io_printf(interp, " [ 'PFC_PMC', {\n");
{
PMC * const pmc = self->u.key;
Parrot_Sub_attributes *sub;
STRING * const null = Parrot_str_new_constant(interp, "(null)");
STRING *namespace_description;
pobj_flag_dump(interp, (long)PObj_get_FLAGS(pmc));
switch (pmc->vtable->base_type) {
case enum_class_FixedBooleanArray:
case enum_class_FixedFloatArray:
case enum_class_FixedPMCArray:
case enum_class_FixedStringArray:
case enum_class_ResizableBooleanArray:
case enum_class_ResizableIntegerArray:
case enum_class_ResizableFloatArray:
case enum_class_ResizablePMCArray:
case enum_class_ResizableStringArray:
{
const int n = VTABLE_get_integer(interp, pmc);
STRING* const out_buffer = VTABLE_get_repr(interp, pmc);
Parrot_io_printf(interp,
"\tclass => %Ss,\n"
"\telement count => %d,\n"
"\telements => %Ss,\n",
pmc->vtable->whoami,
n,
out_buffer);
}
break;
case enum_class_Sub:
case enum_class_Coroutine:
PMC_get_sub(interp, pmc, sub);
if (sub->namespace_name) {
switch (sub->namespace_name->vtable->base_type) {
case enum_class_String:
namespace_description = Parrot_str_new(interp, "'", 1);
namespace_description = Parrot_str_append(interp,
namespace_description,
VTABLE_get_string(interp, sub->namespace_name));
namespace_description = Parrot_str_append(interp,
namespace_description,
Parrot_str_new(interp, "'", 1));
break;
case enum_class_Key:
namespace_description =
key_set_to_string(interp, sub->namespace_name);
break;
default:
namespace_description = sub->namespace_name->vtable->whoami;
}
}
else {
namespace_description = null;
}
Parrot_io_printf(interp,
"\tclass => %Ss,\n"
"\tstart_offs => %d,\n"
"\tend_offs => %d,\n"
"\tname => '%Ss',\n"
"\tsubid => '%Ss',\n"
"\tmethod => '%Ss',\n"
"\tnsentry => '%Ss',\n"
"\tnamespace => %Ss\n"
"\tHLL_id => %d,\n",
pmc->vtable->whoami,
sub->start_offs,
sub->end_offs,
sub->name,
sub->subid,
sub->method_name,
sub->ns_entry_name,
namespace_description,
sub->HLL_id);
break;
case enum_class_FixedIntegerArray:
Parrot_io_printf(interp,
"\tclass => %Ss,\n"
"\trepr => '%Ss'\n",
pmc->vtable->whoami,
VTABLE_get_repr(interp, pmc));
break;
default:
Parrot_io_printf(interp, "\tno dump info for PMC %ld %Ss\n",
pmc->vtable->base_type, pmc->vtable->whoami);
Parrot_io_printf(interp, "\tclass => %Ss,\n", pmc->vtable->whoami);
}
}
Parrot_io_printf(interp, " } ],\n");
break;
default:
Parrot_io_printf(interp, " [ 'PFC_\?\?\?', type '0x%x' ],\n",
self->type);
break;
}
}
int
main(int argc, const char **argv)
{
PackFile *pf;
Interp *interp;
const char *file = NULL;
int terse = 0;
int disas = 0;
int convert = 0;
int nums_only = 0;
int options = PFOPT_UTILS;
struct longopt_opt_info opt = LONGOPT_OPT_INFO_INIT;
int status;
if (argc < 2)
help();
interp = Parrot_new(NULL);
/* init and set top of stack */
Parrot_init_stacktop(interp, &status);
while ((status = longopt_get(interp, argc, argv, opt_options, &opt)) > 0) {
switch (opt.opt_id) {
#if TRACE_PACKFILE
case 'D':
options += atoi(opt.opt_arg) << 2;
break;
#endif
case 'h':
options += PFOPT_HEADERONLY;
break;
case 't':
terse = 1;
break;
case 'd':
disas = 1;
break;
case 'o':
file = opt.opt_arg;
convert = 1;
break;
case 'n':
nums_only = 1;
break;
case '?':
default:
help();
break;
}
}
if (status == -1)
help();
argc -= opt.opt_index;
argv += opt.opt_index;
pf = Parrot_pbc_read(interp, *argv, options);
if (!pf) {
printf("Can't read PBC\n");
return 1;
}
Parrot_pbc_load(interp, pf);
if (convert) {
size_t size = PackFile_pack_size(interp,
interp->code->base.pf) * sizeof (opcode_t);
opcode_t *pack = (opcode_t *)Parrot_gc_allocate_memory_chunk(interp,
size);
FILE *fp;
if (!pack) {
printf("out of mem\n");
exit(EXIT_FAILURE);
}
PackFile_pack(interp, interp->code->base.pf, pack);
if (STREQ(file, "-"))
fp = stdout;
else if ((fp = fopen(file, "wb")) == 0) {
printf("Couldn't open %s\n", file);
exit(EXIT_FAILURE);
}
if ((1 != fwrite(pack, size, 1, fp))) {
printf("Couldn't write %s\n", file);
exit(EXIT_FAILURE);
}
fclose(fp);
Parrot_gc_free_memory_chunk(interp, pack);
Parrot_exit(interp, 0);
}
if (!nums_only)
PackFile_header_dump(interp, pf);
if (options & PFOPT_HEADERONLY)
Parrot_exit(interp, 0);
/* install a dumper function */
if (!terse) {
pf->PackFuncs[PF_CONST_SEG].dump = const_dump;
}
if (disas)
pf->PackFuncs[PF_BYTEC_SEG].dump = disas_dump;
if (nums_only) {
int i;
for (i = PF_DIR_SEG + 1; i < PF_MAX_SEG; ++i)
pf->PackFuncs[i].dump = null_dump;
pf->PackFuncs[PF_DIR_SEG].dump = null_dir_dump;
pf->PackFuncs[PF_BYTEC_SEG].dump = nums_dump;
}
/* do a directory dump, which dumps segs then */
PackFile_Segment_dump(interp, &pf->directory.base);
Parrot_exit(interp, 0);
}
