cvsuser 03/06/08 07:30:24
Modified: languages/BASIC/compiler COMP_expressions.pm
COMP_parsefuncs.pm RT_debugger.pasm compile.pl
testsuite.pl
Log:
Array passing works, at least implied array passing does.
Revision Changes Path
1.9 +10 -1 parrot/languages/BASIC/compiler/COMP_expressions.pm
Index: COMP_expressions.pm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/COMP_expressions.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- COMP_expressions.pm 8 Jun 2003 03:46:23 -0000 1.8
+++ COMP_expressions.pm 8 Jun 2003 14:30:24 -0000 1.9
@@ -82,7 +82,9 @@
return 0
}
sub isarray {
- $_ =(grep /^\Q$_[0]\E$/i, keys %arrays );
+ #print "Looking up $_[0]$seg...";
+ $_ =(grep /^\Q$_[0]$seg\E$/i, keys %arrays );
+ #print "$_\n";
return $_;
}
@@ -519,6 +521,9 @@
push @code, qq{\t.arg $ac\t\t\t# argc};
push @code, qq{\t.arg "$extern$seg"\t\t# array name};
push @code, "\tcall _ARRAY_LOOKUP_$optype";
+ if ($ac == 0) {
+ $optype="P";
+ }
push @code, "\t.result \$$optype$retcount";
push @work, [ "result of $extern()", "RESULT",
"\$$optype$retcount"];
} elsif (isbuiltin($sym)) {
@@ -534,7 +539,11 @@
push @code, "\t.result \$$optype$retcount";
push @work, [ "result of $extern()", "RESULT",
"\$$optype$retcount"];
$retcount++;
+ # External functions return their arguments,
+ # except for PMC types. Figure if you want to locally
+ # modify those, go ahead. This simulates
pass-by-reference.
foreach my $arg (@args) {
+ next if $arg->[0] =~ /^\$P\d+$/;
if ($arg->[2] eq "BARE") {
push @code, "\t.result $arg->[0]";
} else {
1.12 +26 -9 parrot/languages/BASIC/compiler/COMP_parsefuncs.pm
Index: COMP_parsefuncs.pm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/COMP_parsefuncs.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- COMP_parsefuncs.pm 8 Jun 2003 03:46:23 -0000 1.11
+++ COMP_parsefuncs.pm 8 Jun 2003 14:30:24 -0000 1.12
@@ -1059,7 +1059,8 @@
$type=$th{$sigilmap{$_}};
}
}
- $arrays{$var}=1;
+ $arrays{"${var}${seg}"}=1;
+ #print STDERR "Marking ${var}${seg}\n";
push @{$code{$seg}->{code}}, <<DIMARR;
# Set aside storage for Array $var
\$P0 = new PerlHash
@@ -1213,7 +1214,7 @@
while($syms[CURR] ne ")") {
feedme();
}
- push(@params, $a);
+ push(@params, "()$a");
} else {
push(@params, $a); # Always here?
}
@@ -1232,8 +1233,10 @@
end
${englishname}_ARGOK:
EOH
+ $main::code{$main::seg}->{declarations}->{$englishname}=1;
foreach (@params) {
+ unless (/\(\)/) {
my $t=typeof($_);
$t="string" if $t eq "STRING";
$t="float" if $t eq "FLO";
@@ -1241,6 +1244,20 @@
$_=~s/\$/_string/g;
push @{$code{$seg}->{code}}, qq{\t.param $t $_\n};
push @{$code{$seg}->{args}}, $_;
+ } else {
+ s/\(\)//g;
+ $_=changename($_);
+ $_=~s/\$/_string/g;
+ #print "Marking ${_}${seg}\n";
+ $arrays{"${_}${seg}"}=1;
+ push @{$code{$seg}->{code}},<<PUSHARR;
+ .param PerlHash array_$englishname
+ find_global \$P1, "BASICARR"
+ set \$P1["${_}$seg"], array_$englishname
+ store_global "BASICARR", \$P1
+PUSHARR
+ # push @{$code{$seg}->{args}}, $_;
+ }
}
return;
}
1.5 +3 -3 parrot/languages/BASIC/compiler/RT_debugger.pasm
Index: RT_debugger.pasm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/RT_debugger.pasm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- RT_debugger.pasm 6 Jun 2003 21:25:56 -0000 1.4
+++ RT_debugger.pasm 8 Jun 2003 14:30:24 -0000 1.5
@@ -195,9 +195,9 @@
set $S0, $P0[$I1]
inc $I1
eq $S0, "", DEBUG_PRINTLOOP
-
- print "Can't do this either.\n"
-
+ set $S1, locals[$S0]
+ print $S1
+ print "\n"
branch DEBUG_PRINTLOOP
DEBUG_PRINTEND:
1.6 +3 -1 parrot/languages/BASIC/compiler/compile.pl
Index: compile.pl
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/compile.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- compile.pl 8 Jun 2003 03:46:23 -0000 1.5
+++ compile.pl 8 Jun 2003 14:30:24 -0000 1.6
@@ -65,6 +65,7 @@
}
print CODE @{$code{$seg}->{code}};
+ print CODE "\trestoreall\n\tret\n";
if ($debug) {
print CODE<<'EOD';
DEBUGGER:
@@ -91,7 +92,8 @@
ret
EOD
}
- print CODE "\trestoreall\n\tret\n.end\n";
+ print CODE ".end\n";
+
delete $code{$seg};
}
print CODE<<RUNTIMESHUTDOWN;
1.7 +25 -12 parrot/languages/BASIC/compiler/testsuite.pl
Index: testsuite.pl
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/testsuite.pl,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- testsuite.pl 8 Jun 2003 03:46:23 -0000 1.6
+++ testsuite.pl 8 Jun 2003 14:30:24 -0000 1.7
@@ -32,30 +32,43 @@
}
__DATA__
+' Passing arrays, twice, expect 12
+function aftwo(y())
+ print y(4)
+end function
+function arrfunc(x())
+ u=aftwo(x())
+ arrfunc=55
+end function
+dim g(10)
+g(5)=666
+g(4)=12
+a=g(5)+0
+y=arrfunc(g())
+
+' Passing arrays (expect 12)
+function arrfunc(x())
+ print x(4)
+ arrfunc=55
+end function
+dim g(10)
+g(4)=12
+y=arrfunc(g())
+
' Function Array scopes, expect 4, 5.6
function mine(a)
dim t(6)
+ s=32
t(3)=2
mine=a*2
print t(3)*2
end function
dim t(7)
+z=55
t(3)=5.6
a=mine(5)
print t(3)
-
-STOPPLEASE
-' Passing arrays (expect 12)
-function arrfunc(x())
- print x(4)
- arrfunc=55
-end function
-dim g(10)
-g(4)=12
-y=arrfunc(g())
-
-STOPPLEASE
' Expect 234
function inkey$(a, b)
a=3.14
