line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# -*- mode: perl; coding: us-ascii-unix; -*- |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=pod |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Acme::Cow::Interpreter - Cow programming language interpreter |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 SYNOPSIS |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use Acme::Cow::Interpreter; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
my $cow = Acme::Cow::Interpreter -> new(); |
14
|
|
|
|
|
|
|
$cow -> parse_file($file); |
15
|
|
|
|
|
|
|
$cow -> execute(); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 ABSTRACT |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
This module implements an interpreter for the Cow programming language. |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 DESCRIPTION |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
This module implements an interpreter for the Cow programming language. The |
24
|
|
|
|
|
|
|
Cow programming language is a so-called esoteric programming language, with |
25
|
|
|
|
|
|
|
only 12 commands. |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=cut |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
package Acme::Cow::Interpreter; |
30
|
|
|
|
|
|
|
|
31
|
2
|
|
|
2
|
|
177018
|
use strict; # restrict unsafe constructs |
|
2
|
|
|
|
|
24
|
|
|
2
|
|
|
|
|
62
|
|
32
|
2
|
|
|
2
|
|
11
|
use warnings; # control optional warnings |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
55
|
|
33
|
|
|
|
|
|
|
|
34
|
2
|
|
|
2
|
|
10
|
use Carp; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
4419
|
|
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# This hash maps each of the 12 command (used in the source code) to the |
39
|
|
|
|
|
|
|
# corresponding numerical code, from 0 to 11. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
my $cmd2code = |
42
|
|
|
|
|
|
|
{ |
43
|
|
|
|
|
|
|
moo => 0, |
44
|
|
|
|
|
|
|
mOo => 1, |
45
|
|
|
|
|
|
|
moO => 2, |
46
|
|
|
|
|
|
|
mOO => 3, |
47
|
|
|
|
|
|
|
Moo => 4, |
48
|
|
|
|
|
|
|
MOo => 5, |
49
|
|
|
|
|
|
|
MoO => 6, |
50
|
|
|
|
|
|
|
MOO => 7, |
51
|
|
|
|
|
|
|
OOO => 8, |
52
|
|
|
|
|
|
|
MMM => 9, |
53
|
|
|
|
|
|
|
OOM => 10, |
54
|
|
|
|
|
|
|
oom => 11, |
55
|
|
|
|
|
|
|
}; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# This array maps each of the 12 numerical codes to the corresponding |
58
|
|
|
|
|
|
|
# command (used in source code). |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
my $code2cmd = |
61
|
|
|
|
|
|
|
[ |
62
|
|
|
|
|
|
|
'moo', |
63
|
|
|
|
|
|
|
'mOo', |
64
|
|
|
|
|
|
|
'moO', |
65
|
|
|
|
|
|
|
'mOO', |
66
|
|
|
|
|
|
|
'Moo', |
67
|
|
|
|
|
|
|
'MOo', |
68
|
|
|
|
|
|
|
'MoO', |
69
|
|
|
|
|
|
|
'MOO', |
70
|
|
|
|
|
|
|
'OOO', |
71
|
|
|
|
|
|
|
'MMM', |
72
|
|
|
|
|
|
|
'OOM', |
73
|
|
|
|
|
|
|
'oom', |
74
|
|
|
|
|
|
|
]; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# This regular expression matches all the 12 valid commands. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
my $cmd_regex = '(?:[Mm][Oo][Oo]|MMM|OO[MO]|oom)'; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=pod |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 METHODS |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=over 4 |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=item new() |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
Return a new Cow interpreter. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=cut |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub new { |
93
|
1
|
|
|
1
|
1
|
135
|
my $proto = shift; |
94
|
1
|
|
|
|
|
4
|
my $protoref = ref $proto; |
95
|
1
|
|
33
|
|
|
7
|
my $class = $protoref || $proto; |
96
|
1
|
|
|
|
|
2
|
my $name = 'new'; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# Check how the method is called. |
99
|
|
|
|
|
|
|
|
100
|
1
|
50
|
|
|
|
4
|
croak "$name() is a class method, not an instance/object method" |
101
|
|
|
|
|
|
|
if $protoref; |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# The new self. |
104
|
|
|
|
|
|
|
|
105
|
1
|
|
|
|
|
3
|
my $self = {}; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# Bless the reference into an object. |
108
|
|
|
|
|
|
|
|
109
|
1
|
|
|
|
|
3
|
bless $self, $class; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# Initialize it. The return value of init() is the object itself. |
112
|
|
|
|
|
|
|
|
113
|
1
|
|
|
|
|
4
|
$self -> init(); |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=pod |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=item init() |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
Initialize an object instance. Clears the memory and register and sets the |
121
|
|
|
|
|
|
|
memory pointer to zero. Also, the internally stored program source is |
122
|
|
|
|
|
|
|
cleared. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=cut |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub init { |
127
|
5
|
|
|
5
|
1
|
8
|
my $self = shift; |
128
|
5
|
|
|
|
|
10
|
my $selfref = ref $self; |
129
|
5
|
|
33
|
|
|
12
|
my $class = $selfref || $self; |
130
|
5
|
|
|
|
|
10
|
my $name = 'init'; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
# Check how the method is called. |
133
|
|
|
|
|
|
|
|
134
|
5
|
50
|
|
|
|
11
|
croak "$name() is an instance/object method, not a class method" |
135
|
|
|
|
|
|
|
unless $selfref; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# Check number of arguments. |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
#croak "$name(): Not enough input arguments" if @_ < 0; |
140
|
5
|
50
|
|
|
|
13
|
croak "$name(): Too many input arguments" if @_ > 0; |
141
|
|
|
|
|
|
|
|
142
|
5
|
|
|
|
|
25
|
$self -> {prog} = []; # program; array of codes |
143
|
5
|
|
|
|
|
11
|
$self -> {mem} = [0]; # memory |
144
|
5
|
|
|
|
|
8
|
$self -> {reg} = undef; # register |
145
|
5
|
|
|
|
|
8
|
$self -> {prog_pos} = 0; # index of current program code |
146
|
5
|
|
|
|
|
7
|
$self -> {mem_pos} = 0; # index of current memory block |
147
|
|
|
|
|
|
|
|
148
|
5
|
|
|
|
|
16
|
return $self; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=pod |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=item copy() |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
Copy (clone) an Acme::Cow::Interpreter object. |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=cut |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub copy { |
160
|
1
|
|
|
1
|
1
|
4
|
my $self = shift; |
161
|
1
|
|
|
|
|
3
|
my $selfref = ref $self; |
162
|
1
|
|
33
|
|
|
4
|
my $class = $selfref || $self; |
163
|
1
|
|
|
|
|
3
|
my $name = 'copy'; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# Check how the method is called. |
166
|
|
|
|
|
|
|
|
167
|
1
|
50
|
|
|
|
3
|
croak "$name() is an instance/object method, not a class method" |
168
|
|
|
|
|
|
|
unless $selfref; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# Check number of arguments. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
#croak "$name(): Not enough input arguments" if @_ < 0; |
173
|
1
|
50
|
|
|
|
4
|
croak "$name(): Too many input arguments" if @_ > 0; |
174
|
|
|
|
|
|
|
|
175
|
1
|
|
|
|
|
3
|
my $copy = {}; |
176
|
1
|
|
|
|
|
5
|
for my $key (keys %$self) { |
177
|
5
|
|
|
|
|
9
|
my $ref = ref $self -> {$key}; |
178
|
5
|
100
|
|
|
|
12
|
if ($ref eq 'ARRAY') { |
179
|
2
|
|
|
|
|
5
|
@{ $copy -> {$key} } = @{ $self -> {$key} }; |
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
4
|
|
180
|
|
|
|
|
|
|
} else { |
181
|
3
|
|
|
|
|
7
|
$copy -> {$key} = $self -> {$key}; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# Bless the copy into an object. |
186
|
|
|
|
|
|
|
|
187
|
1
|
|
|
|
|
8
|
bless $copy, $class; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=pod |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=item parse_string( STRING ) |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Parses the given string and stores the resulting list of codes in the |
195
|
|
|
|
|
|
|
object. The return value is the object itself. |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=cut |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
sub parse_string { |
200
|
2
|
|
|
2
|
1
|
5
|
my $self = shift; |
201
|
2
|
|
|
|
|
31
|
my $selfref = ref $self; |
202
|
2
|
|
33
|
|
|
9
|
my $class = $selfref || $self; |
203
|
2
|
|
|
|
|
4
|
my $name = 'parse_string'; |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
# Check how the method is called. |
206
|
|
|
|
|
|
|
|
207
|
2
|
50
|
|
|
|
6
|
croak "$name() is an instance/object method, not a class method" |
208
|
|
|
|
|
|
|
unless $selfref; |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# Check number of arguments. |
211
|
|
|
|
|
|
|
|
212
|
2
|
50
|
|
|
|
6
|
croak "$name(): Not enough input arguments" if @_ < 1; |
213
|
2
|
50
|
|
|
|
6
|
croak "$name(): Too many input arguments" if @_ > 1; |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# There is no way the parser can fail. The worst thing that could happen |
216
|
|
|
|
|
|
|
# is that there are no commands in the string. |
217
|
|
|
|
|
|
|
|
218
|
2
|
50
|
|
|
|
4
|
my $string = shift; croak "$name(): Input argument is undefined" |
|
2
|
|
|
|
|
5
|
|
219
|
|
|
|
|
|
|
unless defined $string; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# Reset, i.e., initialize, the invocand object. |
222
|
|
|
|
|
|
|
|
223
|
2
|
|
|
|
|
9
|
$self -> init(); |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# Find the string commands, and convert them to numerical codes. |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
$self -> {prog} = [ |
228
|
2
|
|
|
|
|
307
|
map { $cmd2code -> {$_} } |
|
333
|
|
|
|
|
509
|
|
229
|
|
|
|
|
|
|
$string =~ /($cmd_regex)/go |
230
|
|
|
|
|
|
|
]; |
231
|
|
|
|
|
|
|
|
232
|
2
|
|
|
|
|
32
|
return $self; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=pod |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=item parse_file( FILENAME ) |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
Parses the contents of the given file and stores the resulting list of codes |
240
|
|
|
|
|
|
|
in the object. The return value is the object itself. |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=cut |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub parse_file { |
245
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
246
|
1
|
|
|
|
|
3
|
my $selfref = ref $self; |
247
|
1
|
|
33
|
|
|
4
|
my $class = $selfref || $self; |
248
|
1
|
|
|
|
|
3
|
my $name = 'parse_file'; |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# Check how the method is called. |
251
|
|
|
|
|
|
|
|
252
|
1
|
50
|
|
|
|
3
|
croak "$name() is an instance/object method, not a class method" |
253
|
|
|
|
|
|
|
unless $selfref; |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# Check number of arguments. |
256
|
|
|
|
|
|
|
|
257
|
1
|
50
|
|
|
|
5
|
croak "$name(): Not enough input arguments" if @_ < 1; |
258
|
1
|
50
|
|
|
|
3
|
croak "$name(): Too many input arguments" if @_ > 1; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
# Reset, i.e., initialize, the invocand object. |
261
|
|
|
|
|
|
|
|
262
|
1
|
|
|
|
|
4
|
$self -> init(); |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
# Get the file name argument. |
265
|
|
|
|
|
|
|
|
266
|
1
|
|
|
|
|
3
|
my $file = shift; |
267
|
|
|
|
|
|
|
|
268
|
1
|
50
|
|
|
|
46
|
open FILE, $file or croak "$file: can't open file for reading: $!"; |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# Iterate over each line, find the string commands, and convert them to |
271
|
|
|
|
|
|
|
# numerical codes. |
272
|
|
|
|
|
|
|
|
273
|
1
|
|
|
|
|
18
|
while () { |
274
|
167
|
|
|
|
|
818
|
push @{ $self -> {prog} }, |
275
|
167
|
|
|
|
|
223
|
map { $cmd2code -> {$_} } |
|
323
|
|
|
|
|
629
|
|
276
|
|
|
|
|
|
|
/($cmd_regex)/go; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
1
|
50
|
|
|
|
13
|
close FILE or croak "$file: can't close file after reading: $!"; |
280
|
|
|
|
|
|
|
|
281
|
1
|
|
|
|
|
10
|
return $self; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=pod |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=item dump_mem() |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
Returns a nicely formatted string showing the current memory state. |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=cut |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
sub dump_mem { |
293
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
294
|
1
|
|
|
|
|
3
|
my $selfref = ref $self; |
295
|
1
|
|
33
|
|
|
4
|
my $class = $selfref || $self; |
296
|
1
|
|
|
|
|
2
|
my $name = 'dump_mem'; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# Check how the method is called. |
299
|
|
|
|
|
|
|
|
300
|
1
|
50
|
|
|
|
4
|
croak "$name() is an instance/object method, not a class method" |
301
|
|
|
|
|
|
|
unless $selfref; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
# Check number of arguments. |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
#croak "$name(): Not enough input arguments" if @_ < 0; |
306
|
1
|
50
|
|
|
|
3
|
croak "$name(): Too many input arguments" if @_ > 0; |
307
|
|
|
|
|
|
|
|
308
|
1
|
|
|
|
|
3
|
my $mem = $self -> {mem}; |
309
|
1
|
|
|
|
|
15
|
my $mem_pos = $self -> {mem_pos}; |
310
|
1
|
|
|
|
|
19
|
my $reg = $self -> {reg}; |
311
|
|
|
|
|
|
|
|
312
|
1
|
|
|
|
|
4
|
my $str = ''; |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
# Print the contents of the memory, showing the block which the memory |
315
|
|
|
|
|
|
|
# points at. |
316
|
|
|
|
|
|
|
|
317
|
1
|
|
|
|
|
7
|
for (my $i = $#$mem ; $i >= 0 ; -- $i) { |
318
|
3
|
|
|
|
|
12
|
$str .= sprintf "Memory block %6u: %12d", $i, $mem->[$i]; |
319
|
3
|
100
|
|
|
|
8
|
if ($i == $mem_pos) { |
320
|
1
|
|
|
|
|
4
|
$str .= " <<<"; |
321
|
|
|
|
|
|
|
} |
322
|
3
|
|
|
|
|
8
|
$str .= "\n"; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
# Print the contents of the register. |
326
|
|
|
|
|
|
|
|
327
|
1
|
|
|
|
|
3
|
$str .= "\n"; |
328
|
1
|
50
|
|
|
|
5
|
$str .= sprintf "Register block: %17s", defined $reg ? $reg : ''; |
329
|
1
|
|
|
|
|
3
|
$str .= "\n"; |
330
|
|
|
|
|
|
|
|
331
|
1
|
|
|
|
|
6
|
return $str; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=pod |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
=item dump_obj() |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
Returns a text version of object structure. |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=cut |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
sub dump_obj { |
343
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
344
|
1
|
|
|
|
|
3
|
my $selfref = ref $self; |
345
|
1
|
|
33
|
|
|
4
|
my $class = $selfref || $self; |
346
|
1
|
|
|
|
|
2
|
my $name = 'dump'; |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
# Check how the method is called. |
349
|
|
|
|
|
|
|
|
350
|
1
|
50
|
|
|
|
4
|
croak "$name() is an instance/object method, not a class method" |
351
|
|
|
|
|
|
|
unless $selfref; |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
# Check number of arguments. |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
#croak "$name(): Not enough input arguments" if @_ < 0; |
356
|
1
|
50
|
|
|
|
3
|
croak "$name(): Too many input arguments" if @_ > 0; |
357
|
|
|
|
|
|
|
|
358
|
1
|
|
|
|
|
3
|
my $prog = $self -> {prog}; |
359
|
1
|
|
|
|
|
2
|
my $mem = $self -> {mem}; |
360
|
1
|
|
|
|
|
4
|
my $reg = $self -> {reg}; |
361
|
1
|
|
|
|
|
2
|
my $prog_pos = $self -> {prog_pos}; |
362
|
1
|
|
|
|
|
3
|
my $mem_pos = $self -> {mem_pos}; |
363
|
|
|
|
|
|
|
|
364
|
1
|
|
|
|
|
2
|
my $str; |
365
|
|
|
|
|
|
|
|
366
|
1
|
|
|
|
|
3
|
$str .= '$obj -> {prog} = ['; |
367
|
1
|
|
|
|
|
6
|
$str .= join(', ', @$prog); |
368
|
1
|
|
|
|
|
3
|
$str .= "];\n"; |
369
|
|
|
|
|
|
|
|
370
|
1
|
|
|
|
|
2
|
$str .= '$obj -> {prog_pos} = '; |
371
|
1
|
|
|
|
|
2
|
$str .= $prog_pos; |
372
|
1
|
|
|
|
|
2
|
$str .= ";\n"; |
373
|
|
|
|
|
|
|
|
374
|
1
|
|
|
|
|
3
|
$str .= '$obj -> {mem} = ['; |
375
|
1
|
|
|
|
|
3
|
$str .= join(', ', @$mem); |
376
|
1
|
|
|
|
|
1
|
$str .= "];\n"; |
377
|
|
|
|
|
|
|
|
378
|
1
|
|
|
|
|
3
|
$str .= '$obj -> {mem_pos} = '; |
379
|
1
|
|
|
|
|
1
|
$str .= $mem_pos; |
380
|
1
|
|
|
|
|
3
|
$str .= ";\n"; |
381
|
1
|
|
|
|
|
3
|
$str .= '$obj -> {reg} = '; |
382
|
1
|
50
|
|
|
|
3
|
$str .= defined $reg ? $reg : ''; |
383
|
1
|
|
|
|
|
2
|
$str .= ";\n"; |
384
|
|
|
|
|
|
|
|
385
|
1
|
|
|
|
|
6
|
return $str; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=pod |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=item execute() |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
Executes the source code. The return value is the object itself. |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=cut |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
sub execute { |
397
|
3
|
|
|
3
|
1
|
2895
|
my $self = shift; |
398
|
3
|
|
|
|
|
7
|
my $selfref = ref $self; |
399
|
3
|
|
33
|
|
|
10
|
my $class = $selfref || $self; |
400
|
3
|
|
|
|
|
5
|
my $name = 'execute'; |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
# Check how the method is called. |
403
|
|
|
|
|
|
|
|
404
|
3
|
50
|
|
|
|
8
|
croak "$name() is an instance/object method, not a class method" |
405
|
|
|
|
|
|
|
unless $selfref; |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
# Check number of arguments. |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
#croak "$name(): Not enough input arguments" if @_ < 0; |
410
|
3
|
50
|
|
|
|
7
|
croak "$name(): Too many input arguments" if @_ > 0; |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
# These variables are merely for convenience. They make the code below a |
413
|
|
|
|
|
|
|
# bit cleaner. |
414
|
|
|
|
|
|
|
|
415
|
3
|
|
|
|
|
7
|
my $prog = $self -> {prog}; |
416
|
3
|
|
|
|
|
6
|
my $mem = $self -> {mem}; |
417
|
3
|
|
|
|
|
4
|
my $prog_pos = \$self -> {prog_pos}; |
418
|
3
|
|
|
|
|
6
|
my $mem_pos = \$self -> {mem_pos}; |
419
|
3
|
|
|
|
|
4
|
my $reg = \$self -> {reg}; |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
# Quick exit if there are no commands (program is void). |
422
|
|
|
|
|
|
|
|
423
|
3
|
50
|
|
|
|
7
|
return 1 unless @$prog; |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
# The code to be executed. |
426
|
|
|
|
|
|
|
|
427
|
3
|
|
|
|
|
6
|
my $code = $prog -> [$$prog_pos]; |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
# Main loop. Each round executes one instruction. |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
{ |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
#print "-" x 72, "\n"; |
434
|
|
|
|
|
|
|
#print "prog ...:"; |
435
|
|
|
|
|
|
|
#printf " %3s", $code2cmd -> [$_] for @$prog; |
436
|
|
|
|
|
|
|
#print "\n"; |
437
|
|
|
|
|
|
|
#print "ppos ...:", " " x $$prog_pos, " ^^^\n"; |
438
|
|
|
|
|
|
|
##print "ppos ...: $$prog_pos\n"; |
439
|
|
|
|
|
|
|
#print "code ...: $code ($code2cmd -> [$code])\n"; |
440
|
|
|
|
|
|
|
#print "\n"; |
441
|
|
|
|
|
|
|
#print "mem ....:"; |
442
|
|
|
|
|
|
|
#printf " %4d", $_ for @$mem; |
443
|
|
|
|
|
|
|
#print "\n"; |
444
|
|
|
|
|
|
|
#print "mpos ...:", " " x $$mem_pos, " ^^^^\n"; |
445
|
|
|
|
|
|
|
#print "reg ....: ", defined $$reg ? $$reg : "", "\n"; |
446
|
|
|
|
|
|
|
#; |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
# Code: moo |
449
|
|
|
|
|
|
|
|
450
|
3
|
50
|
|
|
|
4
|
if ($code == 0) { |
|
656
|
100
|
|
|
|
1800
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
# Remember where we started searching for matching 'MOO'. |
453
|
|
|
|
|
|
|
|
454
|
0
|
|
|
|
|
0
|
my $init_pos = $$prog_pos; |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
# Skip previous instruction when looking for matching 'MOO'. |
457
|
|
|
|
|
|
|
|
458
|
0
|
|
|
|
|
0
|
$$prog_pos --; |
459
|
|
|
|
|
|
|
|
460
|
0
|
|
|
|
|
0
|
my $level = 1; |
461
|
0
|
|
|
|
|
0
|
while ($level > 0) { |
462
|
|
|
|
|
|
|
|
463
|
0
|
0
|
|
|
|
0
|
if ($$prog_pos == 0) { |
464
|
0
|
|
|
|
|
0
|
croak "No previous 'MOO' command matching 'moo'", |
465
|
|
|
|
|
|
|
" command. Failed at instruction number $init_pos."; |
466
|
|
|
|
|
|
|
#last; |
467
|
|
|
|
|
|
|
#return 0; |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
0
|
|
|
|
|
0
|
$$prog_pos --; |
471
|
|
|
|
|
|
|
|
472
|
0
|
0
|
|
|
|
0
|
if ($prog -> [$$prog_pos] == 0) { # if "moo" |
|
|
0
|
|
|
|
|
|
473
|
0
|
|
|
|
|
0
|
$level ++; |
474
|
|
|
|
|
|
|
} elsif ($prog -> [$$prog_pos] == 7) { # if "MOO" |
475
|
0
|
|
|
|
|
0
|
$level --; |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
# This if-test is necessary if we use 'last' rather than 'croak' |
480
|
|
|
|
|
|
|
# in the if-test inside the while-loop above. |
481
|
|
|
|
|
|
|
# |
482
|
|
|
|
|
|
|
#if ($level != 0) { |
483
|
|
|
|
|
|
|
# croak "No previous 'MOO' command matching 'moo'", |
484
|
|
|
|
|
|
|
# " command (instruction number $init_pos)."; |
485
|
|
|
|
|
|
|
#} |
486
|
|
|
|
|
|
|
|
487
|
0
|
|
|
|
|
0
|
$code = $prog -> [$$prog_pos]; |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
# Code: mOo |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
elsif ($code == 1) { |
494
|
|
|
|
|
|
|
|
495
|
1
|
50
|
|
|
|
4
|
if ($$mem_pos == 0) { |
496
|
0
|
|
|
|
|
0
|
croak "Can't move memory pointer behind memory block 0.", |
497
|
|
|
|
|
|
|
" Failed at command number $$prog_pos."; |
498
|
|
|
|
|
|
|
} |
499
|
1
|
|
|
|
|
3
|
$$mem_pos --; |
500
|
|
|
|
|
|
|
|
501
|
1
|
50
|
|
|
|
3
|
last if $$prog_pos == $#$prog; |
502
|
0
|
|
|
|
|
0
|
$$prog_pos ++; |
503
|
0
|
|
|
|
|
0
|
$code = $prog -> [$$prog_pos]; |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
# Code: moO |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
elsif ($code == 2) { |
510
|
|
|
|
|
|
|
|
511
|
2
|
|
|
|
|
3
|
$$mem_pos ++; |
512
|
2
|
50
|
|
|
|
5
|
if ($$mem_pos > $#$mem) { |
513
|
2
|
|
|
|
|
4
|
push @$mem, 0; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
|
516
|
2
|
50
|
|
|
|
6
|
last if $$prog_pos == $#$prog; |
517
|
2
|
|
|
|
|
3
|
$$prog_pos ++; |
518
|
2
|
|
|
|
|
4
|
$code = $prog -> [$$prog_pos]; |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
# Code: mOO |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
elsif ($code == 3) { |
525
|
|
|
|
|
|
|
|
526
|
0
|
0
|
|
|
|
0
|
if ($mem -> [$$mem_pos] == 3) { |
527
|
0
|
|
|
|
|
0
|
croak "Invalid instruction at this point (would cause", |
528
|
|
|
|
|
|
|
" infinite loop). Failed at instruction number $$prog_pos."; |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
# We don't need to check for any other invalid instruction |
532
|
|
|
|
|
|
|
# (which exits the program), since this will be taken care of in |
533
|
|
|
|
|
|
|
# the next round. |
534
|
|
|
|
|
|
|
|
535
|
0
|
|
|
|
|
0
|
$code = $mem -> [$$mem_pos]; |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
# Code: Moo |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
elsif ($code == 4) { |
542
|
|
|
|
|
|
|
|
543
|
28
|
50
|
|
|
|
46
|
if ($mem -> [$$mem_pos] == 0) { |
544
|
0
|
|
|
|
|
0
|
my $chr; |
545
|
0
|
|
|
|
|
0
|
read(STDIN, $chr, 1); |
546
|
0
|
|
|
|
|
0
|
$mem -> [$$mem_pos] = ord($chr); |
547
|
|
|
|
|
|
|
} else { |
548
|
28
|
|
|
|
|
389
|
printf "%c", $mem -> [$$mem_pos]; |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
28
|
100
|
|
|
|
110
|
last if $$prog_pos == $#$prog; |
552
|
26
|
|
|
|
|
43
|
$$prog_pos ++; |
553
|
26
|
|
|
|
|
40
|
$code = $prog -> [$$prog_pos]; |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
# Code: MOo |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
elsif ($code == 5) { |
560
|
|
|
|
|
|
|
|
561
|
52
|
|
|
|
|
66
|
$mem -> [$$mem_pos] --; |
562
|
|
|
|
|
|
|
|
563
|
52
|
50
|
|
|
|
90
|
last if $$prog_pos == $#$prog; |
564
|
52
|
|
|
|
|
66
|
$$prog_pos ++; |
565
|
52
|
|
|
|
|
71
|
$code = $prog -> [$$prog_pos]; |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
# Code: MoO |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
elsif ($code == 6) { |
572
|
|
|
|
|
|
|
|
573
|
563
|
|
|
|
|
724
|
$mem -> [$$mem_pos] ++; |
574
|
|
|
|
|
|
|
|
575
|
563
|
50
|
|
|
|
923
|
last if $$prog_pos == $#$prog; |
576
|
563
|
|
|
|
|
758
|
$$prog_pos ++; |
577
|
563
|
|
|
|
|
754
|
$code = $prog -> [$$prog_pos]; |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
} |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
# Code: MOO |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
elsif ($code == 7) { |
584
|
|
|
|
|
|
|
|
585
|
0
|
0
|
|
|
|
0
|
if ($mem -> [$$mem_pos] == 0) { |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
# Remember where we started searching for matching 'moo'. |
588
|
|
|
|
|
|
|
|
589
|
0
|
|
|
|
|
0
|
my $init_pos = $$prog_pos; |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
# Skip next instruction when looking for matching 'moo'. |
592
|
|
|
|
|
|
|
|
593
|
0
|
|
|
|
|
0
|
$$prog_pos ++; |
594
|
|
|
|
|
|
|
|
595
|
0
|
|
|
|
|
0
|
my $level = 1; |
596
|
0
|
|
|
|
|
0
|
my $prev_code; |
597
|
|
|
|
|
|
|
|
598
|
0
|
|
|
|
|
0
|
while ($level > 0) { |
599
|
|
|
|
|
|
|
|
600
|
0
|
0
|
|
|
|
0
|
if ($$prog_pos == $#$prog) { |
601
|
0
|
|
|
|
|
0
|
croak "No following 'moo' command matching 'MOO'", |
602
|
|
|
|
|
|
|
" command. Failed at instruction number $init_pos."; |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
|
605
|
0
|
|
|
|
|
0
|
$prev_code = $prog -> [$$prog_pos]; |
606
|
0
|
|
|
|
|
0
|
$$prog_pos ++; |
607
|
|
|
|
|
|
|
|
608
|
0
|
0
|
|
|
|
0
|
if ($prog -> [$$prog_pos] == 7) { # if "MOO" |
|
|
0
|
|
|
|
|
|
609
|
0
|
|
|
|
|
0
|
$level ++; |
610
|
|
|
|
|
|
|
} elsif ($prog -> [$$prog_pos] == 0) { # if "moo" |
611
|
0
|
|
|
|
|
0
|
$level --; |
612
|
0
|
0
|
|
|
|
0
|
if ($prev_code == 7) { |
613
|
0
|
|
|
|
|
0
|
$level --; |
614
|
|
|
|
|
|
|
} |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
# This if-test is necessary if we use 'last' rather than |
619
|
|
|
|
|
|
|
# 'croak' in the if-test inside the while-loop above. |
620
|
|
|
|
|
|
|
# |
621
|
|
|
|
|
|
|
#if ($level != 0 ) { |
622
|
|
|
|
|
|
|
# croak "No following 'moo' command matching 'MOO'", |
623
|
|
|
|
|
|
|
# " command. Failed at instruction number $init_pos."; |
624
|
|
|
|
|
|
|
#} |
625
|
|
|
|
|
|
|
|
626
|
0
|
0
|
|
|
|
0
|
last if $$prog_pos == $#$prog; |
627
|
0
|
|
|
|
|
0
|
$$prog_pos ++; |
628
|
0
|
|
|
|
|
0
|
$code = $prog -> [$$prog_pos]; |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
} else { |
631
|
|
|
|
|
|
|
|
632
|
0
|
0
|
|
|
|
0
|
last if $$prog_pos == $#$prog; |
633
|
0
|
|
|
|
|
0
|
$$prog_pos ++; |
634
|
0
|
|
|
|
|
0
|
$code = $prog -> [$$prog_pos]; |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
} |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
# Code: OOO |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
elsif ($code == 8) { |
643
|
|
|
|
|
|
|
|
644
|
6
|
|
|
|
|
10
|
$mem -> [$$mem_pos] = 0; |
645
|
|
|
|
|
|
|
|
646
|
6
|
50
|
|
|
|
12
|
last if $$prog_pos == $#$prog; |
647
|
6
|
|
|
|
|
9
|
$$prog_pos ++; |
648
|
6
|
|
|
|
|
19
|
$code = $prog -> [$$prog_pos]; |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
# Code: MMM |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
elsif ($code == 9) { |
655
|
|
|
|
|
|
|
|
656
|
4
|
100
|
|
|
|
8
|
if (defined $$reg) { |
657
|
2
|
|
|
|
|
3
|
$mem -> [$$mem_pos] = $$reg; |
658
|
2
|
|
|
|
|
4
|
$$reg = undef; |
659
|
|
|
|
|
|
|
} else { |
660
|
2
|
|
|
|
|
5
|
$$reg = $mem -> [$$mem_pos]; |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
|
663
|
4
|
50
|
|
|
|
8
|
last if $$prog_pos == $#$prog; |
664
|
4
|
|
|
|
|
7
|
$$prog_pos ++; |
665
|
4
|
|
|
|
|
6
|
$code = $prog -> [$$prog_pos]; |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
# Code: OOM |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
elsif ($code == 10) { |
672
|
|
|
|
|
|
|
|
673
|
0
|
|
|
|
|
0
|
printf "%d\n", $mem -> [$$mem_pos]; |
674
|
|
|
|
|
|
|
|
675
|
0
|
0
|
|
|
|
0
|
last if $$prog_pos == $#$prog; |
676
|
0
|
|
|
|
|
0
|
$$prog_pos ++; |
677
|
0
|
|
|
|
|
0
|
$code = $prog -> [$$prog_pos]; |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
# Code: oom |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
elsif ($code == 11) { |
684
|
|
|
|
|
|
|
|
685
|
0
|
|
|
|
|
0
|
my $input = ; |
686
|
0
|
0
|
|
|
|
0
|
croak "Input was undefined\n" |
687
|
|
|
|
|
|
|
unless defined $input; |
688
|
0
|
|
|
|
|
0
|
$input =~ s/^\s+//; |
689
|
0
|
|
|
|
|
0
|
$input =~ s/\s+$//; |
690
|
0
|
0
|
|
|
|
0
|
croak "Input was not an integer -- $input\n" |
691
|
|
|
|
|
|
|
unless $input =~ /^[+-]?\d+/; |
692
|
|
|
|
|
|
|
|
693
|
0
|
|
|
|
|
0
|
$mem -> [$$mem_pos] = $input; |
694
|
|
|
|
|
|
|
|
695
|
0
|
0
|
|
|
|
0
|
last if $$prog_pos == $#$prog; |
696
|
0
|
|
|
|
|
0
|
$$prog_pos ++; |
697
|
0
|
|
|
|
|
0
|
$code = $prog -> [$$prog_pos]; |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
# An invalid instruction exits the running program. |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
else { |
704
|
0
|
|
|
|
|
0
|
return 1; |
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
|
707
|
653
|
|
|
|
|
819
|
redo; |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
|
710
|
3
|
|
|
|
|
15
|
return $self; |
711
|
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
=pod |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
=back |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=head1 NOTES |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
=head2 The Cow Language |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
The Cow language has 12 instruction. The commands and their corresponding |
722
|
|
|
|
|
|
|
code numbers are: |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
=over 4 |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
=item moo (0) |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
This command is connected to the B command. When encountered during |
729
|
|
|
|
|
|
|
normal execution, it searches the program code in reverse looking for a |
730
|
|
|
|
|
|
|
matching B command and begins executing again starting from the found |
731
|
|
|
|
|
|
|
B command. When searching, it skips the command that is immediately |
732
|
|
|
|
|
|
|
before it (see B). |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=item mOo (1) |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
Moves current memory position back one block. |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
=item moO (2) |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
Moves current memory position forward one block. |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=item mOO (3) |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
Execute value in current memory block as if it were an instruction. The |
745
|
|
|
|
|
|
|
command executed is based on the instruction code value (for example, if the |
746
|
|
|
|
|
|
|
current memory block contains a 2, then the B command is executed). An |
747
|
|
|
|
|
|
|
invalid command exits the running program. Value 3 is invalid as it would |
748
|
|
|
|
|
|
|
cause an infinite loop. |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
=item Moo (4) |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
If current memory block has a 0 in it, read a single ASCII character from |
753
|
|
|
|
|
|
|
the standard input and store it in the current memory block. If the current |
754
|
|
|
|
|
|
|
memory block is not 0, then print the ASCII character that corresponds to |
755
|
|
|
|
|
|
|
the value in the current memory block to the standard output. |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
=item MOo (5) |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
Decrement current memory block value by 1. |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
=item MoO (6) |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
Increment current memory block value by 1. |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
=item MOO (7) |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
If current memory block value is 0, skip next command and resume execution |
768
|
|
|
|
|
|
|
after the next matching B command. If current memory block value is not |
769
|
|
|
|
|
|
|
0, then continue with next command. Note that the fact that it skips the |
770
|
|
|
|
|
|
|
command immediately following it has interesting ramifications for where the |
771
|
|
|
|
|
|
|
matching B command really is. For example, the following will match the |
772
|
|
|
|
|
|
|
second and not the first B: B B B B |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
=item OOO (8) |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
Set current memory block value to 0. |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
=item MMM (9) |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
If no current value in register, copy current memory block value. If there |
781
|
|
|
|
|
|
|
is a value in the register, then paste that value into the current memory |
782
|
|
|
|
|
|
|
block and clear the register. |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
=item OOM (10) |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
Print value of current memory block to the standard output as an integer. |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
=item oom (11) |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
Read an integer from the standard input and put it into the current memory |
791
|
|
|
|
|
|
|
block. |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
=back |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
=head1 TODO |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
Add more tests. The module is far from being tested thoroughly. |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=head1 BUGS |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
There are currently no known bugs. |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
Please report any bugs or feature requests via |
804
|
|
|
|
|
|
|
L. |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
Old bug reports and feature requests can be found at |
807
|
|
|
|
|
|
|
L. |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
=head1 SUPPORT |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
perldoc Acme::Cow::Interpreter |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
You can also look for information at: |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
=over 4 |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
=item * GitHub |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
L |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=item * MetaCPAN |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
L |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=item * CPAN Ratings |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
L |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
=item * CPAN Testers PASS Matrix |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
L |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
=item * CPAN Testers Reports |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
L |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
=item * CPAN Testers Matrix |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
L |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
=back |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=head1 REFERENCES |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=over 4 |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
=item * L |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
=back |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
=head1 AUTHOR |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
Peter John Acklam Epjacklam@gmail.com |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
Copyright 2007-2020 Peter John Acklam. |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
862
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.8.0 or, |
863
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
=cut |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
1; |