cvsuser 03/06/08 11:15:41
Modified: languages/BASIC/compiler COMP_parsefuncs.pm
RT_platform_ANSIscreen.pasm testsuite.pl
Log:
Subs and Call are now active
Revision Changes Path
1.14 +19 -30 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.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- COMP_parsefuncs.pm 8 Jun 2003 17:25:25 -0000 1.13
+++ COMP_parsefuncs.pm 8 Jun 2003 18:15:41 -0000 1.14
@@ -1139,28 +1139,28 @@
die "Subroutine $syms[CURR] not found at line $sourceline\n"
}
my $sub=$syms[CURR];
- my @e=EXPRESSION({ ignorecomma => 1});
- @e=grep !/bsr/, @e;
- print CODE<<CALLSUB;
-
- bsr EXPRINIT
- push P9, "$sub"
- push P9, "FUNC"
[EMAIL PROTECTED] push P9, "ARG"
- push P9, "ARG"
- bsr EVALEXPR
-
+ barf();
+# print STDERR "Processing call $sub\n";
+ ($result, $type, @code)=EXPRESSION({ignorecomma => 1});
+# print STDERR "Got back @code\n";
+ push @{$code{$seg}->{code}},<<CALLSUB;
[EMAIL PROTECTED]
CALLSUB
}
sub parse_sub {
# Deja-vu from functions.
- feedme();
- open(CODESAVE, ">&CODE") || die "Cannot save CODE: $!";
- open(CODE, ">&FUNC") || die "Cannot connect CODE to FUNC: $!";
- $subname=$syms[CURR];
- #print "Sub $subname $syms[CURR] CURR\n";
- $subs{$subname}=1;
- CALL_BODY($subname, "SUB")
+ feedme;
+ my $f;
+ $funcname=$syms[CURR];
+ my $englishname=english_func($funcname);
+ $subs{$funcname}=$englishname;
+ $functions{$funcname}=$englishname;
+
+ $f="_USERFUNC_$funcname";
+ $f=changename($f);
+ $f=~s/\$/_string/g; $f=~tr/a-z/A-Z/;
+ $seg=$f;
+ CALL_BODY($englishname, "SUB");
}
sub parse_function {
@@ -1260,18 +1260,7 @@
return;
}
sub parse_endsub {
- feedme;
- print CODE<<POSTSCRIPT;
-SUB_EXIT_$subname:
- #
- # Teardown code for $subname
- #
- bsr ENDFRAME
- set I1, 0
- branch SUB_DISPATCH_END
-POSTSCRIPT
- open(CODE, ">&CODESAVE") || die "Can't re-open code FH: $!";
- $subname="";
+ goto &parse_endfunc;
}
sub parse_function_dispatch {
1.6 +1 -1 parrot/languages/BASIC/compiler/RT_platform_ANSIscreen.pasm
Index: RT_platform_ANSIscreen.pasm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/RT_platform_ANSIscreen.pasm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- RT_platform_ANSIscreen.pasm 8 Jun 2003 17:38:16 -0000 1.5
+++ RT_platform_ANSIscreen.pasm 8 Jun 2003 18:15:41 -0000 1.6
@@ -102,7 +102,7 @@
# Background
ANSI_BG:find_global $P0, "ANSI_bgcolors"
- set $I3, P0[back]
+ set $I3, $P0[back]
print "4"
print $I3
print "m"
1.8 +17 -1 parrot/languages/BASIC/compiler/testsuite.pl
Index: testsuite.pl
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/testsuite.pl,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- testsuite.pl 8 Jun 2003 14:30:24 -0000 1.7
+++ testsuite.pl 8 Jun 2003 18:15:41 -0000 1.8
@@ -9,7 +9,7 @@
local $/="";
$_=<DATA>;
}
- if (/end sub/ or /type / or /select/) { # /function/
+ if (/type / or /select/) { # /function/
print "Skipped\n";
next;
}
@@ -32,6 +32,22 @@
}
__DATA__
+' Simple subs, Made it here
+sub mysub()
+ print "Made it here"
+end sub
+call mysub()
+
+' Arguments. Expect 2 and 4
+sub twice(a)
+ print a
+ a=a*2
+end sub
+t=2
+call twice t
+print t
+
+STOPPLEASE
' Passing arrays, twice, expect 12
function aftwo(y())
print y(4)
