PARROT_EXPORT
void
PackFile_pack(PARROT_INTERP, ARGMOD(PackFile *self), ARGOUT(opcode_t *cursor))
{
ASSERT_ARGS(PackFile_pack)
opcode_t *ret;
size_t size;
PackFile_Directory * const dir = &self->directory;
PackFile_Segment *seg;
int padding_size;
char *byte_cursor = (char*)cursor;
self->src = cursor;
/* Pack the fixed part of the header */
mem_sys_memcopy(cursor, self->header, PACKFILE_HEADER_BYTES);
byte_cursor += PACKFILE_HEADER_BYTES;
/* Pack the UUID. */
if (self->header->uuid_size > 0)
mem_sys_memcopy(byte_cursor, self->header->uuid_data,
self->header->uuid_size);
/* Padding. */
padding_size = 16 - (PACKFILE_HEADER_BYTES + self->header->uuid_size) % 16;
if (padding_size < 16) {
int i;
for (i = 0; i < padding_size; ++i)
*byte_cursor++ = 0;
}
else {
padding_size = 0;
}
/* Set cursor. */
cursor += (PACKFILE_HEADER_BYTES + self->header->uuid_size + padding_size)
/ sizeof (opcode_t);
/* Directory format and padding. */
*cursor++ = PF_DIR_FORMAT;
*cursor++ = 0;
*cursor++ = 0;
*cursor++ = 0;
/* pack the directory */
seg = (PackFile_Segment *) dir;
/* dir size */
size = seg->op_count;
ret = PackFile_Segment_pack(interp, seg, cursor);
if ((size_t)(ret - cursor) != size) {
Parrot_io_eprintf(interp, "PackFile_pack segment '%Ss' used size %d "
"but reported %d\n", seg->name, (int)(ret-cursor), (int)size);
}
}
void
dump_instructions(ARGMOD(imc_info_t * imcc), ARGIN(const IMC_Unit *unit))
{
ASSERT_ARGS(dump_instructions)
const Instruction *ins;
int pc;
Parrot_io_eprintf(imcc->interp,
"\nDumping the instructions status:"
"\n-------------------------------\n");
Parrot_io_eprintf(imcc->interp,
"nins line blck deep flags\t type opnr size pc X ins\n");
for (pc = 0, ins = unit->instructions; ins; ins = ins->next) {
const Basic_block * const bb = unit->bb_list[ins->bbindex];
if (bb) {
Parrot_io_eprintf(imcc->interp,
"%4i %4d %4d %4d\t%x\t%8x %4d %4d %4d ",
ins->index, ins->line, bb->index, bb->loop_depth,
ins->flags, ins->type, OP_INFO_OPNUM(ins->op),
ins->opsize, pc);
}
else {
Parrot_io_eprintf(imcc->interp, "\t");
}
Parrot_io_eprintf(imcc->interp, "%s\n", ins->opname);
ins_print(imcc, PIO_STDHANDLE(imcc->interp, PIO_STDERR_FILENO), ins);
pc += ins->opsize;
}
Parrot_io_eprintf(imcc->interp, "\n");
}
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;
}
}
PARROT_EXPORT
PARROT_CAN_RETURN_NULL
PackFile *
Parrot_pbc_read(PARROT_INTERP, ARGIN_NULLOK(const char *fullname), const int debug)
{
PackFile *pf;
char *program_code;
FILE *io = NULL;
INTVAL is_mapped = 0;
INTVAL program_size;
#ifdef PARROT_HAS_HEADER_SYSMMAN
int fd = -1;
#endif
if (!fullname || STREQ(fullname, "-")) {
/* read from STDIN */
io = stdin;
/* read 1k at a time */
program_size = 0;
}
else {
STRING * const fs = string_make(interp, fullname, strlen(fullname),
NULL, 0);
/* can't read a file that doesn't exist */
if (!Parrot_stat_info_intval(interp, fs, STAT_EXISTS)) {
Parrot_io_eprintf(interp, "Parrot VM: Can't stat %s, code %i.\n",
fullname, errno);
return NULL;
}
/* we may need to relax this if we want to read bytecode from pipes */
if (!Parrot_stat_info_intval(interp, fs, STAT_ISREG)) {
Parrot_io_eprintf(interp,
"Parrot VM: '%s', is not a regular file %i.\n",
fullname, errno);
return NULL;
}
program_size = Parrot_stat_info_intval(interp, fs, STAT_FILESIZE);
#ifndef PARROT_HAS_HEADER_SYSMMAN
io = fopen(fullname, "rb");
if (!io) {
Parrot_io_eprintf(interp, "Parrot VM: Can't open %s, code %i.\n",
fullname, errno);
return NULL;
}
#endif /* PARROT_HAS_HEADER_SYSMMAN */
}
#ifdef PARROT_HAS_HEADER_SYSMMAN
again:
#endif
/* if we've opened a file (or stdin) with PIO, read it in */
if (io) {
char *cursor;
size_t chunk_size = program_size > 0 ? program_size : 1024;
INTVAL wanted = program_size;
size_t read_result;
program_code = mem_allocate_n_typed(chunk_size, char);
cursor = program_code;
program_size = 0;
while ((read_result = fread(cursor, 1, chunk_size, io)) > 0) {
program_size += read_result;
if (program_size == wanted)
break;
chunk_size = 1024;
mem_realloc_n_typed(program_code, program_size + chunk_size, char);
if (!program_code) {
Parrot_io_eprintf(interp,
"Parrot VM: Could not reallocate buffer "
"while reading packfile from PIO.\n");
fclose(io);
return NULL;
}
cursor = (char *)(program_code + program_size);
}
if (ferror(io)) {
Parrot_io_eprintf(interp,
"Parrot VM: Problem reading packfile from PIO: code %d.\n",
ferror(io));
fclose(io);
mem_sys_free(program_code);
return NULL;
}
fclose(io);
}
else {
/* if we've gotten here, we opted not to use PIO to read the file.
* use mmap */
#ifdef PARROT_HAS_HEADER_SYSMMAN
/* check that fullname isn't NULL, just in case */
if (!fullname)
int
main(int argc, const char *argv[])
{
int nextarg;
Parrot_Interp interp;
PDB_t *pdb;
const char *scriptname = NULL;
const unsigned char * configbytes = Parrot_get_config_hash_bytes();
const int configlength = Parrot_get_config_hash_length();
interp = Parrot_new(NULL);
Parrot_set_executable_name(interp, Parrot_str_new(interp, argv[0], 0));
Parrot_set_configuration_hash_legacy(interp, configlength, configbytes);
Parrot_debugger_init(interp);
pdb = interp->pdb;
pdb->state = PDB_ENTER;
Parrot_block_GC_mark(interp);
Parrot_block_GC_sweep(interp);
nextarg = 1;
if (argv[nextarg] && strcmp(argv[nextarg], "--script") == 0)
{
scriptname = argv [++nextarg];
++nextarg;
}
if (argv[nextarg]) {
const char *filename = argv[nextarg];
const char *ext = strrchr(filename, '.');
if (ext && STREQ(ext, ".pbc")) {
Parrot_PackFile pf = Parrot_pbc_read(interp, filename, 0);
if (!pf)
return 1;
Parrot_pbc_load(interp, pf);
PackFile_fixup_subs(interp, PBC_MAIN, NULL);
}
else {
STRING *errmsg = NULL;
Parrot_PackFile pf = PackFile_new(interp, 0);
Parrot_pbc_load(interp, pf);
Parrot_compile_file(interp, filename, &errmsg);
if (errmsg)
Parrot_ex_throw_from_c_args(interp, NULL, 1, "%S", errmsg);
PackFile_fixup_subs(interp, PBC_POSTCOMP, NULL);
/* load the source for debugger list */
PDB_load_source(interp, filename);
PackFile_fixup_subs(interp, PBC_MAIN, NULL);
}
}
else {
/* Generate some code to be able to enter into runloop */
STRING *compiler = Parrot_str_new_constant(interp, "PIR");
STRING *errstr = NULL;
const char source []= ".sub aux :main\nexit 0\n.end\n";
Parrot_compile_string(interp, compiler, source, &errstr);
if (!STRING_IS_NULL(errstr))
Parrot_io_eprintf(interp, "%Ss\n", errstr);
}
Parrot_unblock_GC_mark(interp);
Parrot_unblock_GC_sweep(interp);
if (scriptname)
PDB_script_file(interp, scriptname);
else
PDB_printwelcome();
Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "debugger"));
PDB_run_code(interp, argc - nextarg, argv + nextarg);
Parrot_x_exit(interp, 0);
}
