cvsuser 04/11/10 03:19:32
Modified: classes eval.pmc
examples/assembly nanoforth.pasm nanoforth2.pasm
imcc parser_util.c pbc.c
include/parrot packfile.h
src packfile.c
t/pmc eval.t
Log:
eval changes 2 - cleanup segment creation, destroy
* move bytecode segment creation to packfile
* fix JIT for evaled code
* fix nanoforth2 example and test
* destroy eval segments
Revision Changes Path
1.31 +34 -3 parrot/classes/eval.pmc
Index: eval.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/eval.pmc,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- eval.pmc 9 Nov 2004 17:16:37 -0000 1.30
+++ eval.pmc 10 Nov 2004 11:19:22 -0000 1.31
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: eval.pmc,v 1.30 2004/11/09 17:16:37 leo Exp $
+$Id: eval.pmc,v 1.31 2004/11/10 11:19:22 leo Exp $
=head1 NAME
@@ -24,12 +24,43 @@
pmclass Eval extends Closure {
void init() {
+ parrot_sub_t sub_data;
SUPER();
- PObj_active_destroy_SET(SELF);
+ sub_data = PMC_sub(SELF);
+ PObj_custom_mark_destroy_SETALL(SELF);
+ sub_data->seg = NULL;
+ }
+
+ void mark() {
+ parrot_sub_t sub_data;
+ PObj *name;
+
+ sub_data = PMC_sub(SELF);
+ name = (PObj*)sub_data->name;
+ if (name)
+ pobject_lives(INTERP, name);
}
void destroy() {
- /* TODO destroy bytecode in seg */
+ parrot_sub_t sub_data;
+ struct PackFile_Segment *seg;
+ struct PackFile_ByteCode *cur_cs;
+
+ sub_data = PMC_sub(SELF);
+ cur_cs = sub_data->seg;
+ if (!cur_cs)
+ return;
+
+ seg = (struct PackFile_Segment *)cur_cs->consts;
+ PackFile_Segment_destroy(seg);
+ seg = (struct PackFile_Segment *)cur_cs->debugs;
+ if (seg)
+ PackFile_Segment_destroy(seg);
+ seg = (struct PackFile_Segment *)cur_cs->fixups;
+ PackFile_Segment_destroy(seg);
+ seg = (struct PackFile_Segment *)cur_cs;
+ PackFile_Segment_destroy(seg);
+ sub_data->seg = NULL;
}
1.2 +5 -0 parrot/examples/assembly/nanoforth.pasm
Index: nanoforth.pasm
===================================================================
RCS file: /cvs/public/parrot/examples/assembly/nanoforth.pasm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- nanoforth.pasm 4 Feb 2004 13:19:10 -0000 1.1
+++ nanoforth.pasm 10 Nov 2004 11:19:25 -0000 1.2
@@ -12,6 +12,11 @@
: x compile single-letter word x
; end compile
+This code uses the same compile/call scheme as Dan's languages/forth
+compiler and is therefor equally broken. The C<jsr> opcode does not allow
+to branch into different code segments, or better it works only if bounds
+checking is disabled.
+
=cut
.macro core(op, label)
1.2 +67 -33 parrot/examples/assembly/nanoforth2.pasm
Index: nanoforth2.pasm
===================================================================
RCS file: /cvs/public/parrot/examples/assembly/nanoforth2.pasm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- nanoforth2.pasm 4 Feb 2004 13:19:10 -0000 1.1
+++ nanoforth2.pasm 10 Nov 2004 11:19:25 -0000 1.2
@@ -9,7 +9,7 @@
+ add
- sub
- \d a number
+ \d a single-digit number
. print
: x compile single-letter word x
; end compile
@@ -18,20 +18,22 @@
.macro core(op, label)
find_global P3, .label
- set P16[.op], P3
+ set P6[.op], P3
.endm
_main:
getstdin P3
readline S5, P3
find_global P0, "_nano_forth_compiler"
+ set I0, 1
+ set I2, 1
invokecc
end
.pcc_sub _nano_forth_compiler:
set P21, P1 #preserve ret cont
set S17, S5 #input src code
- new P16, .PerlHash
+ new P6, .PerlHash
.core("+", "_add")
.core("-", "_sub")
.core(".", "_print")
@@ -45,22 +47,34 @@
.core("7", "_const")
.core("8", "_const")
.core("9", "_const")
- .core(":", "_start_compile")
+ # .core(":", "_start_compile")
+ new P5, .PerlArray
+ new P10, .PerlInt
+ store_global "compiling", P10
#set S17, ": a + ; 2 1 a ."
- set I1, 0 # 1 = compile
+ set I10, 0 # 1 = compile
parse:
length I0, S17
unless I0, fin
# S17 is rest of input, S16 is current word
substr S16, S17, 0, 1, ""
+ eq S16, ':', _start_compile
eq S16, ';', end_compile
eq S16, ' ', parse
eq S16, "\n", parse
- set P0, P16[S16]
+ set P0, P6[S16]
defined I0, P0
unless I0, next
- if I1, compile
+ find_global P10, "compiling"
+ set I10, P10
+ if I10, compile
+ set I0, 1
+ set I1, 0
+ set I2, 1
+ set I3, 2
+ set I4, 0
+ set S5, S16
invokecc P0
branch parse
compile:
@@ -68,18 +82,22 @@
lt I2, 0x30, no_num
gt I2, 0x39, no_num
sub I2, 0x30
- concat S18, "save "
+ concat S18, "push P5, "
set S2, I2
concat S18, S2
concat S18, "\n"
branch parse
no_num:
- concat S18, "pushbottomp\n"
- concat S18, 'set P0, P16["'
+ concat S18, 'set P0, P6["'
concat S18, S16
concat S18, '"]'
- concat S18, "\ninvokecc\n"
- concat S18, "popbottomp\n"
+ concat S18, "\n"
+ concat S18, "set I0, 1\n"
+ concat S18, "set I1, 0\n"
+ concat S18, "set I2, 1\n"
+ concat S18, "set I3, 2\n"
+ concat S18, "set I4, 0\n"
+ concat S18, "invokecc\n"
branch parse
next:
printerr "? "
@@ -88,16 +106,17 @@
branch syntax_error
end_compile:
- set I1, 0
- concat S18, "invoke P1\n"
- ## print S18
+ find_global P10, "compiling"
+ set P10, 0
+ concat S18, "null I0\n"
+ concat S18, "null I3\n"
+ concat S18, "invoke P11\n"
+ # print "\n************\n"
+ # print S18
+ # print "\n************\n"
compreg P2, "PASM"
- compile P1, P2, S18
- # find _entry_X
- set S0, "_entry_"
- concat S0, S19
- find_global P3, S0
- set P16[S19], P3
+ compile P3, P2, S18
+ set P6[S19], P3
branch parse
fin:
set I5, 0
@@ -107,7 +126,7 @@
set I5, 1
invoke P21
-.pcc_sub _start_compile:
+_start_compile:
substr S16, S17, 0, 1, ""
eq S16, " ", _start_compile
# word to cpmpile
@@ -116,29 +135,44 @@
set S18, ".pcc_sub _entry_"
concat S18, S19
concat S18, ":\n"
- set I1, 1
- invoke P1
+ concat S18, "set P11, P1\n"
+ find_global P10, "compiling"
+ set P10, 1
+ branch parse
+# P5 = stack
+# P6 = word hash
+# S5 = input string
.pcc_sub _add:
- restore I16
- restore I17
+ pop I16, P5
+ pop I17, P5
add I16, I17, I16
- save I16
+ push P5, I16
+ null I0
+ null I3
invoke P1
.pcc_sub _sub:
- restore I16
- restore I17
+ pop I16, P5
+ pop I17, P5
sub I16, I17, I16
- save I16
+ push P5, I16
+ null I0
+ null I3
invoke P1
.pcc_sub _print:
- restore I16
+ null I0
+ null I3
+ pop I16, P5
print I16
print "\n"
+ null I0
+ null I3
invoke P1
# single digit 0..9 only
.pcc_sub _const:
- ord I16, S16
+ ord I16, S5
sub I16, 0x30
- save I16
+ push P5, I16
+ null I0
+ null I3
invoke P1
1.81 +1 -4 parrot/imcc/parser_util.c
Index: parser_util.c
===================================================================
RCS file: /cvs/public/parrot/imcc/parser_util.c,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -r1.80 -r1.81
--- parser_util.c 9 Nov 2004 17:16:39 -0000 1.80
+++ parser_util.c 10 Nov 2004 11:19:27 -0000 1.81
@@ -427,9 +427,6 @@
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)
@@ -444,7 +441,7 @@
parrot_sub_t sub_data;
sprintf(name, "EVAL_" INTVAL_FMT, ++interp->code->eval_nr);
- new_cs = PF_create_default_segs(interp, 0);
+ new_cs = PF_create_default_segs(interp, name, 0);
old_cs = Parrot_switch_to_cs(interp, new_cs, 0);
cur_namespace = NULL;
IMCC_INFO(interp)->cur_namespace = NULL;
1.95 +1 -42 parrot/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pbc.c,v
retrieving revision 1.94
retrieving revision 1.95
diff -u -r1.94 -r1.95
--- pbc.c 9 Nov 2004 17:16:39 -0000 1.94
+++ pbc.c 10 Nov 2004 11:19:27 -0000 1.95
@@ -101,47 +101,6 @@
globals.cs = NULL;
}
-static struct PackFile_Segment *
-create_seg(struct PackFile_Directory *dir, pack_file_types t,
- const char *name, int add)
-{
- char *buf;
- struct PackFile_Segment *seg;
- size_t len;
-
- len = strlen(name) + strlen(sourcefile) + 2;
- buf = malloc(len);
- sprintf(buf, "%s_%s", name, sourcefile);
- seg = PackFile_Segment_new_seg(dir, t, buf, add);
- free(buf);
- return seg;
-}
-
-/* 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,
add);
- cur_cs = (struct PackFile_ByteCode*)seg;
-
- 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,
add);
- cur_cs->consts = pf->const_table = (struct PackFile_ConstTable*) seg;
- cur_cs->consts->code = cur_cs;
-
- return cur_cs;
-}
int
e_pbc_open(void *param)
@@ -175,7 +134,7 @@
*/
if (!interpreter->code->cur_cs) {
cs->seg = interpreter->code->cur_cs =
- PF_create_default_segs(interpreter, 1);
+ PF_create_default_segs(interpreter, sourcefile, 1);
}
globals.cs = cs;
return 0;
1.65 +4 -1 parrot/include/parrot/packfile.h
Index: packfile.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/packfile.h,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -r1.64 -r1.65
--- packfile.h 18 Oct 2004 01:35:25 -0000 1.64
+++ packfile.h 10 Nov 2004 11:19:29 -0000 1.65
@@ -1,6 +1,6 @@
/* packfile.h
*
-* $Id: packfile.h,v 1.64 2004/10/18 01:35:25 brentdax Exp $
+* $Id: packfile.h,v 1.65 2004/11/10 11:19:29 leo Exp $
*
* History:
* Rework by Melvin; new bytecode format, make bytecode portable.
@@ -255,6 +255,9 @@
struct PackFile_Segment * PackFile_Segment_new_seg(struct PackFile_Directory
*,
UINTVAL type, const char *name, int add);
+struct PackFile_ByteCode * PF_create_default_segs(Interp*,
+ const char *file_name, int add);
+
void Parrot_load_bytecode(Interp *, const char *filename);
/*
** PackFile_Segment Functions:
1.180 +60 -3 parrot/src/packfile.c
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/src/packfile.c,v
retrieving revision 1.179
retrieving revision 1.180
diff -u -r1.179 -r1.180
--- packfile.c 9 Nov 2004 17:16:44 -0000 1.179
+++ packfile.c 10 Nov 2004 11:19:30 -0000 1.180
@@ -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.179 2004/11/09 17:16:44 leo Exp $
+$Id: packfile.c,v 1.180 2004/11/10 11:19:30 leo Exp $
=head1 NAME
@@ -748,6 +748,8 @@
{
size_t i;
+ if (!dir)
+ return NULL;
for (i=0; i < dir->num_segments; i++) {
struct PackFile_Segment *seg = dir->segments[i];
if (seg && strcmp (seg->name, name) == 0) {
@@ -1152,6 +1154,58 @@
return seg;
}
+static struct PackFile_Segment *
+create_seg(struct PackFile_Directory *dir, pack_file_types t,
+ const char *name, const char *file_name, int add)
+{
+ char *buf;
+ struct PackFile_Segment *seg;
+ size_t len;
+
+ len = strlen(name) + strlen(file_name) + 2;
+ buf = malloc(len);
+ sprintf(buf, "%s_%s", name, file_name);
+ seg = PackFile_Segment_new_seg(dir, t, buf, add);
+ free(buf);
+ return seg;
+}
+
+/*
+
+=item C<struct PackFile_ByteCode *
+PF_create_default_segs(Interp*, const char *file_name, int add)>
+
+Create bytecode, constant, and fixup segment for C<file_nam>. If C<add>
+is true, the current packfile becomes the owner of these segments by
+adding the segments to the directory.
+
+=cut
+
+*/
+
+struct PackFile_ByteCode *
+PF_create_default_segs(Interp* interpreter, const char *file_name, 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,
+ file_name, add);
+ cur_cs = (struct PackFile_ByteCode*)seg;
+
+ seg = create_seg(&pf->directory, PF_FIXUP_SEG, FIXUP_TABLE_SEGMENT_NAME,
+ file_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,
+ file_name, add);
+ cur_cs->consts = pf->const_table = (struct PackFile_ConstTable*) seg;
+ cur_cs->consts->code = cur_cs;
+
+ return cur_cs;
+}
/*
=item C<void
@@ -1809,6 +1863,7 @@
struct PackFile_ByteCode *byte_code;
byte_code = mem_sys_allocate(sizeof(struct PackFile_ByteCode));
+ byte_code->base.dir = NULL;
byte_code->prederef.code = NULL;
byte_code->prederef.branches = NULL;
@@ -2067,7 +2122,8 @@
interpreter->prederef.n_branches = new_cs->prederef.n_branches;
interpreter->prederef.n_allocated= new_cs->prederef.n_allocated;
interpreter->jit_info = new_cs->jit_info;
- prepare_for_run(interpreter);
+ if (really)
+ prepare_for_run(interpreter);
return cur_cs;
}
@@ -2076,7 +2132,7 @@
=item C<void
Parrot_pop_cs(Interp *interpreter)>
-Destroy current byte code segment and switch to previous.
+Remove current byte code segment from directory and switch to previous.
=cut
@@ -2090,6 +2146,7 @@
Parrot_switch_to_cs(interpreter, new_cs, 1);
PackFile_remove_segment_by_name (cur_cs->base.dir, cur_cs->base.name);
+ /* FIXME delete returned segment */
}
/*
1.12 +18 -9 parrot/t/pmc/eval.t
Index: eval.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/eval.t,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- eval.t 9 Nov 2004 17:16:46 -0000 1.11
+++ eval.t 10 Nov 2004 11:19:32 -0000 1.12
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: eval.t,v 1.11 2004/11/09 17:16:46 leo Exp $
+# $Id: eval.t,v 1.12 2004/11/10 11:19:32 leo Exp $
=head1 NAME
@@ -58,6 +58,7 @@
concat S5, "invoke P1\n"
compreg P1, "PASM"
compile P0, P1, S5
+ set P6, P0 # keep Sub PMC segment alive
find_global P0, "_foo"
invokecc
print "back\n"
@@ -72,9 +73,6 @@
fin
OUTPUT
-SKIP: {
- skip("wrong stack handling", 1);
-
output_is(<<'CODE', <<'OUTPUT', "nano forth sub");
_main:
load_bytecode "examples/assembly/nanoforth2.pasm"
@@ -86,14 +84,25 @@
ok2:
print "ok 2\n"
set S5, "1 7 + . 2 3 - .\n"
- pushp
+ set I0, 1
+ set I1, 0
+ set I2, 1
+ set I3, 0
+ set I4, 0
invokecc
- popp
set S5, ": i 1 + ; 5 i .\n"
- pushp
+ set I0, 1
+ set I1, 0
+ set I2, 1
+ set I3, 0
+ set I4, 0
invokecc
- popp
set S5, ": i 1 + ; : j i i ; 9 j .\n"
+ set I0, 1
+ set I1, 0
+ set I2, 1
+ set I3, 0
+ set I4, 0
invokecc
end
CODE
@@ -104,7 +113,7 @@
6
11
OUTPUT
-}
+
output_is(<<'CODE', <<'OUTPUT', "PIR compiler sub");
##PIR##
.sub test @MAIN
