cvsuser 04/11/09 09:16:46
Modified: classes compiler.pmc eval.pmc
imcc parser_util.c pbc.c
imcc/t/syn eval.t
src call_list.txt inter_misc.c packfile.c
t/pmc eval.t
Log:
eval changes
Revision Changes Path
1.20 +5 -11 parrot/classes/compiler.pmc
Index: compiler.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/compiler.pmc,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- compiler.pmc 8 Nov 2004 16:58:02 -0000 1.19
+++ compiler.pmc 9 Nov 2004 17:16:37 -0000 1.20
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: compiler.pmc,v 1.19 2004/11/08 16:58:02 leo Exp $
+$Id: compiler.pmc,v 1.20 2004/11/09 17:16:37 leo Exp $
=head1 NAME
@@ -38,13 +38,12 @@
void* invoke (void * code_ptr) {
Parrot_csub_t func = (Parrot_csub_t)D2FPTR(PMC_data(SELF));
- PMC *code_seg, *p5;
- struct PackFile *eval_pf;
+ PMC *sub, *p5;
STRING *s5;
INTVAL i0[5];
/*
- * preserve regs
+ * preserve regs - TODO if it's a Sub bump frame pointer
*/
s5 = REG_STR(5);
p5 = REG_PMC(5);
@@ -55,16 +54,11 @@
mem_sys_memcopy(®_INT(0), i0, sizeof(INTVAL) * 5);
/* return value PMC is in P5 */
- code_seg = REG_PMC(5);
+ sub = REG_PMC(5);
REG_PMC(5) = p5;
REG_STR(5) = s5;
- 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_pointer(interpreter, code_seg, (void*) eval_pf);
- return code_seg;
+ return sub;
}
}
1.30 +6 -134 parrot/classes/eval.pmc
Index: eval.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/eval.pmc,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- eval.pmc 23 Sep 2004 12:48:25 -0000 1.29
+++ eval.pmc 9 Nov 2004 17:16:37 -0000 1.30
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: eval.pmc,v 1.29 2004/09/23 12:48:25 leo Exp $
+$Id: eval.pmc,v 1.30 2004/11/09 17:16:37 leo Exp $
=head1 NAME
@@ -20,147 +20,19 @@
*/
#include "parrot/parrot.h"
-#include "parrot/runops_cores.h"
-#include "parrot/interp_guts.h"
-#include "parrot/packfile.h"
pmclass Eval extends Closure {
-/*
-
-=item C<void set_pointer(void *value)>
-
-Sets the pointer to the PackFile.
-
-=cut
-
-*/
-
- void set_pointer (void* value) {
- PMC_struct_val(SELF) = value;
- }
-
-/*
-
-=item C<void *get_pointer()>
-
-Returns the pointer PackFile.
-
-=cut
-
-*/
-
- void* get_pointer () {
- return PMC_struct_val(SELF);
- }
-/*
-
-=item C<void destroy()>
-
-TODO - When this PMC gets out of scope it should destroy the attached
-PackFile.
-
-=cut
-
-*/
-
- void destroy () {
+ void init() {
+ SUPER();
+ PObj_active_destroy_SET(SELF);
}
-/*
-
-=item C<void *invoke (void *next)>
-
-Invokes the PMC's code.
-
-=cut
-
-*/
-
- void* invoke (void* next) {
- struct PackFile_ByteCode *old_cs;
- struct PackFile *eval_pf = VTABLE_get_pointer(interpreter, SELF);
-#if EXEC_CAPABLE
- extern int Parrot_exec_run;
- if (Interp_core_TEST(interpreter, PARROT_EXEC_CORE)) {
- Parrot_exec_run = 2;
- }
-#endif
-
- /* switch to code segment */
- old_cs = Parrot_switch_to_cs(interpreter, eval_pf->cur_cs, 1);
- if (Interp_flags_TEST(interpreter, PARROT_TRACE_FLAG)) {
- PIO_eprintf(interpreter, "*** invoking %s\n",
- 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_pf->cur_cs->base.name);
- }
- /* restore ctx */
- interpreter->ctx.pad_stack =
- (PMC_sub(SELF))->pad_stack;
- /* 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, 1);
- return next;
+ void destroy() {
+ /* TODO destroy bytecode in seg */
}
-/*
-
-=item C<INTVAL get_integer_keyed(PMC *key)>
-
-Returns the pointer to the start of the PMC's code as an integer.
-
-C<*key> is ignored.
-
-=cut
-*/
-
- INTVAL get_integer_keyed (PMC* key) {
- struct PackFile *pf = VTABLE_get_pointer(interpreter, SELF);
- opcode_t *code = pf->byte_code;
- /*
- int i = 0;
- for (i=0; i < 16; i++) {
- printf("At %p there is an %i\n", code+i, *(code+i));
- }
- */
- return (INTVAL) code;
- }
-
-/*
-
-=item C<STRING *get_string()>
-
-Returns the PMC's code as a Parrot string.
-
-=cut
-
-*/
-
- STRING* get_string () {
- size_t size;
- opcode_t *packed;
- struct PackFile *pf = VTABLE_get_pointer(interpreter, SELF);
- STRING *s;
-
- size = PackFile_pack_size(pf) * sizeof(opcode_t);
- packed = (opcode_t*) mem_sys_allocate(size);
- PackFile_pack(pf, packed);
- s = string_make(interpreter, packed, size, "iso-8859-1", 0);
- mem_sys_free(packed);
- return s;
- }
}
/*
1.80 +31 -20 parrot/imcc/parser_util.c
Index: parser_util.c
===================================================================
RCS file: /cvs/public/parrot/imcc/parser_util.c,v
retrieving revision 1.79
retrieving revision 1.80
diff -u -r1.79 -r1.80
--- parser_util.c 4 Nov 2004 09:07:58 -0000 1.79
+++ parser_util.c 9 Nov 2004 17:16:39 -0000 1.80
@@ -427,24 +427,27 @@
extern void* yy_scan_string(const char *);
extern SymReg *cur_namespace; /* s. imcc.y */
+/* XXX */
+struct PackFile_ByteCode *
+PF_create_default_segs(Parrot_Interp interpreter, int add);
+
static void *
imcc_compile(Parrot_Interp interp, const char *s)
{
/* imcc always compiles to interp->code->byte_code
* save old cs, make new
*/
- struct PackFile *pf_save = interp->code;
- struct PackFile *pf = PackFile_new(0);
const char *source = sourcefile;
char name[64];
-#ifdef EVAL_TEST
- opcode_t *pc;
-#endif
-
+ struct PackFile_ByteCode *old_cs, *new_cs;
+ PMC *sub;
+ parrot_sub_t sub_data;
+
+ sprintf(name, "EVAL_" INTVAL_FMT, ++interp->code->eval_nr);
+ new_cs = PF_create_default_segs(interp, 0);
+ old_cs = Parrot_switch_to_cs(interp, new_cs, 0);
cur_namespace = NULL;
IMCC_INFO(interp)->cur_namespace = NULL;
- 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)) {
@@ -463,22 +466,23 @@
yyparse((void *) interp);
imc_compile_all_units(interp);
-#ifdef EVAL_TEST
- pc = (opcode_t *) interp->code->byte_code;
- while (pc) {
- DO_OP(pc, interp);
- }
-#endif
PackFile_fixup_subs(interp);
- if (pf_save) {
+ if (old_cs) {
/* restore old byte_code, */
- (void)Parrot_switch_to_cs(interp, pf_save->cur_cs, 0);
- /* append new packfile to current directory */
- PackFile_add_segment(&interp->code->directory,
- &pf->directory.base);
+ (void)Parrot_switch_to_cs(interp, old_cs, 0);
}
sourcefile = source;
- return pf;
+
+ /*
+ * create sub PMC
+ */
+ sub = pmc_new(interp, enum_class_Eval);
+ sub_data = PMC_sub(sub);
+ sub_data->seg = new_cs;
+ sub_data->address = new_cs->base.data;
+ sub_data->end = new_cs->base.data + new_cs->base.size;
+ sub_data->name = string_from_cstring(interp, name, 0);
+ return sub;
}
static void *
@@ -572,6 +576,13 @@
return pf;
}
+void * IMCC_compile_file (Parrot_Interp interp, const char *s);
+void *
+IMCC_compile_file (Parrot_Interp interp, const char *s)
+{
+ return imcc_compile_file(interp, s);
+}
+
/* Register additional compilers with the interpreter */
void
register_compilers(Parrot_Interp interp)
1.94 +16 -9 parrot/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pbc.c,v
retrieving revision 1.93
retrieving revision 1.94
diff -u -r1.93 -r1.94
--- pbc.c 31 Oct 2004 12:51:20 -0000 1.93
+++ pbc.c 9 Nov 2004 17:16:39 -0000 1.94
@@ -102,7 +102,8 @@
}
static struct PackFile_Segment *
-create_seg(struct PackFile_Directory *dir, pack_file_types t, const char
*name)
+create_seg(struct PackFile_Directory *dir, pack_file_types t,
+ const char *name, int add)
{
char *buf;
struct PackFile_Segment *seg;
@@ -111,26 +112,31 @@
len = strlen(name) + strlen(sourcefile) + 2;
buf = malloc(len);
sprintf(buf, "%s_%s", name, sourcefile);
- seg = PackFile_Segment_new_seg(dir, t, buf, 1);
+ seg = PackFile_Segment_new_seg(dir, t, buf, add);
free(buf);
return seg;
}
-static struct PackFile_ByteCode *
-create_default_segs(Parrot_Interp interpreter)
+/* XXX */
+struct PackFile_ByteCode *
+PF_create_default_segs(Parrot_Interp interpreter, int add);
+
+struct PackFile_ByteCode *
+PF_create_default_segs(Parrot_Interp interpreter, int add)
{
struct PackFile_Segment *seg;
struct PackFile *pf = interpreter->code;
struct PackFile_ByteCode *cur_cs;
- seg = create_seg(&pf->directory, PF_BYTEC_SEG, BYTE_CODE_SEGMENT_NAME);
- cur_cs = pf->cur_cs = (struct PackFile_ByteCode*)seg;
+ seg = create_seg(&pf->directory, PF_BYTEC_SEG, BYTE_CODE_SEGMENT_NAME,
add);
+ cur_cs = (struct PackFile_ByteCode*)seg;
- seg = create_seg(&pf->directory, PF_FIXUP_SEG, FIXUP_TABLE_SEGMENT_NAME);
+ seg = create_seg(&pf->directory, PF_FIXUP_SEG, FIXUP_TABLE_SEGMENT_NAME,
+ add);
cur_cs->fixups = (struct PackFile_FixupTable *)seg;
cur_cs->fixups->code = cur_cs;
- seg = create_seg(&pf->directory, PF_CONST_SEG, CONSTANT_SEGMENT_NAME);
+ seg = create_seg(&pf->directory, PF_CONST_SEG, CONSTANT_SEGMENT_NAME,
add);
cur_cs->consts = pf->const_table = (struct PackFile_ConstTable*) seg;
cur_cs->consts->code = cur_cs;
@@ -168,7 +174,8 @@
* we need some segments
*/
if (!interpreter->code->cur_cs) {
- cs->seg = create_default_segs(interpreter);
+ cs->seg = interpreter->code->cur_cs =
+ PF_create_default_segs(interpreter, 1);
}
globals.cs = cs;
return 0;
1.11 +4 -0 parrot/imcc/t/syn/eval.t
Index: eval.t
===================================================================
RCS file: /cvs/public/parrot/imcc/t/syn/eval.t,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- eval.t 26 Feb 2004 19:53:12 -0000 1.10
+++ eval.t 9 Nov 2004 17:16:43 -0000 1.11
@@ -2,6 +2,9 @@
use strict;
use TestCompiler tests => 7;
+SKIP: {
+ skip("changed eval semantics - see t/pmc/eval.t", 7);
+
##############################
output_is(<<'CODE', <<'OUT', "eval pasm");
.sub _test
@@ -142,3 +145,4 @@
hello
back
OUT
+}
1.45 +1 -0 parrot/src/call_list.txt
Index: call_list.txt
===================================================================
RCS file: /cvs/public/parrot/src/call_list.txt,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- call_list.txt 8 Oct 2004 10:21:22 -0000 1.44
+++ call_list.txt 9 Nov 2004 17:16:44 -0000 1.45
@@ -130,6 +130,7 @@
l v
l
p It
+P It
p b
p i
p ii
1.12 +2 -2 parrot/src/inter_misc.c
Index: inter_misc.c
===================================================================
RCS file: /cvs/public/parrot/src/inter_misc.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- inter_misc.c 25 Sep 2004 10:50:45 -0000 1.11
+++ inter_misc.c 9 Nov 2004 17:16:44 -0000 1.12
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: inter_misc.c,v 1.11 2004/09/25 10:50:45 leo Exp $
+$Id: inter_misc.c,v 1.12 2004/11/09 17:16:44 leo Exp $
=head1 NAME
@@ -123,7 +123,7 @@
nci = pmc_new(interpreter, enum_class_Compiler);
VTABLE_set_pmc_keyed_str(interpreter, hash, type, nci);
/* build native call interface fir the C sub in "func" */
- sc = CONST_STRING(interpreter, "pIt");
+ sc = CONST_STRING(interpreter, "PIt");
VTABLE_set_pointer_keyed_str(interpreter, nci, sc, func);
}
1.179 +16 -5 parrot/src/packfile.c
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/src/packfile.c,v
retrieving revision 1.178
retrieving revision 1.179
diff -u -r1.178 -r1.179
--- packfile.c 29 Oct 2004 09:35:04 -0000 1.178
+++ packfile.c 9 Nov 2004 17:16:44 -0000 1.179
@@ -2,7 +2,7 @@
Copyright (C) 2001-2002 Gregor N. Purdy. All rights reserved.
This program is free software. It is subject to the same license as
Parrot itself.
-$Id: packfile.c,v 1.178 2004/10/29 09:35:04 leo Exp $
+$Id: packfile.c,v 1.179 2004/11/09 17:16:44 leo Exp $
=head1 NAME
@@ -2061,6 +2061,7 @@
interpreter->code->cur_cs = new_cs;
new_cs->prev = cur_cs;
interpreter->code->byte_code = new_cs->base.data;
+ interpreter->code->const_table = new_cs->consts;
interpreter->prederef.code = new_cs->prederef.code;
interpreter->prederef.branches = new_cs->prederef.branches;
interpreter->prederef.n_branches = new_cs->prederef.n_branches;
@@ -3077,10 +3078,16 @@
*/
+/*
+ * intermediate hook during changes
+ */
+void * IMCC_compile_file (Parrot_Interp interp, const char *s);
+
void
Parrot_load_bytecode(Interp *interpreter, const char *filename)
{
const char *ext;
+ struct PackFile * pf;
#if TRACE_PACKFILE
fprintf(stderr, "packfile.c: parrot_load_bytecode()\n");
@@ -3088,16 +3095,16 @@
ext = strrchr(filename, '.');
if (ext && strcmp (ext, ".pbc") == 0) {
- struct PackFile * pf;
pf = PackFile_append_pbc(interpreter, filename);
do_sub_pragmas(interpreter, pf, PBC_LOADED);
}
else {
+#if 0
PMC * compiler, *code;
- PMC *key = key_new_cstring(interpreter, "FILE"); /* see
imcc/parser_util.c */
+ /* see imcc/parser_util.c */
+ PMC *key = key_new_cstring(interpreter, "FILE");
PMC *compreg_hash = VTABLE_get_pmc_keyed_int(interpreter,
interpreter->iglobals, IGLOBALS_COMPREG_HASH);
- struct PackFile *pf;
STRING *file;
compiler = VTABLE_get_pmc_keyed(interpreter, compreg_hash, key);
@@ -3107,10 +3114,14 @@
}
file = string_from_cstring(interpreter, filename, 0);
#if TRACE_PACKFILE
- fprintf(stderr, "packfile.c: VTABLE: compiler->invoke '%s'\n",
filename);
+ fprintf(stderr, "packfile.c: VTABLE: compiler->invoke '%s'\n",
+ filename);
#endif
code = VTABLE_invoke(interpreter, compiler, file);
pf = VTABLE_get_pointer(interpreter, code);
+#else
+ pf = IMCC_compile_file(interpreter, filename);
+#endif
if (pf) {
if (pf != interpreter->code)
PackFile_add_segment(&interpreter->code->directory,
1.11 +11 -38 parrot/t/pmc/eval.t
Index: eval.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/eval.t,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- eval.t 1 Oct 2004 21:16:52 -0000 1.10
+++ eval.t 9 Nov 2004 17:16:46 -0000 1.11
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: eval.t,v 1.10 2004/10/01 21:16:52 jrieks Exp $
+# $Id: eval.t,v 1.11 2004/11/09 17:16:46 leo Exp $
=head1 NAME
@@ -16,16 +16,16 @@
=cut
-use Parrot::Test tests => 8;
+use Parrot::Test tests => 6;
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 S1"
- invoke # eval code P0
+ compreg P1, "PASM" # get compiler
+ set S5, "in eval\n"
+ set I0, 1
+ set I2, 1
+ compile P0, P1, "print S5\ninvoke P1\n"
+ invokecc # eval code P0
print "back again\n"
end
CODE
@@ -33,31 +33,6 @@
back again
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "eval_s - check nci globbered reg");
- compreg P1, "PASM1"
- set I0, 40
- set S1, "inc I0\ninc I0"
- compile P0, P1, S1
- invoke
- print I0
- print "\n"
- end
-CODE
-42
-OUTPUT
-
-output_is(<<'CODE', <<'OUTPUT', "eval_s - check nci param S5 ");
- compreg P1, "PASM1"
- set S1, "hello "
- set S5, "concat S1, 'parrot'"
- compile P0, P1, S5
- invoke
- print S1
- print "\n"
- end
-CODE
-hello parrot
-OUTPUT
output_is(<<'CODE', <<'OUTPUT', "call subs in evaled code ");
set S5, ".pcc_sub _foo:\n"
@@ -141,7 +116,7 @@
.local pmc the_sub
.local string code
code = "print \"ok\\n\"\n"
- code .= "end\n"
+ code .= "invoke P1\n"
the_sub = my_compiler("_foo", code)
the_sub()
the_sub = global "_foo"
@@ -176,7 +151,7 @@
$P1['builtin'] = $P0
$P2 = compreg "PIR"
- $S0 = ".sub main\nprint \"dynamic\\n\"\nend\n.end"
+ $S0 = ".sub main\nprint \"dynamic\\n\"\ninvoke P1\n.end"
$P0 = compile $P2, $S0
$P1['dynamic'] = $P0
@@ -185,7 +160,7 @@
$S0 = ".sub main\n$P1 = find_global\"funcs\"\n"
$S0 .= "$P0 = $P1['dynamic']\n$P0()\n"
$S0 .= "$P0 = $P1['builtin']\n$P0()\n"
- $S0 .= "end\n.end"
+ $S0 .= "invoke P1\n.end"
$P2 = compreg "PIR"
$P0 = compile $P2, $S0
@@ -195,8 +170,6 @@
.sub _builtin
print "builtin\n"
- .pcc_begin_return
- .pcc_end_return
.end
CODE
dynamic
