cvsuser 03/08/16 05:41:28
Modified: . KNOWN_ISSUES core.ops debug.c packfile.c
classes compiler.pmc eval.pmc
include/parrot debug.h packfile.h
languages/imcc parser_util.c pbc.c
t/pmc eval.t
Log:
PackFile-11: eval is using packfiles now
Revision Changes Path
1.10 +3 -0 parrot/KNOWN_ISSUES
Index: KNOWN_ISSUES
===================================================================
RCS file: /cvs/public/parrot/KNOWN_ISSUES,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- KNOWN_ISSUES 12 Aug 2003 07:57:30 -0000 1.9
+++ KNOWN_ISSUES 16 Aug 2003 12:41:21 -0000 1.10
@@ -46,6 +46,9 @@
not capable of reading the dir_format=1 PBC format. Non native floats
are also not implemented.
+- the Parrot debugger pdb: "eval" is b0rken, this needs linking
+ to libimcc (which we don't have yet ;-)
+
Classes
- To PerlClass or not to PerlClass, that is the question. The class
1.320 +4 -14 parrot/core.ops
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/core.ops,v
retrieving revision 1.319
retrieving revision 1.320
diff -u -w -r1.319 -r1.320
--- core.ops 14 Aug 2003 13:39:51 -0000 1.319
+++ core.ops 16 Aug 2003 12:41:21 -0000 1.320
@@ -150,23 +150,12 @@
}
-=item B<branch_cs>(inconst INT)
-
-Intersegment branch to location in fixup table $1, $1 is an index into
-the current const_table holding the name of the label.
-
=item B<branch_cs>(in STR)
Intersegment branch to location in fixup table named $1.
=cut
-inline op branch_cs (inconst INT) {
- interpreter->resume_offset = $1;
- interpreter->resume_flag = 2;
- goto ADDRESS(0);
-}
-
inline op branch_cs (in STR) {
char * label = string_to_cstring(interpreter, $1);
struct PackFile_FixupEntry *fe = PackFile_find_fixup_entry(interpreter,
@@ -174,10 +163,11 @@
string_cstring_free(label);
if (!fe)
interpreter->resume_offset = -1;
- else
+ else {
interpreter->resume_offset = fe->offset;
Parrot_switch_to_cs(interpreter, fe->seg);
- interpreter->resume_flag = 1;
+ }
+ interpreter->resume_flag = 2;
goto ADDRESS(0);
}
1.106 +40 -106 parrot/debug.c
Index: debug.c
===================================================================
RCS file: /cvs/public/parrot/debug.c,v
retrieving revision 1.105
retrieving revision 1.106
diff -u -w -r1.105 -r1.106
--- debug.c 29 Jul 2003 01:45:28 -0000 1.105
+++ debug.c 16 Aug 2003 12:41:21 -0000 1.106
@@ -2,7 +2,7 @@
* debug.c
*
* CVS Info
- * $Id: debug.c,v 1.105 2003/07/29 01:45:28 scog Exp $
+ * $Id: debug.c,v 1.106 2003/08/16 12:41:21 leo Exp $
* Overview:
* Parrot debugger
* History:
@@ -1678,118 +1678,52 @@
}
/* PDB_eval
- * evals an instruction with fully qualified opcode name
- * and valid arguments, NO error checking.
+ * evals an instruction
*/
void
PDB_eval(struct Parrot_Interp *interpreter, const char *command)
{
opcode_t *run;
- char *c;
- struct PackFile_ByteCode *eval_cs;
+ struct PackFile *eval_pf;
+ struct PackFile_ByteCode *old_cs;
+
+ eval_pf = PDB_compile(interpreter, command);
- c = mem_sys_allocate(strlen(command) + 1);
- strcpy(c, command);
- eval_cs = PDB_compile(interpreter, c);
-
- if (eval_cs) {
- Parrot_switch_to_cs(interpreter, eval_cs);
- run = eval_cs->base.data;
+ if (eval_pf) {
+ old_cs = Parrot_switch_to_cs(interpreter, eval_pf->cur_cs);
+ run = eval_pf->cur_cs->base.data;
DO_OP(run,interpreter);
- Parrot_pop_cs(interpreter);
+ Parrot_switch_to_cs(interpreter, old_cs);
+ /* TODO destroy packfile */
}
}
/* PDB_compile
- * compiles one instruction with fully qualified opcode name
- * and valid arguments, NO error checking.
+ * compiles instructions with the PASM compiler
+ * append an "end" op
*
* this may be called from PDB_eval above or from the compile opcode
* which generates a malloced string
*/
-struct PackFile_ByteCode *
-PDB_compile(struct Parrot_Interp *interpreter, char *command)
+struct PackFile *
+PDB_compile(struct Parrot_Interp *interpreter, const char *command)
{
- char buf[256];
- char s[1], *c = buf;
- char *orig = command;
- op_info_t *op_info;
- opcode_t *eval;
- int op_number,i,k,l,j = 0;
- struct PackFile_ByteCode * eval_cs = Parrot_new_eval_cs(interpreter);
- /* Opcodes can't have more that 10 arguments, +1 for end */
- eval = eval_cs->base.data = mem_sys_allocate(sizeof(opcode_t) * 11);
-
- /* find_op needs a string with only the opcode name */
- while (*command && !(isspace((int) *command)))
- *(c++) = *(command++);
- *c = '\0';
- /* Find the opcode number */
- op_number = interpreter->op_lib->op_code(buf, 1);
- if (op_number < 0) {
- PIO_eprintf(interpreter, "Invalid opcode '%s'\n", buf);
+ STRING *buf;
+ const char *end = "\nend\n";
+ PMC * compiler, *code;
+ PMC *key = key_new_cstring(interpreter, "PASM");
+ PMC *compreg_hash = VTABLE_get_pmc_keyed_int(interpreter,
+ interpreter->iglobals, IGLOBALS_COMPREG_HASH);
+
+ compiler = VTABLE_get_pmc_keyed(interpreter, compreg_hash, key);
+ if (!VTABLE_defined(interpreter, compiler)) {
+ fprintf(stderr, "Couldn't find PASM compiler");
return NULL;
}
- /* Start generating the bytecode */
- eval[j++] = (opcode_t)op_number;
- /* Get the info for that opcode */
- op_info = &interpreter->op_info_table[op_number];
-
- /* handle the arguments */
- for (i = 1; i < op_info->arg_count; i++) {
- command = nextarg(command);
- switch (op_info->types[i]) {
- /* If it's a register skip the letter that
- precedes the register number */
- case PARROT_ARG_I:
- case PARROT_ARG_N:
- case PARROT_ARG_S:
- case PARROT_ARG_P:
- command++;
- case PARROT_ARG_IC:
- eval[j++] = (opcode_t)atoi(command);
- break;
- case PARROT_ARG_NC:
- k = PDB_extend_const_table(interpreter);
+ buf = Parrot_sprintf_c(interpreter, "%s%s", command, end);
- interpreter->code->const_table->constants[k]->type =PFC_NUMBER;
- interpreter->code->const_table->constants[k]->u.number =
- (FLOATVAL)atof(command);
- eval[j++] = (opcode_t)k;
- break;
- case PARROT_ARG_SC:
- /* Separate the string */
- *s = *command++;
- c = buf;
- while (*command != *s)
- *(c++) = *(command++);
- *c = '\0';
- l = PDB_unescape(buf);
-
- k = PDB_extend_const_table(interpreter);
-
- interpreter->code->const_table->constants[k]->type =PFC_STRING;
- interpreter->code->const_table->constants[k]->u.string =
- string_make(interpreter, buf, (UINTVAL)l,
- NULL, PObj_constant_FLAG, NULL);
-
- /* Add it to the bytecode */
- eval[j++] = (opcode_t)k;
- break;
- case PARROT_ARG_KIC:
- command++; /* Skip opening [ */
- eval[j++] = (opcode_t)atoi(command);
- break;
- default:
- PIO_eprintf(interpreter, "unknown operand at '%s'\n", command);
- return NULL;
- break;
- }
- }
- eval[j++] = 0; /* append end op */
- eval_cs->base.size = j;
- mem_sys_free(orig);
- return eval_cs;
+ code = VTABLE_invoke(interpreter, compiler, buf);
+ return code->cache.struct_val;
}
/* PDB_extend_const_table
1.105 +10 -13 parrot/packfile.c
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/packfile.c,v
retrieving revision 1.104
retrieving revision 1.105
diff -u -w -r1.104 -r1.105
--- packfile.c 16 Aug 2003 09:13:22 -0000 1.104
+++ packfile.c 16 Aug 2003 12:41:21 -0000 1.105
@@ -7,7 +7,7 @@
** This program is free software. It is subject to the same
** license as Parrot itself.
**
-** $Id: packfile.c,v 1.104 2003/08/16 09:13:22 leo Exp $
+** $Id: packfile.c,v 1.105 2003/08/16 12:41:21 leo Exp $
**
** History:
** Rework by Melvin; new bytecode format, make bytecode portable.
@@ -1515,18 +1515,6 @@
return debug;
}
-/* create a new code segment for eval */
-struct PackFile_ByteCode *
-Parrot_new_eval_cs(struct Parrot_Interp *interpreter)
-{
- char name[64];
- struct PackFile_Segment *new_cs;
-
- sprintf(name, "EVAL_" INTVAL_FMT, ++interpreter->code->eval_nr);
- new_cs = PackFile_Segment_new_seg(&interpreter->code->directory,
- PF_BYTEC_SEG, name, 1);
- return (struct PackFile_ByteCode *) new_cs;
-}
/* switch to a byte code seg nr seg */
void
@@ -1561,6 +1549,9 @@
if (!new_cs) {
internal_exception(NO_PREV_CS, "No code segment to switch to\n");
}
+ if (Interp_flags_TEST(interpreter, PARROT_TRACE_FLAG))
+ PIO_eprintf(interpreter, "*** switching to %s\n",
+ new_cs->base.name);
if (new_cs->base.pf != interpreter->code)
interpreter->code = new_cs->base.pf;
interpreter->code->cur_cs = new_cs;
@@ -1829,6 +1820,12 @@
struct PackFile_Directory *dir = &interpreter->code->directory;
struct PackFile_FixupEntry *ep, e;
int found;
+
+ /*
+ * XXX when in eval, the dir is in cur_cs->prev
+ */
+ if (interpreter->code->cur_cs->prev)
+ dir = &interpreter->code->cur_cs->prev->base.pf->directory;
e.type = type;
e.name = name;
1.11 +23 -27 parrot/classes/compiler.pmc
Index: compiler.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/compiler.pmc,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -w -r1.10 -r1.11
--- compiler.pmc 21 Jul 2003 18:00:29 -0000 1.10
+++ compiler.pmc 16 Aug 2003 12:41:23 -0000 1.11
@@ -1,7 +1,7 @@
/* Compiler.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: compiler.pmc,v 1.10 2003/07/21 18:00:29 chromatic Exp $
+ * $Id: compiler.pmc,v 1.11 2003/08/16 12:41:23 leo Exp $
* Overview:
* The vtable functions for implementing assembler/compilers
* Data Structure and Algorithms:
@@ -23,40 +23,36 @@
}
void* invoke (void * code_ptr) {
+ /*
+ * compile source code
+ * return a new Eval pmc (which has a new PackFile attached
+ */
Parrot_csub_t func = (Parrot_csub_t)D2FPTR(PMC_data(SELF));
- PMC *code_seg;
- struct PackFile_ByteCode *eval_cs;
-
+ PMC *code_seg, *p5;
+ struct PackFile *eval_pf;
+ STRING *s5;
- Parrot_push_i(interpreter, &interpreter->int_reg.registers[0]);
- Parrot_push_i(interpreter, &interpreter->int_reg.registers[16]);
- Parrot_push_s(interpreter, &interpreter->string_reg.registers[0]);
- Parrot_push_s(interpreter, &interpreter->string_reg.registers[16]);
- Parrot_push_p(interpreter, &interpreter->pmc_reg.registers[0]);
- Parrot_push_p(interpreter, &interpreter->pmc_reg.registers[16]);
+ /*
+ * preserve regs
+ */
+ s5 = REG_STR(5);
+ p5 = REG_PMC(5);
+ REG_STR(5) = (String*) code_ptr;
+ Parrot_push_i(interpreter, ®_INT(0));
- interpreter->string_reg.registers[5] = (String*) code_ptr;
func(INTERP, SELF);
+
+ Parrot_pop_i(interpreter, ®_INT(0));
/* return value PMC is in P5 */
- stack_push(interpreter, &interpreter->ctx.user_stack,
- interpreter->pmc_reg.registers[5],
- STACK_ENTRY_PMC, STACK_CLEANUP_NULL);
-
- Parrot_pop_p(interpreter, &interpreter->pmc_reg.registers[16]);
- Parrot_pop_p(interpreter, &interpreter->pmc_reg.registers[0]);
- Parrot_pop_s(interpreter, &interpreter->string_reg.registers[16]);
- Parrot_pop_s(interpreter, &interpreter->string_reg.registers[0]);
- Parrot_pop_i(interpreter, &interpreter->int_reg.registers[16]);
- Parrot_pop_i(interpreter, &interpreter->int_reg.registers[0]);
-
- (void)stack_pop(interpreter, &interpreter->ctx.user_stack, &code_seg,
- STACK_ENTRY_PMC);
- eval_cs = (struct PackFile_ByteCode *) PMC_data(code_seg);
+ code_seg = REG_PMC(5);
+ REG_PMC(5) = p5;
+
+ eval_pf = (struct PackFile *) PMC_data(code_seg);
/* morph the Byte_cointer *pointer in code_seg to an invokable sub */
code_seg->vtable = &Parrot_base_vtables[enum_class_Eval];
VTABLE_init(interpreter, code_seg);
VTABLE_set_integer_native(interpreter, code_seg,
- (INTVAL) eval_cs);
+ (INTVAL) eval_pf);
return code_seg;
}
}
1.17 +21 -21 parrot/classes/eval.pmc
Index: eval.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/eval.pmc,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- eval.pmc 15 Aug 2003 14:57:52 -0000 1.16
+++ eval.pmc 16 Aug 2003 12:41:23 -0000 1.17
@@ -1,7 +1,7 @@
/* Eval.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: eval.pmc,v 1.16 2003/08/15 14:57:52 leo Exp $
+ * $Id: eval.pmc,v 1.17 2003/08/16 12:41:23 leo Exp $
* Overview:
* These are the vtable functions for evaluating a code segment
* Data Structure and Algorithms:
@@ -22,9 +22,16 @@
return whoami;
}
+ void destroy () {
+ /* TODO
+ * when this PMC gets out of scope
+ * it should destroy the attached PackFile
+ */
+ }
+
void* invoke (void* next) {
struct PackFile_ByteCode *old_cs;
- struct PackFile_ByteCode *eval_cs = (struct PackFile_ByteCode *)
+ struct PackFile *eval_pf = (struct PackFile *)
SUPER(next); /* invoke on Sub returns the address */
#if EXEC_CAPABLE
extern int Parrot_exec_run;
@@ -33,27 +40,28 @@
}
#endif
- /* return address that the interpreter should jump to */
- stack_push(INTERP, &(INTERP->ctx.control_stack), next,
- STACK_ENTRY_DESTINATION, STACK_CLEANUP_NULL);
/* switch to code segment */
- old_cs = Parrot_switch_to_cs(interpreter, eval_cs);
+ old_cs = Parrot_switch_to_cs(interpreter, eval_pf->cur_cs);
if (Interp_flags_TEST(interpreter, PARROT_TRACE_FLAG)) {
PIO_eprintf(interpreter, "*** invoking %s\n",
- eval_cs->base.name);
+ eval_pf->cur_cs->base.name);
}
runops_int(interpreter, 0);
if (Interp_flags_TEST(interpreter, PARROT_TRACE_FLAG)) {
PIO_eprintf(interpreter, "*** back from %s\n",
- eval_cs->base.name);
+ eval_pf->cur_cs->base.name);
}
/* restore ctx */
interpreter->ctx.pad_stack =
((struct Parrot_Sub*) PMC_data(SELF))->ctx.pad_stack;
- /* if code jumped to different code segment, go out of runloop
- * which then actually will switch segments */
- if (interpreter->resume_flag & 2)
+ /* if code jumped to different code segment, branch_cs
+ * is setting the resum_flag to 2, so that the
+ * runloop was left
+ */
+ if (interpreter->resume_flag & 2) {
+ interpreter->resume_flag = 1;
next = 0;
+ }
else
(void)Parrot_switch_to_cs(interpreter, old_cs);
return next;
@@ -62,17 +70,9 @@
STRING* get_string () {
size_t size;
opcode_t *packed;
- struct PackFile_Segment * seg =
- (struct PackFile_Segment *) SELF->cache.struct_val;
- struct PackFile *pf = interpreter->code;
- STRING *s;
- /* remove bytecode seg from directory, this is
- * cur_cs->prev
- * XXX ugly hack to write only the generated segment
- */
- PackFile_remove_segment_by_name(&pf->directory,
- ((struct PackFile_ByteCode *) seg)->prev->base.name);
+ struct PackFile *pf = (struct PackFile *) SELF->cache.struct_val;
+ STRING *s;
size = PackFile_pack_size(pf) * sizeof(opcode_t);
packed = (opcode_t*) mem_sys_allocate(size);
1.29 +4 -4 parrot/include/parrot/debug.h
Index: debug.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/debug.h,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -w -r1.28 -r1.29
--- debug.h 21 Jul 2003 18:47:44 -0000 1.28
+++ debug.h 16 Aug 2003 12:41:24 -0000 1.29
@@ -2,7 +2,7 @@
* debug.h
*
* CVS Info
- * $Id: debug.h,v 1.28 2003/07/21 18:47:44 scog Exp $
+ * $Id: debug.h,v 1.29 2003/08/16 12:41:24 leo Exp $
* Overview:
* Parrot debugger header files
* History:
@@ -193,7 +193,7 @@
void PDB_trace(struct Parrot_Interp *interpreter, const char *command);
void PDB_eval(struct Parrot_Interp *interpreter, const char *command);
-struct PackFile_ByteCode * PDB_compile(struct Parrot_Interp *, char *);
+struct PackFile * PDB_compile(struct Parrot_Interp *, const char *);
int PDB_extend_const_table(struct Parrot_Interp *interpreter);
1.48 +1 -2 parrot/include/parrot/packfile.h
Index: packfile.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/packfile.h,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -w -r1.47 -r1.48
--- packfile.h 15 Aug 2003 11:27:22 -0000 1.47
+++ packfile.h 16 Aug 2003 12:41:24 -0000 1.48
@@ -1,6 +1,6 @@
/* packfile.h
*
-* $Id: packfile.h,v 1.47 2003/08/15 11:27:22 leo Exp $
+* $Id: packfile.h,v 1.48 2003/08/16 12:41:24 leo Exp $
*
* History:
* Rework by Melvin; new bytecode format, make bytecode portable.
@@ -291,7 +291,6 @@
** PackFile_ByteCode Functions:
*/
-struct PackFile_ByteCode * Parrot_new_eval_cs(struct Parrot_Interp *);
struct PackFile_ByteCode * Parrot_switch_to_cs(struct Parrot_Interp *,
struct PackFile_ByteCode *);
void Parrot_switch_to_cs_by_nr(struct Parrot_Interp *, opcode_t seg);
1.21 +25 -8 parrot/languages/imcc/parser_util.c
Index: parser_util.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/parser_util.c,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -w -r1.20 -r1.21
--- parser_util.c 15 Aug 2003 14:57:53 -0000 1.20
+++ parser_util.c 16 Aug 2003 12:41:26 -0000 1.21
@@ -136,14 +136,17 @@
/* imcc always compiles to interp->code->byte_code
* save old cs, make new
*/
- struct PackFile_ByteCode * eval_cs = Parrot_new_eval_cs(interp);
- struct PackFile_ByteCode *old_cs;
+ struct PackFile *pf_save = interp->code;
+ struct PackFile *pf = PackFile_new(0);
+ char *source = sourcefile;
+ char name[64];
#ifdef EVAL_TEST
opcode_t *pc;
#endif
- old_cs = Parrot_switch_to_cs(interp, eval_cs);
- sourcefile = eval_cs->base.name;
+ interp->code = pf; /* put new packfile in place */
+ sprintf(name, "EVAL_" INTVAL_FMT, ++pf_save->eval_nr);
+ sourcefile = name;
/* spit out the sourcefile */
if (Interp_flags_TEST(interp, PARROT_DEBUG_FLAG)) {
FILE *fp = fopen(sourcefile, "w");
@@ -168,22 +171,36 @@
}
#endif
/* restore old byte_code, */
- (void)Parrot_switch_to_cs(interp, old_cs);
- return eval_cs;
+ (void)Parrot_switch_to_cs(interp, pf_save->cur_cs);
+ sourcefile = source;
+ /* append new packfile to current directory */
+ PackFile_add_segment(&interp->code->directory,
+ &pf->directory.base);
+ return pf;
}
static void *imcc_compile_pasm(Parrot_Interp interp, const char *s)
{
+ int pasm = pasm_file;
+ void *pf;
+
pasm_file = 1;
expect_pasm = 0;
- return imcc_compile(interp, s);
+ pf = imcc_compile(interp, s);
+ pasm_file = pasm;
+ return pf;
}
static void *imcc_compile_pir (Parrot_Interp interp, const char *s)
{
+ int pasm = pasm_file;
+ void *pf;
+
pasm_file = 0;
expect_pasm = 0;
- return imcc_compile(interp, s);
+ pf = imcc_compile(interp, s);
+ pasm_file = pasm;
+ return pf;
}
/* tell the parrot core, which compilers we provide */
1.45 +17 -29 parrot/languages/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/pbc.c,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -w -r1.44 -r1.45
--- pbc.c 16 Aug 2003 09:13:19 -0000 1.44
+++ pbc.c 16 Aug 2003 12:41:26 -0000 1.45
@@ -68,7 +68,7 @@
} globals;
-static int add_const_str(struct Parrot_Interp *, char *str);
+static int add_const_str(struct Parrot_Interp *, char *str, int dup_sym);
void imcc_globals_destroy(int ex, void *param);
void imcc_globals_destroy(int ex, void *param)
@@ -297,23 +297,13 @@
}
/* find a label in interpreters fixup table
- * return the index in the const_table of the name
*/
static int
find_label_cs(struct Parrot_Interp *interpreter, char *name)
{
struct PackFile_FixupEntry *fe =
PackFile_find_fixup_entry(interpreter, enum_fixup_label, name);
- int i;
- struct PackFile *pf = interpreter->code;
- if (!fe)
- return -1;
- for (i = 0; i < PF_NCONST(pf); i++) {
- struct PackFile_Constant * c = PF_CONST(pf, i);
- if (c->type == PFC_STRING && !strcmp(name, c->u.string->strstart))
- return i;
- }
- return -1;
+ return fe != NULL;
}
/* store global labels and bsr for later fixup
* return size in ops
@@ -409,32 +399,28 @@
continue;
if (strcmp(ins->op, "bsr") && strcmp(ins->op, "set_addr") &&
strcmp(ins->op, "branch_cs") && strcmp(ins->op, "newsub")) {
- Instruction *il;
char buf[64];
SymReg *r[IMCC_MAX_REGS];
- int fixup_const_nr;
+ char *glabel;
debug(DEBUG_PBC_FIXUP, "inter_cs found for '%s'\n", addr->name);
/* find symbol */
- if ((fixup_const_nr = find_label_cs(interpreter, addr->name)) < 0)
+ if (!find_label_cs(interpreter, addr->name))
debug(DEBUG_PBC_FIXUP,
"store_labels", "inter_cs label '%s' not found\n",
addr->name);
- fixup_const_nr = add_const_str(interpreter, addr->name);
- debug(DEBUG_PBC_FIXUP, "inter_cs label '%s' const#%d\n",
- addr->name, fixup_const_nr);
+ glabel = addr->name;
/* append inter_cs jump */
- free(addr->name);
- sprintf(buf, "#isc_%d", globals.inter_seg_n);
+ sprintf(buf, "#isc_%d", globals.inter_seg_n++);
addr->name = str_dup(buf);
- il = INS_LABEL(addr, 1);
+ INS_LABEL(addr, 1);
/* this is the new location */
store_label(addr, code_size);
/* increase code_size by 2 ops */
code_size += 2;
/* add inter_segment jump */
- sprintf(buf, "%d", fixup_const_nr);
- r[0] = mk_const(str_dup(buf), 'I');
+ r[0] = mk_const(glabel, 'S');
+ r[0]->color = add_const_str(interpreter, glabel, 1);
INS(interpreter, "branch_cs", "", r, 1, 0, 1);
}
}
@@ -554,7 +540,7 @@
/* add constant string to constants */
static int
-add_const_str(struct Parrot_Interp *interpreter, char *str) {
+add_const_str(struct Parrot_Interp *interpreter, char *str, int dup_sym) {
int k, l;
SymReg * r;
char *o;
@@ -576,10 +562,12 @@
l = unescape(buf);
}
+ if (!dup_sym) {
if ( (r = _get_sym(globals.str_consts, buf)) != 0) {
free(o);
return r->color;
}
+ }
k = PDB_extend_const_table(interpreter);
interpreter->code->const_table->constants[k]->type =
PFC_STRING;
@@ -774,7 +762,7 @@
r->color = atoi(r->name);
break;
case 'S':
- r->color = add_const_str(interpreter, r->name);
+ r->color = add_const_str(interpreter, r->name, 0);
break;
case 'N':
r->color = add_const_num(interpreter, r->name);
@@ -886,7 +874,7 @@
npc, label->color, addr->name,addr->color);
}
else if (strcmp(ins->op, "bsr") && strcmp(ins->op, "set_addr") &&
- strcmp(ins->op, "branch_cs") && strcmp(ins->op, "newsub")) {
+ strcmp(ins->op, "newsub")) {
/* TODO make intersegment branch */
fatal(1, "e_pbc_emit", "label not found for '%s'\n",
addr->name);
1.2 +6 -4 parrot/t/pmc/eval.t
Index: eval.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/eval.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- eval.t 16 Jan 2003 17:26:43 -0000 1.1
+++ eval.t 16 Aug 2003 12:41:28 -0000 1.2
@@ -3,10 +3,12 @@
use Parrot::Test tests => 3;
use Test::More;
+# PASM1 is like PASM but appends an C<end> opcode
+
output_is(<<'CODE', <<'OUTPUT', "eval_sc");
compreg P1, "PASM1" # get compiler
set S1, "in eval\n"
- compile P0, P1, "print_s S1"
+ compile P0, P1, "print S1"
invoke # eval code P0
print "back again\n"
end
@@ -17,8 +19,8 @@
output_is(<<'CODE', <<'OUTPUT', "eval_s - check nci globbered reg");
compreg P1, "PASM1"
- set I0, 41
- set S1, "inc_i I0"
+ set I0, 40
+ set S1, "inc I0\ninc I0"
compile P0, P1, S1
invoke
print I0
@@ -31,7 +33,7 @@
output_is(<<'CODE', <<'OUTPUT', "eval_s - check nci param S5 ");
compreg P1, "PASM1"
set S1, "hello "
- set S5, "concat_s_sc S1, 'parrot'"
+ set S5, "concat S1, 'parrot'"
compile P0, P1, S5
invoke
print S1
