cvsuser 04/09/23 01:38:08
Modified: languages/m4 ChangeLog
languages/m4/examples eval.imc
languages/m4/src builtin.imc eval.c m4.imc
languages/m4/t/basic 003_getopt.t 012_eval.t
languages/m4/t/builtins 011_eval.t
languages/m4/t harness
lib/Parrot/Test m4.pm
runtime/parrot/library/Getopt Long.imc
Log:
[perl #31659] [PATCH] Parrot m4 0.0.8
this revision of Parrot m4 has no new features.
Sorry, it isn't ready for 'autoconf' yet :;).
I fiddled a little bit with the harness script.
Mostly I played with the 'eval' command, which is actually a compiler
implemented in C.
The generated bytecode should now be more conformant to the Parrot calling
conventions.
The problems with the 'eval' tests were propable due to a missing 'end' in
the generated bytecode.
Courtesy of Bernhard Schmalhofer <[EMAIL PROTECTED]>
Revision Changes Path
1.6 +21 -1 parrot/languages/m4/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /cvs/public/parrot/languages/m4/ChangeLog,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- ChangeLog 10 Jul 2004 07:13:48 -0000 1.5
+++ ChangeLog 23 Sep 2004 08:38:01 -0000 1.6
@@ -1,4 +1,24 @@
-# $Id: ChangeLog,v 1.5 2004/07/10 07:13:48 leo Exp $
+# $Id: ChangeLog,v 1.6 2004/09/23 08:38:01 leo Exp $
+
+2004-09-20 Bernhard Schmalhofer
+ * Play again with 'm4_eval_compiler'
+
+2004-08-09 Bernhard Schmalhofer
+ * Fix failing test basic/012_eval.t
+
+2004-07-06 Bernhard Schmalhofer
+ * Make tests work again
+ * add some tests for 'eval'
+ * yank it up to revision 0.0.7
+
+2004-06-27 Andy Dougherty
+ * Build patches for Solaris, RT#30320
+
+2004-06-21 Bernhard Schmalhofer
+ * Don't write test files into '/tmp'
+
+2004-06-10 Bernhard Schmalhofer
+ * The symbolic link 'blib' isn't needed any more
2004-07-06 Bernhard Schmalhofer
* Make tests work again
1.3 +18 -10 parrot/languages/m4/examples/eval.imc
Index: eval.imc
===================================================================
RCS file: /cvs/public/parrot/languages/m4/examples/eval.imc,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- eval.imc 10 Jul 2004 07:13:55 -0000 1.2
+++ eval.imc 23 Sep 2004 08:38:02 -0000 1.3
@@ -1,4 +1,4 @@
-# $Id: eval.imc,v 1.2 2004/07/10 07:13:55 leo Exp $
+# $Id: eval.imc,v 1.3 2004/09/23 08:38:02 leo Exp $
# See examples/compiler/Makefile for how to generate the needed shared lib
@@ -17,21 +17,29 @@
# load shared lib
# There is a init-function in the shared lib,
# which registers the new compiler
+ print "Loading shared library, let the library register the compiler\n"
.local pmc m4_eval_compiler_lib
m4_eval_compiler_lib = loadlib "m4_eval_compiler"
# get compiler
- compreg P1, "m4_eval_compiler"
+ print "Getting the compiler\n"
+ .local pmc m4_eval_compiler
+ m4_eval_compiler = compreg "m4_eval_compiler"
# compile code and run it
- .local string code
- code = '1'
+ .local string expression
+ expression = '1 + 1 * 117'
+ print "Evaluating expression: "
+ print expression
+ print "\n"
.local pmc compiled_code
- compiled_code = compile P1, code
- .local pmc evaled_code
- P16 = new PerlString
- invoke compiled_code
- print P16
- print "\ninvoked compiled code\n"
+ compiled_code = compile m4_eval_compiler, expression
+
+ print "Invoking compiled code, and receive returned expression\n"
+ .local int evaluated_expression
+ ( evaluated_expression ) = compiled_code()
+ print "evaluated: "
+ print evaluated_expression
+ print "\n"
end
.end
1.6 +10 -9 parrot/languages/m4/src/builtin.imc
Index: builtin.imc
===================================================================
RCS file: /cvs/public/parrot/languages/m4/src/builtin.imc,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- builtin.imc 10 Jul 2004 07:13:58 -0000 1.5
+++ builtin.imc 23 Sep 2004 08:38:03 -0000 1.6
@@ -5,7 +5,7 @@
=head2 DESCRIPTION
Copyright: 2004 Bernhard Schmalhofer. All Rights Reserved.
-CVS Info: $Id: builtin.imc,v 1.5 2004/07/10 07:13:58 leo Exp $
+CVS Info: $Id: builtin.imc,v 1.6 2004/09/23 08:38:03 leo Exp $
History: Ported from GNU m4 1.4
References: http://www.gnu.org/software/m4/m4.html
@@ -497,7 +497,7 @@
=head2 _m4_eval
-Frontend for printf like formatting.
+Integer arithmetics.
=cut
@@ -506,17 +506,18 @@
.param PerlArray arguments
# get compiler
- compreg P1, "m4_eval_compiler"
+ .local pmc m4_eval_compiler
+ m4_eval_compiler = compreg "m4_eval_compiler"
# compile code and run it
- .local string code
- code = arguments[0]
+ .local string expression
+ expression = arguments[0]
.local pmc compiled_code
- compiled_code = compile P1, code
- P16 = new PerlString
- invoke compiled_code
+ compiled_code = compile m4_eval_compiler, expression
+ .local int evaluated_expression
+ ( evaluated_expression ) = compiled_code()
.local string ret
- ret = P16
+ ret = evaluated_expression
.pcc_begin_return
.return ret
.pcc_end_return
1.4 +36 -12 parrot/languages/m4/src/eval.c
Index: eval.c
===================================================================
RCS file: /cvs/public/parrot/languages/m4/src/eval.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- eval.c 10 Jul 2004 07:13:58 -0000 1.3
+++ eval.c 23 Sep 2004 08:38:03 -0000 1.4
@@ -1,4 +1,4 @@
-/* $Id: eval.c,v 1.3 2004/07/10 07:13:58 leo Exp $ */
+/* $Id: eval.c,v 1.4 2004/09/23 08:38:03 leo Exp $ */
/* GNU m4 -- A simple macro processor
Copyright (C) 1989, 90, 91, 92, 93, 94 Free Software Foundation, Inc.
@@ -32,7 +32,8 @@
/* This file contains the functions to evaluate integer expressions for
the "eval" macro. It is a little, fairly self-contained module, with
its own scanner, and a recursive descent parser. The only entry point
- is evaluate (). */
+ is evaluate ().
+*/
/* Evaluates token types. */
@@ -66,8 +67,8 @@
eval_error;
+/* declarations */
static eval_error logical_or_term( eval_token, eval_t * );
-
static eval_error logical_and_term( eval_token, eval_t * );
static eval_error or_term( eval_token, eval_t * );
static eval_error xor_term( eval_token, eval_t * );
@@ -81,6 +82,7 @@
static eval_error exp_term( eval_token, eval_t * );
static eval_error unary_term( eval_token, eval_t * );
static eval_error simple_term( eval_token, eval_t * );
+boolean evaluate (const char *, eval_t *);
/*--------------------.
| Lexical functions. |
@@ -908,6 +910,9 @@
opcode_t* pc;
+ /*
+ * The real work is done here
+ */
evaluate( program, &value );
/*
@@ -921,18 +926,37 @@
cur_cs->base.data = mem_sys_allocate(CODE_SIZE * sizeof(opcode_t));
cur_cs->base.size = CODE_SIZE;
consts = cur_cs->consts;
+
/*
- * now start compiling
+ * Generate some bytecode
*/
pc = cur_cs->base.data;
- /* *pc++ = interpreter->op_lib->op_code("print_sc", 1); */
- /* *pc++ = add_const_str(interpreter, consts, "asdfasdf" ); */
- *pc++ = interpreter->op_lib->op_code("set_p_ic", 1);
- *pc++ = 16;
+ /* first integer return value */
+ *pc++ = interpreter->op_lib->op_code("set_i_ic", 1);
+ *pc++ = 5;
*pc++ = value;
- /* *pc++ = add_const_str(interpreter, consts, program ); */
- /* *pc++ = interpreter->op_lib->op_code("invoke_p", 1); */
- /* *pc++ = 1; */
+ /* promise to fill in the counters */
+ *pc++ = interpreter->op_lib->op_code("set_i_ic", 1);
+ *pc++ = 0;
+ *pc++ = 1;
+ /* one integer return value */
+ *pc++ = interpreter->op_lib->op_code("set_i_ic", 1);
+ *pc++ = 1;
+ *pc++ = 1;
+ /* no string return values */
+ *pc++ = interpreter->op_lib->op_code("set_i_ic", 1);
+ *pc++ = 2;
+ *pc++ = 0;
+ /* no PMC return values */
+ *pc++ = interpreter->op_lib->op_code("set_i_ic", 1);
+ *pc++ = 3;
+ *pc++ = 0;
+ /* no numeric return values */
+ *pc++ = interpreter->op_lib->op_code("set_i_ic", 1);
+ *pc++ = 3;
+ *pc++ = 0;
+ /* do something else now */
+ *pc++ = interpreter->op_lib->op_code("end", 1);
return pf;
}
1.9 +2 -2 parrot/languages/m4/src/m4.imc
Index: m4.imc
===================================================================
RCS file: /cvs/public/parrot/languages/m4/src/m4.imc,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- m4.imc 10 Jul 2004 07:13:59 -0000 1.8
+++ m4.imc 23 Sep 2004 08:38:03 -0000 1.9
@@ -5,7 +5,7 @@
=head1 DESCRIPTION
Copyright: 2004 Bernhard Schmalhofer. All Rights Reserved.
-CVS Info: $Id: m4.imc,v 1.8 2004/07/10 07:13:59 leo Exp $
+CVS Info: $Id: m4.imc,v 1.9 2004/09/23 08:38:03 leo Exp $
Overview: Main of Parrot m4.
History: Ported from GNU m4 1.4
References: http://www.gnu.org/software/m4/m4.html
@@ -87,7 +87,7 @@
# Was '--version' passed ?
is_defined = defined opt["version"]
unless is_defined goto NO_VERSION_FLAG
- print "Parrot m4 0.0.7\n"
+ print "Parrot m4 0.0.8\n"
end
NO_VERSION_FLAG:
1.7 +2 -2 parrot/languages/m4/t/basic/003_getopt.t
Index: 003_getopt.t
===================================================================
RCS file: /cvs/public/parrot/languages/m4/t/basic/003_getopt.t,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- 003_getopt.t 10 Jul 2004 07:14:02 -0000 1.6
+++ 003_getopt.t 23 Sep 2004 08:38:04 -0000 1.7
@@ -1,4 +1,4 @@
-# $Id: 003_getopt.t,v 1.6 2004/07/10 07:14:02 leo Exp $
+# $Id: 003_getopt.t,v 1.7 2004/09/23 08:38:04 leo Exp $
# pragmata
use strict;
@@ -31,7 +31,7 @@
#--------------------------------------------
$real_out = `$parrot_m4 --version 2>&1`;
is( $real_out, << 'END_OUT', '--version' );
-Parrot m4 0.0.7
+Parrot m4 0.0.8
END_OUT
1.4 +7 -4 parrot/languages/m4/t/basic/012_eval.t
Index: 012_eval.t
===================================================================
RCS file: /cvs/public/parrot/languages/m4/t/basic/012_eval.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- 012_eval.t 10 Jul 2004 07:14:02 -0000 1.3
+++ 012_eval.t 23 Sep 2004 08:38:04 -0000 1.4
@@ -1,4 +1,4 @@
-# $Id: 012_eval.t,v 1.3 2004/07/10 07:14:02 leo Exp $
+# $Id: 012_eval.t,v 1.4 2004/09/23 08:38:04 leo Exp $
use strict;
@@ -8,7 +8,10 @@
my $parrot = 'cd .. && ./parrot';
$real_out = `$parrot languages/m4/examples/eval.imc 2>&1`;
-is( $real_out, << 'END_OUT', 'single file' );
-1
-invoked compiled code
+is( $real_out, << 'END_OUT', 'single expression' );
+Loading shared library, let the library register the compiler
+Getting the compiler
+Evaluating expression: 1 + 1 * 117
+Invoking compiled code, and receive returned expression
+evaluated: 118
END_OUT
1.4 +18 -2 parrot/languages/m4/t/builtins/011_eval.t
Index: 011_eval.t
===================================================================
RCS file: /cvs/public/parrot/languages/m4/t/builtins/011_eval.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- 011_eval.t 10 Jul 2004 07:14:05 -0000 1.3
+++ 011_eval.t 23 Sep 2004 08:38:05 -0000 1.4
@@ -1,8 +1,8 @@
-# $Id: 011_eval.t,v 1.3 2004/07/10 07:14:05 leo Exp $
+# $Id: 011_eval.t,v 1.4 2004/09/23 08:38:05 leo Exp $
use strict;
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 3;
# Test the m4-Builtin function 'eval'
@@ -89,3 +89,19 @@
OUT
}
+
+{
+ language_output_is( 'm4', <<'CODE', <<'OUT', 'bitwise ops' );
+1 eval( `1 | 2') bitwise OR
+2 eval( `1 | 3') bitwise OR
+3 eval( `4 & 5') bitwise AND
+4 eval( `4 ^ 5') bitwise XOR
+5 eval( `~ 254') bitwise negation
+CODE
+1 3 bitwise OR
+2 3 bitwise OR
+3 4 bitwise AND
+4 1 bitwise XOR
+5 -255 bitwise negation
+OUT
+}
1.3 +10 -11 parrot/languages/m4/t/harness
Index: harness
===================================================================
RCS file: /cvs/public/parrot/languages/m4/t/harness,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- harness 10 Jul 2004 07:14:07 -0000 1.2
+++ harness 23 Sep 2004 08:38:06 -0000 1.3
@@ -1,12 +1,4 @@
-# $Id: harness,v 1.2 2004/07/10 07:14:07 leo Exp $
-
-# pragmata
-use strict;
-
-use Test::Harness;
-use File::Spec;
-
-my $language = 'm4';
+# $Id: harness,v 1.3 2004/09/23 08:38:06 leo Exp $
=head1 NAME
@@ -22,7 +14,6 @@
m4/t/basic/006_define_with_rest \
m4/t/regex/003_two_compiles.t
-
=head1 DESCRIPTION
Conformant to a recent post on p6i, if I'm called with a single
@@ -35,6 +26,14 @@
=cut
+# pragmata
+use strict;
+
+use Test::Harness();
+use File::Spec;
+
+my $language = 'm4';
+
if ( grep { m/^-files$/ } @ARGV )
{
# Only the Makefile in 'parrot/languages' uses -file
@@ -56,7 +55,7 @@
# Propably called out of 'parrot/languages'
@files = glob( "m4/t/*/*.t" );
}
- runtests( @files ) if scalar(@files);
+ Test::Harness::runtests( @files ) if scalar(@files);
}
=head1 HISTORY
1.4 +3 -3 parrot/lib/Parrot/Test/m4.pm
Index: m4.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Test/m4.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- m4.pm 10 Jul 2004 07:14:13 -0000 1.3
+++ m4.pm 23 Sep 2004 08:38:07 -0000 1.4
@@ -1,4 +1,4 @@
-# $Id: m4.pm,v 1.3 2004/07/10 07:14:13 leo Exp $
+# $Id: m4.pm,v 1.4 2004/09/23 08:38:07 leo Exp $
use strict;
@@ -59,7 +59,7 @@
my $exit_code = Parrot::Test::_run_command( $parrot_m4, STDOUT =>
$parrot_m4_out_f );
$exit_code = Parrot::Test::_run_command( $gnu_m4, STDOUT => $gnu_m4_out_f );
- my $pass = $self->{builder}->is_eq( Parrot::Test::slurp_file($parrot_m4_out_f) .
Parrot::Test::slurp_file($parrot_m4_out_f), , $output . $output, $desc );
+ my $pass = $self->{builder}->is_eq( Parrot::Test::slurp_file($parrot_m4_out_f) .
Parrot::Test::slurp_file($gnu_m4_out_f), , $output . $output, $desc );
$self->{builder}->diag( "'$parrot_m4' failed with exit code $exit_code" ) if
$exit_code and not $pass;
# die Data::Dumper::Dumper( $lang_f, `pwd`, $parrot_m4, $parrotdir,
$parrot_m4_out_f );
1.3 +2 -2 parrot/runtime/parrot/library/Getopt/Long.imc
Index: Long.imc
===================================================================
RCS file: /cvs/public/parrot/runtime/parrot/library/Getopt/Long.imc,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- Long.imc 10 Jul 2004 07:14:15 -0000 1.2
+++ Long.imc 23 Sep 2004 08:38:08 -0000 1.3
@@ -1,4 +1,4 @@
-# $Id: Long.imc,v 1.2 2004/07/10 07:14:15 leo Exp $
+# $Id: Long.imc,v 1.3 2004/09/23 08:38:08 leo Exp $
=head1 NAME
@@ -146,7 +146,7 @@
=head1 AUTHOR
-Bernhard Schmalhofer <Bernhard.Schmalhofer at gmx.de>
+Bernhard Schmalhofer - L<[EMAIL PROTECTED]>
=head1 SEE ALSO
