cvsuser 05/01/13 01:16:34
Modified: . MANIFEST
languages/bf README bfc.imc
classes resizableintegerarray.pmc
Added: languages/bf bench.bf
Log:
fix and speedup the bf compiler
* add bf benchmark (from clifford's bfcpu project)
* zero ResziableIntegerArray memory
Revision Changes Path
1.820 +1 -0 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.819
retrieving revision 1.820
diff -u -r1.819 -r1.820
--- MANIFEST 10 Jan 2005 19:58:10 -0000 1.819
+++ MANIFEST 13 Jan 2005 09:16:29 -0000 1.820
@@ -2018,6 +2018,7 @@
languages/befunge/stack.pasm [befunge]
languages/befunge/test.bef [befunge]
languages/bf/README [bf]
+languages/bf/bench.bf [bf]
languages/bf/bf.pasm [bf]
languages/bf/bfc.imc [bf]
languages/bf/countdown.bf [bf]
1.3 +7 -0 parrot/languages/bf/README
Index: README
===================================================================
RCS file: /cvs/public/parrot/languages/bf/README,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- README 10 Nov 2003 11:12:16 -0000 1.2
+++ README 13 Jan 2005 09:16:32 -0000 1.3
@@ -16,6 +16,10 @@
$ ../../parrot bf.pasm helloworld.bf
+There is also a compiler:
+
+ $ ../../parrot bfc.imc helloworld.bf
+
Clifford Wolf <clifford (at) clifford.at> contributed a nice bf
program:
@@ -24,6 +28,9 @@
$ cc -o cw cw.c
$ ./cw
+If you want to run it faster, use the bf compiler:
+
+ $ ../../parrot -j bfc.imc cw.bf < cw.txt > cw.c
AUTHOR
1.6 +99 -33 parrot/languages/bf/bfc.imc
Index: bfc.imc
===================================================================
RCS file: /cvs/public/parrot/languages/bf/bfc.imc,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- bfc.imc 9 Nov 2003 10:15:34 -0000 1.5
+++ bfc.imc 13 Jan 2005 09:16:32 -0000 1.6
@@ -1,10 +1,11 @@
-# $Id: bfc.imc,v 1.5 2003/11/09 10:15:34 leo Exp $
+# $Id: bfc.imc,v 1.6 2005/01/13 09:16:32 leo Exp $
# A Brainfuck compiler
# By Leon Brocard <[EMAIL PROTECTED]>
#
# See http://www.catseye.mb.ca/esoteric/bf/
# for more information on this silly language
.sub _main
+ .param pmc argv
.local int pc
.local int maxpc
.local int label
@@ -16,12 +17,12 @@
.local string program
.local string char
- program = P5[0]
+ program = argv[0]
# check argc
- I0 = P5
- if I0 < 2 goto usage
+ $I0 = argv
+ if $I0 < 2 goto usage
# Get the filename
- filename = P5[1]
+ filename = argv[1]
if filename goto SOURCE
usage:
print "usage: ../../parrot "
@@ -31,24 +32,29 @@
# Read the file into S1
SOURCE:
- open P1, filename, "<"
- defined I0, P1
- if I0, SOURCE_LOOP
+ open $P1, filename, "<"
+ defined $I0, $P1
+ if $I0, SOURCE_LOOP
print filename
print " not found\n"
branch usage
SOURCE_LOOP:
- read line, P1, 1024
+ read line, $P1, 1024
file = file . line
if line goto SOURCE_LOOP
- close P1
+ close $P1
length maxpc, file
# Initialise
code = "set I0, 0 # pc\n"
- concat code, "new P0, .PerlArray # memory\n"
- concat code, "set I1, 0 # pointer\n"
+ # concat code, "trace 1\n"
+ concat code, "new P0, .ResizableIntegerArray # memory\n"
+ # this array doesn't support negative indices properly
+ # start with some offset
+ concat code, "set I1, 256 # pointer\n"
+ concat code, "getstdout P30\n"
+ concat code, "pop S0, P30\n # unbuffer\n"
concat code, "getstdin P30\n"
pc = 0 # pc
@@ -65,46 +71,106 @@
concat code, "\n"
if char != "+" goto NOTPLUS
+ .local int n_plus
+ null n_plus
+ $I0 = pc + 1
+plus_loop:
+ inc n_plus
+ if $I0 == maxpc goto emit_plus
+ substr_r char, file, $I0, 1
+ if char != "+" goto emit_plus
+ inc $I0
+ goto plus_loop
+emit_plus:
+ pc = $I0 - 1
concat code, "set I2, P0[I1]\n"
- concat code, "inc I2\n"
+ concat code, "add I2, "
+ $S0 = n_plus
+ concat code, $S0
+ concat code, "\n"
concat code, "band I2, 0xff\n"
concat code, "set P0[I1], I2\n"
goto NEXT
NOTPLUS:
if char != "-" goto NOTMINUS
+ .local int n_minus
+ null n_minus
+ $I0 = pc + 1
+minus_loop:
+ inc n_minus
+ if $I0 == maxpc goto emit_minus
+ substr_r char, file, $I0, 1
+ if char != "-" goto emit_minus
+ inc $I0
+ goto minus_loop
+emit_minus:
+ pc = $I0 - 1
concat code, "set I2, P0[I1]\n"
- concat code, "dec I2\n"
+ concat code, "sub I2, "
+ $S0 = n_minus
+ concat code, $S0
+ concat code, "\n"
concat code, "band I2, 0xff\n"
concat code, "set P0[I1], I2\n"
goto NEXT
NOTMINUS:
if char != ">" goto NOTGT
- concat code, "inc I1\n"
+ .local int n_gt
+ null n_gt
+ $I0 = pc + 1
+gt_loop:
+ inc n_gt
+ if $I0 == maxpc goto emit_gt
+ substr_r char, file, $I0, 1
+ if char != ">" goto emit_gt
+ inc $I0
+ goto gt_loop
+emit_gt:
+ pc = $I0 - 1
+ concat code, "add I1, "
+ $S0 = n_gt
+ concat code, $S0
+ concat code, "\n"
goto NEXT
NOTGT:
if char != "<" goto NOTLT
- concat code, "dec I1\n"
+ .local int n_lt
+ null n_lt
+ $I0 = pc + 1
+lt_loop:
+ inc n_lt
+ if $I0 == maxpc goto emit_lt
+ substr_r char, file, $I0, 1
+ if char != "<" goto emit_lt
+ inc $I0
+ goto lt_loop
+emit_lt:
+ pc = $I0 - 1
+ concat code, "sub I1, "
+ $S0 = n_lt
+ concat code, $S0
+ concat code, "\n"
goto NEXT
NOTLT:
if char != "[" goto NOTOPEN
- I2 = 0 # "depth"
+ .local int depth
label = pc
OPEN_LOOP:
inc label
- substr S2, file, label, 1
- if S2 != "[" goto OPEN_NOTOPEN
- inc I2
+ substr $S2, file, label, 1
+ if $S2 != "[" goto OPEN_NOTOPEN
+ inc depth
goto OPEN_LOOP
OPEN_NOTOPEN:
- if S2 != "]" goto OPEN_LOOP
- if I2 == 0 goto OPEN_NEXT
- dec I2
+ if $S2 != "]" goto OPEN_LOOP
+ if depth == 0 goto OPEN_NEXT
+ dec depth
goto OPEN_LOOP
OPEN_NEXT:
inc label
@@ -120,18 +186,18 @@
if char != "]" goto NOTCLOSE
label = pc
- I2 = 0 # "height"
+ depth = 0 # "height"
CLOSE_LOOP:
dec label
- substr S2, file, label, 1
- if S2 != "]" goto CLOSE_NOTCLOSE
- inc I2
+ substr $S2, file, label, 1
+ if $S2 != "]" goto CLOSE_NOTCLOSE
+ inc depth
goto CLOSE_LOOP
CLOSE_NOTCLOSE:
- if S2 != "[" goto CLOSE_LOOP
- if I2 == 0 goto CLOSE_NEXT
- dec I2
+ if $S2 != "[" goto CLOSE_LOOP
+ if depth == 0 goto CLOSE_NEXT
+ dec depth
goto CLOSE_LOOP
CLOSE_NEXT:
@@ -176,12 +242,12 @@
if pc < maxpc goto INTERP
concat code, "end\n"
-# print code
-# print "\n"
+ # printerr code
+ # printerr "\n"
# Now actually run it
compreg P1, "PASM"
compile P0, P1, code
- # invoke
+ invoke
end
.end
1.1 parrot/languages/bf/bench.bf
Index: bench.bf
===================================================================
*LL*LH*FF*01
>++[<+++++++++++++>-]<[[>+>+<<-]>[<+>-]++++++++
[>++++++++<-]>.[-]<<>++++++++++[>++++++++++[>++
++++++++[>++++++++++[>++++++++++[>++++++++++[>+
+++++++++[-]<-]<-]<-]<-]<-]<-]<-]++++++++++.
*00
1.6 +14 -12 parrot/classes/resizableintegerarray.pmc
Index: resizableintegerarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/resizableintegerarray.pmc,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- resizableintegerarray.pmc 3 Jan 2005 18:44:11 -0000 1.5
+++ resizableintegerarray.pmc 13 Jan 2005 09:16:34 -0000 1.6
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: resizableintegerarray.pmc,v 1.5 2005/01/03 18:44:11 scog Exp $
+$Id: resizableintegerarray.pmc,v 1.6 2005/01/13 09:16:34 leo Exp $
=head1 NAME
@@ -28,7 +28,7 @@
#define NEEDED_SIZE(n) ((n-1)*sizeof(INTVAL) + sizeof(SizeIntData))
pmclass ResizableIntegerArray extends FixedIntegerArray need_ext does array {
-
+
/*
=item C<INTVAL get_integer_keyed_int(INTVAL key)>
@@ -41,12 +41,12 @@
INTVAL get_integer_keyed_int (INTVAL key) {
SizeIntData *sd;
- if (key < 0)
- internal_exception(OUT_OF_BOUNDS,
+ if (key < 0)
+ internal_exception(OUT_OF_BOUNDS,
"ResizableIntegerArray: index out of bounds!");
if(key >= PMC_int_val(SELF))
DYNSELF.set_integer_native(key+1);
-
+
sd = (SizeIntData *)PMC_data(SELF);
return sd->data[key];
}
@@ -63,8 +63,8 @@
void set_integer_keyed_int (INTVAL key, INTVAL value) {
SizeIntData *sd;
- if (key < 0)
- internal_exception(OUT_OF_BOUNDS,
+ if (key < 0)
+ internal_exception(OUT_OF_BOUNDS,
"ResizableIntegerArray: index out of bounds!");
if(key >= PMC_int_val(SELF))
DYNSELF.set_integer_native(key+1);
@@ -86,17 +86,19 @@
void set_integer_native (INTVAL size) {
SizeIntData *sd;
if (size < 0)
- internal_exception(OUT_OF_BOUNDS,
+ internal_exception(OUT_OF_BOUNDS,
"ResizableIntegerArray: Can't resize!");
sd = PMC_data(SELF);
PMC_int_val(SELF) = size;
if(sd == NULL) {
- sd = mem_sys_allocate(NEEDED_SIZE(size));
+ sd = mem_sys_allocate_zeroed(NEEDED_SIZE(size));
sd->size = size;
} else if(size >= sd->size) {
+ INTVAL old = sd->size;
sd->size = size < 2*sd->size ? sd->size*2 : size;
sd = mem_sys_realloc(sd, NEEDED_SIZE(sd->size));
+ memset(sd->data + old, 0, (sd->size - old) * sizeof(INTVAL));
} else {
return;
}
@@ -140,7 +142,7 @@
sd = (SizeIntData *)PMC_data(SELF);
if (sd == NULL || size == 0) {
- internal_exception(OUT_OF_BOUNDS,
+ internal_exception(OUT_OF_BOUNDS,
"ResizableIntegerArray: Can't pop from an empty array!");
}
@@ -163,12 +165,12 @@
PMC* clone () {
SizeIntData *sd;
PMC * dest = pmc_new(INTERP, SELF->vtable->base_type);
-
+
if (!PMC_data(SELF))
return dest;
PMC_int_val(dest) = PMC_int_val(SELF);
sd = PMC_data(SELF);
-
+
PMC_data(dest) = mem_sys_allocate(NEEDED_SIZE(sd->size));
mem_sys_memcopy(PMC_data(dest), PMC_data(SELF),
NEEDED_SIZE(sd->size));
PObj_active_destroy_SET(dest);
