/*
* Copyright (C) 2002-2007, The Perl Foundation.
* $Id: pbc.c 23777 2007-12-12 03:36:35Z petdance $
*/
#include "imc.h"
#include "pbc.h"
#include "parrot/packfile.h"
/* HEADERIZER HFILE: compilers/imcc/pbc.h */
/*
=head1 NAME
compilers/imcc/pbc.c
=head1 DESCRIPTION
emit imcc instructions into Parrot interpreter
the e_pbc_emit function is called per instruction
Notes:
I'm using existing data structures here (SymReg*) to store
various global items (currently only PMC constants).
The index in the constant table is in SymReg* ->color
data member. This looks odd, but the register number
from imc.c:allocate is also there for variables,
so it's a little bit consistent at least.
So when reading color here it's either a constant table index
or a Parrot register number, depending on data type.
TODO memory clean up
-lt
=head2 Functions
=over 4
=cut
*/
/*
* globals store the state between individual e_pbc_emit calls
*/
typedef struct subs_t {
size_t size; /* code size in ops */
int ins_line; /* line number for debug */
int n_basic_blocks; /* block count */
SymHash fixup; /* currently set_p_pc sub names only */
IMC_Unit *unit;
int pmc_const; /* index in const table */
struct subs_t *prev;
struct subs_t *next;
} subs_t;
/* subs are kept per code segment */
typedef struct cs_t {
PackFile_ByteCode *seg; /* bytecode segment */
PackFile_Segment *jit_info; /* bblocks, register usage */
subs_t *subs; /* current sub data */
subs_t *first; /* first sub of code segment */
struct cs_t *prev; /* previous code segment */
struct cs_t *next; /* next code segment */
SymHash key_consts; /* cached key constants for this seg */
int pic_idx; /* next index of PIC */
} cs_t;
static struct globals {
cs_t *cs; /* current code segment */
cs_t *first; /* first code segment */
int inter_seg_n;
} globals;
/* HEADERIZER BEGIN: static */
static void add_1_const(PARROT_INTERP, NOTNULL(SymReg *r))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static int add_const_key(PARROT_INTERP,
NOTNULL(opcode_t key[]),
int size,
ARGIN(const char *s_key))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(4);
PARROT_WARN_UNUSED_RESULT
static int add_const_num(PARROT_INTERP, ARGIN_NULLOK(const char *buf))
__attribute__nonnull__(1);
static int add_const_pmc_sub(PARROT_INTERP,
NOTNULL(SymReg *r),
int offs,
int end)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_WARN_UNUSED_RESULT
static int add_const_str(PARROT_INTERP, ARGIN(const SymReg *r))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static opcode_t build_key(PARROT_INTERP, NOTNULL(SymReg *key_reg))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static void constant_folding(PARROT_INTERP, NOTNULL(IMC_Unit *unit))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static PMC* create_lexinfo(PARROT_INTERP,
NOTNULL(IMC_Unit *unit),
NOTNULL(PMC *sub),
int need_lex)
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static subs_t * find_global_label(
ARGIN(const char *name),
ARGIN(const subs_t *sym),
NOTNULL(int *pc))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static PMC* find_outer(PARROT_INTERP, NOTNULL(IMC_Unit *unit))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static void fixup_globals(PARROT_INTERP)
__attribute__nonnull__(1);
PARROT_WARN_UNUSED_RESULT
static int get_codesize(PARROT_INTERP,
NOTNULL(IMC_Unit *unit),
NOTNULL(int *src_lines))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
PARROT_WARN_UNUSED_RESULT
static int get_old_size(PARROT_INTERP, NOTNULL(int *ins_line))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static void imcc_globals_destroy(SHIM_INTERP,
SHIM(int ex),
SHIM(void *param));
static void make_new_sub(NOTNULL(IMC_Unit *unit))
__attribute__nonnull__(1);
static void make_pmc_const(PARROT_INTERP, NOTNULL(SymReg *r))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_CANNOT_RETURN_NULL
PARROT_MALLOC
static PMC* mk_multi_sig(PARROT_INTERP, NOTNULL(SymReg *r))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_WARN_UNUSED_RESULT
static int old_blocks(void);
PARROT_CONST_FUNCTION
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static const char * slice_deb(int bits);
static void store_fixup(PARROT_INTERP,
NOTNULL(SymReg *r),
int pc,
int offset)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
static void store_key_const(ARGIN(const char *str), int idx)
__attribute__nonnull__(1);
static void store_sub_size(size_t size, size_t ins_line);
static void verify_signature(PARROT_INTERP,
ARGIN(const Instruction *ins),
NOTNULL(opcode_t *pc))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
/* HEADERIZER END: static */
/*
=item C<static void
imcc_globals_destroy(SHIM_INTERP, SHIM(int ex), SHIM(void *param))>
RT#48260: Not yet documented!!!
=cut
*/
static void
imcc_globals_destroy(SHIM_INTERP, SHIM(int ex), SHIM(void *param))
{
cs_t *cs, *prev_cs;
cs = globals.cs;
while (cs) {
subs_t *s = cs->subs;
while (s) {
subs_t * const prev_s = s->prev;
clear_sym_hash(&s->fixup);
mem_sys_free(s);
s = prev_s;
}
clear_sym_hash(&cs->key_consts);
prev_cs = cs->prev;
mem_sys_free(cs);
cs = prev_cs;
}
globals.cs = NULL;
}
/*
=item C<int
e_pbc_open(PARROT_INTERP, SHIM(void *param))>
RT#48260: Not yet documented!!!
=cut
*/
int
e_pbc_open(PARROT_INTERP, SHIM(void *param))
{
cs_t *cs;
/* register cleanup code */
if (!globals.cs)
Parrot_on_exit(interp, imcc_globals_destroy, NULL);
cs = mem_allocate_zeroed_typed(cs_t);
cs->prev = globals.cs;
/* free previous cached key constants if any */
if (globals.cs)
clear_sym_hash(&globals.cs->key_consts);
create_symhash(&cs->key_consts);
cs->next = NULL;
cs->subs = NULL;
cs->first = NULL;
cs->jit_info = NULL;
if (!globals.first)
globals.first = cs;
else
cs->prev->next = cs;
/* we need some segments */
if (!interp->code) {
PMC *self;
int k;
cs->seg = interp->code =
PF_create_default_segs(interp,
IMCC_INFO(interp)->state->file, 1);
/*
* create a PMC constant holding the interpreter state
*
* see also ParrotInterpreter.thaw and .thawfinish
* currently just HLL_info is saved/restored
*/
self = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
IGLOBALS_INTERPRETER);
k = PDB_extend_const_table(interp);
interp->code->const_table->constants[k]->type = PFC_PMC;
interp->code->const_table->constants[k]->u.key = self;
}
globals.cs = cs;
return 0;
}
#ifdef HAS_JIT
/*
=item C<PARROT_WARN_UNUSED_RESULT
static int
old_blocks(void)>
get size/line of bytecode in ops till now
=cut
*/
PARROT_WARN_UNUSED_RESULT
static int
old_blocks(void)
{
size_t size = 0;
const subs_t *s;
for (s = globals.cs->subs; s; s = s->prev) {
size += s->n_basic_blocks;
}
return size;
}
/*
=item C<PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
opcode_t *
make_jit_info(PARROT_INTERP, NOTNULL(IMC_Unit *unit))>
RT#48260: Not yet documented!!!
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
opcode_t *
make_jit_info(PARROT_INTERP, NOTNULL(IMC_Unit *unit))
{
size_t size, old;
if (!globals.cs->jit_info) {
char * const name = (char *)
mem_sys_allocate(strlen(globals.cs->seg->base.name) + 5);
sprintf(name, "%s_JIT", globals.cs->seg->base.name);
globals.cs->jit_info =
PackFile_Segment_new_seg(interp,
interp->code->base.dir, PF_UNKNOWN_SEG, name, 1);
free(name);
}
size = unit->n_basic_blocks + (old = old_blocks());
/* store current size */
globals.cs->subs->n_basic_blocks = unit->n_basic_blocks;
/* offset of block start and end, 4 * registers_used */
globals.cs->jit_info->data = (opcode_t *)realloc(globals.cs->jit_info->data,
size * sizeof (opcode_t) * 6);
globals.cs->jit_info->size = size * 6;
return globals.cs->jit_info->data + old * 6;
}
#endif
/*
=item C<static void
make_new_sub(NOTNULL(IMC_Unit *unit))>
allocate a new globals.cs->subs structure
=cut
*/
static void
make_new_sub(NOTNULL(IMC_Unit *unit))
{
subs_t * const s = mem_allocate_zeroed_typed(subs_t);
s->prev = globals.cs->subs;
s->next = NULL;
s->unit = unit;
s->pmc_const = -1;
if (globals.cs->subs)
globals.cs->subs->next = s;
if (!globals.cs->first)
globals.cs->first = s;
globals.cs->subs = s;
create_symhash(&s->fixup);
}
/*
=item C<PARROT_WARN_UNUSED_RESULT
static int
get_old_size(PARROT_INTERP, NOTNULL(int *ins_line))>
get size/line of bytecode in ops till now
=cut
*/
PARROT_WARN_UNUSED_RESULT
static int
get_old_size(PARROT_INTERP, NOTNULL(int *ins_line))
{
subs_t *s;
size_t size = 0;
*ins_line = 0;
if (!globals.cs || interp->code->base.data == NULL)
return 0;
for (s = globals.cs->subs; s; s = s->prev) {
size += s->size;
*ins_line += s->ins_line;
}
return size;
}
/*
=item C<static void
store_sub_size(size_t size, size_t ins_line)>
RT#48260: Not yet documented!!!
=cut
*/
static void
store_sub_size(size_t size, size_t ins_line)
{
globals.cs->subs->size = size;
globals.cs->subs->ins_line = ins_line;
}
/*
=item C<static void
store_fixup(PARROT_INTERP, NOTNULL(SymReg *r), int pc, int offset)>
RT#48260: Not yet documented!!!
=cut
*/
static void
store_fixup(PARROT_INTERP, NOTNULL(SymReg *r), int pc, int offset)
{
SymReg * const fixup = _mk_address(interp, &globals.cs->subs->fixup,
str_dup(r->name), U_add_all);
if (r->set == 'p')
fixup->set = 'p';
if (r->type & VT_ENCODED)
fixup->type |= VT_ENCODED;
/* set_p_pc = 2 */
fixup->color = pc;
fixup->offset = offset;
}
/*
=item C<static void
store_key_const(ARGIN(const char *str), int idx)>
RT#48260: Not yet documented!!!
=cut
*/
static void
store_key_const(ARGIN(const char *str), int idx)
{
SymReg * const c = _mk_const(&globals.cs->key_consts, str_dup(str), 0);
c->color = idx;
}
/*
=item C<PARROT_WARN_UNUSED_RESULT
static int
get_codesize(PARROT_INTERP, NOTNULL(IMC_Unit *unit), NOTNULL(int *src_lines))>
store globals for later fixup
return size in ops
=cut
*/
PARROT_WARN_UNUSED_RESULT
static int
get_codesize(PARROT_INTERP, NOTNULL(IMC_Unit *unit), NOTNULL(int *src_lines))
{
Instruction *ins;
int code_size;
/* run through instructions:
* - sanity check
* - calc code size
* - calc nr of src lines for debug info
* - remember addr of labels
* - remember set_p_pc for global fixup
*/
*src_lines = 0;
for (code_size = 0, ins = unit->instructions; ins ; ins = ins->next) {
if (ins->type & ITLABEL)
ins->r[0]->color = code_size;
if (ins->op && *ins->op) {
(*src_lines)++;
if (ins->opnum < 0)
IMCC_fatal(interp, 1, "get_codesize: "
"no opnum ins#%d %I\n",
ins->index, ins);
if (ins->opnum == PARROT_OP_set_p_pc) {
/* set_p_pc opcode */
IMCC_debug(interp, DEBUG_PBC_FIXUP, "PMC constant %s\n",
ins->r[1]->name);
if (ins->r[1]->usage & U_FIXUP)
store_fixup(interp, ins->r[1], code_size, 2);
}
code_size += ins->opsize;
}
else if (ins->opsize)
IMCC_fatal(interp, 1, "get_codesize: "
"non instruction with size found\n");
}
return code_size;
}
/*
=item C<PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static subs_t *
find_global_label(ARGIN(const char *name), ARGIN(const subs_t *sym), NOTNULL(int *pc))>
get a global label, return the pc (absolute)
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static subs_t *
find_global_label(ARGIN(const char *name), ARGIN(const subs_t *sym), NOTNULL(int *pc))
{
subs_t *s;
*pc = 0;
for (s = globals.cs->first; s; s = s->next) {
SymReg * const r = s->unit->instructions->r[0];
/* if names and namespaces are matching - ok */
if (r && !strcmp(r->name, name) &&
((sym->unit->_namespace && s->unit->_namespace &&
!strcmp(sym->unit->_namespace->name,
s->unit->_namespace->name))
|| (!sym->unit->_namespace && !s->unit->_namespace))) {
return s;
}
*pc += s->size;
}
return NULL;
}
/*
=item C<static void
fixup_globals(PARROT_INTERP)>
fix global stuff
=cut
*/
static void
fixup_globals(PARROT_INTERP)
{
Instruction *ins;
SymReg *r1;
pcc_sub_t *pcc_sub;
subs_t *s, *s1;
int i, pc, addr, pmc_const;
int jumppc = 0;
for (s = globals.cs->first; s; s = s->next) {
const SymHash * const hsh = &s->fixup;
for (i = 0; i < hsh->size; i++) {
SymReg *fixup;
for (fixup = hsh->data[i]; fixup; fixup = fixup->next) {
addr = jumppc + fixup->color;
/* check in matching namespace */
s1 = find_global_label(fixup->name, s, &pc);
/*
* if failed change opcode:
* set_p_pc => find_name p_sc
* if a sub label is found
* convert to find_name, if the sub is a multi
*/
if (s1) {
PARROT_ASSERT(s1->unit);
if (s1->unit->type & IMC_PCCSUB) {
ins = s1->unit->instructions;
PARROT_ASSERT(ins);
r1 = ins->r[0];
PARROT_ASSERT(r1);
pcc_sub = r1->pcc_sub;
PARROT_ASSERT(pcc_sub);
/* if the sub is multi, don't insert constant */
if (pcc_sub->nmulti)
s1 = NULL;
}
}
if (!s1) {
int op, col;
SymReg *nam = mk_const(interp, str_dup(fixup->name),
fixup->type & VT_ENCODED ? 'U' : 'S');
op = interp->op_lib->op_code("find_name_p_sc", 1);
PARROT_ASSERT(op);
interp->code->base.data[addr] = op;
if (nam->color >= 0)
col = nam->color;
else
col = nam->color = add_const_str(interp, nam);
interp->code->base.data[addr+2] = col;
IMCC_debug(interp, DEBUG_PBC_FIXUP,
"fixup const PMC"
" find_name sub '%s' const nr: %d\n",
fixup->name, col);
continue;
}
pmc_const = s1->pmc_const;
if (pmc_const < 0) {
IMCC_fatal(interp, 1, "fixup_globals: "
"couldn't find sub 2 '%s'\n",
fixup->name);
}
interp->code->base.data[addr+fixup->offset] = pmc_const;
IMCC_debug(interp, DEBUG_PBC_FIXUP, "fixup const PMC"
" sub '%s' const nr: %d\n", fixup->name,
pmc_const);
continue;
}
}
jumppc += s->size;
}
}
/*
=item C<PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
STRING *
IMCC_string_from_reg(PARROT_INTERP, ARGIN(const SymReg *r))>
RT#48260: Not yet documented!!!
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
STRING *
IMCC_string_from_reg(PARROT_INTERP, ARGIN(const SymReg *r))
{
const char *buf = r->name;
STRING *s;
if (r->type & VT_ENCODED) {
/*
* the lexer parses: foo:"string"
* get first part as charset, rest as string
*/
const char *charset;
char * const p = strchr(r->name, '"');
PARROT_ASSERT(p && p[-1] == ':');
p[-1] = 0;
charset = r->name;
/* past delim */
buf = p + 1;
s = string_unescape_cstring(interp, buf, '"', charset);
/* restore colon, as we may reuse this string */
p[-1] = ':';
}
else if (*buf == '"') {
buf++;
s = string_unescape_cstring(interp, buf, '"', NULL);
}
else if (*buf == '\'') { /* TODO handle python raw strings */
buf++;
s = string_make(interp, buf, strlen(buf) - 1, "ascii",
PObj_constant_FLAG);
}
else {
/* unquoted bare name - ascii only dont't unescape it */
s = string_make(interp, buf, strlen(buf), "ascii",
PObj_constant_FLAG);
}
return s;
}
/*
=item C<PARROT_WARN_UNUSED_RESULT
static int
add_const_str(PARROT_INTERP, ARGIN(const SymReg *r))>
add constant string to constant_table
=cut
*/
PARROT_WARN_UNUSED_RESULT
static int
add_const_str(PARROT_INTERP, ARGIN(const SymReg *r))
{
const int k = PDB_extend_const_table(interp);
STRING * const s = IMCC_string_from_reg(interp, r);
interp->code->const_table->constants[k]->type = PFC_STRING;
interp->code->const_table->constants[k]->u.string = s;
return k;
}
/*
=item C<PARROT_WARN_UNUSED_RESULT
static int
add_const_num(PARROT_INTERP, ARGIN_NULLOK(const char *buf))>
RT#48260: Not yet documented!!!
=cut
*/
PARROT_WARN_UNUSED_RESULT
static int
add_const_num(PARROT_INTERP, ARGIN_NULLOK(const char *buf))
{
const int k = PDB_extend_const_table(interp);
STRING * const s = string_from_cstring(interp, buf, 0);
interp->code->const_table->constants[k]->type = PFC_NUMBER;
interp->code->const_table->constants[k]->u.number = string_to_num(interp, s);
return k;
}
/*
=item C<PARROT_CANNOT_RETURN_NULL
PARROT_MALLOC
static PMC*
mk_multi_sig(PARROT_INTERP, NOTNULL(SymReg *r))>
RT#48260: Not yet documented!!!
=cut
*/
PARROT_CANNOT_RETURN_NULL
PARROT_MALLOC
static PMC*
mk_multi_sig(PARROT_INTERP, NOTNULL(SymReg *r))
{
PMC * const multi_sig = pmc_new(interp, enum_class_FixedPMCArray);
pcc_sub_t * const pcc_sub = r->pcc_sub;
const INTVAL n = pcc_sub->nmulti;
INTVAL i;
PackFile_ConstTable *ct;
VTABLE_set_integer_native(interp, multi_sig, n);
/* :multi() n = 1, reg = NULL */
if (!pcc_sub->multi[0]) {
STRING * const sig = string_from_literal(interp, "__VOID");
PMC * const sig_pmc = pmc_new(interp, enum_class_String);
VTABLE_set_string_native(interp, sig_pmc, sig);
VTABLE_set_pmc_keyed_int(interp, multi_sig, 0, sig_pmc);
return multi_sig;
}
ct = interp->code->const_table;
for (i = 0; i < n; ++i) {
/* multi[i] can be a Key too -
* store PMC constants instead of bare strings */
PMC *sig_pmc;
r = pcc_sub->multi[i];
if (r->set == 'S') {
sig_pmc = pmc_new(interp, enum_class_String);
VTABLE_set_string_native(interp, sig_pmc,
ct->constants[r->color]->u.string);
}
else {
PARROT_ASSERT(r->set == 'K');
sig_pmc = ct->constants[r->color]->u.key;
}
VTABLE_set_pmc_keyed_int(interp, multi_sig, i, sig_pmc);
}
return multi_sig;
}
typedef void (*decl_func_t)(Interp *, PMC*, STRING *, INTVAL);
/*
=item C<PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static PMC*
create_lexinfo(PARROT_INTERP, NOTNULL(IMC_Unit *unit), NOTNULL(PMC *sub), int need_lex)>
RT#48260: Not yet documented!!!
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static PMC*
create_lexinfo(PARROT_INTERP, NOTNULL(IMC_Unit *unit), NOTNULL(PMC *sub), int need_lex)
{
int i;
STRING *lex_name;
decl_func_t decl_func;
PMC *lex_info = NULL;
STRING *decl_lex = const_string(interp, "declare_lex_preg");
SymHash *hsh = &unit->hash;
PackFile_Constant **constants = interp->code->const_table->constants;
const INTVAL lex_info_id = Parrot_get_ctx_HLL_type(interp,
enum_class_LexInfo);
PMC * const lex_info_class = interp->vtables[lex_info_id]->pmc_class;
PMC * const decl_lex_meth = VTABLE_find_method(interp,
lex_info_class, decl_lex);
if (PMC_IS_NULL(decl_lex_meth))
real_exception(interp, NULL, METH_NOT_FOUND,
"Method '%Ss' not found", decl_lex);
if (decl_lex_meth->vtable->base_type != enum_class_NCI)
real_exception(interp, NULL, METH_NOT_FOUND,
"Method '%Ss' is not a NCI", decl_lex);
/*
* I think letting this override in PASM/PIR would be a
* can of worms - how do we call this if it declares .lex
*/
decl_func = (decl_func_t) D2FPTR(PMC_struct_val(decl_lex_meth));
for (i = 0; i < hsh->size; i++) {
SymReg *r;
for (r = hsh->data[i]; r; r = r->next) {
if (r->set == 'P' && r->usage & U_LEXICAL) {
SymReg *n;
if (!lex_info) {
lex_info = pmc_new_noinit(interp, lex_info_id);
VTABLE_init_pmc(interp, lex_info, sub);
}
/* at least one lexical name */
n = r->reg;
PARROT_ASSERT(n);
while (n) {
const int k = n->color;
PARROT_ASSERT(k >= 0);
lex_name = constants[k]->u.string;
PARROT_ASSERT(PObj_is_string_TEST(lex_name));
IMCC_debug(interp, DEBUG_PBC_CONST,
"add lexical '%s' to sub name '%s'\n",
n->name, (char*)PMC_sub(sub)->name->strstart);
(decl_func)(interp, lex_info, lex_name, r->color);
/* next possible name */
n = n->reg;
}
}
}
}
if (!lex_info && (unit->outer || need_lex)) {
lex_info = pmc_new_noinit(interp, lex_info_id);
VTABLE_init_pmc(interp, lex_info, sub);
}
return lex_info;
}
/*
=item C<PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static PMC*
find_outer(PARROT_INTERP, NOTNULL(IMC_Unit *unit))>
RT#48260: Not yet documented!!!
=cut
*/
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static PMC*
find_outer(PARROT_INTERP, NOTNULL(IMC_Unit *unit))
{
subs_t *s;
size_t len;
PMC *current;
STRING *cur_name;
if (!unit->outer)
return NULL;
/*
* we need that the :outer sub is already compiled,
* because we are freezing the outer Sub PMC along with this
* one
*/
len = strlen(unit->outer->name);
if (!len)
return NULL;
for (s = globals.cs->first; s; s = s->next) {
SymReg * const sub = s->unit->instructions->r[0];
if (!strcmp(sub->name, unit->outer->name)) {
PObj_get_FLAGS(s->unit->sub_pmc) |= SUB_FLAG_IS_OUTER;
return s->unit->sub_pmc;
}
}
/* could be eval too; check if :outer is the current sub */
current = CONTEXT(interp->ctx)->current_sub;
if (! current)
IMCC_fatal(interp, 1,
"Undefined :outer sub '%s'.\n",
unit->outer->name);
cur_name = PMC_sub(current)->name;
if (cur_name->strlen == len &&
!memcmp((char*)cur_name->strstart, unit->outer->name, len))
return current;
return NULL;
}
/*
=item C<static int
add_const_pmc_sub(PARROT_INTERP, NOTNULL(SymReg *r), int offs, int end)>
RT#48260: Not yet documented!!!
=cut
*/
static int
add_const_pmc_sub(PARROT_INTERP, NOTNULL(SymReg *r), int offs, int end)
{
int i, k;
int ns_const = -1;
INTVAL type;
INTVAL vtable_index;
PMC *ns_pmc;
PMC *sub_pmc;
struct Parrot_sub *sub;
PackFile_Constant *pfc;
PackFile_ConstTable *ct;
STRING *vtable_name;
IMC_Unit * const unit = globals.cs->subs->unit;
if (unit->_namespace) {
const char *real_name;
SymReg * const ns = unit->_namespace->reg;
IMCC_debug(interp, DEBUG_PBC_CONST,
"name space const = %d ns name '%s'\n", ns->color, ns->name);
ns_const = ns->color;
/* strip namespace off from front */
real_name = strrchr(r->name, '@');
if (real_name) {
char * const p = str_dup(real_name+1);
free(r->name);
r->name = p;
}
}
ct = interp->code->const_table;
k = PDB_extend_const_table(interp);
pfc = ct->constants[k];
globals.cs->subs->pmc_const = k;
type = (r->pcc_sub->calls_a_sub & ITPCCYIELD) ?
enum_class_Coroutine :
unit->outer ? enum_class_Closure : enum_class_Sub;
/* use a possible type mapping for the Sub PMCs */
type = Parrot_get_ctx_HLL_type(interp, type);
/* TODO create constant - see also src/packfile.c */
sub_pmc = pmc_new(interp, type);
PObj_get_FLAGS(sub_pmc) |= (r->pcc_sub->pragma & SUB_FLAG_PF_MASK);
Sub_comp_get_FLAGS(sub_pmc) |= (r->pcc_sub->pragma & SUB_COMP_FLAG_MASK);
sub = PMC_sub(sub_pmc);
r->color = add_const_str(interp, r);
sub->name = ct->constants[r->color]->u.string;
ns_pmc = NULL;
if (ns_const >= 0 && ns_const < ct->const_count) {
switch (ct->constants[ns_const]->type) {
case PFC_KEY:
ns_pmc = ct->constants[ns_const]->u.key;
break;
case PFC_STRING:
ns_pmc = constant_pmc_new(interp, enum_class_String);
PMC_str_val(ns_pmc) = ct->constants[ns_const]->u.string;
break;
default:
break;
}
}
sub->namespace_name = ns_pmc;
sub->start_offs = offs;
sub->end_offs = end;
sub->HLL_id = CONTEXT(interp->ctx)->current_HLL;
for (i = 0; i < 4; ++i)
sub->n_regs_used[i] = unit->n_regs_used[i];
sub->lex_info = create_lexinfo(interp, unit, sub_pmc,
r->pcc_sub->pragma & P_NEED_LEX);
sub->outer_sub = find_outer(interp, unit);
sub->vtable_index = -1;
/* check if it's declared multi */
if (r->pcc_sub->nmulti)
sub->multi_signature = mk_multi_sig(interp, r);
else
sub->multi_signature = NULL;
if (unit->is_vtable_method == 1) {
char *c_name;
/* Work out the name of the vtable method. */
if (unit->vtable_name != NULL)
vtable_name = string_from_cstring(interp, unit->vtable_name + 1,
strlen(unit->vtable_name) - 2);
else
vtable_name = sub->name;
/* Check this is a valid vtable method to override. */
vtable_index = Parrot_get_vtable_index(interp, vtable_name);
c_name = string_to_cstring(interp, vtable_name);
if (vtable_index == -1) {
IMCC_fatal(interp, 1,
"'%s' is not a v-table method, but was used with :vtable.\n",
c_name);
}
string_cstring_free(c_name);
/* TODO check for duplicates */
sub->vtable_index = vtable_index;
}
Parrot_store_sub_in_namespace(interp, sub_pmc);
pfc->type = PFC_PMC;
pfc->u.key = sub_pmc;
unit->sub_pmc = sub_pmc;
IMCC_debug(interp, DEBUG_PBC_CONST,
"add_const_pmc_sub '%s' flags %d color %d (%s) "
"lex_info %s :outer(%s)\n",
r->name, r->pcc_sub->pragma, k,
(char *) sub_pmc->vtable->whoami->strstart,
sub->lex_info ? "yes" : "no",
sub->outer_sub ?
(char *)PMC_sub(sub->outer_sub)->name->strstart :
"*none*");
/*
* create entry in our fixup (=symbol) table
* the offset is the index in the constant table of this Sub
*/
PackFile_FixupTable_new_entry(interp, r->name, enum_fixup_sub, k);
return k;
}
/*
=item C<static int
add_const_key(PARROT_INTERP, NOTNULL(opcode_t key[]), int size, ARGIN(const char *s_key))>
add constant key to constant_table
=cut
*/
static int
add_const_key(PARROT_INTERP, NOTNULL(opcode_t key[]), int size, ARGIN(const char *s_key))
{
int k;
opcode_t *rc;
PackFile_Constant *pfc;
SymReg * const r = _get_sym(&globals.cs->key_consts, s_key);
if (r)
return r->color;
pfc = mem_allocate_typed(PackFile_Constant);
rc = PackFile_Constant_unpack_key(interp,
interp->code->const_table, pfc, key);
if (!rc) {
mem_sys_free(pfc);
IMCC_fatal(interp, 1,
"add_const_key: PackFile_Constant error\n");
}
k = PDB_extend_const_table(interp);
interp->code->const_table->constants[k]->type = PFC_KEY;
interp->code->const_table->constants[k]->u.key = pfc->u.key;
store_key_const(s_key, k);
IMCC_debug(interp, DEBUG_PBC_CONST, "\t=> %s #%d size %d\n",
s_key, k, size);
IMCC_debug(interp, DEBUG_PBC_CONST, "\t %x /%x %x/ /%x %x/\n",
key[0], key[1], key[2], key[3], key[4]);
mem_sys_free(pfc);
return k;
}
/*
=item C<PARROT_CONST_FUNCTION
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static const char *
slice_deb(int bits)>
RT#48260: Not yet documented!!!
=cut
*/
PARROT_CONST_FUNCTION
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static const char *
slice_deb(int bits)
{
if ((bits & VT_SLICE_BITS) == (VT_START_SLICE|VT_END_SLICE))
return "start+end";
if ((bits & VT_SLICE_BITS) == (VT_START_ZERO|VT_END_SLICE))
return "..end";
if ((bits & VT_SLICE_BITS) == (VT_START_SLICE|VT_END_INF))
return "start..";
if (bits & VT_START_SLICE)
return "start";
if (bits & VT_END_SLICE)
return "end";
return "";
}
/*
=item C<static opcode_t
build_key(PARROT_INTERP, NOTNULL(SymReg *key_reg))>
color is a Parrot register number or a constant table index
for the rest, please consult PDD08_KEYS(1)
additionally, I build a string representation of the key,
which gets cached in the globals.keys
=cut
*/
static opcode_t
build_key(PARROT_INTERP, NOTNULL(SymReg *key_reg))
{
#define KEYLEN 21
char s_key[KEYLEN * 10];
opcode_t key[KEYLEN];
opcode_t size;
int key_length; /* P0["hi;there"; S0; 2] has length 3 */
int k;
SymReg *reg;
/* 0 is length */
opcode_t *pc = key + 1;
/* stringified key */
char *s = s_key;
*s = 0;
reg = key_reg->set == 'K' ? key_reg->nextkey : key_reg;
for (key_length = 0; reg ; reg = reg->nextkey, key_length++) {
SymReg *r;
int var_type;
int slice_bits;
int type;
if ((pc - key - 2) >= KEYLEN)
IMCC_fatal(interp, 1, "build_key:"
"key too complex increase KEYLEN\n");
r = reg;
/* if key is a register, the original sym is in r->reg */
type = r->type;
if (r->reg)
r = r->reg;
var_type = type & ~VT_SLICE_BITS;
slice_bits = type & VT_SLICE_BITS;
switch (var_type) {
case VTIDENTIFIER: /* P[S0] */
case VTPASM: /* P[S0] */
case VTREG: /* P[S0] */
if (r->set == 'I')
*pc++ = PARROT_ARG_I | slice_bits; /* register type */
else if (r->set == 'S')
*pc++ = PARROT_ARG_S | slice_bits;
else
IMCC_fatal(interp, 1, "build_key: wrong register set\n");
/* don't emit mapped regs in key parts */
if (r->color < 0)
*pc++ = -1 - r->color;
else
*pc++ = r->color;
sprintf(s+strlen(s), "%c%d", r->set, (int)r->color);
IMCC_debug(interp, DEBUG_PBC_CONST,
" keypart reg %s %c%d slice %s\n",
r->name, r->set, (int)r->color,
slice_deb(slice_bits));
break;
case VT_CONSTP:
case VTCONST:
case VTCONST|VT_ENCODED:
switch (r->set) {
case 'S': /* P["key"] */
/* str constant */
*pc++ = PARROT_ARG_SC | slice_bits;
/* constant idx */
*pc++ = r->color;
IMCC_debug(interp, DEBUG_PBC_CONST,
" keypart SC %s #%d slice %s\n",
r->name, r->color,
slice_deb(slice_bits));
break;
case 'I': /* P[;42;..] */
/* int constant */
*pc++ = PARROT_ARG_IC | slice_bits;
/* value */
*pc++ = r->color = atol(r->name);
IMCC_debug(interp, DEBUG_PBC_CONST,
" keypart IC %s #%d slice %s\n",
r->name, r->color,
slice_deb(slice_bits));
break;
default:
IMCC_fatal(interp, 1, "build_key: unknown set\n");
}
sprintf(s+strlen(s), "%cc" INTVAL_FMT, r->set, r->color);
break;
default:
IMCC_fatal(interp, 1, "build_key: "
"unknown type 0x%x on %s\n", var_type, r->name);
}
}
key[0] = key_length;
size = pc - key;
/* now we have a packed key, which packfile can work on */
/* XXX endianess? probably no, we pack/unpack on the very
* same computer */
k = add_const_key(interp, key, size, s_key);
/* single 'S' keys already have their color assigned */
if (key_reg->set == 'K')
key_reg->color = k;
return k;
}
/*
=item C<INTVAL
IMCC_int_from_reg(PARROT_INTERP, ARGIN(const SymReg *r))>
RT#48260: Not yet documented!!!
=cut
*/
INTVAL
IMCC_int_from_reg(PARROT_INTERP, ARGIN(const SymReg *r))
{
INTVAL i;
errno = 0;
if (r->type & VT_CONSTP)
r = r->reg;
if (r->name[0] == '0' && (r->name[1] == 'x' || r->name[1] == 'X'))
i = strtoul(r->name+2, 0, 16);
else if (r->name[0] == '0' && (r->name[1] == 'O' || r->name[1] == 'o'))
i = strtoul(r->name+2, 0, 8);
else if (r->name[0] == '0' &&
(r->name[1] == 'b' || r->name[1] == 'B'))
i = strtoul(r->name+2, 0, 2);
else
i = strtol(r->name, 0, 10);
/*
* TODO
* - is this portable?
* - there are some more atol()s in this file
*/
if (errno == ERANGE)
IMCC_fatal(interp, 1, "add_1_const:"
"Integer overflow '%s'", r->name);
return i;
}
/*
=item C<static void
make_pmc_const(PARROT_INTERP, NOTNULL(SymReg *r))>
RT#48260: Not yet documented!!!
=cut
*/
static void
make_pmc_const(PARROT_INTERP, NOTNULL(SymReg *r))
{
STRING *s;
PMC *p, *_class;
int k;
if (*r->name == '"')
s = string_unescape_cstring(interp, r->name + 1, '"', NULL);
else
if (*r->name == '\'')
s = string_unescape_cstring(interp, r->name + 1, '\'', NULL);
else
s = string_unescape_cstring(interp, r->name, 0, NULL);
_class = interp->vtables[r->pmc_type]->pmc_class;
p = VTABLE_new_from_string(interp, _class, s, PObj_constant_FLAG);
/* append PMC constant */
k = PDB_extend_const_table(interp);
interp->code->const_table->constants[k]->type = PFC_PMC;
interp->code->const_table->constants[k]->u.key = p;
r->color = k;
}
/*
=item C<static void
add_1_const(PARROT_INTERP, NOTNULL(SymReg *r))>
RT#48260: Not yet documented!!!
=cut
*/
static void
add_1_const(PARROT_INTERP, NOTNULL(SymReg *r))
{
if (r->color >= 0)
return;
if (r->use_count <= 0)
return;
switch (r->set) {
case 'I':
r->color = IMCC_int_from_reg(interp, r);
break;
case 'S':
if (r->type & VT_CONSTP)
r = r->reg;
r->color = add_const_str(interp, r);
break;
case 'N':
r->color = add_const_num(interp, r->name);
break;
case 'K':
{
SymReg *key = r;
for (r = r->nextkey; r; r = r->nextkey)
if (r->type & VTCONST)
add_1_const(interp, r);
build_key(interp, key);
}
break;
case 'P':
make_pmc_const(interp, r);
IMCC_debug(interp, DEBUG_PBC_CONST,
"PMC const %s\tcolor %d\n",
r->name, r->color);
break;
default:
break;
}
if (r)
IMCC_debug(interp, DEBUG_PBC_CONST,
"const %s\tcolor %d use_count %d\n",
r->name, r->color, r->use_count);
}
/*
=item C<static void
constant_folding(PARROT_INTERP, NOTNULL(IMC_Unit *unit))>
store a constants idx for later reuse
=cut
*/
static void
constant_folding(PARROT_INTERP, NOTNULL(IMC_Unit *unit))
{
int i;
SymHash *hsh = &IMCC_INFO(interp)->ghash;
/* go through all consts of current sub */
for (i = 0; i < hsh->size; i++) {
SymReg *r;
/* normally constants are in ghash ... */
for (r = hsh->data[i]; r; r = r->next) {
if (r->type & (VTCONST|VT_CONSTP))
add_1_const(interp, r);
if (r->usage & U_LEXICAL) {
SymReg *n = r->reg;
/* r->reg is a chain of names for the same lex sym */
while (n) {
/* lex_name */
add_1_const(interp, n);
n = n->reg;
}
}
}
}
/* ... but keychains 'K' are in local hash, they may contain
* variables and constants
*/
hsh = &unit->hash;
for (i = 0; i < hsh->size; i++) {
SymReg *r;
/* normally constants are in ghash ... */
for (r = hsh->data[i]; r; r = r->next) {
if (r->type & VTCONST)
add_1_const(interp, r);
}
}
/* and finally, there may be an outer Sub */
if (unit->outer)
add_1_const(interp, unit->outer);
}
/*
=item C<int
e_pbc_new_sub(SHIM_INTERP, SHIM(void *param), NOTNULL(IMC_Unit *unit))>
RT#48260: Not yet documented!!!
=cut
*/
int
e_pbc_new_sub(SHIM_INTERP, SHIM(void *param), NOTNULL(IMC_Unit *unit))
{
if (!unit->instructions)
return 0;
/* we start a new compilation unit */
make_new_sub(unit);
return 0;
}
/*
=item C<int
e_pbc_end_sub(PARROT_INTERP, SHIM(void *param), NOTNULL(IMC_Unit *unit))>
RT#48260: Not yet documented!!!
=cut
*/
int
e_pbc_end_sub(PARROT_INTERP, SHIM(void *param), NOTNULL(IMC_Unit *unit))
{
Instruction *ins;
int pragma;
if (!unit->instructions)
return 0;
/*
* if the sub was marked IMMEDIATE, we run it now
* This is *dangerous*: all possible global state can be messed
* up, e.g. when that sub start loading bytecode
*/
ins = unit->instructions;
/* we run only PCC subs */
if (!ins->r[0] || !ins->r[0]->pcc_sub)
return 0;
pragma = ins->r[0]->pcc_sub->pragma;
if (pragma & P_IMMEDIATE) {
IMCC_debug(interp, DEBUG_PBC, "immediate sub '%s'",
ins->r[0]->name);
PackFile_fixup_subs(interp, PBC_IMMEDIATE, NULL);
}
return 0;
}
/*
=item C<static void
verify_signature(PARROT_INTERP, ARGIN(const Instruction *ins), NOTNULL(opcode_t *pc))>
- check if any get_ argument contains constants
- fill in type bits for argument types and constants, if missing
=cut
*/
static void
verify_signature(PARROT_INTERP, ARGIN(const Instruction *ins), NOTNULL(opcode_t *pc))
{
INTVAL i, n;
int no_consts;
int needed = 0;
PMC *changed_sig = NULL;
PMC * const sig_arr = interp->code->const_table->constants[pc[-1]]->u.key;
PARROT_ASSERT(PObj_is_PMC_TEST(sig_arr));
PARROT_ASSERT(sig_arr->vtable->base_type == enum_class_FixedIntegerArray);
no_consts = (ins->opnum == PARROT_OP_get_results_pc ||
ins->opnum == PARROT_OP_get_params_pc);
n = VTABLE_elements(interp, sig_arr);
for (i = 0; i < n; ++i) {
SymReg * const r = ins->r[i + 1];
INTVAL sig = VTABLE_get_integer_keyed_int(interp, sig_arr, i);
if (! (sig & PARROT_ARG_NAME) &&
no_consts && (r->type & VTCONST))
IMCC_fatal(interp, 1, "e_pbc_emit: "
"constant argument '%s' in get param/result\n", r->name);
if ((r->type & VTCONST) && !(sig & PARROT_ARG_CONSTANT)) {
if (!changed_sig)
changed_sig = VTABLE_clone(interp, sig_arr);
sig |= PARROT_ARG_CONSTANT;
VTABLE_set_integer_keyed_int(interp, changed_sig, i, sig);
}
switch (r->set) {
case 'I': needed = PARROT_ARG_INTVAL; break;
case 'S': needed = PARROT_ARG_STRING; break;
case 'P': needed = PARROT_ARG_PMC; break;
case 'N': needed = PARROT_ARG_FLOATVAL; break;
default : break;
}
if (needed != (sig & PARROT_ARG_TYPE_MASK)) {
if (!changed_sig)
changed_sig = VTABLE_clone(interp, sig_arr);
sig &= ~PARROT_ARG_TYPE_MASK;
sig |= needed;
VTABLE_set_integer_keyed_int(interp, changed_sig, i, sig);
}
}
if (changed_sig) {
/* append PMC constant */
const int k = PDB_extend_const_table(interp);
interp->code->const_table->constants[k]->type = PFC_PMC;
interp->code->const_table->constants[k]->u.key = changed_sig;
pc[-1] = k;
}
}
/*
=item C<int
e_pbc_emit(PARROT_INTERP,
SHIM(void *param),
NOTNULL(IMC_Unit *unit),
ARGIN(const Instruction *ins))>
now let the fun begin, actually emit code for one ins
=cut
*/
int
e_pbc_emit(PARROT_INTERP,
SHIM(void *param),
NOTNULL(IMC_Unit *unit),
ARGIN(const Instruction *ins))
{
int op, i;
int ok = 0;
op_info_t *op_info;
/* XXX move these statics into IMCC_INFO */
static PackFile_Debug *debug_seg;
static int ins_line;
static opcode_t *pc;
static opcode_t npc;
/* XXX end */
#if IMC_TRACE_HIGH
PIO_eprintf(NULL, "e_pbc_emit\n");
#endif
/* first instruction, do initialisation ... */
if (ins == unit->instructions) {
int ins_size, bytes;
const int oldsize = get_old_size(interp, &ins_line);
const int code_size = get_codesize(interp, unit, &ins_size);
IMCC_debug(interp, DEBUG_PBC, "code_size(ops) %d oldsize %d\n",
code_size, oldsize);
constant_folding(interp, unit);
store_sub_size(code_size, ins_size);
bytes = (oldsize + code_size) * sizeof (opcode_t);
/*
* allocate code and pic_index
*
* pic_index is half the size of the code, as one PIC-cachable opcode
* is at least two opcodes wide - see below how to further decrease
* this storage
*/
if (interp->code->base.data) {
interp->code->base.data = (opcode_t *)
mem_sys_realloc(interp->code->base.data, bytes);
interp->code->pic_index->data = (opcode_t *)
mem_sys_realloc(interp->code->pic_index->data, bytes/2);
}
else {
interp->code->base.data = (opcode_t *)mem_sys_allocate(bytes);
interp->code->pic_index->data =
(opcode_t *)mem_sys_allocate(bytes/2);
}
interp->code->base.size = oldsize + code_size;
interp->code->pic_index->size = (oldsize + code_size) / 2;
pc = (opcode_t *)interp->code->base.data + oldsize;
npc = 0;
/* add debug if necessary */
if (!IMCC_INFO(interp)->optimizer_level ||
IMCC_INFO(interp)->optimizer_level == OPT_PASM) {
const char * const sourcefile = unit->file;
/* FIXME length and multiple subs */
debug_seg = Parrot_new_debug_seg(interp,
interp->code, (size_t) ins_line + ins_size + 1);
Parrot_debug_add_mapping(interp, debug_seg, ins_line,
PF_DEBUGMAPPINGTYPE_FILENAME, sourcefile, 0);
}
else
debug_seg = NULL;
/* if item is a PCC_SUB entry then store it constants */
if (ins->r[0] && ins->r[0]->pcc_sub) {
#if IMC_TRACE
PIO_eprintf(NULL, "pbc.c: e_pbc_emit (pcc_sub=%s)\n",
ins->r[0]->name);
#endif
add_const_pmc_sub(interp, ins->r[0], oldsize, oldsize + code_size);
}
else {
/* need a dummy to hold register usage */
SymReg * const r = mk_sub_label(interp, str_dup("(null)"));
r->type = VT_PCC_SUB;
r->pcc_sub = (pcc_sub_t *)calloc(1, sizeof (pcc_sub_t));
add_const_pmc_sub(interp, r, oldsize, oldsize + code_size);
}
}
/* if this is not the first sub then store the sub */
if (npc && unit->pasm_file && ins->r[0] && ins->r[0]->pcc_sub) {
/* we can only set the offset for PASM code */
add_const_pmc_sub(interp, ins->r[0], npc, npc);
}
if (ins->op && *ins->op) {
SymReg *addr, *r;
opcode_t last_label;
last_label = 1;
#if IMC_TRACE_HIGH
PIO_eprintf(NULL, "emit_pbc: op [%d %s]\n", ins->opnum, ins->op);
#endif
if ((ins->type & ITBRANCH) &&
(addr = get_branch_reg(ins)) != 0 &&
!REG_NEEDS_ALLOC(addr)) {
/* fixup local jumps - calc offset */
if (addr->color == -1)
IMCC_fatal(interp, 1, "e_pbc_emit: "
"no label offset defined for '%s'\n", addr->name);
last_label = addr->color - npc;
IMCC_debug(interp, DEBUG_PBC_FIXUP,
"branch label at pc %d addr %d %s %d\n",
npc, addr->color, addr->name, last_label);
}
/* add debug line info */
if (debug_seg)
debug_seg->base.data[ins_line++] = (opcode_t) ins->line;
op = (opcode_t)ins->opnum;
/* add PIC idx */
if (parrot_PIC_op_is_cached(op)) {
const size_t offs = pc - interp->code->base.data;
/*
* for pic_idx fitting into a short, we could
* further reduce the size by storing shorts
* the relation code_size / pic_index_size could
* indicate the used storage
*
* drawback: if we reach 0xffff, we'd have to resize again
*/
interp->code->pic_index->data[offs / 2] = ++globals.cs->pic_idx;
}
/* Start generating the bytecode */
*pc++ = op;
/* Get the info for that opcode */
op_info = &interp->op_info_table[op];
IMCC_debug(interp, DEBUG_PBC, "%d %s", npc, op_info->full_name);
for (i = 0; i < op_info->op_count-1; i++) {
switch (op_info->types[i]) {
case PARROT_ARG_IC:
/* branch instruction */
if (op_info->labels[i]) {
if (last_label == 1)
/* we don't have a branch with offset 1 !? */
IMCC_fatal(interp, 1, "e_pbc_emit: "
"no label offset found\n");
*pc++ = last_label;
last_label = 1;
break;
/* else fall through */
}
case PARROT_ARG_I:
case PARROT_ARG_N:
case PARROT_ARG_S:
case PARROT_ARG_P:
case PARROT_ARG_K:
case PARROT_ARG_KI:
case PARROT_ARG_KIC:
case PARROT_ARG_SC:
case PARROT_ARG_NC:
case PARROT_ARG_PC:
r = ins->r[i];
if (r->type & VT_CONSTP)
r = r->reg;
*pc++ = (opcode_t) r->color;
IMCC_debug(interp, DEBUG_PBC, " %d", r->color);
break;
case PARROT_ARG_KC:
r = ins->r[i];
if (r->set == 'K') {
PARROT_ASSERT(r->color >= 0);
*pc++ = r->color;
}
else {
*pc++ = build_key(interp, r);
}
IMCC_debug(interp, DEBUG_PBC, " %d", pc[-1]);
break;
default:
IMCC_fatal(interp, 1, "e_pbc_emit:"
"unknown argtype in parrot op\n");
break;
}
}
if (ins->opnum == PARROT_OP_set_args_pc ||
ins->opnum == PARROT_OP_get_results_pc ||
ins->opnum == PARROT_OP_get_params_pc ||
ins->opnum == PARROT_OP_set_returns_pc) {
/* TODO get rid of verify_signature - PIR call sigs are already fixed
* PASM still needs it
*/
verify_signature(interp, ins, pc);
/* emit var_args part */
for (; i < ins->opsize - 1; ++i) {
r = ins->r[i];
if (r->type & VT_CONSTP)
r = r->reg;
*pc++ = (opcode_t) r->color;
IMCC_debug(interp, DEBUG_PBC, " %d", r->color);
}
}
IMCC_debug(interp, DEBUG_PBC, "\t%I\n", ins);
npc += ins->opsize;
}
return ok;
}
/*
=item C<int
e_pbc_close(PARROT_INTERP, SHIM(void *param))>
RT#48260: Not yet documented!!!
=cut
*/
int
e_pbc_close(PARROT_INTERP, SHIM(void *param))
{
fixup_globals(interp);
return 0;
}
/*
=back
=cut
*/
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4:
*/
syntax highlighted by Code2HTML, v. 0.9.1