line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Language::Basic; |
2
|
|
|
|
|
|
|
# by Amir Karger (See below for copyright/license/etc.) |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
=pod |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
Language::Basic - Perl Module to interpret BASIC |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 SYNOPSIS |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
use Language::Basic; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
my $Program = new Language::Basic::Program; |
15
|
|
|
|
|
|
|
$Program->input("program.bas"); # Read lines from a file |
16
|
|
|
|
|
|
|
$Program->parse; # Parse the Program |
17
|
|
|
|
|
|
|
$Program->implement; # Run the Program |
18
|
|
|
|
|
|
|
$Program->output_perl; # output Program as a Perl program |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
$Program->line("20 PRINT X"); # add one line to existing Program |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Featured scripts: |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=over 4 |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=item basic.pl |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
Runs BASIC programs from the command line. |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=item termbasic.pl |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Term::Readline program. Input one line of BASIC at a time, then run the |
33
|
|
|
|
|
|
|
program. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=item basic2pl.pl |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
Outputs a Perl program that does the same thing as the input BASIC program. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=back |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=head1 DESCRIPTION |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
This module lets you run any BASIC programs you may have lying around, or |
44
|
|
|
|
|
|
|
may inspire you to write new ones! |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
The aspects of the language that are supported are described below. Note |
47
|
|
|
|
|
|
|
that I was pretty much aiming for Applesoft BASIC (tm) ca. 1985, not some |
48
|
|
|
|
|
|
|
modern BASIC with real subroutines. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=cut |
51
|
|
|
|
|
|
|
|
52
|
16
|
|
|
16
|
|
38403
|
use strict; |
|
16
|
|
|
|
|
37
|
|
|
16
|
|
|
|
|
760
|
|
53
|
|
|
|
|
|
|
require 5.004; # I use 'foreach my' |
54
|
16
|
|
|
16
|
|
16779
|
use IO::File; |
|
16
|
|
|
|
|
640714
|
|
|
16
|
|
|
|
|
2905
|
|
55
|
16
|
|
|
16
|
|
141
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); |
|
16
|
|
|
|
|
43
|
|
|
16
|
|
|
|
|
2493
|
|
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
require Exporter; |
58
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
59
|
|
|
|
|
|
|
@EXPORT = qw( |
60
|
|
|
|
|
|
|
); |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# Stolen from `man perlmod` |
63
|
|
|
|
|
|
|
$VERSION = do { my @r = (q$Revision: 1.44 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# Sub-packages |
66
|
16
|
|
|
16
|
|
13194
|
use Language::Basic::Common; |
|
16
|
|
|
|
|
40
|
|
|
16
|
|
|
|
|
14620
|
|
67
|
16
|
|
|
16
|
|
18469
|
use Language::Basic::Expression; |
|
16
|
|
|
|
|
56
|
|
|
16
|
|
|
|
|
704
|
|
68
|
16
|
|
|
16
|
|
16286
|
use Language::Basic::Function; |
|
16
|
|
|
|
|
49
|
|
|
16
|
|
|
|
|
556
|
|
69
|
16
|
|
|
16
|
|
29327
|
use Language::Basic::Statement; |
|
16
|
|
|
|
|
92
|
|
|
16
|
|
|
|
|
1337
|
|
70
|
16
|
|
|
16
|
|
14540
|
use Language::Basic::Token; |
|
16
|
|
|
|
|
78
|
|
|
16
|
|
|
|
|
534
|
|
71
|
16
|
|
|
16
|
|
17330
|
use Language::Basic::Variable; |
|
16
|
|
|
|
|
67
|
|
|
16
|
|
|
|
|
957
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# sub-packages |
74
|
|
|
|
|
|
|
{ |
75
|
|
|
|
|
|
|
package Language::Basic::Program; |
76
|
|
|
|
|
|
|
package Language::Basic::Line; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
###################################################################### |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=head2 Class Language::Basic::Program |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
This class handles a whole program. A Program is just a bunch of Lines, |
84
|
|
|
|
|
|
|
each of which has one or more Statements on it. Running the program |
85
|
|
|
|
|
|
|
involves moving through the lines, usually in numerical order, and |
86
|
|
|
|
|
|
|
implementing each line. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
Methods: |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=over 4 |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=cut |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
{ |
95
|
|
|
|
|
|
|
package Language::Basic::Program; |
96
|
16
|
|
|
16
|
|
107
|
use Language::Basic::Common; |
|
16
|
|
|
|
|
31
|
|
|
16
|
|
|
|
|
51084
|
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# Fields: |
99
|
|
|
|
|
|
|
# lines Keys are line numbers, values are LB::Line objects |
100
|
|
|
|
|
|
|
# curr_line LB::Line currently being implemented/parsed/whatever |
101
|
|
|
|
|
|
|
# end_program Done implementing the program? |
102
|
|
|
|
|
|
|
# stack The subroutine stack. In BASIC, it's just a list of |
103
|
|
|
|
|
|
|
# statements we GOSUB'ed from. |
104
|
|
|
|
|
|
|
# data The data holder (stuff from DATA statements, read by READ) |
105
|
|
|
|
|
|
|
# parsed Has this Program been parsed since the last time |
106
|
|
|
|
|
|
|
# new lines were added? |
107
|
|
|
|
|
|
|
# needed_subs Functions whose perl-equivalent subs we need to print out |
108
|
|
|
|
|
|
|
# at the end of the program. (Keys are names of subs, values |
109
|
|
|
|
|
|
|
# are sub descriptions.) |
110
|
|
|
|
|
|
|
# column Current column of the screen the program is printing to |
111
|
|
|
|
|
|
|
sub new { |
112
|
21
|
|
|
21
|
|
18450
|
my ($class, $infile) = @_; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
#Initialize the intrinsic functions |
115
|
21
|
|
|
|
|
142
|
&Language::Basic::Function::Intrinsic::initialize(); |
116
|
|
|
|
|
|
|
|
117
|
21
|
|
|
|
|
212
|
my $in = { |
118
|
|
|
|
|
|
|
"lines" => {}, |
119
|
|
|
|
|
|
|
"curr_line" => undef, |
120
|
|
|
|
|
|
|
"end_program" => 0, |
121
|
|
|
|
|
|
|
'stack' => [], |
122
|
|
|
|
|
|
|
"for_statements" => {}, |
123
|
|
|
|
|
|
|
'data' => [], |
124
|
|
|
|
|
|
|
'parsed' => 0, |
125
|
|
|
|
|
|
|
"needed_subs" => {}, |
126
|
|
|
|
|
|
|
"column" => 0, |
127
|
|
|
|
|
|
|
}; |
128
|
21
|
|
|
|
|
114
|
bless $in, $class; |
129
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::new |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=item current_program |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
Returns the program currently being parsed/implemented/whatever |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=item set_current_program |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
Sets arg0 to be the Current Program |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=cut |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
my $_Current_Program; # Gasp! It's an Evil Global Variable! |
142
|
|
|
|
|
|
|
sub current_program { |
143
|
245
|
|
|
245
|
|
574
|
return $_Current_Program; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
sub set_current_program { |
146
|
190
|
50
|
|
190
|
|
614
|
my $self = shift or die "LBP::set_current_program must have argument!\n"; |
147
|
190
|
|
|
|
|
517
|
$_Current_Program = $self; |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=item current_line |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
Returns the LB::line currently being parsed/implemented/whatever |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=item set_current_line |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
Sets the current line in Program arg0 to be line I arg1 |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=item first_line_number |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
Returns (not surprisingly) the first line number in Program arg0 |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=cut |
163
|
|
|
|
|
|
|
|
164
|
679
|
|
|
679
|
|
1841
|
sub current_line { return shift->{"curr_line"}; } |
165
|
|
|
|
|
|
|
sub set_current_line { |
166
|
507
|
|
|
507
|
|
812
|
my $prog = shift; |
167
|
507
|
|
|
|
|
682
|
my $num = shift; |
168
|
507
|
100
|
66
|
|
|
2467
|
if (defined $num && exists $prog->{"lines"}->{$num}) { |
169
|
486
|
|
|
|
|
1682
|
$prog->{"curr_line"} = $prog->{"lines"}->{$num}; |
170
|
|
|
|
|
|
|
} else { |
171
|
21
|
|
|
|
|
101
|
$prog->{"curr_line"} = undef; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
} |
174
|
42
|
|
|
42
|
|
82
|
sub first_line_number {return (sort {$a <=> $b} keys %{shift->{"lines"}})[0]; } |
|
656
|
|
|
|
|
923
|
|
|
42
|
|
|
|
|
309
|
|
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=item current_line_number |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
What line number in Program arg0 are we currently on? |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=cut |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub current_line_number { |
183
|
21
|
|
|
21
|
|
40
|
my $prog = shift; |
184
|
21
|
|
|
|
|
63
|
my $line = $prog->current_line; |
185
|
21
|
50
|
|
|
|
136
|
return (defined $line ? $line->line_number : undef); |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=item input |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
This method reads in a program from a file, whose name is the string arg0. It |
191
|
|
|
|
|
|
|
doesn't do any parsing, except for taking the line number out of the line. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=cut |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub input { |
196
|
1
|
|
|
1
|
|
200
|
my ($self, $filename) = @_; |
197
|
1
|
|
|
|
|
5
|
$self->set_current_program; |
198
|
1
|
|
|
|
|
12
|
my $fh = new IO::File $filename; |
199
|
1
|
50
|
|
|
|
116
|
die "Error opening $filename: $!\n" unless defined $fh; |
200
|
1
|
|
|
|
|
3
|
my $old_num = -1; |
201
|
|
|
|
|
|
|
|
202
|
1
|
|
|
|
|
22
|
while (<$fh>) { |
203
|
2
|
50
|
|
|
|
11
|
next if /^\s*$/; # empty lines |
204
|
2
|
|
|
|
|
5
|
chomp; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# Line Number |
207
|
2
|
|
|
|
|
14
|
my $line_num = $self->_add_line($_); |
208
|
2
|
0
|
|
|
|
8
|
defined $line_num |
|
|
50
|
|
|
|
|
|
209
|
|
|
|
|
|
|
or die "Missing line number " . |
210
|
|
|
|
|
|
|
($old_num > 0 ? "after line $old_num\n" : "on first line\n"); |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# In input files, we make sure lines are in numerical order. |
213
|
|
|
|
|
|
|
# If they're not, it's most likely a bug. |
214
|
|
|
|
|
|
|
# Same is not true for a Term::Readline interpreter |
215
|
2
|
50
|
|
|
|
7
|
if ($line_num <= $old_num) { |
216
|
0
|
|
|
|
|
0
|
die "Line $line_num: lines in file must be in increasing order.\n"; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
2
|
|
|
|
|
12
|
$old_num = $line_num; |
220
|
|
|
|
|
|
|
} |
221
|
1
|
|
|
|
|
18
|
close ($fh); |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# order the lines |
224
|
1
|
|
|
|
|
6
|
$self->_fix_lines; |
225
|
1
|
|
|
|
|
6
|
$self->{'parsed'} = 0; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::input |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=item line |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
This method takes a line of BASIC (arg1, already chomped), forms a new LB::Line |
232
|
|
|
|
|
|
|
with it, and adds it to the Program (arg0). It doesn't do any parsing, |
233
|
|
|
|
|
|
|
except for taking the line number out of the line. |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=cut |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub line { |
238
|
147
|
|
|
147
|
|
846
|
my $self = shift; |
239
|
147
|
|
|
|
|
480
|
$self->set_current_program; |
240
|
147
|
|
|
|
|
706
|
my $line = shift; # sans \n |
241
|
|
|
|
|
|
|
|
242
|
147
|
50
|
|
|
|
300
|
defined $self->_add_line($line) or die "Missing line number in line()!\n"; |
243
|
147
|
|
|
|
|
464
|
$self->_fix_lines; |
244
|
147
|
|
|
|
|
370
|
$self->{'parsed'} = 0; |
245
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::line |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub _add_line { |
248
|
|
|
|
|
|
|
# takes the line (sans \n), returns the line number read or undef if there |
249
|
|
|
|
|
|
|
# is none. |
250
|
|
|
|
|
|
|
# You must call _fix_lines between _add_line and returning to the |
251
|
|
|
|
|
|
|
# user's program! |
252
|
|
|
|
|
|
|
|
253
|
149
|
|
|
149
|
|
174
|
my $self = shift; |
254
|
149
|
|
|
|
|
353
|
my $line = shift; |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# Line Number |
257
|
149
|
50
|
|
|
|
743
|
$line =~ s/^\s*(\d+)\s+// or return; |
258
|
149
|
|
|
|
|
326
|
my $line_num = $1; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
# Create an LB::Line with what's left of the line |
261
|
149
|
|
|
|
|
413
|
$self->{'lines'}{$line_num} = new Language::Basic::Line($line, $line_num); |
262
|
|
|
|
|
|
|
|
263
|
149
|
|
|
|
|
572
|
return $line_num; |
264
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::_add_line |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
# fix the ordering of the lines in the program |
267
|
|
|
|
|
|
|
sub _fix_lines { |
268
|
148
|
|
|
148
|
|
190
|
my $self = shift; |
269
|
|
|
|
|
|
|
|
270
|
148
|
|
|
|
|
211
|
my @line_numbers = sort {$a <=> $b} keys %{$self->{"lines"}}; |
|
2330
|
|
|
|
|
3208
|
|
|
148
|
|
|
|
|
691
|
|
271
|
|
|
|
|
|
|
|
272
|
148
|
|
|
|
|
579
|
for (my $i = 0; $i < @line_numbers - 1; $i++) { # process all but last |
273
|
864
|
|
|
|
|
1404
|
my $line = $self->{'lines'}{ $line_numbers[$i] }; |
274
|
864
|
|
|
|
|
1606
|
$line->set_next( $line_numbers[ $i+1 ] ); |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
148
|
|
|
|
|
408
|
$self->{'lines'}{ $line_numbers[-1] }->set_next( undef ); |
278
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::_fix_lines |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=item parse |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
This method parses the program, which just involves looping over the lines |
283
|
|
|
|
|
|
|
in the program and parsing each line. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=cut |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
sub parse { |
288
|
21
|
|
|
21
|
|
244
|
my $self = shift; |
289
|
21
|
|
|
|
|
82
|
$self->set_current_program; |
290
|
|
|
|
|
|
|
|
291
|
21
|
50
|
|
|
|
85
|
return if $self->{'parsed'}; |
292
|
|
|
|
|
|
|
|
293
|
21
|
|
|
|
|
74
|
$self->set_current_line($self->first_line_number); |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
# Loop through the lines in the program, parse each |
296
|
21
|
|
|
|
|
84
|
while (defined (my $line = $self->current_line)) { |
297
|
|
|
|
|
|
|
#print $line->line_number," ",$line->{"text"},"\n"; |
298
|
149
|
|
|
|
|
363
|
$line->parse; |
299
|
149
|
|
|
|
|
440
|
$self->set_current_line($line->get_next); |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
21
|
|
|
|
|
65
|
$self->{'parsed'} = 1; |
303
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::parse |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=item implement |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
This method actually runs the program. That is, it starts on the first line, |
308
|
|
|
|
|
|
|
and implements statements one at a time. It performs the statements on a |
309
|
|
|
|
|
|
|
line in order, and goes from line to line in numerical order, unless a GOTO, |
310
|
|
|
|
|
|
|
NEXT, etc. sends it somewhere else. It stops when it hits an END statement or |
311
|
|
|
|
|
|
|
"falls off" the end of the program. |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=cut |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub implement { |
316
|
21
|
|
|
21
|
|
3059
|
my $self = shift; |
317
|
21
|
|
|
|
|
81
|
$self->set_current_program; |
318
|
|
|
|
|
|
|
# In case you're lazy & call implement w/out parsing first |
319
|
21
|
100
|
|
|
|
165
|
$self->parse unless $self->{'parsed'}; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
# Zero stack, etc., start at beginning of program |
322
|
21
|
|
|
|
|
102
|
$self->start; |
323
|
|
|
|
|
|
|
# Mini-kludge to get the program running |
324
|
21
|
|
|
|
|
99
|
$self->goto_line($self->current_line_number); |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
# Loop over statements while there are statements |
327
|
21
|
|
|
|
|
90
|
while (defined(my $curr_statement = $self->increment)) { |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# TODO create a "trace" command that prints out line numbers |
330
|
|
|
|
|
|
|
# for debugging |
331
|
|
|
|
|
|
|
#my $line = $self->current_line; |
332
|
|
|
|
|
|
|
#print $line->line_number," ",$line->{"text"},"\n"; |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# Do the statement! |
335
|
|
|
|
|
|
|
# Hooray for OO; just call "implement" on everything! |
336
|
|
|
|
|
|
|
#print "Statement class ",ref($curr_statement),"\n"; |
337
|
|
|
|
|
|
|
# Note that this may well change where the next &increment will go |
338
|
305
|
|
|
|
|
2424
|
$curr_statement->implement; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
#Done! |
342
|
|
|
|
|
|
|
# TODO Exit more gracefully? |
343
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::implement |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
# Return the next Statement we're supposed to execute, based on the Program's |
346
|
|
|
|
|
|
|
# next_statement field. And set the default action for the subsequent call |
347
|
|
|
|
|
|
|
# to increment, which is to do the next Statement in order. (Or return |
348
|
|
|
|
|
|
|
# undef if the program is done.) |
349
|
|
|
|
|
|
|
# |
350
|
|
|
|
|
|
|
# In the simplest case, next_statement will just be the Statement after the |
351
|
|
|
|
|
|
|
# current one on the current Line, although it my well be in a totally |
352
|
|
|
|
|
|
|
# different place due to GOTOs, RETURNs, ELSEs or other interesting programming |
353
|
|
|
|
|
|
|
# tools. |
354
|
|
|
|
|
|
|
# |
355
|
|
|
|
|
|
|
# If next_statement is undefined, we're done with this line (and haven't been |
356
|
|
|
|
|
|
|
# directed to go somewhere more interesting), so go to the next line in order. |
357
|
|
|
|
|
|
|
# |
358
|
|
|
|
|
|
|
# TODO should this method be podded? |
359
|
|
|
|
|
|
|
sub increment { |
360
|
387
|
|
|
387
|
|
489
|
my $self = shift; |
361
|
|
|
|
|
|
|
|
362
|
387
|
|
|
|
|
390
|
my $next; |
363
|
387
|
100
|
|
|
|
928
|
unless (defined($next = $self->{"next_statement"})) { |
364
|
|
|
|
|
|
|
# Program is at the end of a line |
365
|
233
|
|
|
|
|
502
|
my $line = $self->current_line; |
366
|
233
|
|
|
|
|
448
|
my $number = $line->get_next; |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
# goto_line will set Program's next_statement |
369
|
|
|
|
|
|
|
# ($number = undef will set "end_program") |
370
|
233
|
|
|
|
|
485
|
$self->goto_line($number); |
371
|
233
|
|
|
|
|
400
|
$next = $self->{"next_statement"}; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
# Did we hit an END or "fall off" the last line of the program? |
374
|
387
|
100
|
|
|
|
997
|
return undef if $self->{"end_program"}; |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
# By default, we're going to go on to the next statement after this one |
377
|
366
|
|
|
|
|
576
|
$self->{"next_statement"} = $next->{"next_statement"}; |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
# Whether or not we were at end of line, we now know what next |
380
|
|
|
|
|
|
|
# Statement is, so return it. |
381
|
366
|
|
|
|
|
1806
|
return $next; |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=item start |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
This method erases program stack and moves line pointer to beginning of program |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
It should be called any time we start going through the program. |
390
|
|
|
|
|
|
|
(Either implement or output_perl.) |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=cut |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
# Don't erase "data". It's set during parsing. |
395
|
|
|
|
|
|
|
sub start { |
396
|
21
|
|
|
21
|
|
42
|
my $self = shift; |
397
|
21
|
|
|
|
|
61
|
$self->{"stack"} = []; |
398
|
21
|
|
|
|
|
66
|
$self->{"for_statements"} = {}; |
399
|
21
|
|
|
|
|
55
|
$self->{"column"} = 0; |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
# Start on the first line of the program |
402
|
21
|
|
|
|
|
81
|
$self->set_current_line($self->first_line_number); |
403
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::start |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=item goto_line |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
Continue Program execution at the first Statement on line number arg1. |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=cut |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
sub goto_line { |
412
|
277
|
|
|
277
|
|
336
|
my $self = shift; |
413
|
277
|
|
|
|
|
321
|
my $next_line = shift; |
414
|
|
|
|
|
|
|
|
415
|
277
|
100
|
|
|
|
513
|
if (defined $next_line) { |
416
|
255
|
|
|
|
|
630
|
$self->set_current_line($next_line); |
417
|
255
|
50
|
|
|
|
1110
|
my $line = $self->current_line or |
418
|
|
|
|
|
|
|
Exit_Error("Can't find line $next_line!"); |
419
|
255
|
|
|
|
|
604
|
$self->{"next_statement"} = $line->{"first_statement"}; |
420
|
|
|
|
|
|
|
} else { |
421
|
22
|
|
|
|
|
70
|
$self->{"end_program"} = 1; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::set_next_line |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=item goto_after_statement |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
Kind of like goto_line, except go to the Statement I Statement arg1. |
429
|
|
|
|
|
|
|
(Or the first statement on the line just after Statement arg1, if it's the last |
430
|
|
|
|
|
|
|
Statement on its line.) E.g., when you RETURN from a GOSUB, you want to return |
431
|
|
|
|
|
|
|
to the GOSUB line but start execution after the GOSUB. Same with FOR. |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=cut |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sub goto_after_statement { |
436
|
61
|
|
|
61
|
|
80
|
my $self = shift; |
437
|
61
|
|
|
|
|
81
|
my $st = shift; |
438
|
61
|
|
|
|
|
107
|
$self->{"next_statement"} = $st; |
439
|
|
|
|
|
|
|
# May have jumped to (the beginning or middle of) a new line, |
440
|
|
|
|
|
|
|
# so we have to reset this. (It stays the same if we're jumping w/in |
441
|
|
|
|
|
|
|
# one line, but that's OK.) |
442
|
61
|
|
|
|
|
129
|
$self->set_current_line($st->{"line_number"}); |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
# Goto the statement, and set Program's next_statement field, so |
445
|
|
|
|
|
|
|
# that when Program::implement calls increment, it goes to the |
446
|
|
|
|
|
|
|
# statement *after* this one. |
447
|
61
|
|
|
|
|
114
|
$self->increment; |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::goto_after_statement |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
=pod |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
=back |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
The following methods are called from LB::Statement parse or implement |
456
|
|
|
|
|
|
|
methods to implement various BASIC commands. |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
=over 4 |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=item push_stack |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
(GOSUB) Call a subroutine, i.e. push the current Statement::Gosub onto the |
463
|
|
|
|
|
|
|
Program's calling stack |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
=item pop_stack |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
(RETURN) Return from a subroutine, i.e., pop the top Statement::Gosub off of |
468
|
|
|
|
|
|
|
the Program's calling stack |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
=cut |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
sub push_stack { |
473
|
13
|
|
|
13
|
|
23
|
my $self = shift; |
474
|
13
|
|
|
|
|
21
|
my $st = shift; |
475
|
13
|
|
|
|
|
16
|
push @{ $self->{'stack'} }, $st; |
|
13
|
|
|
|
|
48
|
|
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
sub pop_stack { |
479
|
13
|
|
|
13
|
|
18
|
my $self = shift; |
480
|
13
|
|
|
|
|
16
|
return pop @{ $self->{'stack'} }; |
|
13
|
|
|
|
|
76
|
|
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
=item store_for |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
(FOR) Store a Statement::For arg1, so that when we get to the corresponding |
486
|
|
|
|
|
|
|
Statement::Next, we know where to go back to |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
=item pop_stack |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
(NEXT) Get the Statement::For corresponding to Statement::Next arg1 |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
=cut |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
sub store_for { |
495
|
12
|
|
|
12
|
|
18
|
my $self = shift; |
496
|
12
|
|
|
|
|
16
|
my $for_statement = shift; |
497
|
12
|
|
|
|
|
23
|
my $lvalue = $for_statement->{"lvalue"}; |
498
|
12
|
|
|
|
|
26
|
my $name = $lvalue->{"name"}; |
499
|
12
|
|
|
|
|
81
|
$self->{"for_statements"}->{$name} = $for_statement; |
500
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::store_for |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
sub get_for { |
503
|
60
|
|
|
60
|
|
85
|
my $self = shift; |
504
|
60
|
|
|
|
|
67
|
my $next_statement = shift; |
505
|
60
|
|
|
|
|
87
|
my $lvalue = $next_statement->{"lvalue"}; |
506
|
60
|
|
|
|
|
108
|
my $name = $lvalue->{"name"}; |
507
|
60
|
50
|
|
|
|
145
|
if (exists $self->{"for_statements"}->{$name}) { |
508
|
60
|
|
|
|
|
210
|
return $self->{"for_statements"}->{$name}; |
509
|
|
|
|
|
|
|
} else { |
510
|
0
|
|
|
|
|
0
|
Exit_Error("NEXT $name without FOR!"); |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::get_for |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
=item add_data |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
(DATA) Add a piece of data to the Program's data storage, to be accessed |
517
|
|
|
|
|
|
|
later. |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
=cut |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
sub add_data { |
522
|
23
|
|
|
23
|
|
28
|
my $self = shift; |
523
|
23
|
|
|
|
|
25
|
my $thing = shift; |
524
|
23
|
|
|
|
|
23
|
push @{ $self->{'data'} }, $thing; |
|
23
|
|
|
|
|
119
|
|
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
=item get_data |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
(READ) Get a piece of data that was stored earlier. |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
=cut |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
sub get_data { |
534
|
23
|
|
|
23
|
|
30
|
my $self = shift; |
535
|
23
|
50
|
|
|
|
37
|
@{ $self->{'data'} } or Exit_Error("More items READ than input in DATA!"); |
|
23
|
|
|
|
|
77
|
|
536
|
23
|
|
|
|
|
27
|
my $thing = shift @{ $self->{'data'} }; |
|
23
|
|
|
|
|
41
|
|
537
|
23
|
|
|
|
|
64
|
return $thing; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
=pod |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=back |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
Finally, there are methods for translating a Program to Perl. |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
=over 4 |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
=item output_perl |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
This method translates a program to Perl and outputs it. It does so by |
551
|
|
|
|
|
|
|
looping through the Lines of the program in order, and calling output_perl on |
552
|
|
|
|
|
|
|
each one. It also prints some pre- and post- data, such as any subroutines it |
553
|
|
|
|
|
|
|
needs to declare (e.g., subs that imitate BASIC functionality, as well as subs |
554
|
|
|
|
|
|
|
that correspond to BASIC DEF statements). |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
It attempts to print everything out nicely, with added whitespace et al. to |
557
|
|
|
|
|
|
|
make the code somewhat readable. (Note that all of the subpackages' |
558
|
|
|
|
|
|
|
output_perl methods I strings rather than printing them, so we can |
559
|
|
|
|
|
|
|
handle all of the printing, indenting, etc. here.) |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
=cut |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
sub output_perl { |
564
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
565
|
0
|
|
|
|
|
0
|
$self->set_current_program; |
566
|
|
|
|
|
|
|
# In case you're lazy & call implement w/out parsing first |
567
|
0
|
0
|
|
|
|
0
|
$self->parse unless $self->{'parsed'}; |
568
|
|
|
|
|
|
|
|
569
|
0
|
|
|
|
|
0
|
my $sep = '#' x 78; |
570
|
|
|
|
|
|
|
# TODO these variables should be changeable by switches to basic2pl! |
571
|
0
|
|
|
|
|
0
|
my $spaces_per_indent = 4; |
572
|
|
|
|
|
|
|
# Indenting for outputted Perl |
573
|
0
|
|
|
|
|
0
|
my $Output_Indent = 2; # eight spaces by default |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
# Beginning of the program |
576
|
|
|
|
|
|
|
# TODO should basic2pl do these two lines? |
577
|
0
|
|
|
|
|
0
|
print '#!/usr/bin/perl -w'; |
578
|
0
|
|
|
|
|
0
|
print "\n#Translated from BASIC by basic2pl\n\n"; |
579
|
|
|
|
|
|
|
|
580
|
0
|
0
|
|
|
|
0
|
if (@{$self->{"data"}}) { |
|
0
|
|
|
|
|
0
|
|
581
|
0
|
|
|
|
|
0
|
print "$sep\n# Setup\n#\n"; |
582
|
0
|
|
|
|
|
0
|
print "# Read data\n"; |
583
|
0
|
|
|
|
|
0
|
print "while () {chomp; push \@Data, \$_}\n\n"; |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
# Zero program stack, etc., start at beginning of program |
587
|
0
|
|
|
|
|
0
|
$self->start; |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
# Loop through the lines in the program |
590
|
0
|
|
|
|
|
0
|
print "$sep\n# Main program\n#\n"; |
591
|
0
|
|
|
|
|
0
|
while (defined (my $line = $self->current_line)) { |
592
|
0
|
|
|
|
|
0
|
my $line_num = $line->line_number; |
593
|
|
|
|
|
|
|
#warn "Line $line_num\n"; |
594
|
0
|
|
|
|
|
0
|
my $label = "L$line_num:"; |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
# What's the line? |
597
|
0
|
|
|
|
|
0
|
my $out = $label . $line->output_perl; |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
# Print labels all the way against the left edge of the line, |
600
|
|
|
|
|
|
|
# then indent the rest of the line. |
601
|
|
|
|
|
|
|
# Split with -1 so final \n's don't get ignored |
602
|
0
|
|
|
|
|
0
|
foreach (split (/\n/, $out, -1)) { |
603
|
|
|
|
|
|
|
# Change indenting for next time? |
604
|
0
|
0
|
|
|
|
0
|
$Output_Indent += 1, next if $_ eq "INDENT"; |
605
|
0
|
0
|
|
|
|
0
|
$Output_Indent -= 1, next if $_ eq "UNINDENT"; |
606
|
0
|
0
|
|
|
|
0
|
warn "weird indenting $Output_Indent\n" if $Output_Indent < 2; |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
# If we didn't hit an indent-changing command, print the |
609
|
|
|
|
|
|
|
# label (if any) and the actual string |
610
|
|
|
|
|
|
|
# TODO only print out the labels we have to! |
611
|
0
|
0
|
|
|
|
0
|
$label = (s/^A?L\d+:// ? $& : ""); |
612
|
|
|
|
|
|
|
# minus for left justify |
613
|
0
|
|
|
|
|
0
|
my $indent = -$Output_Indent * $spaces_per_indent; |
614
|
0
|
|
|
|
|
0
|
printf("%*s", $indent, $label); |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
# print the actual string |
617
|
0
|
|
|
|
|
0
|
print $_; |
618
|
0
|
|
|
|
|
0
|
print "\n"; # the \n we lost from split, or the last \n |
619
|
|
|
|
|
|
|
} |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
# Go through lines in order |
622
|
0
|
|
|
|
|
0
|
$self->set_current_line($line->get_next); |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
# TODO why not indent these nicely? |
626
|
0
|
|
|
|
|
0
|
my $n = $self->{"needed_subs"}; |
627
|
0
|
0
|
|
|
|
0
|
print "\n$sep\n# Subroutine Definitions\n#\n" if %$n; |
628
|
|
|
|
|
|
|
# Print out required subroutines |
629
|
0
|
|
|
|
|
0
|
foreach (sort keys %$n) { |
630
|
0
|
|
|
|
|
0
|
my $out = join(" ", "sub", $_, $n->{$_}, "# end sub $_\n\n"); |
631
|
0
|
|
|
|
|
0
|
$Output_Indent = 0; |
632
|
|
|
|
|
|
|
|
633
|
0
|
|
|
|
|
0
|
foreach (split (/\n/, $out, -1)) { |
634
|
|
|
|
|
|
|
# Change indenting for next time? |
635
|
0
|
0
|
|
|
|
0
|
$Output_Indent += 1, next if $_ eq "INDENT"; |
636
|
0
|
0
|
|
|
|
0
|
$Output_Indent -= 1, next if $_ eq "UNINDENT"; |
637
|
0
|
0
|
|
|
|
0
|
warn "weird indenting $Output_Indent\n" if $Output_Indent < 0; |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
# If we didn't hit an indent-changing command, print the string |
640
|
0
|
|
|
|
|
0
|
my $indent = $Output_Indent * $spaces_per_indent; |
641
|
0
|
|
|
|
|
0
|
print " " x $indent; |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
# print the actual string |
644
|
0
|
|
|
|
|
0
|
print $_; |
645
|
0
|
|
|
|
|
0
|
print "\n"; # the \n we lost from split, or the last \n |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
# If there were any DATA statements... |
650
|
0
|
0
|
|
|
|
0
|
if (@{$self->{"data"}}) { |
|
0
|
|
|
|
|
0
|
|
651
|
0
|
|
|
|
|
0
|
print "\n\n$sep\n# Data\n#\n__DATA__\n"; |
652
|
0
|
|
|
|
|
0
|
print join("\n", map {$_->output_perl} @{$self->{"data"}}); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
653
|
0
|
|
|
|
|
0
|
print "\n"; |
654
|
|
|
|
|
|
|
} |
655
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::output_perl |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
=item need_sub |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
Tells the Program that it needs to use the sub named arg0 (whose definition |
660
|
|
|
|
|
|
|
is in arg1). This is used for outputting a Perl translation of a BASIC |
661
|
|
|
|
|
|
|
program, so that you only write "sub mid_str {...}" if MID$ is used in |
662
|
|
|
|
|
|
|
the BASIC program. |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
=back |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=cut |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
sub need_sub { |
669
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
670
|
0
|
|
|
|
|
0
|
my $n = $self->{"needed_subs"}; |
671
|
0
|
|
|
|
|
0
|
my ($func_name, $func_desc) = @_; |
672
|
0
|
0
|
|
|
|
0
|
return if exists $n->{$func_name}; |
673
|
0
|
|
|
|
|
0
|
$n->{$func_name} = $func_desc; |
674
|
|
|
|
|
|
|
} # end sub Language::Basic::Program::need_sub |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
} # end package Language::Basic::Program |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
###################################################################### |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
=head2 Class Language::Basic::Line |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
This class handles one line of a BASIC program, which has one or more |
683
|
|
|
|
|
|
|
Statements on it. |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
This class has no implement method. The reason is that sometimes, you'll |
686
|
|
|
|
|
|
|
jump to the middle of a line. (E.g., returning from the GOSUBs in |
687
|
|
|
|
|
|
|
10 FOR A=1 TO 10: GOSUB 1000: NEXT A) |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
Methods: |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
=over 4 |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
=cut |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
{ |
696
|
|
|
|
|
|
|
package Language::Basic::Line; |
697
|
16
|
|
|
16
|
|
162
|
use Language::Basic::Common; |
|
16
|
|
|
|
|
33
|
|
|
16
|
|
|
|
|
9851
|
|
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
# Make a new LB::Line with the text given (don't parse it yet) |
700
|
|
|
|
|
|
|
sub new { |
701
|
149
|
|
|
149
|
|
190
|
my $class = shift; |
702
|
149
|
|
|
|
|
202
|
my $text = shift; |
703
|
149
|
|
|
|
|
203
|
my $line_number = shift; |
704
|
149
|
|
|
|
|
585
|
my $in = { |
705
|
|
|
|
|
|
|
# literal text of the line (not including line number) |
706
|
|
|
|
|
|
|
"text" => $text, |
707
|
|
|
|
|
|
|
# Pointer to first LB::Statement on the line |
708
|
|
|
|
|
|
|
"first_statement" => 0, |
709
|
|
|
|
|
|
|
# number of next line (accessed with set/get_next) |
710
|
|
|
|
|
|
|
'next_line' => undef, |
711
|
|
|
|
|
|
|
# BASIC line number of this Line |
712
|
|
|
|
|
|
|
"line_number" => $line_number, |
713
|
|
|
|
|
|
|
}; |
714
|
149
|
|
|
|
|
928
|
bless $in, $class; |
715
|
|
|
|
|
|
|
} # end sub Language::Basic::Line::new |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=item get_next |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
Returns the Line's line number |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=cut |
722
|
|
|
|
|
|
|
|
723
|
21
|
|
|
21
|
|
123
|
sub line_number { shift->{"line_number"} } |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
=item get_next |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
Returns the next line number in the Program |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
=item set_next |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
Sets the next line number in the Program to be arg1. |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
=cut |
734
|
|
|
|
|
|
|
|
735
|
382
|
|
|
382
|
|
1489
|
sub get_next { return shift->{'next_line'}; } |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
# TODO Should this be _set_next and undocumented? Only gets called by _fix_lines |
738
|
|
|
|
|
|
|
sub set_next { |
739
|
1012
|
|
|
1012
|
|
1059
|
my $self = shift; |
740
|
1012
|
|
|
|
|
1025
|
my $next = shift; |
741
|
|
|
|
|
|
|
|
742
|
1012
|
|
|
|
|
3322
|
$self->{'next_line'} = $next; |
743
|
|
|
|
|
|
|
} # end sub Language::Basic::Line::set_next |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
=item parse |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
This method breaks the line up into Statements (and removes whitespace, except |
748
|
|
|
|
|
|
|
in strings), then parses the Statements in order. |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
=cut |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
sub parse { |
753
|
149
|
|
|
149
|
|
190
|
my $self = shift; |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
# Break the line up into Tokens for later eating/parsing |
756
|
149
|
|
|
|
|
613
|
my $token_group = new Language::Basic::Token::Group; |
757
|
149
|
|
|
|
|
555
|
$token_group->lex($self->{"text"}); |
758
|
149
|
|
|
|
|
246
|
my $oldst; |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
# Parse Statement(s) in the Line |
761
|
149
|
|
|
|
|
210
|
do { |
762
|
|
|
|
|
|
|
# Create the new Statement and figure out what kind of statement it |
763
|
|
|
|
|
|
|
# is. $statement will be an object of a subclass LB::Statement::*) |
764
|
157
|
|
|
|
|
758
|
my $statement = new Language::Basic::Statement $token_group; |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
# Actually parse the Statement |
767
|
157
|
|
|
|
|
807
|
$statement->parse($token_group); |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
# Each statement needs to know which line it's on, in case we |
770
|
|
|
|
|
|
|
# RETURN or NEXT into the middle of a line. |
771
|
157
|
|
|
|
|
960
|
$statement->set_line_number($self->{"line_number"}); |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
# Create a linked list of the Statements in the line |
774
|
157
|
100
|
|
|
|
588
|
if (defined $oldst) { |
775
|
8
|
|
|
|
|
15
|
$oldst->{"next_statement"} = $statement |
776
|
|
|
|
|
|
|
} else { |
777
|
149
|
|
|
|
|
266
|
$self->{"first_statement"} = $statement; |
778
|
|
|
|
|
|
|
} |
779
|
157
|
|
|
|
|
567
|
$oldst = $statement; |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
# If there's a colon, eat it and parse the next Statement on the Line |
782
|
|
|
|
|
|
|
} while ($token_group->eat_if_class("Statement_End")); |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
# TODO make this error prettier |
785
|
149
|
50
|
|
|
|
433
|
if ($token_group->stuff_left) { |
786
|
0
|
|
|
|
|
|
my $p = "Extra tokens left after parsing!\n" . $token_group->print; |
787
|
0
|
|
|
|
|
|
chomp($p); |
788
|
0
|
|
|
|
|
|
Exit_Error($p); |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
} |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
=item output_perl |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
This method simply calls output_perl on each of the Line's Statements in |
795
|
|
|
|
|
|
|
order. |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
=back |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=cut |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
sub output_perl { |
802
|
0
|
|
|
0
|
|
|
my $self = shift; |
803
|
0
|
|
|
|
|
|
my $statement = $self->{"first_statement"}; |
804
|
0
|
|
|
|
|
|
my $out = $statement->output_perl; |
805
|
|
|
|
|
|
|
# Do each statement in the line in order |
806
|
|
|
|
|
|
|
# Put each statement on a separate line. |
807
|
0
|
|
|
|
|
|
while (defined ($statement = $statement->{"next_statement"})) { |
808
|
0
|
|
|
|
|
|
$out .= "\n"; |
809
|
0
|
|
|
|
|
|
$out .= $statement->output_perl; |
810
|
|
|
|
|
|
|
} |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
# Output the statement |
813
|
0
|
|
|
|
|
|
return $out; |
814
|
|
|
|
|
|
|
} # end sub Language::Basic::Line::output_perl |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
} # end package Language::Basic::Line |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
# end package Language::Basic |
820
|
|
|
|
|
|
|
1; |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
__END__ |