Another [PATCH]: allow deactivating computed goto
On Tue, Apr 23, 2002 at 08:54:56PM -0700, Steve Fink wrote:
(And that 3 should really be 4; the computed goto should just be
another option IMHO.)
Maybe not so humble: here's a patch to disable the default computed
goto core, so you can compare all four cores (assuming the previous
patch is applied.)
One weirdness I encountered:
#define setopt(flag) Parrot_setflag(interpreter, flag, (*argv)[0]+2);
What the heck does this do? Parrot_setflag uses its 3rd argument only
as a boolean value. Where this is used, argv[0] always contains the
current command-line argument. So this is equivalent to
argv[0][0]+2
or in the example of -p, that would be the character '-' + 2. Now,
to make that do something, you'd need the first character of the
option to be -2, and that's some weird hi-bit character. Huh?
Index: include/parrot/interpreter.h
===
RCS file: /home/perlcvs/parrot/include/parrot/interpreter.h,v
retrieving revision 1.40
diff -u -r1.40 interpreter.h
--- include/parrot/interpreter.h3 Apr 2002 04:01:41 - 1.40
+++ include/parrot/interpreter.h24 Apr 2002 03:58:02 -
-23,7 +23,8
PARROT_BOUNDS_FLAG = 0x04, /* We're tracking byte code bounds */
PARROT_PROFILE_FLAG = 0x08, /* We're gathering profile information */
PARROT_PREDEREF_FLAG = 0x10, /* We're using the prederef runops */
-PARROT_JIT_FLAG = 0x20 /* We're using the jit runops */
+PARROT_JIT_FLAG = 0x20, /* We're using the jit runops */
+PARROT_CGOTO_FLAG= 0x40 /* We're using the computed goto runops */
} Interp_flags;
#define Interp_flags_SET(interp, flag) (/*@i1*/ (interp)-flags |= (flag))
Index: include/parrot/runops_cores.h
===
RCS file: /home/perlcvs/parrot/include/parrot/runops_cores.h,v
retrieving revision 1.4
diff -u -r1.4 runops_cores.h
--- include/parrot/runops_cores.h 4 Mar 2002 03:17:21 - 1.4
+++ include/parrot/runops_cores.h 24 Apr 2002 03:58:03 -
-20,6 +20,8
opcode_t *runops_fast_core(struct Parrot_Interp *, opcode_t *);
+opcode_t *runops_cgoto_core(struct Parrot_Interp *, opcode_t *);
+
opcode_t *runops_slow_core(struct Parrot_Interp *, opcode_t *);
#endif
Index: interpreter.c
===
RCS file: /home/perlcvs/parrot/interpreter.c,v
retrieving revision 1.84
diff -u -r1.84 interpreter.c
--- interpreter.c 15 Apr 2002 18:05:18 - 1.84
+++ interpreter.c 24 Apr 2002 03:58:04 -
-420,7 +425,12
which |= (Interp_flags_TEST(interpreter, PARROT_PROFILE_FLAG)) ? 0x02 : 0x00;
which |= (Interp_flags_TEST(interpreter, PARROT_TRACE_FLAG)) ? 0x04 : 0x00;
-core = which ? runops_slow_core : runops_fast_core;
+if (which)
+core = runops_slow_core;
+else if (Interp_flags_TEST(interpreter, PARROT_CGOTO_FLAG))
+core = runops_cgoto_core;
+else
+core = runops_fast_core;
if (Interp_flags_TEST(interpreter, PARROT_PROFILE_FLAG)) {
unsigned int i;
Index: runops_cores.c
===
RCS file: /home/perlcvs/parrot/runops_cores.c,v
retrieving revision 1.17
diff -u -r1.17 runops_cores.c
--- runops_cores.c 17 Apr 2002 03:50:25 - 1.17
+++ runops_cores.c 24 Apr 2002 03:58:04 -
-30,12 +30,29
opcode_t *
runops_fast_core(struct Parrot_Interp *interpreter, opcode_t *pc)
{
-#ifdef HAVE_COMPUTED_GOTO
-pc = cg_core(pc, interpreter);
-#else
while (pc) {
DO_OP(pc, interpreter);
}
+return pc;
+}
+
+/*=for api interpreter runops_cgoto_core
+ * run parrot operations until the program is complete, using the computed
+ * goto core (if available).
+ *
+ * No bounds checking.
+ * No profiling.
+ * No tracing.
+ */
+
+opcode_t *
+runops_cgoto_core(struct Parrot_Interp *interpreter, opcode_t *pc)
+{
+#ifdef HAVE_COMPUTED_GOTO
+pc = cg_core(pc, interpreter);
+#else
+fprintf(stderr, Computed goto unavailable in this configuration.\n);
+exit(1);
#endif
return pc;
}
Index: test_main.c
===
RCS file: /home/perlcvs/parrot/test_main.c,v
retrieving revision 1.50
diff -u -r1.50 test_main.c
--- test_main.c 26 Mar 2002 16:33:01 - 1.50
+++ test_main.c 24 Apr 2002 04:01:25 -
-14,6 +14,7
#include stdlib.h
#define setopt(flag) Parrot_setflag(interpreter, flag, (*argv)[0]+2);
+#define unsetopt(flag) Parrot_setflag(interpreter, flag, 0)
char *parseflags(Parrot interpreter, int *argc, char **argv[]);
-62,6 +63,10
(*argc)--;
(*argv)++;
+#ifdef HAVE_COMPUTED_GOTO
+setopt(PARROT_CGOTO_FLAG);
+#endif
+
while ((*argc) (*argv)[0][0] == '-') {
switch ((*argv)[0][1]) {
case 'b':
-76,6 +81,9
case 'P':
another patch to configure (so make test works)
9:00 pm EST update would not pass make test for lack of core.pm being in existance. Following patch hacks it in in the manner of vtable.h. Sigh --- parrot/Configure.pl Sun Oct 14 21:02:50 2001 +++ parrot-moby-10-14/Configure.pl Sun Oct 14 21:17:02 2001 @@ -190,6 +190,8 @@ # Temporary hack system(make include/parrot/vtable.h); +system(make Parrot/OpLib/core.pm ); + # and now we figure out how big our things are print END; Michael -- Michael Fischer 7.5 million years to run [EMAIL PROTECTED]printf %d, 0x2a; -- deep thought
Re: another patch to configure (so make test works)
On Sun, Oct 14, 2001 at 09:19:09PM -0400, Michael Fischer wrote:
9:00 pm EST update would not pass make test for lack
of core.pm being in existance. Following patch hacks
it in in the manner of vtable.h. Sigh
This is Yet Another Configure Patch. This substitutes a slightly less evil
hack for vtable.h not existing during configure (we don't need anything in
there, so it isn't included when the preprocessor symbol CONFIGURE_PL is
defined.
It also cleans up some other stuff, including making vtable.h a dependency
of test. In fact, you should just be able to do 'perl Configure.pl; make
test'.
-=- James Mastros
? languages/jako/a.out
? languages/jako/benchmarks
? languages/jako/mops.c
? t/op/number20.out
? t/op/number20.pasm
Index: Configure.pl
===
RCS file: /home/perlcvs/parrot/Configure.pl,v
retrieving revision 1.28
diff -u -r1.28 Configure.pl
--- Configure.pl2001/10/14 10:00:23 1.28
+++ Configure.pl2001/10/15 03:20:53
@@ -188,9 +188,6 @@
# and the types file
buildfile(Types_pm, Parrot);
-# Temporary hack
-system(make include/parrot/vtable.h);
-
# and now we figure out how big our things are
print END;
@@ -325,7 +322,7 @@
my $name;
$name = shift;
$name = test unless $name;
-system($c{cc} $c{ccflags} -o test_siz$c{exe} $name.c) and die C compiler
died!;
+system($c{cc} -DCONFIGURE_PL $c{ccflags} -o test_siz$c{exe} $name.c) and die C
+compiler died!;
}
sub runtestc {
Index: Makefile.in
===
RCS file: /home/perlcvs/parrot/Makefile.in,v
retrieving revision 1.24
diff -u -r1.24 Makefile.in
--- Makefile.in 2001/10/14 10:58:19 1.24
+++ Makefile.in 2001/10/15 03:20:53
@@ -22,7 +22,7 @@
.c$(O):
$(CC) $(CFLAGS) -o $@ -c $
-all : $(TEST_PROG) $(PDUMP) t/test1${exe}
+all: $(TEST_PROG) $(PDUMP) t/test1${exe} $(INC)/vtable.h Parrot/OpLib/core.pm
#XXX This target is not portable to Win32
@@ -99,14 +99,16 @@
cd docs; make
clean:
- $(RM_F) *$(O) *.s core_ops.c $(TEST_PROG) $(PDISASM) $(PDUMP)
- $(RM_F) $(INC)/vtable.h
- $(RM_F) $(INC)/oplib/core_ops.h
- $(RM_F) $(TEST_PROG) $(PDISASM) $(PDUMP)
+ $(RM_F) *$(O) *.s $(TEST_PROG) $(PDISASM) $(PDUMP)
+ $(RM_F) $(INC)/vtable.h $(INC)/oplib/core_ops.h
+ $(RM_F) interp_guts.c op_info.h op_info.c $(INC)/op_info.h
+ $(RM_F) $(INC)/config.h
+ $(RM_F) Parrot/OpLib/core.pm
+ $(RM_F) libparrot.so
cd t; make clean
cd docs; make clean
-test: .test_dummy
+test: test_prog Parrot/OpLib/core.pm .test_dummy
.test_dummy:
$(PERL) t/harness
Index: include/parrot/parrot.h
===
RCS file: /home/perlcvs/parrot/include/parrot/parrot.h,v
retrieving revision 1.6
diff -u -r1.6 parrot.h
--- include/parrot/parrot.h 2001/10/12 17:59:44 1.6
+++ include/parrot/parrot.h 2001/10/15 03:20:54
@@ -67,7 +67,9 @@
#include parrot/global_setup.h
#include parrot/string.h
#include parrot/transcode.h
-#include parrot/vtable.h
+#ifndef CONFIGURE_PL
+# include parrot/vtable.h
+#endif
#include parrot/interpreter.h
#include parrot/register.h
#include parrot/exceptions.h
Yet another patch: assemble.pl - better opcode guessing
This does a better job at guessing the correct opcode: the constant is
compared to a regex and determined which kind it is, instead of saying
its just some sort of constant. This fixes the guessing problems with
my (print_ic print_sc print_nc) patch.
Brian
Index: assemble.pl
===
RCS file: /home/perlcvs/parrot/assemble.pl,v
retrieving revision 1.12
diff -r1.12 assemble.pl
95,97d94
} elsif(m/^\d+$/) {
# a constant of some sort
push @arg_t,'(ic|nc|sc)';
99,100c96,109
# a label
push @arg_t,'ic';
---
# a constant of some sort
if(m/^\[(\d+)\]$/) {
# string
push @arg_t,'sc';
} elsif(m/^((-?\d+)|(0b[01]+)|(0x[0-9a-f]+))$/i) {
# integer
push @arg_t,'ic';
} elsif(m/^[a-z][\w]*$/i) {
# label
push @arg_t,'ic';
} else {
# numeric
push @arg_t,'nc';
}
109a119
print STDERR test: $test\n;
112c122
if($op=~/$test/) {
---
if($op eq $test) {
121,122c131
error(Wrong arg count--got .scalar(@args). needed
.$opcodes{$opcode}{ARGS});
---
error(Wrong arg count--got .scalar(@args). needed
.$opcodes{$opcode}{ARGS});
131,132c140
if($rtype eq I || $rtype eq N || $rtype eq P || $rtype eq
S) {
---
if($rtype eq I || $rtype eq N || $rtype eq P || $rtype eq S) {
145a154,156
} elsif($rtype eq 's') {
$args[$_]=~s/[\[\]]//g;
$pc+=$sizeof{$rtype};
220,222c231,238
return $constants{$s} if exists $constants{$s};
push @constants, $s;
return $constants{$s} = $#constants;
---
# handle \ characters in the constant
my %escape = ('a'=\a,'n'=\n,'r'=\r,'t'=\t,'\\'='\\',);
$s=~s/\\([anrt\\])/$escape{$1}/g;
if(!exists($constants{$s})) {
push(@constants,$s);
$constants{$s}=$#constants;
}
return [.$constants{$s}.];
223a240
Another Patch...
This patch (which is pretty big) does:
* Changes the opcode_table file to provide additional information about
the operands. Case shouldn't be a problem since that data never becomes
a C symbol [this is pretty much as before]
* Padding errors solved: assemble.pl and bytecode.c were padding the
constants incorrectly. It should have been 4-(size % 4), not just (size
% 4). It is now fixed in both places.
* assembler has less special cases, and should be easier to hang error
checking on
* disassembler dumps constant table and the format is a bit prettier,
including register names, etc. Test2.pbc dumps as this:
# Constants: 1 entries (32 bytes)
# ID FlagsEncoding Type Size Data
: 000b Hello World
# Code Section
: set_i_ic I2, 1
000c: set_i_ic I1, 0
0018: set_s_sc S1, [string ]
0024: eq_i_ic I1, I2, 0060, 0038
0038: length_s_i S1, I1
0044: print_s S1
004c: chopn_s_ic S1, 1
0058: branch_ic0024
0060: end
Let me know what you guys think!
Brian
[Crap, there's some wordwrapping below. Too bad you can plug emacs into
evolution :) ]
Index: assemble.pl
===
RCS file: /home/perlcvs/parrot/assemble.pl,v
retrieving revision 1.6
diff -u -r1.6 assemble.pl
--- assemble.pl 2001/09/10 21:26:08 1.6
+++ assemble.pl 2001/09/11 03:14:32
@@ -9,7 +9,16 @@
my %pack_type;
%pack_type = (i = 'l',
n = 'd',
- );
+ );
+
+my %real_type=('i'='i',
+ 'n'='n',
+ 'N'='i',
+ 'I'='i',
+ 'S'='i',
+ 's'='i',
+ 'D'='i');
+
my $sizeof_packi = length(pack($pack_type{i},1024));
open GUTS, interp_guts.h;
@@ -26,8 +35,11 @@
s/^\s+//;
next unless $_;
my ($name, $args, @types) = split /\s+/, $_;
+my @rtypes=@types;
+@types=map { $_ = $real_type{$_}} @types;
$opcodes{$name}{ARGS} = $args;
$opcodes{$name}{TYPES} = [@types];
+$opcodes{$name}{RTYPES}=[@rtypes];
}
my $pc = 0;
@@ -65,23 +77,17 @@
die wrong arg count--got . scalar @args. needed .
$opcodes{$opcode}{ARGS};
}
-$args[0] = fixup($args[0])
-if $opcode eq branch_ic and $args[0] =~ /[a-zA-Z]/;
-
-#if ($opcode eq eq_i_ic or $opcode eq lt_i_ic) {
-if ($opcode =~ /^(eq|ne|lt|le|gt|ge)_i_ic$/) {
-$args[2] = fixup($args[2]) if $args[2] =~ /[a-zA-Z]/;
-$args[3] = fixup($args[3]) if $args[3] =~ /[a-zA-Z]/;
-}
-if ($opcode eq if_i_ic) {
-$args[1] = fixup($args[1]) if $args[1] =~ /[a-zA-Z]/;
-$args[2] = fixup($args[2]) if $args[2] =~ /[a-zA-Z]/;
-}
-
print pack l, $opcodes{$opcode}{CODE};
foreach (0..$#args) {
- $args[$_] =~ s/^[INPS]?(\d+)$/$1/i;
- my $type = $pack_type{$opcodes{$opcode}{TYPES}[$_]};
+ my($rtype)=$opcodes{$opcode}{RTYPES}[$_];
+ my($type)=$opcodes{$opcode}{TYPES}[$_];
+ if($rtype eq I || $rtype eq N || $rtype eq P || $rtype eq S) {
+ # its a register argument
+ $args[$_]=~s/^[INPS](\d+)$/$1/i;
+ } elsif($rtype eq D) {
+ # a destination
+ $args[$_]=fixup($args[$_]);
+ }
print pack $type, $args[$_];
}
$pc += 1+@args;
@@ -112,7 +118,10 @@
for (@constants) {
$size += 4*$sizeof_packi;
$size += length($_);
-$size += length($_) % $sizeof_packi; # Padding
+ my($pad)=length($_) % $sizeof_packi;
+ if($pad) {
+ $size+=$sizeof_packi-$pad;
+ }
}
$size += $sizeof_packi if @constants; # That's for the number of
constants
@@ -127,6 +136,9 @@
print pack($pack_type{i},0) x 3; # Flags, encoding, type
print pack($pack_type{i},length($_)); # Strlen followed by that
many bytes.
print $_;
-print \0 x (length($_) % $sizeof_packi); # Padding;
+ my $pad=(length($_) % $sizeof_packi);
+ if($pad) {
+ print \0 x ($sizeof_packi-(length($_) % $sizeof_packi)); #
Padding;
+ }
}
}
Index: bytecode.c
===
RCS file: /home/perlcvs/parrot/bytecode.c,v
retrieving revision 1.4
diff -u -r1.4 bytecode.c
--- bytecode.c 2001/09/10 21:47:26 1.4
+++ bytecode.c 2001/09/11 03:14:33
@@ -79,6 +79,7 @@
IV encoding = GRAB_IV(program_code);
IV type = GRAB_IV(program_code);
IV buflen = GRAB_IV(program_code);
+ int pad;
len -= 4 * sizeof(IV);
@@ -87,9 +88,11 @@
len -= buflen;
/* Padding */
-if (buflen % sizeof(IV)) {
-len -= buflen % sizeof(IV);
-(char*)*program_code += buflen % sizeof(IV);
+ pad=buflen % sizeof(IV);
+ if(pad) {
+ pad=sizeof(IV)-pad;
+ len -= pad;
+ (char*)*program_code += pad;
}
num--;
if (len 0 ||
