cvsuser 04/07/14 02:42:28
Modified: classes parrotobject.pmc
languages/python pie-thon.pl
src objects.c
Log:
Pie-thon 64 - pie-thon.pl bit better name handling; start w. classes
Revision Changes Path
1.31 +10 -1 parrot/classes/parrotobject.pmc
Index: parrotobject.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotobject.pmc,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -w -r1.30 -r1.31
--- parrotobject.pmc 23 Jun 2004 07:14:30 -0000 1.30
+++ parrotobject.pmc 14 Jul 2004 09:42:21 -0000 1.31
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: parrotobject.pmc,v 1.30 2004/06/23 07:14:30 leo Exp $
+$Id: parrotobject.pmc,v 1.31 2004/07/14 09:42:21 leo Exp $
=head1 NAME
@@ -66,6 +66,15 @@
"use the registered class instead");
}
+ void init_pmc() {
+ SELF.init();
+ }
+
+ void* invoke(void* next) {
+ SELF.init();
+ return next;
+ }
+
void mark() {
SLOTTYPE *attrib_array = PMC_data(SELF);
UINTVAL i;
1.42 +74 -62 parrot/languages/python/pie-thon.pl
Index: pie-thon.pl
===================================================================
RCS file: /cvs/public/parrot/languages/python/pie-thon.pl,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -w -r1.41 -r1.42
--- pie-thon.pl 13 Jul 2004 16:28:21 -0000 1.41
+++ pie-thon.pl 14 Jul 2004 09:42:25 -0000 1.42
@@ -8,7 +8,8 @@
use strict;
use Getopt::Std;
-my ($DIS, @dis, @source, $file, %opt, $DEFVAR, $cur_func, $lambda_count);
+my ($DIS, @dis, @source, $file, %opt, $DEFVAR, $cur_func, $lambda_count,
+ %main_names);
$DIS = 'python mydis.py';
$DEFVAR = 'PerlInt';
@@ -215,12 +216,13 @@
$params
EOC
print <<EOC;
- new_pad 0
+ new_pad -1
.local pmc None
None = new .None
EOC
- $names{None} = 1;
- $globals{None} = 1;
+ %globals = ();
+ $names{None} = 'None';
+ $globals{None} = 'None';
if ($def_args{$arg}) {
my ($i, $n, $defs);
$n = $arg_count{$arg};
@@ -261,13 +263,14 @@
print <<EOC;
.sub $cur_func [EMAIL PROTECTED]
.param pmc sys::argv
+ new_pad 0
.local pmc __name__
__name__ = new $DEFVAR
__name__ = '__main__'
.local pmc None
None = new .None
EOC
- $globals{'__name__'} = 1;
+ $globals{'__name__'} = '__name__';
$code_l = 0;
for (@dis) {
next if /^\s*$/;
@@ -433,65 +436,46 @@
my ($n, $c, $cmt) = @_;
if ($make_f) {
$make_f = 0;
- print "\t\t$cmt\n";
+ print "# make_f t$cmt\n";
return;
}
my $tos = pop @stack;
- my $pmc;
- print "\t\t$cmt\n";
- unless ($names{$c}) {
- print <<"EOC";
- .local pmc $c \t# case 0
-EOC
- if ($tos->[2] eq 'P' && $tos->[1] =~ /^\$/) {
- $pmc = $tos->[1];
- }
- elsif ($builtins{$tos->[1]}) {
- $pmc = $tos->[1];
- }
- else {
- print <<"EOC";
- $c = new $DEFVAR \t# case 1
+ my $p = $tos->[1];
+ if ($names{$c}) {
+ my $pmc = $names{$c};
+ print <<EOC;
+ assign $pmc, $p $cmt
EOC
- $pmc = $c
- }
- }
- if ($tos->[2] eq 'P') {
- $pmc = $tos->[1];
+ $p = $pmc;
}
else {
- $pmc = promote($tos);
+ $p = promote($tos);
+ if ($cur_func eq 'test::main') {
+ $main_names{$c} = $p;
}
- $globals{$c} = 1;
- $names{$c} = 1;
- if ($builtins{$pmc}) {
- print <<"EOC";
- global "$c" = $pmc \t# case 2b
- $c = $pmc
-EOC
- return;
- }
- # a temp - store it - XXX or a global dunno
- if (1||$pmc =~ /^\$/) {
- print <<"EOC";
- global "$c" = $pmc \t# case 2
- $c = $pmc
-EOC
- }
- else {
- print <<"EOC";
- assign $c, $pmc \t# case 3
+ print <<EOC;
+ store_lex -1, $n, $p $cmt
EOC
}
+ $names{$c} = $p;
}
sub STORE_GLOBAL {
my ($n, $c, $cmt) = @_;
my $tos = pop @stack;
+ my $p = $tos->[1];
+ if ($globals{$c}) {
print <<EOC;
- global "$c" = $tos->[1] $cmt
+ assign $c, $p;
EOC
}
+ else {
+ print <<EOC;
+ global "$c" = $p $cmt
+EOC
+ }
+ $globals{$c} = $p;
+}
sub is_opcode {
@@ -504,10 +488,25 @@
if (is_opcode($c) || $builtins{$c}) {
return LOAD_NAME(@_);
}
- my $p = temp('P');
+ my $p;
+ if (($p = $globals{$c})) {
+ print <<EOC;
+ # $p = global "$c" $cmt
+EOC
+ }
+ elsif ($main_names{$c}) {
+ $p = temp('P');
+ print <<EOC;
+ $p = find_lex -1, $n $cmt
+EOC
+ }
+ else {
+ $p = temp('P');
+ $globals{$c} = $p;
print <<"EOC";
$p = global "$c" $cmt
EOC
+ }
push @stack, [$c, $p, 'P'];
# print_stack();
}
@@ -516,6 +515,7 @@
sub LOAD_NAME() {
my ($n, $c, $cmt) = @_;
my ($o);
+ my $p;
if (($o = is_opcode($c))) {
print <<EOC;
# builtin $c $cmt $o
@@ -523,22 +523,33 @@
push @stack, [$c, $c, $o];
return;
}
- if ($globals{$c}) {
+ # params TODO
+ if ($names{$c}) {
+ $p = $names{$c};
+ print <<"EOC";
+ # lexical $n '$c' := $p $cmt
+EOC
+ }
+ elsif ($globals{$c}) {
+ $p = $globals{$c};
print <<"EOC";
# $c = global "$c" $cmt
EOC
}
else {
- $c = type_map($c);
- $globals{$c} = 1;
my $type = 'pmc';
- $type = 'NCI' if ($builtins{$c});
+ $p = $c;
+ if ($type_map{$c}) {
+ $c = $p = $type_map{$c};
+ $type = 'NCI';
+ }
+ $globals{$c} = $c;
print <<"EOC";
.local $type $c $cmt
$c = global "$c"
EOC
}
- push @stack, [$c, $c, 'P'];
+ push @stack, [$c, $p, 'P'];
}
sub PRINT_ITEM
@@ -929,9 +940,9 @@
if ($make_f) {
$make_f = 0;
print <<EOC;
- \t$cmt
+ # make_f \t$cmt
EOC
- pop @stack;
+ # pop @stack;
return;
}
my $func;
@@ -1051,9 +1062,9 @@
}
else {
my $p = 5 + keys %params;
- $params{$c} = 1;
- $lexicals{$c} = 1;
- $names{$c} = 1;
+ $params{$c} = $c;
+ $lexicals{$c} = $c;
+ $names{$c} = $c;
print <<EOC;
# .param pmc $c $cmt
#.local pmc $c
@@ -1320,11 +1331,12 @@
sub BUILD_CLASS
{
my ($n, $c, $cmt) = @_;
+ my $parent_tuple = pop @stack;
my $tos = pop @stack;
my $cl = temp('P');
$classes{$tos->[1]} = 1;
print <<EOC;
- $cl = newclass $tos->[1] $cmt
+ $cl = subclass $parent_tuple->[1], $tos->[1] $cmt
EOC
push @stack, ["class $tos->[1]", $cl, 'P'];
}
1.102 +36 -2 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.101
retrieving revision 1.102
diff -u -w -r1.101 -r1.102
--- objects.c 10 Jul 2004 09:02:35 -0000 1.101
+++ objects.c 14 Jul 2004 09:42:28 -0000 1.102
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.101 2004/07/10 09:02:35 leo Exp $
+$Id: objects.c,v 1.102 2004/07/14 09:42:28 leo Exp $
=head1 NAME
@@ -24,6 +24,8 @@
#include "objects.str"
+static void* instantiate_py_object(Interp*, PMC*, void*);
+
static PMC *
clone_array(Parrot_Interp interpreter, PMC *source_array)
{
@@ -179,6 +181,10 @@
int i;
const char *meth;
STRING meth_str;
+ union {
+ const void * __c_ptr;
+ void * __ptr;
+ } __ptr_u;
vtable_pmc = get_attrib_num((SLOTTYPE *)PMC_data(class), PCD_OBJECT_VTABLE);
vtable = PMC_struct_val(vtable_pmc);
@@ -191,7 +197,7 @@
for (i = 0; (meth = Parrot_vtable_slot_names[i]); ++i) {
if (!*meth)
continue;
- meth_str.strstart = meth;
+ meth_str.strstart = const_cast(meth);
meth_str.strlen = strlen(meth);
meth_str.hashval = 0;
if (Parrot_find_global(interpreter, class_name, &meth_str)) {
@@ -248,6 +254,23 @@
PMC *parents, *temp_pmc;
int parent_is_class;
+ if (base_class->vtable->base_type == enum_class_FixedPMCArray) {
+ PMC *tuple = base_class;
+ /* got a tuple holding parents - Python!
+ */
+ INTVAL n = VTABLE_elements(interpreter, tuple);
+ if (!n) {
+ PMC* class = pmc_new(interpreter, enum_class_ParrotClass);
+ Parrot_new_class(interpreter, class, child_class_name);
+ return class;
+ }
+ if (n > 1)
+ internal_exception(1, "subclass: unimp multiple parents");
+ base_class = VTABLE_get_pmc_keyed_int(interpreter, tuple, 0);
+ if (0&&PMC_struct_val(base_class) == (void*)0xdeadbeef)
+ base_class = pmc_new(interpreter, base_class->vtable->base_type);
+ }
+
parent_is_class = PObj_is_class_TEST(base_class);
child_class = pmc_new(interpreter, enum_class_ParrotClass);
@@ -446,6 +469,7 @@
/* Reset the init method to our instantiation method */
new_vtable->init = Parrot_instantiate_object;
new_vtable->init_pmc = Parrot_instantiate_object_init;
+ new_vtable->invoke = instantiate_py_object;
new_class->vtable = new_vtable;
/* Put our new vtable in the global table */
@@ -626,6 +650,16 @@
instantiate_object(interpreter, object, NULL);
}
+static void*
+instantiate_py_object(Interp* interpreter, PMC* class, void* next)
+{
+ INTVAL type = class->vtable->base_type;
+ PMC *object = pmc_new_noinit(interpreter, type);
+ VTABLE_init(interpreter, object);
+ REG_PMC(5) = object;
+ return next;
+}
+
static void
instantiate_object(Parrot_Interp interpreter, PMC *object, PMC *init)
{
