cvsuser 03/06/16 19:24:48
Modified: languages/BASIC/compiler COMP_expressions.pm COMP_parser.pm
RT_debugger.pasm RT_initialize.pasm compile.pl
Removed: languages/BASIC/compiler RT_expr.pasm RT_math.pasm
RT_userfunc.pasm RT_variables.pasm
Log:
The BASIC debugger is completely fixed. Additionally the compile command now takes
a -d argument (compile.pl -d foo.bas) to get the debugger going.
Revision Changes Path
1.12 +4 -3 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.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- COMP_expressions.pm 12 Jun 2003 02:52:59 -0000 1.11
+++ COMP_expressions.pm 17 Jun 2003 02:24:48 -0000 1.12
@@ -68,12 +68,14 @@
print "Previous: $type[2] $syms[2]\n";
}
sub isbuiltin { # Built in functions
+ return 0 unless defined $_[0];
return 1 if (grep /^\Q$_[0]\E$/i, @builtins );
return 0;
}
sub isuserfunc {
# print "Isuserfunc $_[0] and $funcname..";
- return 0 if $funcname eq $_[0]; # We're processing this, don't count!
+ return 0 unless defined $_[0];
+ return 0 if $funcname and $funcname eq $_[0]; # We're processing this, don't
count!
if (grep /^\Q$_[0]\E$/i, keys %functions ) {
# print "Yes\n";
return 1;
@@ -496,7 +498,6 @@
my(@code,@work);
my $oneop=0;
- my $result; # Result from prior operation
my $optype="N";
my $result="";
foreach my $token (@stream) {
@@ -541,7 +542,7 @@
} else {
$extern=~s/\$/_string/g; $extern=~tr/a-z/A-Z/;
push @code, qq{\t.arg $ac\t\t\t# argc};
- push @code, qq{\tcall _USERFUNC_$extern};
+ push @code, qq{\tcall _USERFUNC_${extern}_run};
push @code, "\t.result \$$optype$retcount";
push @work, [ "result of $extern()", "RESULT",
"\$$optype$retcount"];
$retcount++;
1.11 +6 -54 parrot/languages/BASIC/compiler/COMP_parser.pm
Index: COMP_parser.pm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/COMP_parser.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -w -r1.10 -r1.11
--- COMP_parser.pm 12 Jun 2003 02:52:59 -0000 1.10
+++ COMP_parser.pm 17 Jun 2003 02:24:48 -0000 1.11
@@ -1,7 +1,7 @@
#!/usr/bin/perl -w
use strict;
-use constant VERSION => 2.0;
+use constant VERSION => 2.2;
use constant PREV => 2;
use constant CURR => 1;
@@ -73,10 +73,6 @@
use vars qw( $funcname );
use vars qw( $branchseq @selects $sourceline );
sub parse {
- my(%opts)[EMAIL PROTECTED];
- if (%opts) {
- print STDERR "Options: ", join(',', %opts), "\n";
- }
$runtime_jump=0;
init;
runtime_init;
@@ -93,11 +89,8 @@
my(@lhs, @rhs);
my($result, $type, @code);
- #print CODE "set .LINE, $sourceline\n";
- trace() if $opts{trace};
- if ($opts{debug}) {
- push @{$code{$seg}->{code}},"\tbsr DEBUG_INIT\n";
- $debug=1;
+ if ($debug) {
+ push @{$code{$seg}->{code}},"\tcall _DEBUG_INIT\n";
debug();
}
@@ -109,7 +102,6 @@
$sourceline++;
unless ($type[PREV] eq "STMT") {
#print CODE "set .LINE, $sourceline\n";
- trace() if $opts{trace};
debug() if $debug;
}
}
@@ -272,7 +264,6 @@
create_label();
label_defined($syms[CURR]);
push @{$code{$seg}->{code}}, "$labels{$syms[CURR]}: # For user
branch ($syms[CURR])\n";
- trace() if ($opts{trace});
debug() if $debug;
$currline="$labels{$syms[CURR]}";
feedme; # Get the :
@@ -344,7 +335,7 @@
or
$type[CURR] eq "COMP") { goto PARSE; }
if ($type[CURR] eq 'COMM') {
- print CODE "\t# $syms[CURR]\n";
+ push @{$code{$seg}->{code}}, "\t# $syms[CURR]\n";
goto PARSE;
}
if ($type[CURR] eq "INT" and
@@ -353,7 +344,6 @@
$currline="$labels{$syms[CURR]}";
label_defined($syms[CURR]);
push @{$code{$seg}->{code}}, "$labels{$syms[CURR]}: # For user
branch ($syms[CURR])\n";
- trace() if ($opts{trace});
debug() if $debug;
goto PARSE
}
@@ -363,19 +353,10 @@
if ($syms[CURR] eq "") {
FORCE_FINISH:
runtime_shutdown();
- print CODE <<FINISH;
- #
- # All of this crap is generated dynamically because we can't
- # compute addresses this early to provide a proper jump-table
- # and this stuff needs to be done at runtime
-FINISH
-
parse_function_dispatch();
parse_struct_copy_dispatch();
parse_data_setup();
check_branches();
- debug_init($debug);
-
return;
}
@@ -384,16 +365,10 @@
dumpq;
die;
}
-sub trace {
- print CODE<<TRACE;
-print 2, .LINE
-print 2, "\\n"
-TRACE
-}
sub debug {
push @{$code{$seg}->{code}}, <<DEBUG;
- set \$I100, $sourceline
- bsr DEBUGGER
+ .arg $sourceline
+ call ${seg}_debug
DEBUG
}
@@ -410,30 +385,7 @@
sub label_defined {
$labdef{$_[0]}++;
}
-sub debug_init {
- return unless $debug;
- push @{$code{$seg}->{code}},<<START;
-DEBUG_INIT:
- \$P0=new PerlArray
- find_global \$P1, "DEBUGGER"
-START
- foreach([EMAIL PROTECTED]::basic) {
- my $line=$main::basic[$_];
- $line=~s/"/'/g;
- push @{$code{$seg}->{code}}, "\tset \$P0[",$_+1,"], \"$line\"\n";
- }
- push @{$code{$seg}->{code}},<<DEBEND;
- set \$P1["code"], \$P0
- set \$P1["step"], 1 # Turn on stepping mode
- \$P0=new PerlHash
- set \$P1["break"], \$P0 # Breakpoints
- \$P0=new PerlArray
- set \$P1["watch"], \$P0 # Watch
- store_global "DEBUGGER", \$P1
- ret
-DEBEND
-}
sub check_branches {
foreach(keys %labels) {
print "Label $_ not defined\n" unless exists $labdef{$_};
1.7 +6 -6 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.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- RT_debugger.pasm 12 Jun 2003 02:52:59 -0000 1.6
+++ RT_debugger.pasm 17 Jun 2003 02:24:48 -0000 1.7
@@ -6,8 +6,10 @@
set $P0, $P25["code"]
set $S0, $P0[line]
+ print "\n"
print $S0
print "\n"
+ bsr DEBUGGER_PRINTWATCH
branch DEBUGGER_COMMAND
# Commands are:
@@ -64,9 +66,6 @@
eq $I0, 0, DEBUGGER_PARG
shift $S0, $P1
- print "->"
- print $S0
- print "<-\n"
set $S1, locals[$S0]
print $S1
print "\n"
@@ -183,21 +182,22 @@
DEBUG_ADDNEW: push $P0, $S0
DEBUG_ADDEND: ret
-
DEBUGGER_PRINTWATCH:
set $P0, $P25["watch"]
set $I0, $P0
eq $I0, 0, DEBUG_PRINTEND
+ print "Watches: "
set $I1, 0
-
DEBUG_PRINTLOOP:
eq $I1, $I0, DEBUG_PRINTEND
set $S0, $P0[$I1]
inc $I1
eq $S0, "", DEBUG_PRINTLOOP
+ print $S0
+ print "="
set $S1, locals[$S0]
print $S1
- print "\n"
+ print "\t"
branch DEBUG_PRINTLOOP
DEBUG_PRINTEND:
1.6 +2 -2 parrot/languages/BASIC/compiler/RT_initialize.pasm
Index: RT_initialize.pasm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/RT_initialize.pasm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- RT_initialize.pasm 8 Jun 2003 17:25:25 -0000 1.5
+++ RT_initialize.pasm 17 Jun 2003 02:24:48 -0000 1.6
@@ -22,9 +22,9 @@
JUMPLABEL = ""
- call _data
+ call _data_run
call _platform_setup
- call _basicmain
+ call _basicmain_run
end
.end
1.9 +75 -53 parrot/languages/BASIC/compiler/compile.pl
Index: compile.pl
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/compile.pl,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- compile.pl 12 Jun 2003 02:52:59 -0000 1.8
+++ compile.pl 17 Jun 2003 02:24:48 -0000 1.9
@@ -1,4 +1,3 @@
-
#!/usr/bin/perl -w
# Remember, this is BAD PERL later to be translated to PASM
@@ -6,8 +5,12 @@
# @tokens and @tokdsc
# Then compile.
use strict;
+use Getopt::Std;
our @basic=();
-use vars qw(%code);
+use vars qw(%code %options @basic);
+use vars qw( @tokens @tokdsc);
+use vars qw( @syms @type );
+use vars qw( %labels $runtime_jump $debug $sourceline);
require "COMP_toker.pm";
require "COMP_parser.pm";
@@ -22,7 +25,11 @@
exit 1;
};
+getopts('d', \%options);
+$debug=1 if $options{d};
+
if (@ARGV) {
+ print "File: $ARGV[0]\n";
open(D, $ARGV[0]) || die;
@basic=<D>;
chomp(@basic);
@@ -32,11 +39,6 @@
}
shift(@ARGV);
-use vars qw( @tokens @tokdsc);
-use vars qw( @syms @type );
-use vars qw( %labels $runtime_jump );
-
-
tokenize();
push(@ARGV);
parse(@ARGV);
@@ -44,79 +46,99 @@
open(CODE, ">TARG_test.imc") || die;
print CODE qq{.include "RT_initialize.pasm"\n};
-my $debug=0;
foreach my $seg ("_main", "_basicmain", keys %code) {
next unless exists $code{$seg};
my @debdecl=();
- $debug=1 if (grep /debug/, @ARGV);
- print CODE ".sub $seg\n\tsaveall\n";
+ print CODE ".sub $seg\n";
if (exists $code{$seg}->{declarations}) {
foreach my $var (sort keys %{$code{$seg}->{declarations}}) {
if ($var=~/_string$/) {
print CODE "\t.local string $var\n";
- push @debdecl, "\tset \$P1[\"$var\"], $var\n";
+ push @debdecl, "\t\tset \$P1[\"$var\"], $var\n";
} else {
print CODE "\t.local float $var\n";
- push @debdecl, "\tset \$S0, $var\n\tset
\$P1[\"$var\"], \$S0\n";
+ push @debdecl, "\t\tset \$S0, $var\n\t\tset
\$P1[\"$var\"], \$S0\n";
}
}
}
-
+ print CODE<<INIT;
+ .sub ${seg}_run # Always jump here.
+ call ${seg}_main
+ ret
+ .end
+INIT
+ print CODE "\t.sub ${seg}_main\n\t\tsaveall\n";
foreach(@{$code{$seg}->{code}}) {
s/#RTJ// if $runtime_jump;
- print CODE $_;
+ s/^/\t/gm;
+ print CODE;
}
- print CODE "\trestoreall\n\tret\n";
- if ($debug) {
- print CODE<<'EOD';
-DEBUGGER:
- find_global $P0, "DEBUGGER"
- set $I0, $P0["step"]
- ne $I0, 0, DEBUGGER_STOP
- set $P1, $P0["break"]
- set $I0, $P1
- eq $I0, 0, DEBUGGER_DONE # No breakpoints
- set $S0, $I100
- exists $I0, $P1[$S0]
- eq $I0, 0, DEBUGGER_DONE # This breakpoint doesn't exist
-
+ print CODE "\t\trestoreall\n\t\tret\n";
+ print CODE "\t.end\t# main segment\n";
+ delete $code{$seg};
+ if (! $debug) {
+ print CODE ".end\t# outer segment\n";
+ next;
+ }
+ print CODE<<EOD;
+ .sub ${seg}_debug
+ .param int debline
+ find_global \$P0, "DEBUGGER"
+ set \$I0, \$P0["step"]
+ ne \$I0, 0, DEBUGGER_STOP
+ set \$P1, \$P0["break"]
+ set \$I0, \$P1
+ eq \$I0, 0, DEBUGGER_DONE # No breakpoints
+ set \$S0, debline
+ exists \$I0, \$P1[\$S0]
+ eq \$I0, 0, DEBUGGER_DONE # This breakpoint doesn't exist
DEBUGGER_STOP:
- $P1=new PerlHash
-EOD
- print CODE "@debdecl";
-
- print CODE<<'EOD';
- .arg $P1
- .arg $I100
- call _DEBUGGER_STOP
+ \$P1=new PerlHash
[EMAIL PROTECTED] .arg \$P1
+ .arg debline
+ call _DEBUGGER_STOP_FOR_REAL
DEBUGGER_DONE:
ret
+
+ .end # End debug segment
+.end # End outer segment
EOD
}
- print CODE ".end\n";
-
- delete $code{$seg};
+if ($debug) {
+ print CODE<<FOO;
+.sub _DEBUG_INIT
+ \$P0=new PerlArray
+ find_global \$P1, "DEBUGGER"
+FOO
+ foreach([EMAIL PROTECTED]::basic-1) {
+ my $line=$main::basic[$_];
+ $line=~s/"/'/g;
+ print CODE "\tset \$P0[",$_+1,"], \"$line\"\n";
+ }
+ print CODE<<FOO;
+ set \$P1["code"], \$P0
+ set \$P1["step"], 1 # Turn on stepping mode
+ \$P0=new PerlHash
+ set \$P1["break"], \$P0 # Breakpoints
+ \$P0=new PerlArray
+ set \$P1["watch"], \$P0 # Watch
+ store_global "DEBUGGER", \$P1
+ ret
+.end
+FOO
}
print CODE<<RUNTIMESHUTDOWN;
#
# Pull in the runtime libraries
#
-#.include "RT_expr.pasm"
-#.include "RT_math.pasm"
-#.include "RT_variables.pasm"
-.include "RT_builtins.pasm"
-#.include "RT_userfunc.pasm"
.include "RT_aggregates.pasm"
-.include "RT_support.pasm"
+.include "RT_builtins.pasm"
+.include "RT_debugger.pasm"
.include "RT_io.pasm"
.include "RT_platform.pasm"
-.include "RT_debugger.pasm"
- #
- # Pull in user-defined functions
- #
-#.include "TARG_localfuncs.pasm"
+.include "RT_support.pasm"
RUNTIMESHUTDOWN
close(CODE);
