#!/usr/bin/perl
=begin metadata
Name: bc
Description: an arbitrary precision calculator language
Author: Philip A. Nelson, phil@cs.wwu.edu
License: gpl
=end metadata
=cut
=head1 NAME
bc - an arbitrary precision calculator language
=head1 SYNOPSIS
Show a help message
% bc -h
Run a bc program from FILE
bc [-bdiqswy] FILE
Run a bc program from standard input
bc [-bdiqswy] -
=head1 DESCRIPTION
This is the PerlPowerTools implementations of GNU version of bc, a
souped-up calculator language. This is documented at:
https://www.gnu.org/software/bc/manual/html_mono/bc.html
=head2 Options
=over
=item * -b - use Math::BigFloat
=item * -d - turn on debugging output
=item * -h - show a help message and exit
=item * -i - force interactive mode (a no-op for compatibility)
=item * -l - use mathlib
=item * -q - suppress the welcome message
=item * -s - process the POSIX bc language (a no-op for compatibility)
=item * -w - give warnings for POSIX bc extensions (a no-op for compatibility)
=item * -y - turn on parsing debugging output
=back
=head2 Environment
There are no environment variables that affect this program.
=head1 The bc language
NOTE: Some of this documentation is lifted straight from the GNU
documentation for its version of B<bc>.
C<bc> is a language that supports arbitrary precision numbers with
interactive execution of statements. There are some similarities in
the syntax to the C programming language.
=begin comment ### XXX hidden because function support generate syntax errors
A standard math library is
available by command line option. If requested, the math library is
defined before processing any files.
=end comment
C<bc> starts by processing code from all the files listed on the
command line in the order listed. If no files are listed, then stdin
is read. If a file contains a command to halt the processor,
C<bc> will never read from the standard input.
Dash ('-') is a pseudo-filename which represents stdin. This makes
it possible to do something like C<bc fileA - fileB> and have bc
run commands from fileA before prompting for input, and then run
commands from fileB after interactive input is finished.
=begin comment ### XXX for accuracy, the following is superceded by the above
C<bc> starts by processing code from all the files listed on the
command line in the order listed. After all files have been
processed, C<bc> reads from the standard input. All code is executed
as it is read. (If a file contains a command to halt the processor,
C<bc> will never read from the standard input.)
=end comment
C<bc> will terminate interactive input via stdin if you enter C<quit>
or press C<CTRL-C>.
Pressing C<CTRL-Z> will end stdin input and move on the the next
filename on the command line (if there is one). Otherwise, execution
ends.
=head1 OPTIONS
C<bc> takes the following options from the command line:
=over 4
=item -b
Use Math::BigFloat for arbitrarily large number support.
=item -d
Print debugging data (using Data::Dumper).
=item -y
Turn on parser debugging.
=begin comment ### -l hidden because it generate syntax errors
=item -l
Define the standard math library.
=end comment
=begin comment ### -h and hidden because it's not supported
=item -h
Print the documentation.
=end comment
=back
=head1 BASIC ELEMENTS
=head2 Numbers
The most basic element in C<bc> is the number. Numbers are arbitrary
precision numbers. This precision is both in the integer part and the
fractional part. All numbers are represented internally in decimal and
all computation is done in decimal.
=begin comment ### hidden because it doesn't seem to be true in this implementation
(This version truncates results
from divide and multiply operations.)
=end comment
There are two attributes of
numbers, the length and the scale. The length is the total number of
significant decimal digits in a number and the scale is the total number
of decimal digits after the decimal point. For example, .000001 has a
length of 6 and scale of 6, while 1935.000 has a length of 7 and a scale
of 3.
=head2 Variables
Numbers are stored in two types of variables, simple variables and
arrays. Both simple variables and array variables are named. Names
begin with a letter followed by any number of letters, digits and
underscores. All letters must be lower case.
=begin comment ### hidden because it's not applicable and confusing
(Full alphanumeric names
are an extension. In POSIX C<bc> all names are a single lower case
letter.)
=end comment
The type of variable is clear by the context because all
array variable names will be followed by brackets ( [ ] ).
=head2 Special Variables
=over 8
=item C<scale>
Defines how some operations use digits after the decimal point.
The default value is 0.
=item C<ibase>
Defines the conversion base for input numbers. Defaults to 10.
=item C<obase>
Defines the conversion base for output numbers. Defaults to 10.
=back
=head2 Comments
Comments in C<bc> start with the characters '/*' and end with the
characters '*/'. Comments may start anywhere and appear as a single
space in the input. Note that this causes comments to delimit other
input items, therefore a comment cannot be included the middle of a
variable name. Comments include any newlines (end of line) between
the start and the end of the comment.
To support the use of scripts for C<bc>, a single line comment has
been added as an extension. A single line comment starts at a '#'
character and continues to the next end of the line. The end of line
character is not part of the comment and is processed normally.
=head1 EXPRESSIONS
Numbers are manipulated by expressions and statements. Since
the language was designed to be interactive, statements and expressions
are executed as soon as possible. There is no main program. Instead,
code is executed as it is encountered.
A simple expression is just a constant. C<bc> converts constants into
internal decimal numbers using the current input base, specified by the
variable C<ibase>.
Full expressions are similar to many other high level languages.
Since there is only one kind of number, there are no rules for mixing
types. Instead, there are rules on the scale of expressions. Every
expression has a scale. This is derived from the scale of original
numbers, the operation performed and in many cases, the value of the
variable C<scale>.
=begin comment ### replace by the above for accurary w.r.t this implementation
The numbers are manipulated by expressions and statements. Since the language was designed to be interactive, statements and expressions are executed as soon as possible. There is no main program. Instead, code is executed as it is encountered. (Functions, discussed in detail later, are defined when encountered.)
A simple expression is just a constant. bc converts constants into internal decimal numbers using the current input base, specified by the variable ibase. (There is an exception in functions.) The legal values of ibase are 2 through 16. Assigning a value outside this range to ibase will result in a value of 2 or 16. Input numbers may contain the characters 0-9 and A-F. (Note: They must be capitals. Lower case letters are variable names.) Single digit numbers always have the value of the digit regardless of the value of ibase. (i.e. A = 10.) For multi-digit numbers, bc changes all input digits greater or equal to ibase to the value of ibase-1. This makes the number FFF always be the largest 3 digit number of the input base.
Full expressions are similar to many other high level languages. Since there is only one kind of number, there are no rules for mixing types. Instead, there are rules on the scale of expressions. Every expression has a scale. This is derived from the scale of original numbers, the operation performed and in many cases, the value of the variable scale. Legal values of the variable scale are 0 to the maximum number representable by a C integer.
=end comment
=head2 Basic Expressions
In the following descriptions of legal expressions, "expr" refers to
a complete expression and "VAR" refers to a simple or an array variable.
A simple variable is just a NAME and an array variable is specified as
NAME[EXPR].
Unless specifically mentioned the scale of the result is the maximum
scale of the expressions involved.
=over 4
=item C<- expr>
The result is the negation of the expression.
=item C<++ VAR>
The variable is incremented by one and the new value is the result
of the expression.
=item C<-- VAR>
The variable is decremented by one and the new value is the result
of the expression.
=item C<VAR ++>
The result of the expression is the value of the variable and then
the variable is incremented by one.
=item C<VAR -->
The result of the expression is the value of the variable and then
the variable is decremented by one.
=item C<expr + expr>
The result of the expression is the sum of the two expressions.
=item C<expr - expr>
The result of the expression is the difference of the two
expressions.
=item C<expr * expr>
The result of the expression is the product of the two expressions.
=item C<expr / expr>
The result of the expression is the quotient of the two
expressions. The scale of the result is the value of the variable
C<scale>
=item C<expr % expr>
The result of the expression is the "remainder" and it is computed
in the following way. To compute a%b, first a/b is computed to
SCALE digits. That result is used to compute a-(a/b)*b to the
scale of the maximum of SCALE+scale(b) and scale(a). If SCALE is
set to zero and both expressions are integers this expression is
the integer remainder function.
=item C<expr ^ expr>
The result of the expression is the value of the first raised to
the second.
=begin comment ### hidden because it doesn't seem to be true in the implementation
The second expression must be an integer. (If the
second expression is not an integer, a warning is generated and the
expression is truncated to get an integer value.)
=end comment
The scale of the result is SCALE if the exponent is negative. If the
exponent is positive the scale of the result is the minimum of the
scale of the first expression times the value of the exponent and the
maximum of SCALE and the scale of the first expression. (e.g.
scale(a^b) = min(scale(a)*b, max(SCALE, scale(a))).) It should be
noted that expr^0 will always return the value of 1.
=item C<( expr )>
This alters the standard precedence to force the evaluation of the
expression.
=item C<VAR = expr>
The variable is assigned the value of the expression.
=item C<VAR op= expr>
This is equivalent to "VAR = VAR op expr" with the exception
that the "VAR" part is evaluated only once. This can make a
difference if "VAR" is an array.
=back
=head2 Relational Expressions
Relational expressions are a special kind of expression that always
evaluate to 0 or 1, 0 if the relation is false and 1 if the relation is
true. These may appear in any legal expression. (POSIX C<bc> requires
that relational expressions are used only in C<if>, C<while>, and C<for>
statements and that only one relational test may be done in them.) The
relational operators are
=over 4
=item expr1 < expr2
The result is 1 if expr1 is strictly less than expr2.
=item expr1 <= expr2
The result is 1 if expr1 is less than or equal to expr2.
=item expr1 > expr2
The result is 1 if expr1 is strictly greater than expr2.
=item expr1 >= expr2
The result is 1 if expr1 is greater than or equal to expr2.
=item expr1 == expr2
The result is 1 if expr1 is equal to expr2.
=item expr1 != expr2
The result is 1 if expr1 is not equal to expr2.
=back
=head2 Boolean Expressions
Boolean operations are also legal. (POSIX C<bc> does NOT have
boolean operations). The result of all boolean operations are 0 and 1
(for false and true) as in relational expressions. The boolean
operators are:
=over 4
=item C<!expr>
The result is 1 if expr is 0.
=item C<expr && expr>
The result is 1 if both expressions are non-zero.
=item C<expr || expr>
The result is 1 if either expression is non-zero.
=back
=head2 Precedence
The expression precedence is as follows: (lowest to highest)
= += etc operators (assigment) right associative
|| OR operator left associative
&& AND operator left associative
! NOT operator nonassociative
< > etc relational operators left associative
+ and - operators left associative
*, / and % operators left associative
^ operator (power) right associative
unary - operator nonassociative
++ and -- operators nonassociative
This differs from POSIX-compliant C<bc>, which puts assignment between
relational operators and addition/subtraction. As a result, expressions
behave more like they do in most languages (including perl and C).
=head2 Special Expressions
There are a few more special expressions that are provided in C<bc>.
These have to do with user-defined functions and standard functions.
These are:
=over 4
=item C<length ( expression )>
The value of the C<length> function is the number of significant
digits in the expression.
=begin comment ### hidden because it's not supported
=item C<read ( )>
The C<read> function (an extension) will read a number from the
standard input, regardless of where the function occurs. Beware,
this can cause problems with the mixing of data and program in the
standard input. The best use for this function is in a previously
written program that needs input from the user, but never allows
program code to be input from the user. The value of the `read'
function is the number read from the standard input using the
current value of the variable C<ibase> for the conversion base.
=end comment
=item C<scale ( expression )>
The value of the C<scale> function is the number of digits after the
decimal point in the expression.
=item C<sqrt ( expression )>
The value of the C<sqrt> function is the square root of the
expression. If the expression is negative, a run time error is
generated.
=back
=head2 Statements
Statements (as in most algebraic languages) provide the sequencing of
expression evaluation. In C<bc> statements are executed "as soon as
possible." Execution happens when a newline in encountered and there
is one or more complete statements. Due to this immediate execution,
newlines are very important in C<bc>. In fact, both a semicolon and a
newline are used as statement separators. An improperly placed
newline will cause a syntax error.
Because newlines are statement separators, it is possible to hide a
newline by using the backslash character. The sequence "\<nl>" (where
<nl> represents a newline your typed) appears to C<bc> as whitespace
instead of an actual newline.
A statement list is a series of statements separated by semicolons
and newlines.
The following is a list of C<bc> statements and what they do. Things
enclosed in brackets ( [ ] ) are optional parts of the statement.
=over 4
=item EXPRESSION
This statement does one of two things. If the expression starts
with "<variable> <assignment> ...", it is considered to be an
assignment statement. If the expression is not an assignment
statement, the expression is evaluated and printed to the output.
After the number is printed, a newline is printed.
For example, "a=1" is an assignment statement and "(a=1)" is an
expression that has an embedded assignment.
=begin comment ### hidden because obase and last don't seem to work
All numbers that are printed are printed in the base specified by the
variable OBASE. The legal values for OBASE are 2 through BC_BASE_MAX
(*note Environment Variables::). For bases 2 through 16, the usual
method of writing numbers is used. For bases greater than 16, C<bc>
uses a multi-character digit method of printing the numbers where each
higher base digit is printed as a base 10 number. The multi-character
digits are separated by spaces. Each digit contains the number of
characters required to represent the base ten value of "OBASE -1".
Since numbers are of arbitrary precision, some numbers may not be
printable on a single output line. These long numbers will be split
across lines using the "\" as the last character on a line. The
maximum number of characters printed per line is 70. Due to the
interactive nature of C<bc>, printing a number causes the side effect
of assigning the printed value to the special variable LAST. This
allows the user to recover the last value printed without having to
retype the expression that printed the number. Assigning to LAST is
legal and will overwrite the last printed value with the assigned
value. The newly assigned value will remain until the next number is
printed or another value is assigned to LAST. (Some installations may
allow the use of a single period (.) which is not part of a number as
a short hand notation for for LAST.)
=end comment
=item STRING
The string is printed to the output. Strings start with a double
quote character and contain all characters until the next double
quote character. All characters are taken literally, including
any newline. No newline character is printed after the string.
=item C<print> LIST
The C<print> statement (an extension) provides another method of
output. The LIST is a list of strings and expressions separated by
commas. Each string or expression is printed in the order of the
list. No terminating newline is printed. Expressions are
evaluated and their value is printed and assigned to the variable
C<last>. Strings in the print statement are printed to the output
and may contain special characters. Special characters start with
the backslash character. The special characters include:
\a alert or bell
\b backspace
\f form feed
\n newline
\r carriage return
\q double quote
\t tab
\e backslash.
Any other character following a backslash will be ignored.
=item { STATEMENT_LIST }
This is the compound statement. It allows multiple statements to
be grouped together for execution.
=item C<if> ( EXPRESSION ) STATEMENT
The C<if> statement evaluates the expression and executes STATEMENT
depending on the value of the expression. If the expression is
non-zero, STATEMENT is executed. Otherwise it isn't. (The statement
can be a block enclosed in { }.)
=begin comment ### if-else is not supported in this implementation
If the expression is non-zero, statement1 is executed. If statement2
is present and the value of the expression is 0, then statement2 is
executed. (The C<else> clause is an extension.)
=end comment
=item C<while> ( EXPRESSION ) STATEMENT
The while statement will execute the statement while the expression
is non-zero. It evaluates the expression before each execution of
the statement. Termination of the loop is caused by a zero
expression value or the execution of a C<break> statement.
=item C<for> ( [EXPRESSION1] ; [EXPRESSION2] ; [EXPRESSION3] ) STATEMENT
The C<for> statement controls repeated execution of the statement.
EXPRESSION1 is evaluated before the loop. EXPRESSION2 is
evaluated before each execution of the statement. If it is
non-zero, the statement is evaluated. If it is zero, the loop is
terminated.
After each execution of the statement, EXPRESSION3 is
evaluated before the reevaluation of expression2. If EXPRESSION1
or EXPRESSION3 are missing, nothing is evaluated at the point they
would be evaluated. If EXPRESSION2 is missing, it is the same as
substituting the value 1 for EXPRESSION2.
(The optional expressions are an extension. POSIX C<bc> requires all
three expressions.)
The following is equivalent code for the C<for>
statement:
expression1;
while (expression2) {
statement;
expression3;
}
=item C<break>
This statement causes a forced exit of the most recent enclosing
C<while> statement or C<for> statement.
=item C<quit>
When the C<quit> statement is read, the C<bc> processor is
terminated, regardless of where the C<quit> statement is found. For
example, C<if (0 == 1) quit> will cause C<bc> to terminate.
=back
=begin comment ### hidden because functions aren't working
=head1 MATH LIBRARY FUNCTIONS
If C<bc> is invoked with the C<-l> option, a math library is preloaded
and the default SCALE is set to 20. The math functions will calculate
their results to the scale set at the time of their call. The math
library defines the following functions:
=over 4
=item C<s (X)>
The sine of X, X is in radians.
=item C<c (X)>
The cosine of X, X is in radians.
=item C<a (X)>
The arctangent of X, arctangent returns radians.
=item C<l (X)>
The natural logarithm of X.
=item C<E (X)>
The exponential function of raising E to the value X.
=item C<J (N,X)>
The bessel function of integer order N of X.
=back
=end comment
=head1 EXAMPLE
The following illustrates how C<bc> expressions can be written in
script form and fed to C<bc> via stdin.
=begin comment
Note that the /* and */ are necessary to around the C<bc> code example
in order to prevent -l from processing these statements when reading <DATA>
/*
=end comment
print "\nCompute balances after withdrawals\n"
bal = 100.00
withdrawal = 20.00;
while (1) {
print "Balance: ", "\t", bal, "\n"
print "Withdrawal: ", "\t", withdrawal, "\n"
if ( (bal - withdrawal) < 0 ) break;
bal -= withdrawal
}
print "Balance:", bal
quit
=begin comment
*/
=end comment
=head1 BUGS AND LIMITATIONS
This implementation of C<bc> is mostly POSIX compliant and has similar
extensions to GNU C<bc>. However, some features and extensions are
either not supported or are not working.
Perhaps the biggest non-working feature would be Function definitions
via the C<define> syntax, which if used generats syntax errors. As a
consequence, the -l option (to load math library definitions) doesn't
work either.
Setting the following variables don't seem to have the intended effects:
scale
ibase
obase
Hexadecimal values, for use when ibase is > 10, are not supported.
Old style assignment operators (=+, =-, =*, =/, =%, =^) are not
required to be supported by the POSIX standard, and they are not
supported by this implementation. However, they will not generate
any errors. Instead you will get a result you don't expect.
For example:
v=3; v += 2 # v is 5 as you would expect
v=3; v =+ 2 # v is 2 because the 2nd expression is seen as v = +2
=head1 COMPARISON TO GNU C<bc> AND OTHERS
The following C<bc> features are not supported in this implementation.
(Some are syntactically accepted, but simply return zero).
* -w, --warn option
* -s, --standard option
* -q, --quiet option
* -v, --version option
* long options (e.g. --help)
* LC_ language and NLSPATH environment variables
* "last" special variable
* "if" statement: "else" clause
* "read" function
* "continue" statement
* "halt" statement
* "limits" pseudo statement
* "warranty" pseudo statement
* function definitions
In addition, the GNU implementation set the precedence of assignent
below + and - and above relational operators (< > etc). This
implementation seems to make it the lowest precedence (i.e. below ||),
as most perl (and C) users would expect.
=head1 REFERENCES
POSIX C<bc> L<https://pubs.opengroup.org/onlinepubs/9699919799/utilities/bc.html>
GNU C<bc> L<https://www.gnu.org/software/bc/manual/html_mono/bc.html>
=head2 GNU's mathlib
Load the GNU math extensions with the C<-l> switch:
% bc -l FILE
The library provides these functions:
=over 4
=item * a(x) - the arctangent of X, where X is expressed in radians
=item * c(x) - the cosine of X, where X is expressed in radians
=item * e(X) - the natural base, e, raised to the X power
=item * j(X) - the Bessel function of order X, where X is an integer
=item * l(X) - the natural logarithm of X
=item * s(x) - the sine of X, where X is expressed in radians
=back
=head1 AUTHOR
Philip A. Nelson originally translated GNU bc to Perl for the PerlPowerTools
project.
https://github.com/briandfoy/PerlPowerTools
=head1 LICENSE
You can use and modify this program under the terms of the GNU Public
License version 2. A copy of this license is in the PerlPowerTools
repository:
https://github.com/briandfoy/PerlPowerTools/
=cut
#define YYBYACC 1
#line 49 "bc.y"
;# The symbol table : the keys are the identifiers, the value is in the
;# "var" field if it is a variable, in the "func" field if it is a
;# function.
my %sym_table;
my @stmt_list = ();
my @ope_stack;
my @backup_sym_table;
my $input;
my $cur_file = '-';
my $bignum = 0;
$debug = 0;
sub debug(&) {
my $fn = shift;
print STDERR "\t".&$fn()
if $debug;
}
;#$yydebug=1;
#line 32 "y.tab.pl"
$INT=257;
$FLOAT=258;
$STRING=259;
$IDENT=260;
$C_COMMENT=261;
$BREAK=262;
$DEFINE=263;
$AUTO=264;
$RETURN=265;
$PRINT=266;
$AUTO_LIST=267;
$IF=268;
$ELSE=269;
$QUIT=270;
$WHILE=271;
$FOR=272;
$EQ=273;
$NE=274;
$GT=275;
$GE=276;
$LT=277;
$LE=278;
$PP=279;
$MM=280;
$P_EQ=281;
$M_EQ=282;
$F_EQ=283;
$D_EQ=284;
$EXP_EQ=285;
$MOD_EQ=286;
$L_SHIFT=287;
$R_SHIFT=288;
$E_E=289;
$O_O=290;
$EXP=291;
$UNARY=292;
$PPP=293;
$MMM=294;
$YYERRCODE=256;
@yylhs = ( -1,
0, 0, 1, 1, 1, 3, 4, 9, 3, 3,
3, 12, 3, 13, 3, 14, 3, 15, 17, 3,
18, 19, 20, 3, 3, 10, 10, 16, 16, 8,
8, 6, 6, 2, 2, 5, 5, 22, 22, 23,
23, 24, 24, 7, 7, 25, 25, 11, 11, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
21, 21, 21, 21, 21, 21, 21, 26, 26,
);
@yylen = ( 2,
0, 2, 1, 2, 2, 1, 0, 0, 13, 1,
1, 0, 3, 0, 4, 0, 7, 0, 0, 8,
0, 0, 0, 13, 1, 1, 4, 0, 1, 1,
3, 0, 1, 1, 1, 0, 1, 1, 3, 0,
1, 1, 3, 0, 3, 1, 3, 1, 3, 4,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
3, 3, 3, 2, 2, 2, 2, 2, 2, 2,
2, 3, 6, 1, 1, 1, 1, 1, 4,
);
@yydefred = ( 1,
0, 0, 85, 86, 87, 0, 0, 11, 7, 0,
12, 0, 6, 18, 0, 0, 0, 0, 0, 0,
14, 0, 34, 35, 2, 3, 0, 10, 0, 0,
5, 0, 0, 0, 81, 0, 0, 0, 0, 0,
0, 0, 76, 77, 80, 74, 0, 0, 75, 4,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 78, 79, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 29, 0, 0, 51, 0,
30, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 50, 0, 0, 0, 27, 0, 16,
0, 21, 0, 15, 0, 0, 0, 38, 0, 0,
0, 0, 0, 0, 89, 31, 0, 0, 0, 33,
0, 19, 0, 0, 39, 17, 0, 22, 0, 20,
0, 0, 0, 0, 8, 23, 46, 0, 0, 0,
0, 45, 0, 0, 47, 9, 24,
);
@yydgoto = ( 1,
25, 140, 86, 36, 129, 141, 155, 90, 159, 28,
82, 38, 48, 132, 40, 91, 147, 134, 151, 160,
29, 130, 77, 78, 158, 30,
);
@yysindex = ( 0,
475, -8, 0, 0, 0, 84, -239, 0, 0, -11,
0, 3, 0, 0, 19, -218, -218, 899, 899, 899,
0, 899, 0, 0, 0, 0, -8, 0, 893, -54,
0, 899, 899, 899, 0, -199, 899, 899, 958, 24,
958, -26, 0, 0, 0, 0, -32, 958, 0, 0,
899, 899, 899, 899, 899, 899, 899, 899, 899, 899,
899, 899, 899, 899, 899, 899, 899, 899, 899, 899,
899, 899, 0, 0, 893, 893, 25, 48, 830, 65,
852, 64, 893, 27, 958, 0, 53, 899, 0, 26,
0, 923, 923, 142, 142, 142, 142, 416, 416, -21,
-21, -30, -30, -29, -29, -180, -180, 142, 142, 142,
142, 142, 142, 0, 899, 67, -146, 0, 899, 0,
85, 0, 874, 0, 958, 893, 899, 0, 86, 87,
893, -8, -8, 958, 0, 0, 893, -8, -127, 0,
958, 0, 88, 41, 0, 0, 958, 0, -8, 0,
958, -116, 108, -103, 0, 0, 0, 18, 958, -8,
-100, 0, 31, 958, 0, 0, 0,
);
@yyrindex = ( 0,
0, 0, 0, 0, 0, -10, 0, 0, 0, 28,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 30, 37,
0, 0, 127, 0, 0, 0, 0, 0, 0, 0,
119, 57, 0, 0, 0, 0, 0, 36, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 4, -40, 0, 139, 0, 0,
0, 34, 66, 0, 145, 0, 0, 0, 0, 0,
0, 820, 822, 507, 518, 537, 551, 405, 442, 298,
380, 122, 192, 129, 167, 76, 99, 572, 579, 680,
758, 777, 799, 0, 0, 13, 149, 0, 0, 0,
0, 0, 0, 0, 36, -38, 0, 0, 0, 153,
93, 1023, 1023, 119, 0, 0, 29, 60, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
145, 499, 0, 0, 0, 0, 0, 0, 36, 1023,
0, 0, 0, 0, 0, 0, 0,
);
@yygindex = ( 0,
0, 358, 52, 0, 0, -108, 0, 38, 0, 0,
0, 0, 0, 0, 0, 337, 0, 0, 0, 0,
1278, 0, 0, 0, 0, 2,
);
$YYTABLESIZE=1405;
@yytable = ( 88,
42, 24, 43, 42, 65, 43, 65, 65, 89, 63,
61, 63, 62, 82, 64, 65, 64, 43, 44, 35,
63, 61, 89, 62, 142, 64, 88, 24, 37, 144,
88, 88, 88, 88, 88, 24, 88, 26, 83, 25,
24, 42, 39, 13, 82, 28, 84, 82, 88, 89,
23, 164, 27, 89, 89, 89, 89, 89, 41, 89,
80, 161, 82, 85, 88, 114, 88, 120, 26, 83,
25, 89, 83, 84, 13, 48, 23, 84, 84, 84,
84, 84, 88, 84, 23, 67, 26, 83, 25, 23,
84, 115, 13, 88, 28, 84, 82, 88, 88, 88,
88, 88, 49, 88, 117, 89, 48, 119, 66, 48,
66, 122, 67, 128, 88, 88, 67, 67, 67, 67,
67, 83, 67, 33, 48, 133, 138, 127, 82, 84,
139, 62, 145, 49, 67, 66, 49, 89, 64, 66,
66, 66, 66, 66, 32, 66, 148, 154, 156, 88,
124, 49, 26, 83, 25, 166, 157, 66, 13, 165,
28, 84, 62, 149, 62, 62, 62, 40, 67, 64,
64, 64, 64, 64, 34, 64, 65, 28, 65, 41,
62, 88, 32, 63, 61, 28, 62, 64, 64, 36,
48, 66, 146, 37, 0, 0, 163, 0, 150, 0,
67, 63, 0, 0, 0, 0, 0, 65, 65, 65,
65, 65, 0, 65, 62, 167, 0, 49, 0, 0,
0, 64, 0, 66, 0, 65, 67, 68, 69, 70,
71, 72, 63, 0, 63, 63, 63, 0, 73, 74,
51, 52, 53, 54, 55, 56, 62, 0, 0, 0,
63, 0, 0, 64, 57, 58, 59, 60, 66, 65,
66, 66, 88, 88, 88, 88, 88, 88, 0, 66,
88, 88, 88, 88, 88, 88, 88, 88, 88, 88,
88, 0, 88, 88, 63, 89, 89, 89, 89, 89,
89, 65, 0, 89, 89, 89, 89, 89, 89, 89,
89, 89, 89, 89, 0, 89, 89, 53, 0, 84,
84, 84, 84, 84, 84, 0, 63, 0, 0, 0,
0, 0, 0, 84, 84, 84, 84, 84, 0, 88,
88, 88, 88, 88, 88, 0, 0, 0, 53, 0,
0, 53, 0, 88, 88, 88, 88, 88, 67, 67,
67, 67, 67, 67, 0, 0, 53, 0, 26, 31,
0, 0, 67, 67, 67, 67, 0, 0, 0, 0,
0, 66, 66, 66, 66, 66, 66, 87, 0, 0,
0, 0, 0, 0, 50, 66, 66, 66, 66, 52,
53, 0, 0, 0, 62, 62, 62, 62, 62, 62,
0, 64, 64, 64, 64, 64, 64, 0, 62, 62,
62, 62, 0, 0, 60, 64, 64, 64, 64, 0,
52, 121, 53, 52, 0, 0, 0, 0, 57, 58,
59, 60, 66, 0, 0, 0, 0, 0, 52, 65,
65, 65, 65, 65, 65, 60, 0, 125, 60, 0,
0, 61, 65, 65, 65, 65, 65, 63, 61, 0,
62, 136, 64, 60, 63, 63, 63, 63, 63, 63,
143, 0, 52, 0, 0, 0, 0, 0, 63, 63,
63, 63, 61, 0, 24, 61, 0, 153, 0, 0,
0, 0, 0, 0, 0, 0, 0, 60, 0, 0,
61, 0, 0, 0, 52, 0, 152, 22, 44, 0,
0, 0, 7, 0, 20, 162, 56, 18, 0, 19,
125, 0, 0, 0, 0, 0, 0, 57, 0, 60,
0, 44, 0, 23, 61, 0, 44, 0, 44, 0,
0, 44, 0, 44, 0, 0, 58, 56, 0, 0,
56, 0, 0, 0, 0, 0, 0, 44, 57, 0,
59, 57, 0, 0, 0, 56, 61, 0, 0, 0,
53, 53, 53, 53, 53, 53, 57, 58, 0, 0,
58, 68, 0, 0, 53, 53, 53, 53, 69, 0,
0, 59, 0, 0, 59, 58, 0, 21, 0, 56,
0, 0, 0, 0, 0, 0, 0, 0, 0, 59,
57, 0, 68, 0, 0, 68, 0, 0, 0, 69,
0, 44, 69, 44, 0, 0, 0, 0, 0, 58,
68, 56, 0, 0, 0, 0, 0, 69, 0, 0,
0, 0, 57, 59, 0, 0, 0, 0, 0, 0,
0, 0, 52, 52, 52, 52, 52, 52, 0, 0,
0, 58, 0, 0, 68, 0, 52, 52, 52, 52,
0, 69, 0, 0, 0, 59, 0, 60, 60, 60,
60, 60, 60, 0, 0, 0, 0, 0, 0, 70,
0, 60, 60, 0, 0, 0, 68, 0, 0, 0,
0, 0, 0, 69, 59, 60, 66, 0, 0, 0,
0, 0, 0, 0, 61, 61, 61, 61, 61, 61,
70, 0, 0, 70, 0, 0, 0, 0, 61, 61,
2, 3, 4, 5, 6, 0, 8, 9, 70, 10,
11, 0, 12, 0, 13, 14, 15, 0, 0, 0,
0, 0, 0, 16, 17, 44, 44, 44, 44, 0,
44, 44, 0, 44, 44, 0, 44, 71, 44, 44,
44, 0, 70, 0, 0, 0, 0, 44, 44, 56,
56, 56, 56, 56, 56, 0, 72, 0, 0, 0,
57, 57, 57, 57, 57, 57, 0, 0, 71, 0,
0, 71, 0, 0, 70, 0, 0, 0, 73, 58,
58, 58, 58, 58, 58, 0, 71, 72, 0, 0,
72, 0, 0, 59, 59, 59, 59, 59, 59, 54,
0, 55, 0, 0, 0, 72, 0, 0, 0, 73,
0, 0, 73, 0, 68, 68, 68, 68, 68, 68,
71, 69, 69, 69, 69, 69, 69, 73, 0, 0,
54, 0, 55, 54, 0, 55, 65, 0, 0, 72,
0, 63, 61, 0, 62, 0, 64, 0, 54, 0,
55, 0, 71, 0, 0, 0, 0, 0, 65, 0,
0, 73, 118, 63, 61, 0, 62, 0, 64, 0,
0, 72, 0, 0, 0, 0, 0, 0, 0, 0,
65, 0, 54, 0, 55, 63, 61, 0, 62, 0,
64, 0, 116, 73, 0, 0, 0, 0, 0, 65,
0, 22, 0, 0, 63, 61, 7, 62, 20, 64,
0, 18, 0, 19, 54, 0, 55, 0, 0, 0,
0, 0, 70, 70, 70, 70, 70, 70, 0, 65,
0, 0, 0, 0, 63, 61, 135, 62, 0, 64,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
22, 0, 0, 0, 0, 7, 0, 20, 0, 0,
18, 0, 19, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
71, 71, 71, 71, 71, 71, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 72,
72, 72, 72, 72, 72, 32, 0, 0, 0, 0,
32, 0, 32, 0, 0, 32, 0, 32, 0, 0,
0, 73, 73, 73, 73, 73, 73, 0, 0, 0,
21, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 54, 54, 55, 55, 0, 0, 0, 0,
0, 0, 51, 52, 53, 54, 55, 56, 0, 0,
0, 0, 0, 0, 0, 0, 57, 58, 59, 60,
66, 0, 0, 0, 51, 52, 53, 54, 55, 56,
0, 0, 0, 0, 0, 0, 0, 0, 57, 58,
59, 60, 66, 0, 0, 32, 51, 52, 53, 54,
55, 56, 0, 0, 0, 3, 4, 5, 6, 0,
57, 58, 59, 60, 66, 51, 52, 53, 54, 55,
56, 0, 0, 0, 0, 0, 0, 16, 17, 57,
58, 59, 60, 66, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 53, 54, 55,
56, 0, 0, 0, 0, 0, 0, 0, 0, 57,
58, 59, 60, 66, 3, 4, 5, 6, 0, 8,
9, 0, 10, 11, 0, 12, 0, 13, 14, 15,
0, 0, 0, 0, 0, 0, 16, 17, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 32,
32, 32, 32, 0, 32, 32, 0, 32, 32, 0,
32, 0, 32, 32, 32, 45, 46, 47, 0, 49,
0, 32, 32, 0, 0, 0, 0, 0, 0, 75,
76, 79, 0, 0, 81, 83, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 92, 93,
94, 95, 96, 97, 98, 99, 100, 101, 102, 103,
104, 105, 106, 107, 108, 109, 110, 111, 112, 113,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 123, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 126, 0, 0, 0, 131, 0, 0, 0,
0, 0, 0, 0, 137,
);
@yycheck = ( 10,
41, 10, 41, 44, 37, 44, 37, 37, 41, 42,
43, 42, 45, 10, 47, 37, 47, 16, 17, 259,
42, 43, 10, 45, 133, 47, 37, 10, 40, 138,
41, 42, 43, 44, 45, 10, 47, 10, 10, 10,
10, 260, 40, 10, 41, 10, 10, 44, 59, 37,
59, 160, 1, 41, 42, 43, 44, 45, 40, 47,
260, 44, 59, 40, 91, 41, 10, 41, 41, 41,
41, 59, 44, 37, 41, 10, 59, 41, 42, 43,
44, 45, 93, 47, 59, 10, 59, 59, 59, 59,
39, 44, 59, 37, 59, 59, 93, 41, 42, 43,
44, 45, 10, 47, 40, 93, 41, 44, 10, 44,
291, 59, 37, 260, 125, 59, 41, 42, 43, 44,
45, 93, 47, 40, 59, 41, 41, 61, 125, 93,
44, 10, 260, 41, 59, 37, 44, 125, 10, 41,
42, 43, 44, 45, 61, 47, 59, 264, 41, 93,
125, 59, 125, 125, 125, 125, 260, 59, 125, 260,
125, 125, 41, 123, 43, 44, 45, 41, 93, 41,
42, 43, 44, 45, 91, 47, 10, 59, 37, 41,
59, 125, 123, 42, 43, 41, 45, 59, 47, 41,
125, 93, 141, 41, -1, -1, 159, -1, 147, -1,
125, 10, -1, -1, -1, -1, -1, 41, 42, 43,
44, 45, -1, 47, 93, 164, -1, 125, -1, -1,
-1, 93, -1, 125, -1, 59, 281, 282, 283, 284,
285, 286, 41, -1, 43, 44, 45, -1, 293, 294,
273, 274, 275, 276, 277, 278, 125, -1, -1, -1,
59, -1, -1, 125, 287, 288, 289, 290, 291, 93,
291, 291, 273, 274, 275, 276, 277, 278, -1, 291,
281, 282, 283, 284, 285, 286, 287, 288, 289, 290,
291, -1, 293, 294, 93, 273, 274, 275, 276, 277,
278, 125, -1, 281, 282, 283, 284, 285, 286, 287,
288, 289, 290, 291, -1, 293, 294, 10, -1, 273,
274, 275, 276, 277, 278, -1, 125, -1, -1, -1,
-1, -1, -1, 287, 288, 289, 290, 291, -1, 273,
274, 275, 276, 277, 278, -1, -1, -1, 41, -1,
-1, 44, -1, 287, 288, 289, 290, 291, 273, 274,
275, 276, 277, 278, -1, -1, 59, -1, 1, 2,
-1, -1, 287, 288, 289, 290, -1, -1, -1, -1,
-1, 273, 274, 275, 276, 277, 278, 41, -1, -1,
-1, -1, -1, -1, 27, 287, 288, 289, 290, 10,
93, -1, -1, -1, 273, 274, 275, 276, 277, 278,
-1, 273, 274, 275, 276, 277, 278, -1, 287, 288,
289, 290, -1, -1, 10, 287, 288, 289, 290, -1,
41, 85, 125, 44, -1, -1, -1, -1, 287, 288,
289, 290, 291, -1, -1, -1, -1, -1, 59, 273,
274, 275, 276, 277, 278, 41, -1, 90, 44, -1,
-1, 10, 37, 287, 288, 289, 290, 42, 43, -1,
45, 125, 47, 59, 273, 274, 275, 276, 277, 278,
134, -1, 93, -1, -1, -1, -1, -1, 287, 288,
289, 290, 41, -1, 10, 44, -1, 151, -1, -1,
-1, -1, -1, -1, -1, -1, -1, 93, -1, -1,
59, -1, -1, -1, 125, -1, 149, 33, 10, -1,
-1, -1, 38, -1, 40, 158, 10, 43, -1, 45,
163, -1, -1, -1, -1, -1, -1, 10, -1, 125,
-1, 33, -1, 59, 93, -1, 38, -1, 40, -1,
-1, 43, -1, 45, -1, -1, 10, 41, -1, -1,
44, -1, -1, -1, -1, -1, -1, 59, 41, -1,
10, 44, -1, -1, -1, 59, 125, -1, -1, -1,
273, 274, 275, 276, 277, 278, 59, 41, -1, -1,
44, 10, -1, -1, 287, 288, 289, 290, 10, -1,
-1, 41, -1, -1, 44, 59, -1, 123, -1, 93,
-1, -1, -1, -1, -1, -1, -1, -1, -1, 59,
93, -1, 41, -1, -1, 44, -1, -1, -1, 41,
-1, 123, 44, 125, -1, -1, -1, -1, -1, 93,
59, 125, -1, -1, -1, -1, -1, 59, -1, -1,
-1, -1, 125, 93, -1, -1, -1, -1, -1, -1,
-1, -1, 273, 274, 275, 276, 277, 278, -1, -1,
-1, 125, -1, -1, 93, -1, 287, 288, 289, 290,
-1, 93, -1, -1, -1, 125, -1, 273, 274, 275,
276, 277, 278, -1, -1, -1, -1, -1, -1, 10,
-1, 287, 288, -1, -1, -1, 125, -1, -1, -1,
-1, -1, -1, 125, 289, 290, 291, -1, -1, -1,
-1, -1, -1, -1, 273, 274, 275, 276, 277, 278,
41, -1, -1, 44, -1, -1, -1, -1, 287, 288,
256, 257, 258, 259, 260, -1, 262, 263, 59, 265,
266, -1, 268, -1, 270, 271, 272, -1, -1, -1,
-1, -1, -1, 279, 280, 257, 258, 259, 260, -1,
262, 263, -1, 265, 266, -1, 268, 10, 270, 271,
272, -1, 93, -1, -1, -1, -1, 279, 280, 273,
274, 275, 276, 277, 278, -1, 10, -1, -1, -1,
273, 274, 275, 276, 277, 278, -1, -1, 41, -1,
-1, 44, -1, -1, 125, -1, -1, -1, 10, 273,
274, 275, 276, 277, 278, -1, 59, 41, -1, -1,
44, -1, -1, 273, 274, 275, 276, 277, 278, 10,
-1, 10, -1, -1, -1, 59, -1, -1, -1, 41,
-1, -1, 44, -1, 273, 274, 275, 276, 277, 278,
93, 273, 274, 275, 276, 277, 278, 59, -1, -1,
41, -1, 41, 44, -1, 44, 37, -1, -1, 93,
-1, 42, 43, -1, 45, -1, 47, -1, 59, -1,
59, -1, 125, -1, -1, -1, -1, -1, 37, -1,
-1, 93, 41, 42, 43, -1, 45, -1, 47, -1,
-1, 125, -1, -1, -1, -1, -1, -1, -1, -1,
37, -1, 93, -1, 93, 42, 43, -1, 45, -1,
47, -1, 93, 125, -1, -1, -1, -1, -1, 37,
-1, 33, -1, -1, 42, 43, 38, 45, 40, 47,
-1, 43, -1, 45, 125, -1, 125, -1, -1, -1,
-1, -1, 273, 274, 275, 276, 277, 278, -1, 37,
-1, -1, -1, -1, 42, 43, 93, 45, -1, 47,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
33, -1, -1, -1, -1, 38, -1, 40, -1, -1,
43, -1, 45, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
273, 274, 275, 276, 277, 278, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, 273,
274, 275, 276, 277, 278, 33, -1, -1, -1, -1,
38, -1, 40, -1, -1, 43, -1, 45, -1, -1,
-1, 273, 274, 275, 276, 277, 278, -1, -1, -1,
123, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, 273, 274, 273, 274, -1, -1, -1, -1,
-1, -1, 273, 274, 275, 276, 277, 278, -1, -1,
-1, -1, -1, -1, -1, -1, 287, 288, 289, 290,
291, -1, -1, -1, 273, 274, 275, 276, 277, 278,
-1, -1, -1, -1, -1, -1, -1, -1, 287, 288,
289, 290, 291, -1, -1, 123, 273, 274, 275, 276,
277, 278, -1, -1, -1, 257, 258, 259, 260, -1,
287, 288, 289, 290, 291, 273, 274, 275, 276, 277,
278, -1, -1, -1, -1, -1, -1, 279, 280, 287,
288, 289, 290, 291, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, 275, 276, 277,
278, -1, -1, -1, -1, -1, -1, -1, -1, 287,
288, 289, 290, 291, 257, 258, 259, 260, -1, 262,
263, -1, 265, 266, -1, 268, -1, 270, 271, 272,
-1, -1, -1, -1, -1, -1, 279, 280, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, 257,
258, 259, 260, -1, 262, 263, -1, 265, 266, -1,
268, -1, 270, 271, 272, 18, 19, 20, -1, 22,
-1, 279, 280, -1, -1, -1, -1, -1, -1, 32,
33, 34, -1, -1, 37, 38, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, 51, 52,
53, 54, 55, 56, 57, 58, 59, 60, 61, 62,
63, 64, 65, 66, 67, 68, 69, 70, 71, 72,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, 88, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, 115, -1, -1, -1, 119, -1, -1, -1,
-1, -1, -1, -1, 127,
);
$YYFINAL=1;
#ifndef YYDEBUG
#define YYDEBUG 0
#endif
$YYMAXTOKEN=294;
#if YYDEBUG
@yyname = (
"end-of-file",'','','','','','','','','',"'\\n'",'','','','','','','','','','','','','','','','','','','','',
'','',"'!'",'','','',"'%'","'&'",'',"'('","')'","'*'","'+'","','","'-'","'.'","'/'",'',
'','','','','','','','','','',"';'",'',"'='",'','','','','','','','','','','','','','','','','','','','','','','',
'','','','','','',"'['",'',"']'",'','','','','','','','','','','','','','','','','','','','','','','','','','','',
'','',"'{'","'|'","'}'",'','','','','','','','','','','','','','','','','','','','','','','','','','','','','',
'','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','',
'','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','',
'','','','','','','','','','','','','','','','','','','','','','',"INT","FLOAT","STRING","IDENT",
"C_COMMENT","BREAK","DEFINE","AUTO","RETURN","PRINT","AUTO_LIST","IF","ELSE",
"QUIT","WHILE","FOR","EQ","NE","GT","GE","LT","LE","PP","MM","P_EQ","M_EQ",
"F_EQ","D_EQ","EXP_EQ","MOD_EQ","L_SHIFT","R_SHIFT","E_E","O_O","EXP","UNARY",
"PPP","MMM",
);
@yyrule = (
"\$accept : stmt_list_exec",
"stmt_list_exec :",
"stmt_list_exec : stmt_list_exec stmt_exec",
"stmt_exec : terminator",
"stmt_exec : stmt_compile terminator",
"stmt_exec : error terminator",
"stmt_compile : QUIT",
"\$$1 :",
"\$$2 :",
"stmt_compile : DEFINE $$1 IDENT '(' arg_list ')' terminator_or_void '{' terminator auto_list $$2 stmt_list_block '}'",
"stmt_compile : return",
"stmt_compile : BREAK",
"\$$3 :",
"stmt_compile : PRINT $$3 expr_list_commas",
"\$$4 :",
"stmt_compile : '{' $$4 stmt_list_block '}'",
"\$$5 :",
"stmt_compile : IF '(' stmt_compile ')' $$5 terminator_or_void stmt_compile",
"\$$6 :",
"\$$7 :",
"stmt_compile : WHILE $$6 '(' stmt_compile_or_void ')' terminator_or_void $$7 stmt_compile",
"\$$8 :",
"\$$9 :",
"\$$10 :",
"stmt_compile : FOR '(' stmt_compile_or_void ';' $$8 stmt_compile_or_void ';' $$9 stmt_compile_or_void ')' $$10 terminator_or_void stmt_compile",
"stmt_compile : expr",
"return : RETURN",
"return : RETURN '(' expr ')'",
"stmt_compile_or_void :",
"stmt_compile_or_void : stmt_compile",
"stmt_list_block : stmt_compile_or_void",
"stmt_list_block : stmt_list_block terminator stmt_compile_or_void",
"terminator_or_void :",
"terminator_or_void : terminator",
"terminator : ';'",
"terminator : '\\n'",
"arg_list :",
"arg_list : arg_list_nonempty",
"arg_list_nonempty : IDENT",
"arg_list_nonempty : arg_list_nonempty ',' IDENT",
"param_list :",
"param_list : param_list_nonempty",
"param_list_nonempty : expr",
"param_list_nonempty : param_list_nonempty ',' expr",
"auto_list :",
"auto_list : AUTO auto_list_nonempty terminator",
"auto_list_nonempty : IDENT",
"auto_list_nonempty : auto_list_nonempty ',' IDENT",
"expr_list_commas : expr",
"expr_list_commas : expr_list_commas ',' expr",
"expr : IDENT '(' param_list ')'",
"expr : '(' expr ')'",
"expr : expr O_O expr",
"expr : expr E_E expr",
"expr : expr EQ expr",
"expr : expr NE expr",
"expr : expr GT expr",
"expr : expr GE expr",
"expr : expr LT expr",
"expr : expr LE expr",
"expr : expr L_SHIFT expr",
"expr : expr R_SHIFT expr",
"expr : expr '+' expr",
"expr : expr '-' expr",
"expr : expr '*' expr",
"expr : expr '/' expr",
"expr : expr EXP expr",
"expr : expr '%' expr",
"expr : ident P_EQ expr",
"expr : ident M_EQ expr",
"expr : ident F_EQ expr",
"expr : ident D_EQ expr",
"expr : ident EXP_EQ expr",
"expr : ident MOD_EQ expr",
"expr : '-' expr",
"expr : '!' expr",
"expr : PP ident",
"expr : MM ident",
"expr : ident PPP",
"expr : ident MMM",
"expr : '+' expr",
undef, # "expr : '&' STRING", # removed feature but we didn't want to disturb sequence
"expr : IDENT '=' expr",
"expr : IDENT '[' expr ']' '=' expr",
"expr : ident",
"expr : INT",
"expr : FLOAT",
"expr : STRING",
"ident : IDENT",
"ident : IDENT '[' expr ']'",
);
#endif
sub yyclearin { $yychar = -1; }
sub yyerrok { $yyerrflag = 0; }
$YYSTACKSIZE = $YYSTACKSIZE || $YYMAXDEPTH || 500;
$YYMAXDEPTH = $YYMAXDEPTH || $YYSTACKSIZE || 500;
$yyss[$YYSTACKSIZE] = 0;
$yyvs[$YYSTACKSIZE] = 0;
sub YYERROR { ++$yynerrs; &yy_err_recover; }
sub yy_err_recover
{
if ($yyerrflag < 3)
{
$yyerrflag = 3;
while (1)
{
if (($yyn = $yysindex[$yyss[$yyssp]]) &&
($yyn += $YYERRCODE) >= 0 &&
$yycheck[$yyn] == $YYERRCODE)
{
#if YYDEBUG
print "yydebug: state $yyss[$yyssp], error recovery shifting",
" to state $yytable[$yyn]\n" if $yydebug;
#endif
$yyss[++$yyssp] = $yystate = $yytable[$yyn];
$yyvs[++$yyvsp] = $yylval;
next yyloop;
}
else
{
#if YYDEBUG
print "yydebug: error recovery discarding state ",
$yyss[$yyssp], "\n" if $yydebug;
#endif
return(1) if $yyssp <= 0;
--$yyssp;
--$yyvsp;
}
}
}
else
{
return (1) if $yychar == 0;
#if YYDEBUG
if ($yydebug)
{
$yys = '';
if ($yychar <= $YYMAXTOKEN) { $yys = $yyname[$yychar]; }
if (!$yys) { $yys = 'illegal-symbol'; }
print "yydebug: state $yystate, error recovery discards ",
"token $yychar ($yys)\n";
}
#endif
$yychar = -1;
next yyloop;
}
0;
} # yy_err_recover
sub yyparse
{
#ifdef YYDEBUG
if ($yys = $ENV{'YYDEBUG'})
{
$yydebug = int($1) if $yys =~ /^(\d)/;
}
#endif
$yynerrs = 0;
$yyerrflag = 0;
$yychar = (-1);
$yyssp = 0;
$yyvsp = 0;
$yyss[$yyssp] = $yystate = 0;
yyloop: while(1)
{
yyreduce: {
last yyreduce if ($yyn = $yydefred[$yystate]);
if ($yychar < 0)
{
if (($yychar = &yylex) < 0) { $yychar = 0; }
#if YYDEBUG
if ($yydebug)
{
$yys = '';
if ($yychar <= $#yyname) { $yys = $yyname[$yychar]; }
if (!$yys) { $yys = 'illegal-symbol'; };
print "yydebug: state $yystate, reading $yychar ($yys)\n";
}
#endif
}
if (($yyn = $yysindex[$yystate]) && ($yyn += $yychar) >= 0 &&
$yycheck[$yyn] == $yychar)
{
#if YYDEBUG
print "yydebug: state $yystate, shifting to state ",
$yytable[$yyn], "\n" if $yydebug;
#endif
$yyss[++$yyssp] = $yystate = $yytable[$yyn];
$yyvs[++$yyvsp] = $yylval;
$yychar = (-1);
--$yyerrflag if $yyerrflag > 0;
next yyloop;
}
if (($yyn = $yyrindex[$yystate]) && ($yyn += $yychar) >= 0 &&
$yycheck[$yyn] == $yychar)
{
$yyn = $yytable[$yyn];
last yyreduce;
}
if (! $yyerrflag) {
&yyerror('syntax error');
++$yynerrs;
}
return(1) if &yy_err_recover;
} # yyreduce
#if YYDEBUG
print "yydebug: state $yystate, reducing by rule ",
"$yyn ($yyrule[$yyn])\n" if $yydebug;
#endif
$yym = $yylen[$yyn];
$yyval = $yyvs[$yyvsp+1-$yym];
switch:
{
if ($yyn == 4) {
#line 126 "bc.y"
{
my ($res, $val) = exec_stmt(shift @stmt_list);
if($res == 0 and defined($val) and
$cur_file ne 'main::DATA') {
print "$val\n";
}
start_stmt();
last switch;
} }
if ($yyn == 5) {
#line 136 "bc.y"
{
@ope_stack = ();
@stmt_list = ();
start_stmt();
&yyerrok;
last switch;
} }
if ($yyn == 7) {
#line 147 "bc.y"
{
start_stmt();
last switch;
} }
if ($yyn == 8) {
#line 153 "bc.y"
{
start_stmt();
start_stmt();
last switch;
} }
if ($yyn == 9) {
#line 159 "bc.y"
{
finish_stmt(); # The last one is empty
push_instr('RETURN', 0);
my $body = finish_stmt();
push_instr('{}', $body);
my $code = finish_stmt();
push_instr('FUNCTION-DEF', $yyvs[$yyvsp-10], $code);
last switch;
} }
if ($yyn == 11) {
#line 170 "bc.y"
{ push_instr('BREAK');
last switch;
} }
if ($yyn == 12) {
#line 173 "bc.y"
{
push_instr(',');
start_stmt();
start_stmt();
last switch;
} }
if ($yyn == 13) {
#line 179 "bc.y"
{
finish_stmt(); # The last one is empty
my $stmt = finish_stmt();
push_instr('PRINT', $stmt);
last switch;
} }
if ($yyn == 14) {
#line 186 "bc.y"
{
start_stmt();
start_stmt();
last switch;
} }
if ($yyn == 15) {
#line 191 "bc.y"
{
finish_stmt(); # The last one is empty
my $stmt = finish_stmt();
push_instr('{}', $stmt);
last switch;
} }
if ($yyn == 16) {
#line 197 "bc.y"
{ start_stmt();
last switch;
} }
if ($yyn == 17) {
#line 200 "bc.y"
{
my $stmt = finish_stmt();
push_instr('IF', $stmt);
last switch;
} }
if ($yyn == 18) {
#line 205 "bc.y"
{ start_stmt();
last switch;
} }
if ($yyn == 19) {
#line 207 "bc.y"
{
my $stmt = finish_stmt();
push_instr('FOR-COND', $stmt);
start_stmt();
last switch;
} }
if ($yyn == 20) {
#line 213 "bc.y"
{
my $stmt = finish_stmt();
push_instr('FOR-INCR', []);
push_instr('FOR-BODY', $stmt);
last switch;
} }
if ($yyn == 21) {
#line 219 "bc.y"
{ start_stmt();
last switch;
} }
if ($yyn == 22) {
#line 221 "bc.y"
{
my $stmt = finish_stmt();
push_instr('FOR-COND', $stmt);
start_stmt();
last switch;
} }
if ($yyn == 23) {
#line 227 "bc.y"
{
my $stmt = finish_stmt();
push_instr('FOR-INCR', $stmt);
start_stmt();
last switch;
} }
if ($yyn == 24) {
#line 232 "bc.y"
{
my $stmt = finish_stmt();
push_instr('FOR-BODY', $stmt);
last switch;
} }
if ($yyn == 26) {
#line 241 "bc.y"
{ push_instr('RETURN', 0);
last switch;
} }
if ($yyn == 27) {
#line 242 "bc.y"
{ push_instr('RETURN', 1);
last switch;
} }
if ($yyn == 30) {
#line 250 "bc.y"
{
my $stmt = finish_stmt();
if(scalar(@$stmt) > 0) {
push_instr('STMT', $stmt);
}
start_stmt();
last switch;
} }
if ($yyn == 31) {
#line 258 "bc.y"
{
my $stmt = finish_stmt();
if(scalar(@$stmt) > 0) {
push_instr('STMT', $stmt);
}
start_stmt();
last switch;
} }
if ($yyn == 38) {
#line 281 "bc.y"
{ push_instr('a', $yyvs[$yyvsp-0]);
last switch;
} }
if ($yyn == 39) {
#line 282 "bc.y"
{ push_instr('a', $yyvs[$yyvsp-0]);
last switch;
} }
if ($yyn == 46) {
#line 299 "bc.y"
{ push_instr('A', $yyvs[$yyvsp-0]);
last switch;
} }
if ($yyn == 47) {
#line 300 "bc.y"
{ push_instr('A', $yyvs[$yyvsp-0]);
last switch;
} }
if ($yyn == 48) {
#line 305 "bc.y"
{
my $stmt = finish_stmt();
push_instr('PRINT-STMT', $stmt);
start_stmt();
last switch;
} }
if ($yyn == 49) {
#line 311 "bc.y"
{
my $stmt = finish_stmt();
push_instr('PRINT-STMT', $stmt);
start_stmt();
last switch;
} }
if ($yyn == 50) {
#line 320 "bc.y"
{
push_instr('FUNCTION-CALL', $yyvs[$yyvsp-3]);
last switch;
} }
if ($yyn == 51) {
#line 324 "bc.y"
{
last switch;
} }
if ($yyn == 52) {
#line 326 "bc.y"
{ push_instr('||_');
last switch;
} }
if ($yyn == 53) {
#line 327 "bc.y"
{ push_instr('&&_');
last switch;
} }
if ($yyn == 54) {
#line 329 "bc.y"
{ push_instr('==_');
last switch;
} }
if ($yyn == 55) {
#line 330 "bc.y"
{ push_instr('!=_');
last switch;
} }
if ($yyn == 56) {
#line 331 "bc.y"
{ push_instr('>_');
last switch;
} }
if ($yyn == 57) {
#line 332 "bc.y"
{ push_instr('>=_');
last switch;
} }
if ($yyn == 58) {
#line 333 "bc.y"
{ push_instr('<_');
last switch;
} }
if ($yyn == 59) {
#line 334 "bc.y"
{ push_instr('<=_');
last switch;
} }
if ($yyn == 60) {
#line 335 "bc.y"
{ push_instr('<<_');
last switch;
} }
if ($yyn == 61) {
#line 336 "bc.y"
{ push_instr('>>_');
last switch;
} }
if ($yyn == 62) {
#line 338 "bc.y"
{ push_instr('+_');
last switch;
} }
if ($yyn == 63) {
#line 339 "bc.y"
{ push_instr('-_');
last switch;
} }
if ($yyn == 64) {
#line 340 "bc.y"
{ push_instr('*_');
last switch;
} }
if ($yyn == 65) {
#line 341 "bc.y"
{ push_instr('/_');
last switch;
} }
if ($yyn == 66) {
#line 342 "bc.y"
{ push_instr('^_');
last switch;
} }
if ($yyn == 67) {
#line 343 "bc.y"
{ push_instr('%_');
last switch;
} }
if ($yyn == 68) {
#line 347 "bc.y"
{
push_instr('+_');
push_instr('V', $yyvs[$yyvsp-2]);
push_instr('=V');
last switch;
} }
if ($yyn == 69) {
#line 353 "bc.y"
{
push_instr('-_');
push_instr('V', $yyvs[$yyvsp-2]);
push_instr('=V');
last switch;
} }
if ($yyn == 70) {
#line 359 "bc.y"
{
push_instr('*_');
push_instr('V', $yyvs[$yyvsp-2]);
push_instr('=V');
last switch;
} }
if ($yyn == 71) {
#line 365 "bc.y"
{
push_instr('/_');
push_instr('V', $yyvs[$yyvsp-2]);
push_instr('=V');
last switch;
} }
if ($yyn == 72) {
#line 371 "bc.y"
{
push_instr('^_');
push_instr('V', $yyvs[$yyvsp-2]);
push_instr('=V');
last switch;
} }
if ($yyn == 73) {
#line 377 "bc.y"
{
push_instr('%_');
push_instr('V', $yyvs[$yyvsp-2]);
push_instr('=V');
last switch;
} }
if ($yyn == 74) {
#line 386 "bc.y"
{
push_instr('m_');
last switch;
} }
if ($yyn == 75) {
#line 390 "bc.y"
{
push_instr('!_');
last switch;
} }
if ($yyn == 76) {
#line 394 "bc.y"
{
# 'v'.$2 has already been pushed in the 'ident' rule
push_instr('N', 1);
push_instr('+_');
push_instr('V', $yyvs[$yyvsp-0]);
push_instr('=V');
last switch;
} }
if ($yyn == 77) {
#line 402 "bc.y"
{
push_instr('N', 1);
push_instr('-_');
push_instr('V', $yyvs[$yyvsp-0]);
push_instr('=V');
last switch;
} }
if ($yyn == 78) {
#line 409 "bc.y"
{
# $1 is already on the stack (see the "ident:" rule)
push_instr('v', $yyvs[$yyvsp-1]) ;
push_instr('V', '*tmp') ;
push_instr('=V') ; # *tmp = $1
push_instr(',') ;
push_instr('N', 1) ;
push_instr('+_') ;
push_instr('V', $yyvs[$yyvsp-1]) ;
push_instr('=V') ; # $1 = $1 + 1
push_instr(',') ;
push_instr('v', '*tmp') ; # Return *tmp
last switch;
} }
if ($yyn == 79) {
#line 426 "bc.y"
{
# See PPP for comments
push_instr('v', $yyvs[$yyvsp-1]);
push_instr('V', '*tmp');
push_instr('=V');
push_instr(',');
push_instr('N', 1);
push_instr('-_');
push_instr('V', $yyvs[$yyvsp-1]);
push_instr('=V');
push_instr(',');
push_instr('v', '*tmp');
last switch;
} }
if ($yyn == 80) {
#line 440 "bc.y"
{ $yyval = $yyvs[$yyvsp-0];
last switch;
} }
if ($yyn == 82) {
#line 448 "bc.y"
{
push_instr('V', $yyvs[$yyvsp-2]);
push_instr('=V');
$yyval = $yyvs[$yyvsp-0];
last switch;
} }
if ($yyn == 83) {
#line 454 "bc.y"
{
# Add [] to the name in order to allow the same name
# for an array and a scalar
push_instr('P', $yyvs[$yyvsp-5]);
push_instr('=P');
$yyval = $yyvs[$yyvsp-0];
last switch;
} }
if ($yyn == 84) {
#line 462 "bc.y"
{ $yyval = $yyvs[$yyvsp-0]->{"value"};
last switch;
} }
if ($yyn == 85) {
#line 464 "bc.y"
{ push_instr('N', $yyvs[$yyvsp-0]);
last switch;
} }
if ($yyn == 86) {
#line 465 "bc.y"
{ push_instr('N', $yyvs[$yyvsp-0]);
last switch;
} }
if ($yyn == 87) {
#line 466 "bc.y"
{ push_instr('S', $yyvs[$yyvsp-0]);
last switch;
} }
if ($yyn == 88) {
#line 470 "bc.y"
{ push_instr('v', $yyvs[$yyvsp-0]);
last switch;
} }
if ($yyn == 89) {
#line 473 "bc.y"
{
push_instr('p', $yyvs[$yyvsp-3]);
$yyval = $yyvs[$yyvsp-3].'[]'.$yyvs[$yyvsp-1];
last switch;
} }
#line 1201 "y.tab.pl"
} # switch
$yyssp -= $yym;
$yystate = $yyss[$yyssp];
$yyvsp -= $yym;
$yym = $yylhs[$yyn];
if ($yystate == 0 && $yym == 0)
{
#if YYDEBUG
print "yydebug: after reduction, shifting from state 0 ",
"to state $YYFINAL\n" if $yydebug;
#endif
$yystate = $YYFINAL;
$yyss[++$yyssp] = $YYFINAL;
$yyvs[++$yyvsp] = $yyval;
if ($yychar < 0)
{
if (($yychar = &yylex) < 0) { $yychar = 0; }
#if YYDEBUG
if ($yydebug)
{
$yys = '';
if ($yychar <= $#yyname) { $yys = $yyname[$yychar]; }
if (!$yys) { $yys = 'illegal-symbol'; }
print "yydebug: state $YYFINAL, reading $yychar ($yys)\n";
}
#endif
}
return(0) if $yychar == 0;
next yyloop;
}
if (($yyn = $yygindex[$yym]) && ($yyn += $yystate) >= 0 &&
$yyn <= $#yycheck && $yycheck[$yyn] == $yystate)
{
$yystate = $yytable[$yyn];
} else {
$yystate = $yydgoto[$yym];
}
#if YYDEBUG
print "yydebug: after reduction, shifting from state ",
"$yyss[$yyssp] to state $yystate\n" if $yydebug;
#endif
$yyss[++$yyssp] = $yystate;
$yyvs[++$yyvsp] = $yyval;
} # yyloop
} # yyparse
#line 479 "bc.y"
@file_list=();
$mathlib=0;
sub command_line()
{
while ($f = shift(@ARGV)) {
if ($f eq '-b') {
use Math::BigFloat;
$bignum = 1;
} elsif ($f eq '-d') {
use Data::Dumper;
$debug = 1;
} elsif ($f eq '-y') {
$yydebug = 1;
} elsif ($f eq '-l') {
$mathlib = 1;
} else {
push(@file_list, $f);
}
}
# read from STDIN if no files are named on the command line
@file_list = ('-') if $#file_list < 0;
}
# After finishing a file, open the next one. Return whether there
# really is a next one that was opened.
sub next_file
{
if($cur_file) {
close $input;
}
if($mathlib) {
debug { "reading the math library\n" };
$input = \*main::DATA;
$mathlib=0;
$cur_file="main::DATA";
return 1;
} elsif($file = shift(@file_list)) {
debug { "reading from $file\n" };
if ($file eq '-') {
$input = STDIN;
} else {
open(IN, '<', $file) or die("$file: cannot open file: $!\n");
$input = IN;
}
$cur_file = $file;
return 1;
}
debug { "no next file\n" };
return 0;
}
# print an error message
sub yyerror
{
print STDERR "\"$cur_file\", " if $cur_file ne '-';
# debug { "yyerror-stmt_list : ".Dumper(\@stmt_list) };
print STDERR "line $.: ", @_, "\n";
@ope_stack = ();
start_stmt();
}
# Hand-coded lex
sub yylex
{
lexloop: {
# get a line of input, if we need it.
if ($line eq '')
{
while(! ($line = <$input>)) {
&next_file || do {
return(0); };
}
}
# Skip over white space, and grab the first character.
# If there is no such character, then grab the next line.
$line =~ s/^\s*(.|\n)// || next lexloop;
local($char) = $1;
if ($char eq '/' and $line =~ /^\*/) {
# C-style comment
while($line !~ m%\*/%) {
$line = <$input>;
}
$line =~ s%.*?\*/% %;
yylex();
}
elsif ($char eq '#') {
# comment, so discard the line
$line = "\n";
&yylex;
} elsif ($char eq '\\' and $line eq "\n") {
# Discard the newline
$line = '';
yylex();
} elsif ($char =~ /^(['"])/) {
$yylval = "";
my $c = $1;
while($line !~ /$c/) {
$yylval .= $line;
$line = <$input>;
}
$line =~ s%(.*?)$c% %;
$yylval .= $1;
$STRING;
} elsif ($char =~ /^[\dA-F]/ or
($char eq '.' and $line =~ /\d/)) {
if($char =~ /[A-F]/) {
&yyerror('Sorry, hexadecimal values are not supported');
}
$line = "0.$line" if($char eq '.');
# number, is it integer or float?
if ($line =~ s/^(\d+)//) {
$yylval = 0 + ($char.$1);
$yylval = Math::BigFloat->new($yylval) if $bignum;
} else {
$yylval = 0 + $char;
$yylval = Math::BigFloat->new($yylval) if $bignum;
}
$type = $INT;
if ($line =~ s/^(\.\d*)//) {
$tmp = "0$1"; # ".1" -> "0.1"
$yylval += $tmp;
$type = $FLOAT;
}
if ($line =~ s/^[eE]([-+]*\d+)//) {
$yylval *= 10 ** $1;
$type = $FLOAT;
}
$type;
} elsif ($char =~ /^[a-z]/) {
# Uppercase is reserved for hexadecimal numbers
$line =~ s/^([\w\d]*)//;
$yylval = $char.$1;
if($yylval eq 'auto') {
$AUTO;
} elsif($yylval eq 'break') {
$BREAK;
} elsif($yylval eq 'define') {
$DEFINE;
} elsif($yylval eq 'for') {
$FOR;
} elsif($yylval eq 'if') {
$IF;
} elsif($yylval eq 'else') {
$ELSE;
} elsif($yylval eq 'print') {
$PRINT;
} elsif($yylval eq 'quit') {
# $QUIT;
# GNU bc exits immediately when it encounters quit, even if
# seen in unreachable code like "if (0 == 1) quit"
# OpenBSD bc acts like this too but calls it a bug
exit;
} elsif($yylval eq 'return') {
$RETURN;
} elsif($yylval eq 'while') {
$WHILE;
} else {
$IDENT;
}
} elsif (($char eq '*' && $line =~ s/^\*=//) or
($char eq '^' && $line =~ s/=//)) {
$EXP_EQ;
} elsif (($char eq '*' && $line =~ s/^\*//) or
($char eq '^')) {
$EXP;
} elsif ($char eq '|' && $line =~ s/^\|//) {
$O_O;
} elsif ($char eq '&' && $line =~ s/^&//) {
$E_E;
} elsif ($char eq '%' && $line =~ s/^=//) {
$MOD_EQ;
} elsif ($char eq '!' && $line =~ s/^=//) {
$NE;
} elsif ($char eq '=' && $line =~ s/^=//) {
$EQ;
} elsif ($char =~ /^[<>]/ && $line =~ s/^=//) {
$char eq '<' ? $LE : $GE;
} elsif ($char =~ /^[<>]/ && $line =~ s/^$char//) {
$char eq '<' ? $L_SHIFT : $R_SHIFT;
} elsif ($char =~ /^[<>]/) {
$char eq '<' ? $LT : $GT;
} elsif ($char eq '+' && $line =~ s/^\+(\s*\w)/$1/) {
$PP;
} elsif ($char eq '+' && $line =~ s/^=//) {
$P_EQ;
} elsif ($char eq '+' && $line =~ s/^\+//) {
$PPP;
} elsif ($char eq '-' && $line =~ s/^\-(\s*\w)/$1/) {
$MM;
} elsif ($char eq '-' && $line =~ s/^\-//) {
$MMM;
} elsif ($char eq '-' && $line =~ s/^=//) {
$M_EQ;
} elsif ($char eq '*' && $line =~ s/^=//) {
$F_EQ;
} elsif ($char eq '/' && $line =~ s/^=//) {
$D_EQ;
} else {
$yylval = $char;
ord($char);
}
}
}
sub bi_length
{
my $stack = shift;
$_ = pop @$stack;
my ($a, $b);
die "NaN" unless ($a, $b) = /[-+]?(\d*)\.?(\d+)?/;
$a =~ s/^0+//;
$b =~ s/0+$//;
my $len = length($a) + length($b);
return $len == 0 ? 1 : $len;
}
sub bi_scale
{
my $stack = shift;
$_ = pop @$stack;
my ($a, $b);
die "NaN" unless ($a, $b) = /[-+]?(\d*)\.?(\d+)?/;
return length($b);
}
sub bi_sqrt
{
my $stack = shift;
$_ = pop @$stack;
return sqrt($_);
}
# Initialize the symbol table
sub init_table
{
$sym_table{'scale'} = { type => 'var', value => 0};
$sym_table{'ibase'} = { type => 'var', value => 0};
$sym_table{'obase'} = { type => 'var', value => 0};
$sym_table{'last'} = { type => 'var', value => 0};
$sym_table{'length()'} = { type => 'builtin',
value => \&bi_length };
$sym_table{'scale()'} = { type => 'builtin',
value => \&bi_scale };
$sym_table{'sqrt()'} = { type => 'builtin',
value => \&bi_sqrt };
}
#
# Pseudo-code
#
# Compilation time: a stack of statements is maintained. Each statement
# is itself a stack of instructions.
# Each instruction is appended to the statement which is on the top.
# When a sub-block (IF, DEFINE...) is encountered, a
# new, empty statement is pushed onto the stack, and it receives the
# instructions in the sub-block.
my $cur_stmt;
# Pushes one instruction onto the current statement
# First element is the type, others are 0 or more arguments, depending on
# the type.
sub push_instr
{
die "Internal error: no cur stmt" unless($cur_stmt);
my @args = @_;
push(@$cur_stmt, [ @args ]);
}
# Pushes a new statement onto the stack of statements, and makes it the
# current
sub start_stmt
{
$cur_stmt = [];
push(@stmt_list, $cur_stmt);
}
# Closes a statement, and returns a reference on it.
sub finish_stmt
{
my $stmt = pop @stmt_list;
$cur_stmt = $stmt_list[$#stmt_list];
return $stmt;
}
my ($res, $val);
my $code;
#
# exec_stmt
# Really executes a statement. Calls itself recursively when it
# encounters sub-statements (in block, loops, functions...)
#
sub exec_stmt
{
my $stmt = shift;
my $return = 0; # 1 if a "return" statement is encountered
my @stmt_s = @$stmt;
# print STDERR "ko\n";"executing statement: ".Dumper(\@stmt_s);
# Each instruction in the stack is an array which first element gives
# the type. Others elements may contain references to sub-statements
my $instr;
INSTR: while (defined($instr = shift @stmt_s)) {
$_ = $instr->[0];
print STDERR ("instruction: ".join(', ', @$instr)."\n" ) if $debug;
# remove the stack top value, and forget about it
if($_ eq ',') {
$res = pop @ope_stack;
next INSTR;
} elsif($_ eq 'N') {
# N for number
push(@ope_stack, 0 + $instr->[1]);
next INSTR;
} elsif($_ eq '+_' or $_ eq '-_' or $_ eq '*_' or $_ eq '/_' or
$_ eq '^_' or $_ eq '%_' or $_ eq '==_' or $_ eq '!=_' or
$_ eq '>_' or $_ eq '>=_' or $_ eq '<_' or $_ eq '<=_' or
$_ eq '<<_' or $_ eq '>>_' or $_ eq '||_' or $_ eq '&&_') {
# Binary operators
my $b = pop(@ope_stack); my $a = pop(@ope_stack);
if ($_ eq '+_') { $res = $a + $b ; 1 }
elsif($_ eq '-_') { $res = $a - $b ; 1 }
elsif($_ eq '*_') { $res = $a * $b ; 1 }
elsif($_ eq '/_') { $res = $a / $b ; 1 }
elsif($_ eq '^_') { $res = $a ** $b ; 1 }
elsif($_ eq '%_') { $res = $a % $b ; 1 }
elsif($_ eq '==_') { $res = 0 + ($a == $b) ; 1 }
elsif($_ eq '!=_') { $res = 0 + ($a != $b) ; 1 }
elsif($_ eq '>_') { $res = 0 + ($a > $b) ; 1 }
elsif($_ eq '>=_') { $res = 0 + ($a >= $b) ; 1 }
elsif($_ eq '<_') { $res = 0 + ($a < $b) ; 1 }
elsif($_ eq '<=_') { $res = 0 + ($a <= $b) ; 1 }
elsif($_ eq '<<_') { $res = ($a << $b) ; 1 }
elsif($_ eq '>>_') { $res = ($a >> $b) ; 1 }
elsif($_ eq '||_') { $res = ($a || $b) ? 1 : 0 ; 1 }
elsif($_ eq '&&_') { $res = ($a && $b) ? 1 : 0 ; 1 }
;
push(@ope_stack, $res);
next INSTR;
# Unary operators
} elsif($_ eq 'm_') {
$res = pop(@ope_stack);
push(@ope_stack, -$res);
next INSTR;
} elsif($_ eq '!_') {
$res = pop(@ope_stack);
push(@ope_stack, 0+!$res);
next INSTR;
} elsif($_ eq 'V') {
# Variable or array identifier
push(@ope_stack, $instr->[1]);
next INSTR;
} elsif($_ eq 'P') {
my $value = pop @ope_stack;
my $index = pop @ope_stack;
push @ope_stack, $value;
push @ope_stack, $instr->[1] . '[]' . $index;
next INSTR;
} elsif($_ eq 'v') {
# Variable value : initialized to 0
# '*' is reserved for internal variables
my $name = $instr->[1];
unless (defined($sym_table{$name})
and $sym_table{$name}{'type'} eq 'var') {
$sym_table{$name}{'value'} = 0;
}
push(@ope_stack, $sym_table{$name}{'value'});
next INSTR;
} elsif($_ eq 'p') {
# Array value : initialized to 0
my ($name, $idx) = ($instr->[1], pop(@ope_stack));
if($idx !~ /^\d+$/) {
print STDERR "Non-integer index $idx for array\n";
$return = 3;
@ope_stack = ();
@stmt_list=();
YYERROR;
}
# debug {"p: $name, $idx.\n"};
unless (defined($sym_table{$name.'[]'})
and $sym_table{$name.'[]'}{'type'} eq 'array') {
$sym_table{$name.'[]'} = { type => 'array'};
}
unless ($sym_table{$name.'[]'}{'value'}[$idx]) {
$sym_table{$name.'[]'}{'value'}[$idx] = { type => 'var',
value => 0 };
}
push(@ope_stack, $sym_table{$name.'[]'}{'value'}[$idx]{'value'});
next INSTR;
} elsif($_ eq '=V') {
# Attribution of a value to a variable
# ope_stack ends with a NUMBER and an IDENTIFIER
my $varName = pop(@ope_stack);
my $value = pop(@ope_stack);
$sym_table{$varName} = { type => 'var',
value => $value };
push(@ope_stack, $value);
next INSTR;
} elsif($_ eq '=P') {
my $varName = pop(@ope_stack);
my $value = pop(@ope_stack);
my ($name, $idx) = ($varName =~ /([a-z]+)\[\](\d+)/);
$name .= '[]';
unless (defined($sym_table{$name})
and $sym_table{$name}{'type'} eq 'array')
{
$sym_table{$name} = { type => 'array',
value => [] };
}
$sym_table{$name}{'value'}[$idx] = { type => 'var',
value => $value };
push(@ope_stack, $value);
next INSTR;
} elsif($_ eq 'IF') {
# IF statement
my $cond = pop @ope_stack;
$val = 0;
if($cond) {
($return, $val) = exec_stmt($instr->[1]);
push(@ope_stack, $val), last INSTR if $return;
}
# debug {"IF: $val.\n"};
push(@ope_stack, $val);
# debug {"IF: ope_stack=".Dumper(\@ope_stack)};
next INSTR;
} elsif($_ eq 'FOR-COND') {
# WHILE and FOR statement
# debug {"while-cond: stmt_s=".Dumper(\@stmt_s)};
my $i_cond = $instr;
my $i_incr = shift @stmt_s;
my $i_body = shift @stmt_s;
my $val=1;
# debug { "cond: ".Dumper($i_cond) };
LOOP: while(1) {
@ope_stack=();
if($#{ $i_cond->[1] } >= 0) {
($return, $val) = exec_stmt($i_cond->[1]);
# debug {"results of cond: $return, $val"};
push(@ope_stack, $val), last INSTR
if($return == 1 or $return == 2);
last LOOP if $val == 0;
}
# debug {"while: executing a body\n"};
if($#{ $i_body->[1] } >= 0) {
($return, $val) = exec_stmt($i_body->[1]);
push(@ope_stack, $val);
if($return == 1) {
last INSTR;
} elsif($return == 2) {
$return = 0 ;
last INSTR;
}
}
if($#{ $i_incr->[1] } >= 0) {
# debug {"for: executing the increment: ".Dumper($i_incr)};
@ope_stack = ();
($return, $val) = exec_stmt($i_incr->[1]);
push(@ope_stack, $val);
last INSTR if($return == 1 or $return == 2);
}
}
$return = 3;
push(@ope_stack, 1); # whatever
next INSTR;
} elsif($_ eq 'FUNCTION-CALL') {
# Function call
push @backup_sym_table, undef; # Hmmm...
my $name = $instr->[1];
$name .= '()';
unless($sym_table{$name}) {
print STDERR "No function $name has been defined\n";
@ope_stack = (0);
$return = 3;
YYERROR;
}
if($sym_table{$name}{type} eq 'builtin') {
($return, $val) =
(1, &{ $sym_table{$name}{value} }(\@ope_stack));
} else {
($return, $val) = exec_stmt($sym_table{$name}{'value'});
# Restore the symbols temporarily pushed in 'a' and 'A' instructions
debug {"restoring backup: ".Dumper(\@backup_sym_table)};
my $n;
# pop @backup_sym_table; # The first is undef
while($var = pop @backup_sym_table) {
debug {"restoring var: ".Dumper($var)};
if($var->{'type'} eq 'undef') {
delete $sym_table{$var->{'name'}};;
} else {
$sym_table{$var->{'name'}} = $var->{'entry'};
}
}
# push @backup_sym_table, undef;
}
# debug {"result from function $name: $return, $val.\n"};
push(@ope_stack, $val);
if($return == 1) {
$return = 0; # so the result will be printed
} elsif($return == 2) {
print STDERR "No enclosing while or for";
YYERROR;
} elsif($return == 3) {
$return = 0;
}
next INSTR;
} elsif($_ eq 'a' or $_ eq 'A') {
# Function arguments and auto list declaration
# The difference is that function arguments are initialized from the
# operation stack, while auto variables are initialized to zero
my ($where, $name) = ($_, $instr->[1]);
if(defined $sym_table{$name}) {
debug { "backup $name, $sym_table{$name}\n" };
push @backup_sym_table, { name => $name,
entry => $sym_table{$name} };
} else {
debug { "backup $name, undef \n" };
push @backup_sym_table, { name => $name,
type => 'undef' };
}
$sym_table{$name} = { type => 'var',
value => ($where eq 'a' ?
shift(@ope_stack) : 0) };
# debug { "new entry $name in sym table: $sym_table{$name}{'value'}" };
next INSTR;
} elsif($_ eq '{}') {
# Grouped statements
if(scalar @{ $instr->[1] } > 0) {
($return, $val) = exec_stmt($instr->[1]);
} else {
($return, $val) = (0, 0);
}
push(@ope_stack, $val), last INSTR
if($return eq 1 or $return eq 2);
$return = 3;
push(@ope_stack, $val);
next INSTR;
} elsif($_ eq 'STMT') {
@ope_stack=();
if(scalar $instr->[1] > 0) {
($return, $val) = exec_stmt($instr->[1]);
} else {
($return, $val) = (3, undef);
}
@ope_stack = ($val), last INSTR
if($return eq 1 or $return eq 2);
$return = 3;
@ope_stack = ($val);
next INSTR;
} elsif($_ eq 'RETURN') {
# Return statement
# debug {"returning $instr->[1].\n"};
my $value = ($instr->[1] == 0) ? 0
: pop(@ope_stack);
$return = 1;
@ope_stack = ($value);
last INSTR;
} elsif($_ eq 'BREAK') {
# Break statement
# debug {"breaking.\n"};
$return = 2;
push(@ope_stack, 0);
last INSTR;
} elsif($_ eq 'PRINT') {
# PRINT statement
if(scalar @{ $instr->[1] } > 0) {
($return, $val) = exec_stmt($instr->[1]);
} else {
($return, $val) = (0, 0);
}
push(@ope_stack, $val), last INSTR
if($return eq 1 or $return eq 2);
$return = 3;
next INSTR;
} elsif($_ eq 'PRINT-STMT') {
@ope_stack=();
if(scalar $instr->[1] > 0) {
($return, $val) = exec_stmt($instr->[1]);
} else {
($return, $val) = (3, undef);
}
last INSTR if($return eq 1 or $return eq 2);
$return = 3;
print $val;
next INSTR;
} elsif($_ eq 'FUNCTION-DEF') {
# Function definition
my ($name, $code) = ($instr->[1], $instr->[2]);
push(@$code, ["RETURN", 0]);
$sym_table{$name.'()'} = { type => 'func',
value => $code };
$return = 3;
push(@ope_stack, 1); # whatever
next INSTR;
} elsif($_ eq 'S') {
# S for string
$_ = $instr->[1];
s/ \\a /\a/gx;
s/ \\b /\b/gx;
s/ \\f /\f/gx;
s/ \\n /\n/gx;
s/ \\r /\r/gx;
s/ \\t /\t/gx;
s/ \\q /"/gx; # "
s/ \\\\ /\\/gx;
push(@ope_stack, $_);
next INSTR;
} else {
die "internal error: illegal statement $_";
}
}
my $val;
if ($return == 3) {
@ope_stack = ();
} else {
if(scalar @ope_stack != 1) {
die("internal error: ope_stack = ".join(", ", @ope_stack).".\n");
}
$val = pop(@ope_stack);
# debug {"Returning ($return, $val)\n"};
# debug {"ope_stack at e-o-func: ".Dumper(\@ope_stack)};
}
return ($return, $val);
}
# catch signals
sub catch
{
local($signum) = @_;
print STDERR "\n" if (-t STDERR && -t STDIN);
&yyerror("Floating point exception") if $signum == 8;
# next outer;
main();
}
# main program
sub main
{
# outer:
while(1)
{
$line = '';
eval '$status = &yyparse;';
# debug { "yyparse returned $status" } if !$@;
exit $status if ! $@;
&yyerror($@);
}
}
init_table();
command_line();
$SIG{'INT'} = 'catch';
$SIG{'FPE'} = 'catch';
select(STDERR); $| = 1;
select(STDOUT);
&next_file;
start_stmt();
main();
__END__
/* libmath.b for GNU bc. */
/* This file is part of GNU bc.
Copyright (C) 1991, 1992, 1993, 1997 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License , or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
You may contact the author by:
e-mail: phil@cs.wwu.edu
us-mail: Philip A. Nelson
Computer Science Department, 9062
Western Washington University
Bellingham, WA 98226-9062
*************************************************************************/
scale = 20
/* Uses the fact that e^x = (e^(x/2))^2
When x is small enough, we use the series:
e^x = 1 + x + x^2/2! + x^3/3! + ...
*/
define e(x) {
auto a, d, e, f, i, m, n, v, z
/* a - holds x^y of x^y/y! */
/* d - holds y! */
/* e - is the value x^y/y! */
/* v - is the sum of the e's */
/* f - number of times x was divided by 2. */
/* m - is 1 if x was minus. */
/* i - iteration count. */
/* n - the scale to compute the sum. */
/* z - orignal scale. */
/* Check the sign of x. */
if (x<0) {
m = 1
x = -x
}
/* Precondition x. */
z = scale;
n = 6 + z + .44*x;
scale = scale(x)+1;
while (x > 1) {
f += 1;
x /= 2;
scale += 1;
}
/* Initialize the variables. */
scale = n;
v = 1+x
a = x
d = 1
for (i=2; 1; i++) {
e = (a *= x) / (d *= i)
if (e == 0) {
if (f>0) while (f--) v = v*v;
scale = z
if (m) return (1/v);
return (v/1);
}
v += e
}
}
/* Natural log. Uses the fact that ln(x^2) = 2*ln(x)
The series used is:
ln(x) = 2(a+a^3/3+a^5/5+...) where a=(x-1)/(x+1)
*/
define l(x) {
auto e, f, i, m, n, v, z
/* return something for the special case. */
if (x <= 0) return ((1 - 10^scale)/1)
/* Precondition x to make .5 < x < 2.0. */
z = scale;
scale = 6 + scale;
f = 2;
i=0
while (x >= 2) { /* for large numbers */
f *= 2;
x = sqrt(x);
}
while (x <= .5) { /* for small numbers */
f *= 2;
x = sqrt(x);
}
/* Set up the loop. */
v = n = (x-1)/(x+1)
m = n*n
/* Sum the series. */
for (i=3; 1; i+=2) {
e = (n *= m) / i
if (e == 0) {
v = f*v
scale = z
return (v/1)
}
v += e
}
}
/* Sin(x) uses the standard series:
sin(x) = x - x^3/3! + x^5/5! - x^7/7! ... */
define s(x) {
auto e, i, m, n, s, v, z
/* precondition x. */
z = scale
scale = 1.1*z + 2;
v = a(1)
if (x < 0) {
m = 1;
x = -x;
}
scale = 0
n = (x / v + 2 )/4
x = x - 4*n*v
if (n%2) x = -x
/* Do the loop. */
scale = z + 2;
v = e = x
s = -x*x
for (i=3; 1; i+=2) {
e *= s/(i*(i-1))
if (e == 0) {
scale = z
if (m) return (-v/1);
return (v/1);
}
v += e
}
}
/* Cosine : cos(x) = sin(x+pi/2) */
define c(x) {
auto v;
scale += 1;
v = s(x+a(1)*2);
scale -= 1;
return (v/1);
}
/* Arctan: Using the formula:
atan(x) = atan(c) + atan((x-c)/(1+xc)) for a small c (.2 here)
For under .2, use the series:
atan(x) = x - x^3/3 + x^5/5 - x^7/7 + ... */
define a(x) {
auto a, e, f, i, m, n, s, v, z
/* a is the value of a(.2) if it is needed. */
/* f is the value to multiply by a in the return. */
/* e is the value of the current term in the series. */
/* v is the accumulated value of the series. */
/* m is 1 or -1 depending on x (-x -> -1). results are divided by m. */
/* i is the denominator value for series element. */
/* n is the numerator value for the series element. */
/* s is -x*x. */
/* z is the saved user's scale. */
/* Negative x? */
m = 1;
if (x<0) {
m = -1;
x = -x;
}
/* Special case and for fast answers */
if (x==1) {
if (scale <= 25) return (.7853981633974483096156608/m)
if (scale <= 40) return (.7853981633974483096156608458198757210492/m)
if (scale <= 60) \
return (.785398163397448309615660845819875721049292349843776455243736/m)
}
if (x==.2) {
if (scale <= 25) return (.1973955598498807583700497/m)
if (scale <= 40) return (.1973955598498807583700497651947902934475/m)
if (scale <= 60) \
return (.197395559849880758370049765194790293447585103787852101517688/m)
}
/* Save the scale. */
z = scale;
/* Note: a and f are known to be zero due to being auto vars. */
/* Calculate atan of a known number. */
if (x > .2) {
scale = z+5;
a = a(.2);
}
/* Precondition x. */
scale = z+3;
while (x > .2) {
f += 1;
x = (x-.2) / (1+x*.2);
}
/* Initialize the series. */
v = n = x;
s = -x*x;
/* Calculate the series. */
for (i=3; 1; i+=2) {
e = (n *= s) / i;
if (e == 0) {
scale = z;
return ((f*a+v)/m);
}
v += e
}
}
/* Bessel function of integer order. Uses the following:
j(-n,x) = (-1)^n*j(n,x)
j(n,x) = x^n/(2^n*n!) * (1 - x^2/(2^2*1!*(n+1)) + x^4/(2^4*2!*(n+1)*(n+2))
- x^6/(2^6*3!*(n+1)*(n+2)*(n+3)) .... )
*/
define j(n,x) {
auto a, d, e, f, i, m, s, v, z
/* Make n an integer and check for negative n. */
z = scale;
scale = 0;
n = n/1;
if (n<0) {
n = -n;
if (n%2 == 1) m = 1;
}
/* Compute the factor of x^n/(2^n*n!) */
f = 1;
for (i=2; i<=n; i++) f = f*i;
scale = 1.5*z;
f = x^n / 2^n / f;
/* Initialize the loop .*/
v = e = 1;
s = -x*x/4
scale = 1.5*z
/* The Loop.... */
for (i=1; 1; i++) {
e = e * s / i / (n+i);
if (e == 0) {
scale = z
if (m) return (-f*v/1);
return (f*v/1);
}
v += e;
}
}
#line 2391 "y.tab.pl"