cvsuser 04/04/30 08:34:27
Modified: classes perlint.pmc pmc2c2.pl
ops bit.ops
Log:
some experiments with mmd
* fix method ordering WRT class_init
* bxor uses MMD dispatch now
* implement needed code fragments in PerlInt
Revision Changes Path
1.60 +18 -13 parrot/classes/perlint.pmc
Index: perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -w -r1.59 -r1.60
--- perlint.pmc 28 Feb 2004 13:57:56 -0000 1.59
+++ perlint.pmc 30 Apr 2004 15:34:24 -0000 1.60
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlint.pmc,v 1.59 2004/02/28 13:57:56 leo Exp $
+$Id: perlint.pmc,v 1.60 2004/04/30 15:34:24 leo Exp $
=head1 NAME
@@ -24,6 +24,11 @@
pmclass PerlInt extends perlscalar {
+ void class_init() {
+ mmd_register(interp, MMD_BXOR, enum_class_PerlInt, enum_class_PerlInt,
+ (funcptr_t)Parrot_PerlInt_bitwise_xor);
+ }
+
/*
=item C<void init()>
1.13 +29 -13 parrot/classes/pmc2c2.pl
Index: pmc2c2.pl
===================================================================
RCS file: /cvs/public/parrot/classes/pmc2c2.pl,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- pmc2c2.pl 30 Apr 2004 08:43:46 -0000 1.12
+++ pmc2c2.pl 30 Apr 2004 15:34:24 -0000 1.13
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: pmc2c2.pl,v 1.12 2004/04/30 08:43:46 leo Exp $
+# $Id: pmc2c2.pl,v 1.13 2004/04/30 15:34:24 leo Exp $
=head1 NAME
@@ -335,7 +335,7 @@
my ($classblock, $post, $lines) = extract_balanced($_);
$classblock = substr($classblock, 1,-1); # trim out the { }
- my (@methods, %meth_hash);
+ my (@methods, %meth_hash, $class_init);
while ($classblock =~ s/($signature_re)//) {
$lineno += count_newlines($1);
@@ -343,6 +343,16 @@
my ($methodblock, $rema, $lines) = extract_balanced($classblock);
$lineno += $lines;
$methodblock = "" if $opt{nobody};
+ if ($methodname eq 'class_init') {
+ $class_init =
+ { 'meth' => $methodname,
+ 'body' => $methodblock,
+ 'line' => $lineno,
+ 'type' => $type,
+ 'parameters' => $parameters
+ };
+ }
+ else {
# name => method idx mapping
$meth_hash{$methodname} = scalar @methods;
push @methods,
@@ -352,9 +362,15 @@
'type' => $type,
'parameters' => $parameters
};
+ }
$classblock = $rema;
$lineno += count_newlines($methodblock);
}
+ if ($class_init) {
+ $meth_hash{'class_init'} = scalar @methods;
+ push @methods, $class_init;
+ }
+
return ( $classname, {
'pre' => $pre,
1.9 +4 -2 parrot/ops/bit.ops
Index: bit.ops
===================================================================
RCS file: /cvs/public/parrot/ops/bit.ops,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- bit.ops 23 Mar 2004 07:55:40 -0000 1.8
+++ bit.ops 30 Apr 2004 15:34:27 -0000 1.9
@@ -404,7 +404,8 @@
}
inline op bxor(in PMC, in PMC) :base_core {
- $1->vtable->bitwise_xor(interpreter, $1, $2, $1);
+ mmd_dispatch_pmc(interpreter, $1, $2, $1, MMD_BXOR);
+ /* $1->vtable->bitwise_xor(interpreter, $1, $2, $1); */
goto NEXT();
}
@@ -419,7 +420,8 @@
}
inline op bxor(in PMC, in PMC, in PMC) :base_core {
- $2->vtable->bitwise_xor(interpreter, $2, $3, $1);
+ mmd_dispatch_pmc(interpreter, $2, $3, $1, MMD_BXOR);
+ /* $2->vtable->bitwise_xor(interpreter, $2, $3, $1); */
goto NEXT();
}
