File Coverage

bin/bc
Criterion Covered Total %
statement 713 987 72.2
branch 356 542 65.6
condition 131 183 71.5
subroutine 21 37 56.7
pod n/a
total 1221 1749 69.8


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             =begin metadata
4              
5             Name: bc
6             Description: an arbitrary precision calculator language
7             Author: Philip A. Nelson, phil@cs.wwu.edu
8             License: gpl
9              
10             =end metadata
11              
12             =cut
13              
14             =head1 NAME
15              
16             bc - an arbitrary precision calculator language
17              
18             =head1 SYNOPSIS
19              
20             Run a bc program from FILE
21              
22             bc [-bdiqswy] FILE...
23              
24             Start an interactive bc session
25              
26             bc [-bdiqswy]
27              
28             =head1 DESCRIPTION
29              
30             This is the PerlPowerTools implementation of the GNU version of bc, a
31             standard calculator language. This is documented at:
32              
33             https://www.gnu.org/software/bc/manual/html_mono/bc.html
34              
35             =head2 Options
36              
37             =over
38              
39             =item * -b - use Math::BigFloat
40              
41             =item * -d - turn on debugging output
42              
43             =item * -l - use mathlib
44              
45             =item * -y - turn on parser debugging output
46              
47             =back
48              
49             =head2 Environment
50              
51             There are no environment variables that affect this program.
52              
53             =head1 The bc language
54              
55             NOTE: Some of this documentation is lifted straight from the GNU
56             documentation for its version of B.
57              
58             C is a language that supports arbitrary precision numbers with
59             interactive execution of statements. There are some similarities in
60             the syntax to the C programming language.
61              
62             =begin comment ### XXX hidden because function support generate syntax errors
63              
64             A standard math library is
65             available by command line option. If requested, the math library is
66             defined before processing any files.
67              
68             =end comment
69              
70             C starts by processing code from all the files listed on the
71             command line in the order listed. If no files are listed, then stdin
72             is read. If a file contains a command to halt the processor,
73             C will never read from the standard input.
74              
75             Dash ('-') is a pseudo-filename which represents stdin. This makes
76             it possible to do something like C and have bc
77             run commands from fileA before prompting for input, and then run
78             commands from fileB after interactive input is finished.
79              
80             =begin comment ### XXX for accuracy, the following is superceded by the above
81              
82             C starts by processing code from all the files listed on the
83             command line in the order listed. After all files have been
84             processed, C reads from the standard input. All code is executed
85             as it is read. (If a file contains a command to halt the processor,
86             C will never read from the standard input.)
87              
88             =end comment
89              
90             C will terminate interactive input via stdin if you enter C
91             or press C.
92              
93             =head1 BASIC ELEMENTS
94              
95             =head2 Numbers
96              
97             The most basic element in C is the number. Numbers are arbitrary
98             precision numbers. This precision is both in the integer part and the
99             fractional part. All numbers are represented internally in decimal and
100             all computation is done in decimal.
101              
102             =begin comment ### hidden because it doesn't seem to be true in this implementation
103              
104             (This version truncates results
105             from divide and multiply operations.)
106              
107             =end comment
108              
109              
110             There are two attributes of
111             numbers, the length and the scale. The length is the total number of
112             significant decimal digits in a number and the scale is the total number
113             of decimal digits after the decimal point. For example, .000001 has a
114             length of 6 and scale of 6, while 1935.000 has a length of 7 and a scale
115             of 3.
116              
117             =head2 Variables
118              
119             Numbers are stored in two types of variables, simple variables and
120             arrays. Both simple variables and array variables are named. Names
121             begin with a letter followed by any number of letters, digits and
122             underscores. All letters must be lower case.
123              
124             =begin comment ### hidden because it's not applicable and confusing
125              
126             (Full alphanumeric names
127             are an extension. In POSIX C all names are a single lower case
128             letter.)
129              
130             =end comment
131              
132             The type of variable is clear by the context because all
133             array variable names will be followed by brackets ( [ ] ).
134              
135             =head2 Special Variables
136              
137             =over 8
138              
139             =item C
140              
141             Defines how some operations use digits after the decimal point.
142             The default value is 0.
143              
144             =item C
145              
146             Defines the conversion base for input numbers. Defaults to 10.
147              
148             =item C
149              
150             Defines the conversion base for output numbers. Defaults to 10.
151              
152             =back
153              
154             =head2 Comments
155              
156             Comments in C start with the characters '/*' and end with the
157             characters '*/'. Comments may start anywhere and appear as a single
158             space in the input. Note that this causes comments to delimit other
159             input items, therefore a comment cannot be included the middle of a
160             variable name. Comments include any newlines (end of line) between
161             the start and the end of the comment.
162              
163             To support the use of scripts for C, a single line comment has
164             been added as an extension. A single line comment starts at a '#'
165             character and continues to the next end of the line. The end of line
166             character is not part of the comment and is processed normally.
167              
168             =head1 EXPRESSIONS
169              
170             Numbers are manipulated by expressions and statements. Since
171             the language was designed to be interactive, statements and expressions
172             are executed as soon as possible. There is no main program. Instead,
173             code is executed as it is encountered.
174              
175             A simple expression is just a constant. C converts constants into
176             internal decimal numbers using the current input base, specified by the
177             variable C.
178              
179             Full expressions are similar to many other high level languages.
180             Since there is only one kind of number, there are no rules for mixing
181             types. Instead, there are rules on the scale of expressions. Every
182             expression has a scale. This is derived from the scale of original
183             numbers, the operation performed and in many cases, the value of the
184             variable C.
185              
186             =begin comment ### replace by the above for accurary w.r.t this implementation
187              
188             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.)
189              
190             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.
191              
192             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.
193              
194             =end comment
195              
196             =head2 Basic Expressions
197              
198             In the following descriptions of legal expressions, "expr" refers to
199             a complete expression and "VAR" refers to a simple or an array variable.
200             A simple variable is just a NAME and an array variable is specified as
201             NAME[EXPR].
202              
203             Unless specifically mentioned the scale of the result is the maximum
204             scale of the expressions involved.
205              
206             =over 4
207              
208             =item C<- expr>
209              
210             The result is the negation of the expression.
211              
212             =item C<++ VAR>
213              
214             The variable is incremented by one and the new value is the result
215             of the expression.
216              
217             =item C<-- VAR>
218              
219             The variable is decremented by one and the new value is the result
220             of the expression.
221              
222             =item C
223              
224             The result of the expression is the value of the variable and then
225             the variable is incremented by one.
226              
227             =item C
228              
229             The result of the expression is the value of the variable and then
230             the variable is decremented by one.
231              
232             =item C
233              
234             The result of the expression is the sum of the two expressions.
235              
236             =item C
237              
238             The result of the expression is the difference of the two
239             expressions.
240              
241             =item C
242              
243             The result of the expression is the product of the two expressions.
244              
245             =item C
246              
247             The result of the expression is the quotient of the two
248             expressions. The scale of the result is the value of the variable
249             C
250              
251             =item C
252              
253             The result of the expression is the "remainder" and it is computed
254             in the following way. To compute a%b, first a/b is computed to
255             SCALE digits. That result is used to compute a-(a/b)*b to the
256             scale of the maximum of SCALE+scale(b) and scale(a). If SCALE is
257             set to zero and both expressions are integers this expression is
258             the integer remainder function.
259              
260             =item C
261              
262             The result of the expression is the value of the first raised to
263             the second.
264              
265             =begin comment ### hidden because it doesn't seem to be true in the implementation
266              
267             The second expression must be an integer. (If the
268             second expression is not an integer, a warning is generated and the
269             expression is truncated to get an integer value.)
270              
271             =end comment
272              
273             The scale of the result is SCALE if the exponent is negative. If the
274             exponent is positive the scale of the result is the minimum of the
275             scale of the first expression times the value of the exponent and the
276             maximum of SCALE and the scale of the first expression. (e.g.
277             scale(a^b) = min(scale(a)*b, max(SCALE, scale(a))).) It should be
278             noted that expr^0 will always return the value of 1.
279              
280              
281             =item C<( expr )>
282              
283             This alters the standard precedence to force the evaluation of the
284             expression.
285              
286             =item C
287              
288             The variable is assigned the value of the expression.
289              
290             =item C
291              
292             This is equivalent to "VAR = VAR op expr" with the exception
293             that the "VAR" part is evaluated only once. This can make a
294             difference if "VAR" is an array.
295              
296             =back
297              
298             =head2 Relational Expressions
299              
300             Relational expressions are a special kind of expression that always
301             evaluate to 0 or 1, 0 if the relation is false and 1 if the relation is
302             true. These may appear in any legal expression. (POSIX C requires
303             that relational expressions are used only in C, C, and C
304             statements and that only one relational test may be done in them.) The
305             relational operators are
306              
307             =over 4
308              
309             =item expr1 < expr2
310              
311             The result is 1 if expr1 is strictly less than expr2.
312              
313             =item expr1 <= expr2
314              
315             The result is 1 if expr1 is less than or equal to expr2.
316              
317             =item expr1 > expr2
318              
319             The result is 1 if expr1 is strictly greater than expr2.
320              
321             =item expr1 >= expr2
322              
323             The result is 1 if expr1 is greater than or equal to expr2.
324              
325             =item expr1 == expr2
326              
327             The result is 1 if expr1 is equal to expr2.
328              
329             =item expr1 != expr2
330              
331             The result is 1 if expr1 is not equal to expr2.
332              
333             =back
334              
335             =head2 Boolean Expressions
336              
337             Boolean operations are also legal. (POSIX C does NOT have
338             boolean operations). The result of all boolean operations are 0 and 1
339             (for false and true) as in relational expressions. The boolean
340             operators are:
341              
342             =over 4
343              
344             =item C
345              
346             The result is 1 if expr is 0.
347              
348             =item C
349              
350             The result is 1 if both expressions are non-zero.
351              
352             =item C
353              
354             The result is 1 if either expression is non-zero.
355              
356             =back
357              
358             =head2 Precedence
359              
360             The expression precedence is as follows: (lowest to highest)
361              
362             = += etc operators (assignment) right associative
363             || OR operator left associative
364             && AND operator left associative
365             ! NOT operator nonassociative
366             < > etc relational operators left associative
367             + and - operators left associative
368             *, / and % operators left associative
369             ^ operator (power) right associative
370             unary - operator nonassociative
371             ++ and -- operators nonassociative
372              
373             This differs from POSIX-compliant C, which puts assignment between
374             relational operators and addition/subtraction. As a result, expressions
375             behave more like they do in most languages (including perl and C).
376              
377             =head2 Special Expressions
378              
379             There are a few more special expressions that are provided in C.
380             These have to do with user-defined functions and standard functions.
381             These are:
382              
383             =over 4
384              
385             =item C
386              
387             The value of the C function is the number of significant
388             digits in the expression.
389              
390             =begin comment ### hidden because it's not supported
391              
392             =item C
393              
394             The C function (an extension) will read a number from the
395             standard input, regardless of where the function occurs. Beware,
396             this can cause problems with the mixing of data and program in the
397             standard input. The best use for this function is in a previously
398             written program that needs input from the user, but never allows
399             program code to be input from the user. The value of the `read'
400             function is the number read from the standard input using the
401             current value of the variable C for the conversion base.
402              
403             =end comment
404              
405             =item C
406              
407             The value of the C function is the number of digits after the
408             decimal point in the expression.
409              
410             =item C
411              
412             The value of the C function is the square root of the
413             expression. If the expression is negative, a run time error is
414             generated.
415              
416             =back
417              
418             =head2 Statements
419              
420             Statements (as in most algebraic languages) provide the sequencing of
421             expression evaluation. In C statements are executed "as soon as
422             possible." Execution happens when a newline is encountered and there
423             is one or more complete statements. Due to this immediate execution,
424             newlines are very important in C. In fact, both a semicolon and a
425             newline are used as statement separators. An improperly placed
426             newline will cause a syntax error.
427              
428             Because newlines are statement separators, it is possible to hide a
429             newline by using the backslash character. The sequence "\" (where
430             represents a newline your typed) appears to C as whitespace
431             instead of an actual newline.
432              
433             A statement list is a series of statements separated by semicolons
434             and newlines.
435              
436             The following is a list of C statements and what they do. Things
437             enclosed in brackets ( [ ] ) are optional parts of the statement.
438              
439             =over 4
440              
441             =item EXPRESSION
442              
443             This statement does one of two things. If the expression starts
444             with " ...", it is considered to be an
445             assignment statement. If the expression is not an assignment
446             statement, the expression is evaluated and printed to the output.
447             After the number is printed, a newline is printed.
448              
449             For example, "a=1" is an assignment statement and "(a=1)" is an
450             expression that has an embedded assignment.
451              
452             =begin comment ### hidden because obase and last don't seem to work
453              
454             All numbers that are printed are printed in the base specified by the
455             variable OBASE. The legal values for OBASE are 2 through BC_BASE_MAX
456             (*note Environment Variables::). For bases 2 through 16, the usual
457             method of writing numbers is used. For bases greater than 16, C
458             uses a multi-character digit method of printing the numbers where each
459             higher base digit is printed as a base 10 number. The multi-character
460             digits are separated by spaces. Each digit contains the number of
461             characters required to represent the base ten value of "OBASE -1".
462             Since numbers are of arbitrary precision, some numbers may not be
463             printable on a single output line. These long numbers will be split
464             across lines using the "\" as the last character on a line. The
465             maximum number of characters printed per line is 70. Due to the
466             interactive nature of C, printing a number causes the side effect
467             of assigning the printed value to the special variable LAST. This
468             allows the user to recover the last value printed without having to
469             retype the expression that printed the number. Assigning to LAST is
470             legal and will overwrite the last printed value with the assigned
471             value. The newly assigned value will remain until the next number is
472             printed or another value is assigned to LAST. (Some installations may
473             allow the use of a single period (.) which is not part of a number as
474             a short hand notation for for LAST.)
475              
476             =end comment
477              
478             =item STRING
479              
480             The string is printed to the output. Strings start with a double
481             quote character and contain all characters until the next double
482             quote character. All characters are taken literally, including
483             any newline. No newline character is printed after the string.
484              
485             =item C LIST
486              
487             The C statement (an extension) provides another method of
488             output. The LIST is a list of strings and expressions separated by
489             commas. Each string or expression is printed in the order of the
490             list. No terminating newline is printed. Expressions are
491             evaluated and their value is printed and assigned to the variable
492             C. Strings in the print statement are printed to the output
493             and may contain special characters. Special characters start with
494             the backslash character. The special characters include:
495              
496             \a alert or bell
497             \b backspace
498             \f form feed
499             \n newline
500             \r carriage return
501             \q double quote
502             \t tab
503             \e backslash.
504              
505             Any other character following a backslash will be ignored.
506              
507             =item { STATEMENT_LIST }
508              
509             This is the compound statement. It allows multiple statements to
510             be grouped together for execution.
511              
512             =item C ( EXPRESSION ) STATEMENT
513              
514             The C statement evaluates the expression and executes STATEMENT
515             depending on the value of the expression. If the expression is
516             non-zero, STATEMENT is executed. Otherwise it isn't. (The statement
517             can be a block enclosed in { }.)
518              
519             =begin comment ### if-else is not supported in this implementation
520              
521             If the expression is non-zero, statement1 is executed. If statement2
522             is present and the value of the expression is 0, then statement2 is
523             executed. (The C clause is an extension.)
524              
525             =end comment
526              
527             =item C ( EXPRESSION ) STATEMENT
528              
529             The while statement will execute the statement while the expression
530             is non-zero. It evaluates the expression before each execution of
531             the statement. Termination of the loop is caused by a zero
532             expression value or the execution of a C statement.
533              
534             =item C ( [EXPRESSION1] ; [EXPRESSION2] ; [EXPRESSION3] ) STATEMENT
535              
536             The C statement controls repeated execution of the statement.
537             EXPRESSION1 is evaluated before the loop. EXPRESSION2 is
538             evaluated before each execution of the statement. If it is
539             non-zero, the statement is evaluated. If it is zero, the loop is
540             terminated.
541              
542             After each execution of the statement, EXPRESSION3 is
543             evaluated before the reevaluation of expression2. If EXPRESSION1
544             or EXPRESSION3 are missing, nothing is evaluated at the point they
545             would be evaluated. If EXPRESSION2 is missing, it is the same as
546             substituting the value 1 for EXPRESSION2.
547              
548             (The optional expressions are an extension. POSIX C requires all
549             three expressions.)
550              
551             The following is equivalent code for the C
552             statement:
553              
554             expression1;
555             while (expression2) {
556             statement;
557             expression3;
558             }
559              
560             =item C
561              
562             This statement causes a forced exit of the most recent enclosing
563             C statement or C statement.
564              
565             =item C
566              
567             When the C statement is read, the C processor is
568             terminated, regardless of where the C statement is found. For
569             example, C will cause C to terminate.
570              
571             =back
572              
573             =head1 EXAMPLE
574              
575             The following illustrates how C expressions can be written in
576             script form and fed to C via stdin.
577              
578             =begin comment
579              
580             Note that the /* and */ are necessary to around the C code example
581             in order to prevent -l from processing these statements when reading
582              
583             /*
584              
585             =end comment
586              
587             print "\nCompute balances after withdrawals\n"
588              
589             bal = 100.00
590             withdrawal = 20.00;
591              
592             while (1) {
593             print "Balance: ", "\t", bal, "\n"
594             print "Withdrawal: ", "\t", withdrawal, "\n"
595             if ( (bal - withdrawal) < 0 ) break;
596             bal -= withdrawal
597             }
598              
599             print "Balance:", bal
600              
601             quit
602              
603             =begin comment
604              
605             */
606              
607             =end comment
608              
609             =head1 BUGS AND LIMITATIONS
610              
611             This implementation of C is mostly POSIX compliant and has similar
612             extensions to GNU C. However, some features and extensions are
613             either not supported or are not working.
614              
615             Perhaps the biggest non-working feature would be Function definitions
616             via the C syntax, which if used generates syntax errors. As a
617             consequence, the -l option (to load math library definitions) doesn't
618             work either.
619              
620             Setting the following variables don't seem to have the intended effects:
621              
622             scale
623             ibase
624             obase
625              
626             Hexadecimal values, for use when ibase is > 10, are not supported.
627              
628             Old style assignment operators (=+, =-, =*, =/, =%, =^) are not
629             required to be supported by the POSIX standard, and they are not
630             supported by this implementation. However, they will not generate
631             any errors. Instead you will get a result you don't expect.
632             For example:
633              
634             v=3; v += 2 # v is 5 as you would expect
635             v=3; v =+ 2 # v is 2 because the 2nd expression is seen as v = +2
636              
637             =head1 COMPARISON TO GNU C AND OTHERS
638              
639             The following C features are not supported in this implementation.
640             (Some are syntactically accepted, but simply return zero).
641              
642             * -w, --warn option
643             * -s, --standard option
644             * -q, --quiet option
645             * -v, --version option
646             * long options (e.g. --help)
647             * LC_ language and NLSPATH environment variables
648             * "last" special variable
649             * "if" statement: "else" clause
650             * "read" function
651             * "continue" statement
652             * "halt" statement
653             * "limits" pseudo statement
654             * "warranty" pseudo statement
655             * function definitions
656              
657             In addition, the GNU implementation set the precedence of assignment
658             below + and - and above relational operators (< > etc). This
659             implementation seems to make it the lowest precedence (i.e. below ||),
660             as most perl (and C) users would expect.
661              
662             =head1 REFERENCES
663              
664             POSIX C L
665              
666             GNU C L
667              
668             =head2 GNU's mathlib
669              
670             Load the GNU math extensions with the C<-l> switch:
671              
672             % bc -l FILE
673              
674             The library provides these functions:
675              
676             =over 4
677              
678             =item * a(x) - the arctangent of X, where X is expressed in radians
679              
680             =item * c(x) - the cosine of X, where X is expressed in radians
681              
682             =item * e(X) - the natural base, e, raised to the X power
683              
684             =item * j(n,x) - the Bessel function of order n, where n is an integer
685              
686             =item * l(X) - the natural logarithm of X
687              
688             =item * s(x) - the sine of X, where X is expressed in radians
689              
690             =back
691              
692             =head1 AUTHOR
693              
694             Philip A. Nelson originally translated GNU bc to Perl for the PerlPowerTools
695             project.
696              
697             https://github.com/briandfoy/PerlPowerTools
698              
699             =head1 LICENSE
700              
701             You can use and modify this program under the terms of the GNU Public
702             License version 2. A copy of this license is in the PerlPowerTools
703             repository:
704              
705             https://github.com/briandfoy/PerlPowerTools/
706              
707             =cut
708              
709 67     67   394483 use strict;
  67         119  
  67         2901  
710              
711 67     67   41710 use Math::Trig;
  67         1360421  
  67         12911  
712 67     67   40171 use POSIX;
  67         572427  
  67         368  
713              
714             # The symbol table : the keys are the identifiers, the value is in the
715             # "var" field if it is a variable, in the "func" field if it is a
716             # function.
717 67         14014048 my %sym_table;
718 67         312 my @stmt_list = ();
719 67         325 my @ope_stack;
720             my @backup_sym_table;
721 67         0 my $input;
722 67         204 my $cur_file = '-';
723 67         147 my $bignum = 0;
724 67         137 my $do_stdin = 0;
725 67         1056 my $line;
726             my $var;
727 67         0 my $yychar;
728 67         0 my $yydebug;
729 67         0 my $yyerrflag;
730 67         0 my $yylval;
731 67         0 my $yyn;
732 67         0 my $yym;
733 67         0 my $yyssp;
734 67         0 my $yystate;
735 67         0 my $yyval;
736 67         0 my $yyvsp;
737              
738 67         142 my $debug = 0;
739             sub debug(&) {
740 134     134   246 my $fn = shift;
741 134 50       362 print STDERR "\t".&$fn()
742             if $debug;
743             }
744              
745 67         121 my $INT=257;
746 67         159 my $FLOAT=258;
747 67         153 my $STRING=259;
748 67         121 my $IDENT=260;
749 67         240 my $C_COMMENT=261;
750 67         167 my $BREAK=262;
751 67         236 my $DEFINE=263;
752 67         116 my $AUTO=264;
753 67         123 my $RETURN=265;
754 67         106 my $PRINT=266;
755 67         152 my $AUTO_LIST=267;
756 67         119 my $IF=268;
757 67         175 my $ELSE=269;
758 67         132 my $QUIT=270;
759 67         137 my $WHILE=271;
760 67         116 my $FOR=272;
761 67         121 my $EQ=273;
762 67         135 my $NE=274;
763 67         133 my $GT=275;
764 67         134 my $GE=276;
765 67         513 my $LT=277;
766 67         242 my $LE=278;
767 67         253 my $PP=279;
768 67         200 my $MM=280;
769 67         142 my $P_EQ=281;
770 67         226 my $M_EQ=282;
771 67         133 my $F_EQ=283;
772 67         117 my $D_EQ=284;
773 67         119 my $EXP_EQ=285;
774 67         106 my $MOD_EQ=286;
775 67         102 my $L_SHIFT=287;
776 67         106 my $R_SHIFT=288;
777 67         102 my $E_E=289;
778 67         104 my $O_O=290;
779 67         129 my $EXP=291;
780 67         99 my $UNARY=292;
781 67         135 my $PPP=293;
782 67         128 my $MMM=294;
783 67         145 my $YYERRCODE=256;
784 67         853 my @yylhs = ( -1,
785             0, 0, 1, 1, 1, 3, 4, 9, 3, 3,
786             3, 12, 3, 13, 3, 14, 3, 15, 17, 3,
787             18, 19, 20, 3, 3, 10, 10, 16, 16, 8,
788             8, 6, 6, 2, 2, 5, 5, 22, 22, 23,
789             23, 24, 24, 7, 7, 25, 25, 11, 11, 21,
790             21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
791             21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
792             21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
793             21, 21, 21, 21, 21, 21, 21, 26, 26,
794             );
795 67         716 my @yylen = ( 2,
796             0, 2, 1, 2, 2, 1, 0, 0, 13, 1,
797             1, 0, 3, 0, 4, 0, 7, 0, 0, 8,
798             0, 0, 0, 13, 1, 1, 4, 0, 1, 1,
799             3, 0, 1, 1, 1, 0, 1, 1, 3, 0,
800             1, 1, 3, 0, 3, 1, 3, 1, 3, 4,
801             3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
802             3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
803             3, 3, 3, 2, 2, 2, 2, 2, 2, 2,
804             2, 3, 6, 1, 1, 1, 1, 1, 4,
805             );
806 67         1615 my @yydefred = ( 1,
807             0, 0, 85, 86, 87, 0, 0, 11, 7, 0,
808             12, 0, 6, 18, 0, 0, 0, 0, 0, 0,
809             14, 0, 34, 35, 2, 3, 0, 10, 0, 0,
810             5, 0, 0, 0, 81, 0, 0, 0, 0, 0,
811             0, 0, 76, 77, 80, 74, 0, 0, 75, 4,
812             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
813             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
814             0, 0, 78, 79, 0, 0, 0, 0, 0, 0,
815             0, 0, 0, 0, 0, 29, 0, 0, 51, 0,
816             30, 0, 0, 0, 0, 0, 0, 0, 0, 0,
817             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
818             0, 0, 0, 50, 0, 0, 0, 27, 0, 16,
819             0, 21, 0, 15, 0, 0, 0, 38, 0, 0,
820             0, 0, 0, 0, 89, 31, 0, 0, 0, 33,
821             0, 19, 0, 0, 39, 17, 0, 22, 0, 20,
822             0, 0, 0, 0, 8, 23, 46, 0, 0, 0,
823             0, 45, 0, 0, 47, 9, 24,
824             );
825 67         793 my @yydgoto = ( 1,
826             25, 140, 86, 36, 129, 141, 155, 90, 159, 28,
827             82, 38, 48, 132, 40, 91, 147, 134, 151, 160,
828             29, 130, 77, 78, 158, 30,
829             );
830 67         1561 my @yysindex = ( 0,
831             475, -8, 0, 0, 0, 84, -239, 0, 0, -11,
832             0, 3, 0, 0, 19, -218, -218, 899, 899, 899,
833             0, 899, 0, 0, 0, 0, -8, 0, 893, -54,
834             0, 899, 899, 899, 0, -199, 899, 899, 958, 24,
835             958, -26, 0, 0, 0, 0, -32, 958, 0, 0,
836             899, 899, 899, 899, 899, 899, 899, 899, 899, 899,
837             899, 899, 899, 899, 899, 899, 899, 899, 899, 899,
838             899, 899, 0, 0, 893, 893, 25, 48, 830, 65,
839             852, 64, 893, 27, 958, 0, 53, 899, 0, 26,
840             0, 923, 923, 142, 142, 142, 142, 416, 416, -21,
841             -21, -30, -30, -29, -29, -180, -180, 142, 142, 142,
842             142, 142, 142, 0, 899, 67, -146, 0, 899, 0,
843             85, 0, 874, 0, 958, 893, 899, 0, 86, 87,
844             893, -8, -8, 958, 0, 0, 893, -8, -127, 0,
845             958, 0, 88, 41, 0, 0, 958, 0, -8, 0,
846             958, -116, 108, -103, 0, 0, 0, 18, 958, -8,
847             -100, 0, 31, 958, 0, 0, 0,
848             );
849 67         2265 my @yyrindex = ( 0,
850             0, 0, 0, 0, 0, -10, 0, 0, 0, 28,
851             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
852             0, 0, 0, 0, 0, 0, 0, 0, 30, 37,
853             0, 0, 127, 0, 0, 0, 0, 0, 0, 0,
854             119, 57, 0, 0, 0, 0, 0, 36, 0, 0,
855             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
856             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
857             0, 0, 0, 0, 4, -40, 0, 139, 0, 0,
858             0, 34, 66, 0, 145, 0, 0, 0, 0, 0,
859             0, 820, 822, 507, 518, 537, 551, 405, 442, 298,
860             380, 122, 192, 129, 167, 76, 99, 572, 579, 680,
861             758, 777, 799, 0, 0, 13, 149, 0, 0, 0,
862             0, 0, 0, 0, 36, -38, 0, 0, 0, 153,
863             93, 1023, 1023, 119, 0, 0, 29, 60, 0, 0,
864             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
865             145, 499, 0, 0, 0, 0, 0, 0, 36, 1023,
866             0, 0, 0, 0, 0, 0, 0,
867             );
868 67         329 my @yygindex = ( 0,
869             0, 358, 52, 0, 0, -108, 0, 38, 0, 0,
870             0, 0, 0, 0, 0, 337, 0, 0, 0, 0,
871             1278, 0, 0, 0, 0, 2,
872             );
873 67         9161 my @yytable = ( 88,
874             42, 24, 43, 42, 65, 43, 65, 65, 89, 63,
875             61, 63, 62, 82, 64, 65, 64, 43, 44, 35,
876             63, 61, 89, 62, 142, 64, 88, 24, 37, 144,
877             88, 88, 88, 88, 88, 24, 88, 26, 83, 25,
878             24, 42, 39, 13, 82, 28, 84, 82, 88, 89,
879             23, 164, 27, 89, 89, 89, 89, 89, 41, 89,
880             80, 161, 82, 85, 88, 114, 88, 120, 26, 83,
881             25, 89, 83, 84, 13, 48, 23, 84, 84, 84,
882             84, 84, 88, 84, 23, 67, 26, 83, 25, 23,
883             84, 115, 13, 88, 28, 84, 82, 88, 88, 88,
884             88, 88, 49, 88, 117, 89, 48, 119, 66, 48,
885             66, 122, 67, 128, 88, 88, 67, 67, 67, 67,
886             67, 83, 67, 33, 48, 133, 138, 127, 82, 84,
887             139, 62, 145, 49, 67, 66, 49, 89, 64, 66,
888             66, 66, 66, 66, 32, 66, 148, 154, 156, 88,
889             124, 49, 26, 83, 25, 166, 157, 66, 13, 165,
890             28, 84, 62, 149, 62, 62, 62, 40, 67, 64,
891             64, 64, 64, 64, 34, 64, 65, 28, 65, 41,
892             62, 88, 32, 63, 61, 28, 62, 64, 64, 36,
893             48, 66, 146, 37, 0, 0, 163, 0, 150, 0,
894             67, 63, 0, 0, 0, 0, 0, 65, 65, 65,
895             65, 65, 0, 65, 62, 167, 0, 49, 0, 0,
896             0, 64, 0, 66, 0, 65, 67, 68, 69, 70,
897             71, 72, 63, 0, 63, 63, 63, 0, 73, 74,
898             51, 52, 53, 54, 55, 56, 62, 0, 0, 0,
899             63, 0, 0, 64, 57, 58, 59, 60, 66, 65,
900             66, 66, 88, 88, 88, 88, 88, 88, 0, 66,
901             88, 88, 88, 88, 88, 88, 88, 88, 88, 88,
902             88, 0, 88, 88, 63, 89, 89, 89, 89, 89,
903             89, 65, 0, 89, 89, 89, 89, 89, 89, 89,
904             89, 89, 89, 89, 0, 89, 89, 53, 0, 84,
905             84, 84, 84, 84, 84, 0, 63, 0, 0, 0,
906             0, 0, 0, 84, 84, 84, 84, 84, 0, 88,
907             88, 88, 88, 88, 88, 0, 0, 0, 53, 0,
908             0, 53, 0, 88, 88, 88, 88, 88, 67, 67,
909             67, 67, 67, 67, 0, 0, 53, 0, 26, 31,
910             0, 0, 67, 67, 67, 67, 0, 0, 0, 0,
911             0, 66, 66, 66, 66, 66, 66, 87, 0, 0,
912             0, 0, 0, 0, 50, 66, 66, 66, 66, 52,
913             53, 0, 0, 0, 62, 62, 62, 62, 62, 62,
914             0, 64, 64, 64, 64, 64, 64, 0, 62, 62,
915             62, 62, 0, 0, 60, 64, 64, 64, 64, 0,
916             52, 121, 53, 52, 0, 0, 0, 0, 57, 58,
917             59, 60, 66, 0, 0, 0, 0, 0, 52, 65,
918             65, 65, 65, 65, 65, 60, 0, 125, 60, 0,
919             0, 61, 65, 65, 65, 65, 65, 63, 61, 0,
920             62, 136, 64, 60, 63, 63, 63, 63, 63, 63,
921             143, 0, 52, 0, 0, 0, 0, 0, 63, 63,
922             63, 63, 61, 0, 24, 61, 0, 153, 0, 0,
923             0, 0, 0, 0, 0, 0, 0, 60, 0, 0,
924             61, 0, 0, 0, 52, 0, 152, 22, 44, 0,
925             0, 0, 7, 0, 20, 162, 56, 18, 0, 19,
926             125, 0, 0, 0, 0, 0, 0, 57, 0, 60,
927             0, 44, 0, 23, 61, 0, 44, 0, 44, 0,
928             0, 44, 0, 44, 0, 0, 58, 56, 0, 0,
929             56, 0, 0, 0, 0, 0, 0, 44, 57, 0,
930             59, 57, 0, 0, 0, 56, 61, 0, 0, 0,
931             53, 53, 53, 53, 53, 53, 57, 58, 0, 0,
932             58, 68, 0, 0, 53, 53, 53, 53, 69, 0,
933             0, 59, 0, 0, 59, 58, 0, 21, 0, 56,
934             0, 0, 0, 0, 0, 0, 0, 0, 0, 59,
935             57, 0, 68, 0, 0, 68, 0, 0, 0, 69,
936             0, 44, 69, 44, 0, 0, 0, 0, 0, 58,
937             68, 56, 0, 0, 0, 0, 0, 69, 0, 0,
938             0, 0, 57, 59, 0, 0, 0, 0, 0, 0,
939             0, 0, 52, 52, 52, 52, 52, 52, 0, 0,
940             0, 58, 0, 0, 68, 0, 52, 52, 52, 52,
941             0, 69, 0, 0, 0, 59, 0, 60, 60, 60,
942             60, 60, 60, 0, 0, 0, 0, 0, 0, 70,
943             0, 60, 60, 0, 0, 0, 68, 0, 0, 0,
944             0, 0, 0, 69, 59, 60, 66, 0, 0, 0,
945             0, 0, 0, 0, 61, 61, 61, 61, 61, 61,
946             70, 0, 0, 70, 0, 0, 0, 0, 61, 61,
947             2, 3, 4, 5, 6, 0, 8, 9, 70, 10,
948             11, 0, 12, 0, 13, 14, 15, 0, 0, 0,
949             0, 0, 0, 16, 17, 44, 44, 44, 44, 0,
950             44, 44, 0, 44, 44, 0, 44, 71, 44, 44,
951             44, 0, 70, 0, 0, 0, 0, 44, 44, 56,
952             56, 56, 56, 56, 56, 0, 72, 0, 0, 0,
953             57, 57, 57, 57, 57, 57, 0, 0, 71, 0,
954             0, 71, 0, 0, 70, 0, 0, 0, 73, 58,
955             58, 58, 58, 58, 58, 0, 71, 72, 0, 0,
956             72, 0, 0, 59, 59, 59, 59, 59, 59, 54,
957             0, 55, 0, 0, 0, 72, 0, 0, 0, 73,
958             0, 0, 73, 0, 68, 68, 68, 68, 68, 68,
959             71, 69, 69, 69, 69, 69, 69, 73, 0, 0,
960             54, 0, 55, 54, 0, 55, 65, 0, 0, 72,
961             0, 63, 61, 0, 62, 0, 64, 0, 54, 0,
962             55, 0, 71, 0, 0, 0, 0, 0, 65, 0,
963             0, 73, 118, 63, 61, 0, 62, 0, 64, 0,
964             0, 72, 0, 0, 0, 0, 0, 0, 0, 0,
965             65, 0, 54, 0, 55, 63, 61, 0, 62, 0,
966             64, 0, 116, 73, 0, 0, 0, 0, 0, 65,
967             0, 22, 0, 0, 63, 61, 7, 62, 20, 64,
968             0, 18, 0, 19, 54, 0, 55, 0, 0, 0,
969             0, 0, 70, 70, 70, 70, 70, 70, 0, 65,
970             0, 0, 0, 0, 63, 61, 135, 62, 0, 64,
971             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
972             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
973             22, 0, 0, 0, 0, 7, 0, 20, 0, 0,
974             18, 0, 19, 0, 0, 0, 0, 0, 0, 0,
975             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
976             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
977             71, 71, 71, 71, 71, 71, 0, 0, 0, 0,
978             0, 0, 0, 0, 0, 0, 0, 0, 0, 72,
979             72, 72, 72, 72, 72, 32, 0, 0, 0, 0,
980             32, 0, 32, 0, 0, 32, 0, 32, 0, 0,
981             0, 73, 73, 73, 73, 73, 73, 0, 0, 0,
982             21, 0, 0, 0, 0, 0, 0, 0, 0, 0,
983             0, 0, 54, 54, 55, 55, 0, 0, 0, 0,
984             0, 0, 51, 52, 53, 54, 55, 56, 0, 0,
985             0, 0, 0, 0, 0, 0, 57, 58, 59, 60,
986             66, 0, 0, 0, 51, 52, 53, 54, 55, 56,
987             0, 0, 0, 0, 0, 0, 0, 0, 57, 58,
988             59, 60, 66, 0, 0, 32, 51, 52, 53, 54,
989             55, 56, 0, 0, 0, 3, 4, 5, 6, 0,
990             57, 58, 59, 60, 66, 51, 52, 53, 54, 55,
991             56, 0, 0, 0, 0, 0, 0, 16, 17, 57,
992             58, 59, 60, 66, 0, 0, 0, 0, 0, 0,
993             0, 0, 0, 0, 0, 0, 0, 53, 54, 55,
994             56, 0, 0, 0, 0, 0, 0, 0, 0, 57,
995             58, 59, 60, 66, 3, 4, 5, 6, 0, 8,
996             9, 0, 10, 11, 0, 12, 0, 13, 14, 15,
997             0, 0, 0, 0, 0, 0, 16, 17, 0, 0,
998             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
999             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1000             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1001             0, 0, 0, 0, 0, 0, 0, 0, 0, 32,
1002             32, 32, 32, 0, 32, 32, 0, 32, 32, 0,
1003             32, 0, 32, 32, 32, 45, 46, 47, 0, 49,
1004             0, 32, 32, 0, 0, 0, 0, 0, 0, 75,
1005             76, 79, 0, 0, 81, 83, 0, 0, 0, 0,
1006             0, 0, 0, 0, 0, 0, 0, 0, 92, 93,
1007             94, 95, 96, 97, 98, 99, 100, 101, 102, 103,
1008             104, 105, 106, 107, 108, 109, 110, 111, 112, 113,
1009             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1010             0, 0, 0, 0, 0, 123, 0, 0, 0, 0,
1011             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1012             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1013             0, 0, 126, 0, 0, 0, 131, 0, 0, 0,
1014             0, 0, 0, 0, 137,
1015             );
1016 67         9253 my @yycheck = ( 10,
1017             41, 10, 41, 44, 37, 44, 37, 37, 41, 42,
1018             43, 42, 45, 10, 47, 37, 47, 16, 17, 259,
1019             42, 43, 10, 45, 133, 47, 37, 10, 40, 138,
1020             41, 42, 43, 44, 45, 10, 47, 10, 10, 10,
1021             10, 260, 40, 10, 41, 10, 10, 44, 59, 37,
1022             59, 160, 1, 41, 42, 43, 44, 45, 40, 47,
1023             260, 44, 59, 40, 91, 41, 10, 41, 41, 41,
1024             41, 59, 44, 37, 41, 10, 59, 41, 42, 43,
1025             44, 45, 93, 47, 59, 10, 59, 59, 59, 59,
1026             39, 44, 59, 37, 59, 59, 93, 41, 42, 43,
1027             44, 45, 10, 47, 40, 93, 41, 44, 10, 44,
1028             291, 59, 37, 260, 125, 59, 41, 42, 43, 44,
1029             45, 93, 47, 40, 59, 41, 41, 61, 125, 93,
1030             44, 10, 260, 41, 59, 37, 44, 125, 10, 41,
1031             42, 43, 44, 45, 61, 47, 59, 264, 41, 93,
1032             125, 59, 125, 125, 125, 125, 260, 59, 125, 260,
1033             125, 125, 41, 123, 43, 44, 45, 41, 93, 41,
1034             42, 43, 44, 45, 91, 47, 10, 59, 37, 41,
1035             59, 125, 123, 42, 43, 41, 45, 59, 47, 41,
1036             125, 93, 141, 41, -1, -1, 159, -1, 147, -1,
1037             125, 10, -1, -1, -1, -1, -1, 41, 42, 43,
1038             44, 45, -1, 47, 93, 164, -1, 125, -1, -1,
1039             -1, 93, -1, 125, -1, 59, 281, 282, 283, 284,
1040             285, 286, 41, -1, 43, 44, 45, -1, 293, 294,
1041             273, 274, 275, 276, 277, 278, 125, -1, -1, -1,
1042             59, -1, -1, 125, 287, 288, 289, 290, 291, 93,
1043             291, 291, 273, 274, 275, 276, 277, 278, -1, 291,
1044             281, 282, 283, 284, 285, 286, 287, 288, 289, 290,
1045             291, -1, 293, 294, 93, 273, 274, 275, 276, 277,
1046             278, 125, -1, 281, 282, 283, 284, 285, 286, 287,
1047             288, 289, 290, 291, -1, 293, 294, 10, -1, 273,
1048             274, 275, 276, 277, 278, -1, 125, -1, -1, -1,
1049             -1, -1, -1, 287, 288, 289, 290, 291, -1, 273,
1050             274, 275, 276, 277, 278, -1, -1, -1, 41, -1,
1051             -1, 44, -1, 287, 288, 289, 290, 291, 273, 274,
1052             275, 276, 277, 278, -1, -1, 59, -1, 1, 2,
1053             -1, -1, 287, 288, 289, 290, -1, -1, -1, -1,
1054             -1, 273, 274, 275, 276, 277, 278, 41, -1, -1,
1055             -1, -1, -1, -1, 27, 287, 288, 289, 290, 10,
1056             93, -1, -1, -1, 273, 274, 275, 276, 277, 278,
1057             -1, 273, 274, 275, 276, 277, 278, -1, 287, 288,
1058             289, 290, -1, -1, 10, 287, 288, 289, 290, -1,
1059             41, 85, 125, 44, -1, -1, -1, -1, 287, 288,
1060             289, 290, 291, -1, -1, -1, -1, -1, 59, 273,
1061             274, 275, 276, 277, 278, 41, -1, 90, 44, -1,
1062             -1, 10, 37, 287, 288, 289, 290, 42, 43, -1,
1063             45, 125, 47, 59, 273, 274, 275, 276, 277, 278,
1064             134, -1, 93, -1, -1, -1, -1, -1, 287, 288,
1065             289, 290, 41, -1, 10, 44, -1, 151, -1, -1,
1066             -1, -1, -1, -1, -1, -1, -1, 93, -1, -1,
1067             59, -1, -1, -1, 125, -1, 149, 33, 10, -1,
1068             -1, -1, 38, -1, 40, 158, 10, 43, -1, 45,
1069             163, -1, -1, -1, -1, -1, -1, 10, -1, 125,
1070             -1, 33, -1, 59, 93, -1, 38, -1, 40, -1,
1071             -1, 43, -1, 45, -1, -1, 10, 41, -1, -1,
1072             44, -1, -1, -1, -1, -1, -1, 59, 41, -1,
1073             10, 44, -1, -1, -1, 59, 125, -1, -1, -1,
1074             273, 274, 275, 276, 277, 278, 59, 41, -1, -1,
1075             44, 10, -1, -1, 287, 288, 289, 290, 10, -1,
1076             -1, 41, -1, -1, 44, 59, -1, 123, -1, 93,
1077             -1, -1, -1, -1, -1, -1, -1, -1, -1, 59,
1078             93, -1, 41, -1, -1, 44, -1, -1, -1, 41,
1079             -1, 123, 44, 125, -1, -1, -1, -1, -1, 93,
1080             59, 125, -1, -1, -1, -1, -1, 59, -1, -1,
1081             -1, -1, 125, 93, -1, -1, -1, -1, -1, -1,
1082             -1, -1, 273, 274, 275, 276, 277, 278, -1, -1,
1083             -1, 125, -1, -1, 93, -1, 287, 288, 289, 290,
1084             -1, 93, -1, -1, -1, 125, -1, 273, 274, 275,
1085             276, 277, 278, -1, -1, -1, -1, -1, -1, 10,
1086             -1, 287, 288, -1, -1, -1, 125, -1, -1, -1,
1087             -1, -1, -1, 125, 289, 290, 291, -1, -1, -1,
1088             -1, -1, -1, -1, 273, 274, 275, 276, 277, 278,
1089             41, -1, -1, 44, -1, -1, -1, -1, 287, 288,
1090             256, 257, 258, 259, 260, -1, 262, 263, 59, 265,
1091             266, -1, 268, -1, 270, 271, 272, -1, -1, -1,
1092             -1, -1, -1, 279, 280, 257, 258, 259, 260, -1,
1093             262, 263, -1, 265, 266, -1, 268, 10, 270, 271,
1094             272, -1, 93, -1, -1, -1, -1, 279, 280, 273,
1095             274, 275, 276, 277, 278, -1, 10, -1, -1, -1,
1096             273, 274, 275, 276, 277, 278, -1, -1, 41, -1,
1097             -1, 44, -1, -1, 125, -1, -1, -1, 10, 273,
1098             274, 275, 276, 277, 278, -1, 59, 41, -1, -1,
1099             44, -1, -1, 273, 274, 275, 276, 277, 278, 10,
1100             -1, 10, -1, -1, -1, 59, -1, -1, -1, 41,
1101             -1, -1, 44, -1, 273, 274, 275, 276, 277, 278,
1102             93, 273, 274, 275, 276, 277, 278, 59, -1, -1,
1103             41, -1, 41, 44, -1, 44, 37, -1, -1, 93,
1104             -1, 42, 43, -1, 45, -1, 47, -1, 59, -1,
1105             59, -1, 125, -1, -1, -1, -1, -1, 37, -1,
1106             -1, 93, 41, 42, 43, -1, 45, -1, 47, -1,
1107             -1, 125, -1, -1, -1, -1, -1, -1, -1, -1,
1108             37, -1, 93, -1, 93, 42, 43, -1, 45, -1,
1109             47, -1, 93, 125, -1, -1, -1, -1, -1, 37,
1110             -1, 33, -1, -1, 42, 43, 38, 45, 40, 47,
1111             -1, 43, -1, 45, 125, -1, 125, -1, -1, -1,
1112             -1, -1, 273, 274, 275, 276, 277, 278, -1, 37,
1113             -1, -1, -1, -1, 42, 43, 93, 45, -1, 47,
1114             -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
1115             -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
1116             33, -1, -1, -1, -1, 38, -1, 40, -1, -1,
1117             43, -1, 45, -1, -1, -1, -1, -1, -1, -1,
1118             -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
1119             -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
1120             273, 274, 275, 276, 277, 278, -1, -1, -1, -1,
1121             -1, -1, -1, -1, -1, -1, -1, -1, -1, 273,
1122             274, 275, 276, 277, 278, 33, -1, -1, -1, -1,
1123             38, -1, 40, -1, -1, 43, -1, 45, -1, -1,
1124             -1, 273, 274, 275, 276, 277, 278, -1, -1, -1,
1125             123, -1, -1, -1, -1, -1, -1, -1, -1, -1,
1126             -1, -1, 273, 274, 273, 274, -1, -1, -1, -1,
1127             -1, -1, 273, 274, 275, 276, 277, 278, -1, -1,
1128             -1, -1, -1, -1, -1, -1, 287, 288, 289, 290,
1129             291, -1, -1, -1, 273, 274, 275, 276, 277, 278,
1130             -1, -1, -1, -1, -1, -1, -1, -1, 287, 288,
1131             289, 290, 291, -1, -1, 123, 273, 274, 275, 276,
1132             277, 278, -1, -1, -1, 257, 258, 259, 260, -1,
1133             287, 288, 289, 290, 291, 273, 274, 275, 276, 277,
1134             278, -1, -1, -1, -1, -1, -1, 279, 280, 287,
1135             288, 289, 290, 291, -1, -1, -1, -1, -1, -1,
1136             -1, -1, -1, -1, -1, -1, -1, 275, 276, 277,
1137             278, -1, -1, -1, -1, -1, -1, -1, -1, 287,
1138             288, 289, 290, 291, 257, 258, 259, 260, -1, 262,
1139             263, -1, 265, 266, -1, 268, -1, 270, 271, 272,
1140             -1, -1, -1, -1, -1, -1, 279, 280, -1, -1,
1141             -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
1142             -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
1143             -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
1144             -1, -1, -1, -1, -1, -1, -1, -1, -1, 257,
1145             258, 259, 260, -1, 262, 263, -1, 265, 266, -1,
1146             268, -1, 270, 271, 272, 18, 19, 20, -1, 22,
1147             -1, 279, 280, -1, -1, -1, -1, -1, -1, 32,
1148             33, 34, -1, -1, 37, 38, -1, -1, -1, -1,
1149             -1, -1, -1, -1, -1, -1, -1, -1, 51, 52,
1150             53, 54, 55, 56, 57, 58, 59, 60, 61, 62,
1151             63, 64, 65, 66, 67, 68, 69, 70, 71, 72,
1152             -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
1153             -1, -1, -1, -1, -1, 88, -1, -1, -1, -1,
1154             -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
1155             -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
1156             -1, -1, 115, -1, -1, -1, 119, -1, -1, -1,
1157             -1, -1, -1, -1, 127,
1158             );
1159 67         203 my $YYFINAL=1;
1160 67         120 my $YYMAXTOKEN=294;
1161 67         4559 my @yyname = (
1162             "end-of-file",'','','','','','','','','',"'\\n'",'','','','','','','','','','','','','','','','','','','','',
1163             '','',"'!'",'','','',"'%'","'&'",'',"'('","')'","'*'","'+'","','","'-'","'.'","'/'",'',
1164             '','','','','','','','','','',"';'",'',"'='",'','','','','','','','','','','','','','','','','','','','','','','',
1165             '','','','','','',"'['",'',"']'",'','','','','','','','','','','','','','','','','','','','','','','','','','','',
1166             '','',"'{'","'|'","'}'",'','','','','','','','','','','','','','','','','','','','','','','','','','','','','',
1167             '','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','',
1168             '','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','','',
1169             '','','','','','','','','','','','','','','','','','','','','','',"INT","FLOAT","STRING","IDENT",
1170             "C_COMMENT","BREAK","DEFINE","AUTO","RETURN","PRINT","AUTO_LIST","IF","ELSE",
1171             "QUIT","WHILE","FOR","EQ","NE","GT","GE","LT","LE","PP","MM","P_EQ","M_EQ",
1172             "F_EQ","D_EQ","EXP_EQ","MOD_EQ","L_SHIFT","R_SHIFT","E_E","O_O","EXP","UNARY",
1173             "PPP","MMM",
1174             );
1175 67         1972 my @yyrule = (
1176             "\$accept : stmt_list_exec",
1177             "stmt_list_exec :",
1178             "stmt_list_exec : stmt_list_exec stmt_exec",
1179             "stmt_exec : terminator",
1180             "stmt_exec : stmt_compile terminator",
1181             "stmt_exec : error terminator",
1182             "stmt_compile : QUIT",
1183             "\$\$1 :",
1184             "\$\$2 :",
1185             "stmt_compile : DEFINE \$\$1 IDENT '(' arg_list ')' terminator_or_void '{' terminator auto_list \$\$2 stmt_list_block '}'",
1186             "stmt_compile : return",
1187             "stmt_compile : BREAK",
1188             "\$\$3 :",
1189             "stmt_compile : PRINT \$\$3 expr_list_commas",
1190             "\$\$4 :",
1191             "stmt_compile : '{' \$\$4 stmt_list_block '}'",
1192             "\$\$5 :",
1193             "stmt_compile : IF '(' stmt_compile ')' \$\$5 terminator_or_void stmt_compile",
1194             "\$\$6 :",
1195             "\$\$7 :",
1196             "stmt_compile : WHILE \$\$6 '(' stmt_compile_or_void ')' terminator_or_void \$\$7 stmt_compile",
1197             "\$\$8 :",
1198             "\$\$9 :",
1199             "\$\$10 :",
1200             "stmt_compile : FOR '(' stmt_compile_or_void ';' \$\$8 stmt_compile_or_void ';' \$\$9 stmt_compile_or_void ')' \$\$10 terminator_or_void stmt_compile",
1201             "stmt_compile : expr",
1202             "return : RETURN",
1203             "return : RETURN '(' expr ')'",
1204             "stmt_compile_or_void :",
1205             "stmt_compile_or_void : stmt_compile",
1206             "stmt_list_block : stmt_compile_or_void",
1207             "stmt_list_block : stmt_list_block terminator stmt_compile_or_void",
1208             "terminator_or_void :",
1209             "terminator_or_void : terminator",
1210             "terminator : ';'",
1211             "terminator : '\\n'",
1212             "arg_list :",
1213             "arg_list : arg_list_nonempty",
1214             "arg_list_nonempty : IDENT",
1215             "arg_list_nonempty : arg_list_nonempty ',' IDENT",
1216             "param_list :",
1217             "param_list : param_list_nonempty",
1218             "param_list_nonempty : expr",
1219             "param_list_nonempty : param_list_nonempty ',' expr",
1220             "auto_list :",
1221             "auto_list : AUTO auto_list_nonempty terminator",
1222             "auto_list_nonempty : IDENT",
1223             "auto_list_nonempty : auto_list_nonempty ',' IDENT",
1224             "expr_list_commas : expr",
1225             "expr_list_commas : expr_list_commas ',' expr",
1226             "expr : IDENT '(' param_list ')'",
1227             "expr : '(' expr ')'",
1228             "expr : expr O_O expr",
1229             "expr : expr E_E expr",
1230             "expr : expr EQ expr",
1231             "expr : expr NE expr",
1232             "expr : expr GT expr",
1233             "expr : expr GE expr",
1234             "expr : expr LT expr",
1235             "expr : expr LE expr",
1236             "expr : expr L_SHIFT expr",
1237             "expr : expr R_SHIFT expr",
1238             "expr : expr '+' expr",
1239             "expr : expr '-' expr",
1240             "expr : expr '*' expr",
1241             "expr : expr '/' expr",
1242             "expr : expr EXP expr",
1243             "expr : expr '%' expr",
1244             "expr : ident P_EQ expr",
1245             "expr : ident M_EQ expr",
1246             "expr : ident F_EQ expr",
1247             "expr : ident D_EQ expr",
1248             "expr : ident EXP_EQ expr",
1249             "expr : ident MOD_EQ expr",
1250             "expr : '-' expr",
1251             "expr : '!' expr",
1252             "expr : PP ident",
1253             "expr : MM ident",
1254             "expr : ident PPP",
1255             "expr : ident MMM",
1256             "expr : '+' expr",
1257             undef, # "expr : '&' STRING", # removed feature but we didn't want to disturb sequence
1258             "expr : IDENT '=' expr",
1259             "expr : IDENT '[' expr ']' '=' expr",
1260             "expr : ident",
1261             "expr : INT",
1262             "expr : FLOAT",
1263             "expr : STRING",
1264             "ident : IDENT",
1265             "ident : IDENT '[' expr ']'",
1266             );
1267 584     584   788 sub yyclearin { $yychar = -1; }
1268 0     0   0 sub yyerrok { $yyerrflag = 0; }
1269 67         149 my $YYSTACKSIZE = 500;
1270 67         195 my @yyss;
1271             my @yyvs;
1272 67         875 $yyss[$YYSTACKSIZE] = 0;
1273 67         770 $yyvs[$YYSTACKSIZE] = 0;
1274              
1275             sub yy_err_recover
1276             {
1277 0 0   0   0 if ($yyerrflag < 3)
1278             {
1279 0         0 $yyerrflag = 3;
1280 0         0 while (1)
1281             {
1282 0 0 0     0 if (($yyn = $yysindex[$yyss[$yyssp]]) &&
      0        
1283             ($yyn += $YYERRCODE) >= 0 &&
1284             $yycheck[$yyn] == $YYERRCODE)
1285             {
1286 0 0       0 print "yydebug: state $yyss[$yyssp], error recovery shifting",
1287             " to state $yytable[$yyn]\n" if $yydebug;
1288 0         0 $yyss[++$yyssp] = $yystate = $yytable[$yyn];
1289 0         0 $yyvs[++$yyvsp] = $yylval;
1290 0         0 return 1;
1291             }
1292             else
1293             {
1294 0 0       0 print "yydebug: error recovery discarding state ",
1295             $yyss[$yyssp], "\n" if $yydebug;
1296 0 0       0 return(1) if $yyssp <= 0;
1297 0         0 --$yyssp;
1298 0         0 --$yyvsp;
1299             }
1300             }
1301             }
1302             else
1303             {
1304 0 0       0 return (1) if $yychar == 0;
1305 0 0       0 if ($yydebug)
1306             {
1307 0         0 my $yys = '';
1308 0 0       0 if ($yychar <= $YYMAXTOKEN) { $yys = $yyname[$yychar]; }
  0         0  
1309 0 0       0 if (!$yys) { $yys = 'illegal-symbol'; }
  0         0  
1310 0         0 print "yydebug: state $yystate, error recovery discards ",
1311             "token $yychar ($yys)\n";
1312             }
1313 0         0 return 1;
1314             }
1315 0         0 0;
1316             } # yy_err_recover
1317              
1318             sub clear_flags
1319             {
1320 70     70   279 yyclearin();
1321 70         743 $yyerrflag = $yyssp = $yyvsp = $yyss[0] = $yystate = 0;
1322             }
1323              
1324             sub yyparse
1325             {
1326 70     70   297 yyloop: while(1)
1327             {
1328             yyreduce: {
1329 1490 100       1687 last yyreduce if ($yyn = $yydefred[$yystate]);
  1490         3116  
1330 853 100       1534 if ($yychar < 0)
1331             {
1332 395 50       703 if (($yychar = &yylex) < 0) { $yychar = 0; }
  0         0  
1333 395 50       772 if ($yydebug)
1334             {
1335 0         0 my $yys = '';
1336 0 0       0 if ($yychar <= $#yyname) { $yys = $yyname[$yychar]; }
  0         0  
1337 0 0       0 if (!$yys) { $yys = 'illegal-symbol'; };
  0         0  
1338 0         0 print "yydebug: state $yystate, reading $yychar ($yys)\n";
1339             }
1340             }
1341 853 100 66     4084 if (($yyn = $yysindex[$yystate]) && ($yyn += $yychar) >= 0 &&
      100        
1342             $yycheck[$yyn] == $yychar)
1343             {
1344 514 50       945 print "yydebug: state $yystate, shifting to state ",
1345             $yytable[$yyn], "\n" if $yydebug;
1346 514         977 $yyss[++$yyssp] = $yystate = $yytable[$yyn];
1347 514         828 $yyvs[++$yyvsp] = $yylval;
1348 514         1069 yyclearin();
1349 514 50       1005 --$yyerrflag if $yyerrflag > 0;
1350 514         774 next yyloop;
1351             }
1352 339 50 33     1829 if (($yyn = $yyrindex[$yystate]) && ($yyn += $yychar) >= 0 &&
      33        
1353             $yycheck[$yyn] == $yychar)
1354             {
1355 339         530 $yyn = $yytable[$yyn];
1356 339         494 last yyreduce;
1357             }
1358 0 0       0 if (! $yyerrflag) {
1359 0         0 &yyerror('syntax error');
1360             }
1361 0 0       0 return(1) if &yy_err_recover;
1362             } # yyreduce
1363 976 50       1647 print "yydebug: state $yystate, reducing by rule ",
1364             "$yyn ($yyrule[$yyn])\n" if $yydebug;
1365 976         3542 $yym = $yylen[$yyn];
1366 976         1548 $yyval = $yyvs[$yyvsp+1-$yym];
1367             switch:
1368             {
1369 976 100       1059 if ($yyn == 4) {
  976         1694  
1370             {
1371              
1372 119         378 my ($res, $val) = exec_stmt(shift @stmt_list);
  119         590  
1373 116 50 66     960 if($res == 0 and defined($val) and
      66        
1374             $cur_file ne 'main::DATA') {
1375 59         919 print "$val\n";
1376             }
1377 116         446 start_stmt();
1378              
1379 116         216 last switch;
1380             } }
1381 857 50       1423 if ($yyn == 5) {
1382             {
1383 0         0 @ope_stack = ();
  0         0  
1384 0         0 @stmt_list = ();
1385 0         0 start_stmt();
1386 0         0 &yyerrok;
1387              
1388 0         0 last switch;
1389             } }
1390 857 50       1362 if ($yyn == 7) {
1391             {
1392 0         0 start_stmt();
  0         0  
1393              
1394 0         0 last switch;
1395             } }
1396 857 50       1345 if ($yyn == 8) {
1397             {
1398 0         0 start_stmt();
  0         0  
1399 0         0 start_stmt();
1400              
1401 0         0 last switch;
1402             } }
1403 857 50       1647 if ($yyn == 9) {
1404             {
1405 0         0 finish_stmt(); # The last one is empty
  0         0  
1406 0         0 push_instr('RETURN', 0);
1407 0         0 my $body = finish_stmt();
1408 0         0 push_instr('{}', $body);
1409 0         0 my $code = finish_stmt();
1410 0         0 push_instr('FUNCTION-DEF', $yyvs[$yyvsp-10], $code);
1411              
1412 0         0 last switch;
1413             } }
1414 857 100       1392 if ($yyn == 11) {
1415 1         2 { push_instr('BREAK');
  1         5  
1416 1         2 last switch;
1417             } }
1418 856 100       1398 if ($yyn == 12) {
1419             {
1420 10         12 push_instr(',');
  10         45  
1421 10         27 start_stmt();
1422 10         17 start_stmt();
1423              
1424 10         13 last switch;
1425             } }
1426 846 100       1362 if ($yyn == 13) {
1427             {
1428 10         14 finish_stmt(); # The last one is empty
  10         19  
1429 10         15 my $stmt = finish_stmt();
1430 10         20 push_instr('PRINT', $stmt);
1431              
1432 10         14 last switch;
1433             } }
1434 836 100       1423 if ($yyn == 14) {
1435             {
1436 4         7 start_stmt();
  4         13  
1437 4         8 start_stmt();
1438              
1439 4         6 last switch;
1440             } }
1441 832 100       1630 if ($yyn == 15) {
1442             {
1443 4         7 finish_stmt(); # The last one is empty
  4         11  
1444 4         8 my $stmt = finish_stmt();
1445 4         37 push_instr('{}', $stmt);
1446              
1447 4         6 last switch;
1448             } }
1449 828 100       1415 if ($yyn == 16) {
1450 1         2 { start_stmt();
  1         3  
1451 1         1 last switch;
1452             } }
1453 827 100       1390 if ($yyn == 17) {
1454             {
1455 1         2 my $stmt = finish_stmt();
  1         37  
1456 1         5 push_instr('IF', $stmt);
1457              
1458 1         2 last switch;
1459             } }
1460 826 100       1414 if ($yyn == 18) {
1461 1         1 { start_stmt();
  1         3  
1462 1         1 last switch;
1463             } }
1464 825 100       1895 if ($yyn == 19) {
1465             {
1466 1         7 my $stmt = finish_stmt();
  1         2  
1467 1         3 push_instr('FOR-COND', $stmt);
1468 1         7 start_stmt();
1469              
1470 1         1 last switch;
1471             } }
1472 824 100       1405 if ($yyn == 20) {
1473             {
1474 1         1 my $stmt = finish_stmt();
  1         2  
1475 1         2 push_instr('FOR-INCR', []);
1476 1         2 push_instr('FOR-BODY', $stmt);
1477              
1478 1         1 last switch;
1479             } }
1480 823 100       1351 if ($yyn == 21) {
1481 2         5 { start_stmt();
  2         11  
1482 2         4 last switch;
1483             } }
1484 821 100       1300 if ($yyn == 22) {
1485             {
1486 2         35 my $stmt = finish_stmt();
  2         9  
1487 2         8 push_instr('FOR-COND', $stmt);
1488 2         7 start_stmt();
1489              
1490 2         5 last switch;
1491             } }
1492 819 100       1335 if ($yyn == 23) {
1493             {
1494 2         5 my $stmt = finish_stmt();
  2         9  
1495 2         30 push_instr('FOR-INCR', $stmt);
1496 2         7 start_stmt();
1497              
1498 2         5 last switch;
1499             } }
1500 817 100       1278 if ($yyn == 24) {
1501             {
1502 2         4 my $stmt = finish_stmt();
  2         6  
1503 2         7 push_instr('FOR-BODY', $stmt);
1504              
1505 2         5 last switch;
1506             } }
1507 815 50       1341 if ($yyn == 26) {
1508 0         0 { push_instr('RETURN', 0);
  0         0  
1509 0         0 last switch;
1510             } }
1511 815 50       1329 if ($yyn == 27) {
1512 0         0 { push_instr('RETURN', 1);
  0         0  
1513 0         0 last switch;
1514             } }
1515 815 100       1296 if ($yyn == 30) {
1516             {
1517 4         28 my $stmt = finish_stmt();
  4         43  
1518 4 50       16 if(scalar(@$stmt) > 0) {
1519 4         10 push_instr('STMT', $stmt);
1520             }
1521 4         12 start_stmt();
1522              
1523 4         45 last switch;
1524             } }
1525 811 100       1381 if ($yyn == 31) {
1526             {
1527 3         4 my $stmt = finish_stmt();
  3         5  
1528 3 50       9 if(scalar(@$stmt) > 0) {
1529 3         6 push_instr('STMT', $stmt);
1530             }
1531 3         6 start_stmt();
1532              
1533 3         5 last switch;
1534             } }
1535 808 50       1692 if ($yyn == 38) {
1536 0         0 { push_instr('a', $yyvs[$yyvsp-0]);
  0         0  
1537 0         0 last switch;
1538             } }
1539 808 50       1304 if ($yyn == 39) {
1540 0         0 { push_instr('a', $yyvs[$yyvsp-0]);
  0         0  
1541 0         0 last switch;
1542             } }
1543 808 50       1405 if ($yyn == 46) {
1544 0         0 { push_instr('A', $yyvs[$yyvsp-0]);
  0         0  
1545 0         0 last switch;
1546             } }
1547 808 50       1329 if ($yyn == 47) {
1548 0         0 { push_instr('A', $yyvs[$yyvsp-0]);
  0         0  
1549 0         0 last switch;
1550             } }
1551 808 100       1377 if ($yyn == 48) {
1552             {
1553 10         13 my $stmt = finish_stmt();
  10         32  
1554 10         31 push_instr('PRINT-STMT', $stmt);
1555 10         19 start_stmt();
1556              
1557 10         16 last switch;
1558             } }
1559 798 100       1566 if ($yyn == 49) {
1560             {
1561 3         2 my $stmt = finish_stmt();
  3         4  
1562 3         5 push_instr('PRINT-STMT', $stmt);
1563 3         3 start_stmt();
1564              
1565 3         2 last switch;
1566             } }
1567 795 100       1256 if ($yyn == 50) {
1568             {
1569 6         40 push_instr('FUNCTION-CALL', $yyvs[$yyvsp-3]);
  6         86  
1570              
1571 6         14 last switch;
1572             } }
1573 789 100       1487 if ($yyn == 51) {
1574             {
1575 4         14 last switch;
  4         17  
1576             } }
1577 785 100       1840 if ($yyn == 52) {
1578 4         7 { push_instr('||_');
  4         13  
1579 4         8 last switch;
1580             } }
1581 781 100       1348 if ($yyn == 53) {
1582 4         24 { push_instr('&&_');
  4         13  
1583 4         6 last switch;
1584             } }
1585 777 100       1310 if ($yyn == 54) {
1586 2         2 { push_instr('==_');
  2         8  
1587 2         4 last switch;
1588             } }
1589 775 100       1360 if ($yyn == 55) {
1590 2         2 { push_instr('!=_');
  2         4  
1591 2         3 last switch;
1592             } }
1593 773 100       1309 if ($yyn == 56) {
1594 2         4 { push_instr('>_');
  2         6  
1595 2         3 last switch;
1596             } }
1597 771 100       1331 if ($yyn == 57) {
1598 2         3 { push_instr('>=_');
  2         7  
1599 2         4 last switch;
1600             } }
1601 769 100       1658 if ($yyn == 58) {
1602 5         7 { push_instr('<_');
  5         51  
1603 5         8 last switch;
1604             } }
1605 764 100       1220 if ($yyn == 59) {
1606 1         2 { push_instr('<=_');
  1         15  
1607 1         3 last switch;
1608             } }
1609 763 50       1724 if ($yyn == 60) {
1610 0         0 { push_instr('<<_');
  0         0  
1611 0         0 last switch;
1612             } }
1613 763 50       1512 if ($yyn == 61) {
1614 0         0 { push_instr('>>_');
  0         0  
1615 0         0 last switch;
1616             } }
1617 763 100       1331 if ($yyn == 62) {
1618 8         11 { push_instr('+_');
  8         36  
1619 8         11 last switch;
1620             } }
1621 755 100       1344 if ($yyn == 63) {
1622 1         2 { push_instr('-_');
  1         3  
1623 1         2 last switch;
1624             } }
1625 754 100       1215 if ($yyn == 64) {
1626 5         29 { push_instr('*_');
  5         16  
1627 5         10 last switch;
1628             } }
1629 749 100       1264 if ($yyn == 65) {
1630 1         2 { push_instr('/_');
  1         4  
1631 1         3 last switch;
1632             } }
1633 748 100       1137 if ($yyn == 66) {
1634 2         2 { push_instr('^_');
  2         5  
1635 2         4 last switch;
1636             } }
1637 746 100       1211 if ($yyn == 67) {
1638 2         2 { push_instr('%_');
  2         15  
1639 2         2 last switch;
1640             } }
1641 744 100       1179 if ($yyn == 68) {
1642             {
1643 1         48 push_instr('+_');
  1         5  
1644 1         4 push_instr('V', $yyvs[$yyvsp-2]);
1645 1         4 push_instr('=V');
1646              
1647 1         2 last switch;
1648             } }
1649 743 100       1228 if ($yyn == 69) {
1650             {
1651 1         3 push_instr('-_');
  1         41  
1652 1         3 push_instr('V', $yyvs[$yyvsp-2]);
1653 1         3 push_instr('=V');
1654              
1655 1         2 last switch;
1656             } }
1657 742 100       1247 if ($yyn == 70) {
1658             {
1659 1         2 push_instr('*_');
  1         2  
1660 1         33 push_instr('V', $yyvs[$yyvsp-2]);
1661 1         2 push_instr('=V');
1662              
1663 1         1 last switch;
1664             } }
1665 741 100       1256 if ($yyn == 71) {
1666             {
1667 3         7 push_instr('/_');
  3         10  
1668 3         10 push_instr('V', $yyvs[$yyvsp-2]);
1669 3         7 push_instr('=V');
1670              
1671 3         5 last switch;
1672             } }
1673 738 100       1274 if ($yyn == 72) {
1674             {
1675 6         17 push_instr('^_');
  6         115  
1676 6         26 push_instr('V', $yyvs[$yyvsp-2]);
1677 6         17 push_instr('=V');
1678              
1679 6         12 last switch;
1680             } }
1681 732 100       1246 if ($yyn == 73) {
1682             {
1683 5         8 push_instr('%_');
  5         19  
1684 5         16 push_instr('V', $yyvs[$yyvsp-2]);
1685 5         11 push_instr('=V');
1686              
1687 5         8 last switch;
1688             } }
1689 727 100       1158 if ($yyn == 74) {
1690             {
1691 5         9 push_instr('m_');
  5         16  
1692              
1693 5         30 last switch;
1694             } }
1695 722 100       1225 if ($yyn == 75) {
1696             {
1697 2         2 push_instr('!_');
  2         4  
1698              
1699 2         3 last switch;
1700             } }
1701 720 100       1236 if ($yyn == 76) {
1702             {
1703             # 'v'.$2 has already been pushed in the 'ident' rule
1704 1         36 push_instr('N', 1);
  1         5  
1705 1         3 push_instr('+_');
1706 1         3 push_instr('V', $yyvs[$yyvsp-0]);
1707 1         2 push_instr('=V');
1708              
1709 1         2 last switch;
1710             } }
1711 719 100       1237 if ($yyn == 77) {
1712             {
1713 1         2 push_instr('N', 1);
  1         50  
1714 1         3 push_instr('-_');
1715 1         3 push_instr('V', $yyvs[$yyvsp-0]);
1716 1         3 push_instr('=V');
1717              
1718 1         2 last switch;
1719             } }
1720 718 100       1344 if ($yyn == 78) {
1721             {
1722             # $1 is already on the stack (see the "ident:" rule)
1723 3         8 push_instr('v', $yyvs[$yyvsp-1]) ;
  3         12  
1724 3         46 push_instr('V', '*tmp') ;
1725 3         9 push_instr('=V') ; # *tmp = $1
1726 3         6 push_instr(',') ;
1727              
1728 3         8 push_instr('N', 1) ;
1729 3         25 push_instr('+_') ;
1730 3         40 push_instr('V', $yyvs[$yyvsp-1]) ;
1731 3         48 push_instr('=V') ; # $1 = $1 + 1
1732 3         10 push_instr(',') ;
1733              
1734 3         9 push_instr('v', '*tmp') ; # Return *tmp
1735              
1736              
1737 3         8 last switch;
1738             } }
1739 715 100       1185 if ($yyn == 79) {
1740             {
1741             # See PPP for comments
1742 2         31 push_instr('v', $yyvs[$yyvsp-1]);
  2         7  
1743 2         5 push_instr('V', '*tmp');
1744 2         4 push_instr('=V');
1745 2         4 push_instr(',');
1746 2         5 push_instr('N', 1);
1747 2         3 push_instr('-_');
1748 2         6 push_instr('V', $yyvs[$yyvsp-1]);
1749 2         4 push_instr('=V');
1750 2         3 push_instr(',');
1751 2         4 push_instr('v', '*tmp');
1752              
1753 2         3 last switch;
1754             } }
1755 713 50       1211 if ($yyn == 80) {
1756 0         0 { $yyval = $yyvs[$yyvsp-0];
  0         0  
1757 0         0 last switch;
1758             } }
1759 713 100       1196 if ($yyn == 82) {
1760             {
1761 33         88 push_instr('V', $yyvs[$yyvsp-2]);
  33         151  
1762 33         106 push_instr('=V');
1763 33         61 $yyval = $yyvs[$yyvsp-0];
1764              
1765 33         76 last switch;
1766             } }
1767 680 50       1685 if ($yyn == 83) {
1768             {
1769             # Add [] to the name in order to allow the same name
1770             # for an array and a scalar
1771 0         0 push_instr('P', $yyvs[$yyvsp-5]);
  0         0  
1772 0         0 push_instr('=P');
1773 0         0 $yyval = $yyvs[$yyvsp-0];
1774              
1775 0         0 last switch;
1776             } }
1777 680 100       1206 if ($yyn == 84) {
1778 33         86 { $yyval = $yyvs[$yyvsp-0];
  33         125  
1779 33         110 last switch;
1780             } }
1781 647 100       1068 if ($yyn == 85) {
1782 118         217 { push_instr('N', $yyvs[$yyvsp-0]);
  118         537  
1783 118         231 last switch;
1784             } }
1785 529 100       846 if ($yyn == 86) {
1786 5         11 { push_instr('N', $yyvs[$yyvsp-0]);
  5         35  
1787 5         9 last switch;
1788             } }
1789 524 100       874 if ($yyn == 87) {
1790 10         12 { push_instr('S', $yyvs[$yyvsp-0]);
  10         37  
1791 10         15 last switch;
1792             } }
1793 514 100       863 if ($yyn == 88) {
1794 57         106 { push_instr('v', $yyvs[$yyvsp-0]);
  57         218  
1795 57         334 last switch;
1796             } }
1797 457 50       834 if ($yyn == 89) {
1798             {
1799 0         0 push_instr('p', $yyvs[$yyvsp-3]);
  0         0  
1800 0         0 $yyval = $yyvs[$yyvsp-3].'[]'.$yyvs[$yyvsp-1];
1801              
1802 0         0 last switch;
1803             } }
1804             } # switch
1805 973         1165 $yyssp -= $yym;
1806 973         1293 $yystate = $yyss[$yyssp];
1807 973         1028 $yyvsp -= $yym;
1808 973         1253 $yym = $yylhs[$yyn];
1809 973 100 66     2307 if ($yystate == 0 && $yym == 0)
1810             {
1811 186 50       397 print "yydebug: after reduction, shifting from state 0 ",
1812             "to state $YYFINAL\n" if $yydebug;
1813 186         265 $yystate = $YYFINAL;
1814 186         306 $yyss[++$yyssp] = $YYFINAL;
1815 186         325 $yyvs[++$yyvsp] = $yyval;
1816 186 50       421 if ($yychar < 0)
1817             {
1818 186 50       446 if (($yychar = &yylex) < 0) { $yychar = 0; }
  0         0  
1819 186 50       445 if ($yydebug)
1820             {
1821 0         0 my $yys = '';
1822 0 0       0 if ($yychar <= $#yyname) { $yys = $yyname[$yychar]; }
  0         0  
1823 0 0       0 if (!$yys) { $yys = 'illegal-symbol'; }
  0         0  
1824 0         0 print "yydebug: state $YYFINAL, reading $yychar ($yys)\n";
1825             }
1826             }
1827 186 100       492 return(0) if $yychar == 0;
1828 119         250 next yyloop;
1829             }
1830 787 100 66     4716 if (($yyn = $yygindex[$yym]) && ($yyn += $yystate) >= 0 &&
      100        
      100        
1831             $yyn <= $#yycheck && $yycheck[$yyn] == $yystate)
1832             {
1833 393         759 $yystate = $yytable[$yyn];
1834             } else {
1835 394         776 $yystate = $yydgoto[$yym];
1836             }
1837 787 50       1344 print "yydebug: after reduction, shifting from state ",
1838             "$yyss[$yyssp] to state $yystate\n" if $yydebug;
1839 787         1081 $yyss[++$yyssp] = $yystate;
1840 787         1127 $yyvs[++$yyvsp] = $yyval;
1841             } # yyloop
1842             } # yyparse
1843              
1844 67         142 my @file_list;
1845 67         123 my $mathlib = 0;
1846             sub command_line
1847             {
1848 67   33 67   1039 while (@ARGV && $ARGV[0] =~ m/\A\-/) {
1849 0         0 my $f = shift @ARGV;
1850 0 0       0 if ($f eq '-b') {
    0          
    0          
    0          
    0          
1851 0 0       0 eval { require Math::BigFloat } or die "This program requires the Math::BigFloat module\n";
  0         0  
1852 0         0 $bignum = 1;
1853             } elsif ($f eq '-d') {
1854 0 0       0 eval { require Data::Dumper; Data::Dumper->import; 1; } or die "This program requires the Data::Dumper module\n";
  0         0  
  0         0  
  0         0  
1855 0         0 $debug = 1;
1856             } elsif ($f eq '-y') {
1857 0         0 $yydebug = 1;
1858             } elsif ($f eq '-l') {
1859 0         0 $mathlib = 1;
1860             } elsif ($f eq '--') {
1861 0         0 last;
1862             } else {
1863 0         0 usage();
1864             }
1865             }
1866 67 50       269 if (@ARGV) {
1867 67         217 @file_list = @ARGV;
1868             } else {
1869 0         0 $do_stdin = 1;
1870             }
1871             }
1872              
1873             sub usage {
1874 0     0   0 warn "usage: bc [-b] [-d] [-y] [-l] [file ...]\n";
1875 0         0 exit 1;
1876             }
1877              
1878             # After finishing a file, open the next one. Return whether there
1879             # really is a next one that was opened.
1880             sub next_file
1881             {
1882 134 100   134   428 if (defined $input) {
1883 67         1007 close $input;
1884 67         354 $input = undef;
1885             }
1886 134 50       1092 if ($do_stdin) {
1887 0         0 $input = *STDIN;
1888 0         0 $do_stdin = 0;
1889 0         0 $cur_file = '-';
1890 0         0 return 1;
1891             }
1892 134 100       376 if (@file_list) {
1893 67         146 my $file = shift @file_list;
1894              
1895 67     0   615 debug { "reading from $file\n" };
  0         0  
1896              
1897 67 50       2539 die "path '$file' is a directory\n" if (-d $file);
1898 67 50       3769 open($input, '<', $file) or die("cannot open '$file': $!\n");
1899 67         200 $cur_file = $file;
1900 67         186 return 1;
1901              
1902             }
1903              
1904 67     0   580 debug { "no next file\n" };
  0         0  
1905              
1906 67         359 return 0;
1907             }
1908              
1909             # print an error message
1910             sub yyerror
1911             {
1912 3 50   3   123 print STDERR "\"$cur_file\", " if $cur_file ne '-';
1913             # debug { "yyerror-stmt_list : ".Dumper(\@stmt_list) };
1914              
1915 3         46 print STDERR "line $.: ", @_, "\n";
1916              
1917 3         8 @ope_stack = ();
1918 3         13 start_stmt();
1919             }
1920              
1921             # Hand-coded lex
1922             sub yylex
1923             {
1924             lexloop: {
1925             # get a line of input, if we need it.
1926 581 100   581   710 if ($line eq '')
  581         1624  
1927             {
1928 171         4132 while(! ($line = <$input>)) {
1929 67 50       393 &next_file || do {
1930 67         314 return(0); };
1931             }
1932             }
1933              
1934             # Skip over white space, and grab the first character.
1935             # If there is no such character, then grab the next line.
1936 514 50       2862 $line =~ s/^\s*(.|\n)// || next lexloop;
1937 514         1384 my $char = $1;
1938              
1939 514 50 66     13072 if ($char eq '/' and $line =~ /^\*/) {
    50 33        
    50 33        
    100 66        
    100 100        
    100 66        
    100 66        
    100 100        
    100 100        
    100 100        
    100 100        
    100 66        
    100 100        
    100 100        
    50 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100          
    100          
    100          
    100          
1940             # C-style comment
1941 0         0 while($line !~ m%\*/%) {
1942 0         0 $line = <$input>;
1943             }
1944 0         0 $line =~ s%.*?\*/% %;
1945 0         0 yylex();
1946             }
1947              
1948             elsif ($char eq '#') {
1949             # comment, so discard the line
1950 0         0 $line = "\n";
1951 0         0 &yylex;
1952              
1953             } elsif ($char eq '\\' and $line eq "\n") {
1954              
1955             # Discard the newline
1956 0         0 $line = '';
1957 0         0 yylex();
1958              
1959             } elsif ($char =~ /^(['"])/) {
1960              
1961 10         15 $yylval = "";
1962              
1963 10         18 my $c = $1;
1964 10         182 while($line !~ /$c/) {
1965 0         0 $yylval .= $line;
1966 0         0 $line = <$input>;
1967             }
1968              
1969 10         143 $line =~ s%(.*?)$c% %;
1970 10         35 $yylval .= $1;
1971              
1972 10         34 $STRING;
1973              
1974             } elsif ($char =~ /^[\dA-F]/ or
1975             ($char eq '.' and $line =~ /\d/)) {
1976              
1977 123 50       502 if($char =~ /[A-F]/) {
1978 0         0 &yyerror('Sorry, hexadecimal values are not supported');
1979             }
1980              
1981 123 50       770 $line = "0.$line" if($char eq '.');
1982              
1983             # number, is it integer or float?
1984 123 100       492 if ($line =~ s/^(\d+)//) {
1985 16         107 my $str = $char . $1;
1986 16 50       76 $yylval = $bignum ? Math::BigFloat->new($str) : int($str);
1987             } else {
1988 107 50       554 $yylval = $bignum ? Math::BigFloat->new($char) : int($char);
1989             }
1990 123         248 my $type = $INT;
1991              
1992 123 100       375 if ($line =~ s/^(\.\d*)//) {
1993 5         19 my $tmp = "0$1"; # ".1" -> "0.1"
1994 5         123 $yylval += $tmp;
1995 5         11 $type = $FLOAT;
1996             }
1997 123 50       355 if ($line =~ s/^[eE]([-+]*\d+)//) {
1998 0 0       0 my $mult = $bignum ? Math::BigFloat->new('10') : 10;
1999 0         0 $mult = $mult ** $1;
2000 0         0 $yylval *= $mult;
2001 0         0 $type = $FLOAT;
2002             }
2003              
2004 123         396 $type;
2005              
2006             } elsif ($char =~ /^[a-z]/) {
2007             # Uppercase is reserved for hexadecimal numbers
2008 111         539 $line =~ s/^([\w\d]*)//;
2009 111         342 $yylval = $char.$1;
2010              
2011 111 50       1528 if($yylval eq 'auto') {
    100          
    50          
    100          
    100          
    50          
    100          
    50          
    50          
    100          
2012 0         0 $AUTO;
2013             } elsif($yylval eq 'break') {
2014 1         5 $BREAK;
2015             } elsif($yylval eq 'define') {
2016 0         0 $DEFINE;
2017             } elsif($yylval eq 'for') {
2018 2         11 $FOR;
2019             } elsif($yylval eq 'if') {
2020 1         5 $IF;
2021             } elsif($yylval eq 'else') {
2022 0         0 $ELSE;
2023             } elsif($yylval eq 'print') {
2024 10         36 $PRINT;
2025             } elsif($yylval eq 'quit') {
2026             # $QUIT;
2027             # GNU bc exits immediately when it encounters quit, even if
2028             # seen in unreachable code like "if (0 == 1) quit"
2029             # OpenBSD bc acts like this too but calls it a bug
2030 0         0 exit;
2031             } elsif($yylval eq 'return') {
2032 0         0 $RETURN;
2033             } elsif($yylval eq 'while') {
2034 1         2 $WHILE;
2035             } else {
2036 96         413 $IDENT;
2037             }
2038              
2039             } elsif ($char eq '^' && $line =~ s/=//) {
2040 6         20 $EXP_EQ;
2041             } elsif ($char eq '^') {
2042 2         7 $EXP;
2043             } elsif ($char eq '|' && $line =~ s/^\|//) {
2044 4         28 $O_O;
2045             } elsif ($char eq '&' && $line =~ s/^&//) {
2046 4         19 $E_E;
2047              
2048             } elsif ($char eq '%' && $line =~ s/^=//) {
2049 5         16 $MOD_EQ;
2050             } elsif ($char eq '!' && $line =~ s/^=//) {
2051 2         7 $NE;
2052             } elsif ($char eq '=' && $line =~ s/^=//) {
2053 2         8 $EQ;
2054              
2055             } elsif ($char =~ /^[<>]/ && $line =~ s/^=//) {
2056 3 100       22 $char eq '<' ? $LE : $GE;
2057             } elsif ($char =~ /^[<>]/ && $line =~ s/^$char//) {
2058 0 0       0 $char eq '<' ? $L_SHIFT : $R_SHIFT;
2059             } elsif ($char =~ /^[<>]/) {
2060 7 100       38 $char eq '<' ? $LT : $GT;
2061              
2062             } elsif ($char eq '+' && $line =~ s/^\+(\s*\w)/$1/) {
2063 1         4 $PP;
2064             } elsif ($char eq '+' && $line =~ s/^=//) {
2065 1         5 $P_EQ;
2066             } elsif ($char eq '+' && $line =~ s/^\+//) {
2067 3         12 $PPP;
2068             } elsif ($char eq '-' && $line =~ s/^\-(\s*\w)/$1/) {
2069 1         5 $MM;
2070             } elsif ($char eq '-' && $line =~ s/^\-//) {
2071 2         28 $MMM;
2072             } elsif ($char eq '-' && $line =~ s/^=//) {
2073 1         3 $M_EQ;
2074             } elsif ($char eq '*' && $line =~ s/^=//) {
2075 1         2 $F_EQ;
2076             } elsif ($char eq '/' && $line =~ s/^=//) {
2077 3         9 $D_EQ;
2078             } else {
2079 222         438 $yylval = $char;
2080 222         749 ord($char);
2081             }
2082             }
2083             }
2084              
2085             sub bi_length
2086             {
2087 1     1   2 my $stack = shift;
2088              
2089 1         3 $_ = pop @$stack;
2090 1 50       3 die "length(n): missing argument\n" unless defined;
2091              
2092 1         2 my ($a, $b);
2093 1 50       17 die "NaN" unless ($a, $b) = /[-+]?(\d*)\.?(\d+)?/;
2094              
2095 1         40 $a =~ s/^0+//;
2096 1         4 $b =~ s/0+$//;
2097              
2098 1         3 my $len = length($a) + length($b);
2099              
2100 1 50       6 return $len == 0 ? 1 : $len;
2101             }
2102              
2103             sub bi_scale
2104             {
2105 1     1   3 my $stack = shift;
2106              
2107 1         3 $_ = pop @$stack;
2108 1 50       5 die "scale(n): missing argument\n" unless defined;
2109              
2110 1         3 my ($a, $b);
2111 1 50       16 die "NaN" unless ($a, $b) = /[-+]?(\d*)\.?(\d+)?/;
2112              
2113 1         31 return length($b);
2114             }
2115              
2116             sub bi_sqrt
2117             {
2118 4     4   9 my $stack = shift;
2119              
2120 4         11 $_ = pop @$stack;
2121 4 50       50 die "sqrt(n): missing argument\n" unless defined;
2122              
2123 4         33 return sqrt($_);
2124             }
2125              
2126             # mathlib sine function
2127             sub bi_s
2128             {
2129 0     0   0 my $stack = shift;
2130              
2131 0         0 my $val = pop @$stack;
2132 0 0       0 die "s(n): missing argument\n" unless defined $val;
2133 0         0 my $bignum = ref $val;
2134 0 0       0 $val = $val->numify() if $bignum;
2135 0         0 return sin($val);
2136             }
2137              
2138             # mathlib cosine function
2139             sub bi_c
2140             {
2141 0     0   0 my $stack = shift;
2142              
2143 0         0 my $val = pop @$stack;
2144 0 0       0 die "c(n): missing argument\n" unless defined $val;
2145 0         0 my $bignum = ref $val;
2146 0 0       0 $val = $val->numify() if $bignum;
2147 0         0 return cos($val);
2148             }
2149              
2150             # mathlib arctan function
2151             sub bi_a
2152             {
2153 0     0   0 my $stack = shift;
2154              
2155 0         0 my $val = pop @$stack;
2156 0 0       0 die "a(n): missing argument\n" unless defined $val;
2157 0         0 my $bignum = ref $val;
2158 0 0       0 $val = $val->numify() if $bignum;
2159 0         0 return Math::Trig::atan($val);
2160             }
2161              
2162             # mathlib ln function
2163             sub bi_l
2164             {
2165 0     0   0 my $stack = shift;
2166              
2167 0         0 my $val = pop @$stack;
2168 0 0       0 die "l(n): missing argument\n" unless defined $val;
2169 0         0 my $bignum = ref $val;
2170 0 0       0 $val = $val->numify() if $bignum;
2171 0         0 return log($val);
2172             }
2173              
2174             # mathlib exp function
2175             sub bi_e
2176             {
2177 0     0   0 my $stack = shift;
2178              
2179 0         0 my $val = pop @$stack;
2180 0 0       0 die "e(n): missing argument\n" unless defined $val;
2181 0         0 my $bignum = ref $val;
2182 0 0       0 $val = $val->numify() if $bignum;
2183 0         0 return exp($val);
2184             }
2185              
2186             # mathlib jn function
2187             sub bi_j
2188             {
2189 0     0   0 my $stack = shift;
2190              
2191 0         0 my $val = pop @$stack;
2192 0         0 my $n = pop @$stack;
2193 0 0 0     0 die "j(n,x): missing argument\n" if (!defined($n) || !defined($val));
2194 0         0 my $bignum = ref $val;
2195 0 0       0 $val = $val->numify() if $bignum;
2196 0         0 return POSIX::jn($n, $val);
2197             }
2198              
2199             # Initialize the symbol table
2200             sub init_table
2201             {
2202 67     67   756 $sym_table{'scale'} = { type => 'var', value => 0};
2203 67         414 $sym_table{'ibase'} = { type => 'var', value => 0};
2204 67         282 $sym_table{'obase'} = { type => 'var', value => 0};
2205 67         247 $sym_table{'last'} = { type => 'var', value => 0};
2206              
2207 67         408 register_builtin('length', \&bi_length);
2208 67         226 register_builtin('scale', \&bi_scale);
2209 67         213 register_builtin('sqrt', \&bi_sqrt);
2210 67 50       214 if ($mathlib) {
2211 0         0 register_builtin('a', \&bi_a);
2212 0         0 register_builtin('c', \&bi_c);
2213 0         0 register_builtin('e', \&bi_e);
2214 0         0 register_builtin('j', \&bi_j);
2215 0         0 register_builtin('l', \&bi_l);
2216 0         0 register_builtin('s', \&bi_s);
2217             }
2218             }
2219              
2220             sub register_builtin {
2221 201     201   354 my $name = shift;
2222 201         299 my $func = shift;
2223              
2224 201         320 $name .= '()';
2225 201 50       1048 if (exists $sym_table{$name}) {
2226 0         0 die "conflicting builtin: $name\n";
2227             }
2228 201         697 $sym_table{$name} = { 'type' => 'builtin', 'value' => $func };
2229 201         334 return;
2230             }
2231              
2232             #
2233             # Pseudo-code
2234             #
2235              
2236             # Compilation time: a stack of statements is maintained. Each statement
2237             # is itself a stack of instructions.
2238             # Each instruction is appended to the statement which is on the top.
2239             # When a sub-block (IF, DEFINE...) is encountered, a
2240             # new, empty statement is pushed onto the stack, and it receives the
2241             # instructions in the sub-block.
2242              
2243 67         106 my $cur_stmt;
2244              
2245              
2246             # Pushes one instruction onto the current statement
2247             # First element is the type, others are 0 or more arguments, depending on
2248             # the type.
2249             sub push_instr
2250             {
2251 474 50   474   982 die "Internal error: no cur stmt" unless($cur_stmt);
2252 474         1261 my @args = @_;
2253 474         1727 push(@$cur_stmt, [ @args ]);
2254             }
2255              
2256             # Pushes a new statement onto the stack of statements, and makes it the
2257             # current
2258             sub start_stmt
2259             {
2260 243     243   513 $cur_stmt = [];
2261 243         668 push(@stmt_list, $cur_stmt);
2262             }
2263              
2264             # Closes a statement, and returns a reference on it.
2265             sub finish_stmt
2266             {
2267 57     57   86 my $stmt = pop @stmt_list;
2268 57         69 $cur_stmt = $stmt_list[$#stmt_list];
2269 57         103 return $stmt;
2270             }
2271              
2272 67         149 my ($res, $val);
2273              
2274             #
2275             # exec_stmt
2276             # Really executes a statement. Calls itself recursively when it
2277             # encounters sub-statements (in block, loops, functions...)
2278             #
2279             sub exec_stmt
2280             {
2281 239     239   547 my $stmt = shift;
2282              
2283 239         326 my $return = 0; # 1 if a "return" statement is encountered
2284              
2285 239         674 my @stmt_s = @$stmt;
2286             # print STDERR "ko\n";"executing statement: ".Dumper(\@stmt_s);
2287              
2288              
2289             # Each instruction in the stack is an array which first element gives
2290             # the type. Others elements may contain references to sub-statements
2291              
2292 239         412 my $instr;
2293              
2294 239         800 INSTR: while (defined($instr = shift @stmt_s)) {
2295              
2296 688         1146 $_ = $instr->[0];
2297              
2298 688 50       1209 print STDERR ("instruction: ".join(', ', @$instr)."\n" ) if $debug;
2299              
2300             # remove the stack top value, and forget about it
2301 688 100 100     13108 if($_ eq ',') {
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    50 100        
    100 100        
    50 100        
    100 100        
    50 100        
    100 66        
    100 66        
    100 66        
    50 100        
    100 33        
    100          
    50          
    100          
    100          
    100          
    50          
    50          
2302 53         76 $res = pop @ope_stack;
2303 53         103 next INSTR;
2304              
2305             } elsif($_ eq 'N') {
2306              
2307             # N for number
2308 152         316 push(@ope_stack, 0 + $instr->[1]);
2309 152         368 next INSTR;
2310              
2311             } elsif($_ eq '+_' or $_ eq '-_' or $_ eq '*_' or $_ eq '/_' or
2312             $_ eq '^_' or $_ eq '%_' or $_ eq '==_' or $_ eq '!=_' or
2313             $_ eq '>_' or $_ eq '>=_' or $_ eq '<_' or $_ eq '<=_' or
2314             $_ eq '<<_' or $_ eq '>>_' or $_ eq '||_' or $_ eq '&&_') {
2315              
2316             # Binary operators
2317 87         174 my $b = pop(@ope_stack); my $a = pop(@ope_stack);
  87         175  
2318              
2319 87 100       1040 if ($_ eq '+_') { $res = $a + $b ; 1 }
  19 100       32  
  19 100       26  
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    50          
    100          
    50          
2320 10         18 elsif($_ eq '-_') { $res = $a - $b ; 1 }
  10         12  
2321 6         30 elsif($_ eq '*_') { $res = $a * $b ; 1 }
  6         26  
2322 4 50       32 elsif($_ eq '/_') { die 'divide by 0' if ($bignum ? $b->is_zero : $b == 0); $res = $a / $b }
  3 100       12  
2323 8         55 elsif($_ eq '^_') { $res = $a ** $b ; 1 }
  8         12  
2324 7 50       53 elsif($_ eq '%_') { die 'modulo by 0' if ($bignum ? $b->is_zero : $b == 0); $res = $a % $b }
  6 100       49  
2325              
2326 2         3 elsif($_ eq '==_') { $res = 0 + ($a == $b) ; 1 }
  2         2  
2327 2         3 elsif($_ eq '!=_') { $res = 0 + ($a != $b) ; 1 }
  2         3  
2328 5         8 elsif($_ eq '>_') { $res = 0 + ($a > $b) ; 1 }
  5         8  
2329 2         7 elsif($_ eq '>=_') { $res = 0 + ($a >= $b) ; 1 }
  2         2  
2330 13         29 elsif($_ eq '<_') { $res = 0 + ($a < $b) ; 1 }
  13         18  
2331 1         3 elsif($_ eq '<=_') { $res = 0 + ($a <= $b) ; 1 }
  1         2  
2332              
2333 0         0 elsif($_ eq '<<_') { $res = ($a << $b) ; 1 }
  0         0  
2334 0         0 elsif($_ eq '>>_') { $res = ($a >> $b) ; 1 }
  0         0  
2335              
2336 4 100 100     20 elsif($_ eq '||_') { $res = ($a || $b) ? 1 : 0 ; 1 }
  4         7  
2337 4 100 100     15 elsif($_ eq '&&_') { $res = ($a && $b) ? 1 : 0 ; 1 }
  4         6  
2338              
2339             ;
2340              
2341 84         157 push(@ope_stack, $res);
2342 84         266 next INSTR;
2343              
2344              
2345             # Unary operators
2346              
2347             } elsif($_ eq 'm_') {
2348              
2349 5         11 $res = pop(@ope_stack);
2350 5         13 push(@ope_stack, -$res);
2351 5         11 next INSTR;
2352              
2353             } elsif($_ eq '!_') {
2354              
2355 2         3 $res = pop(@ope_stack);
2356 2         4 push(@ope_stack, 0+!$res);
2357 2         4 next INSTR;
2358              
2359             } elsif($_ eq 'V') {
2360              
2361             # Variable or array identifier
2362 81         214 push(@ope_stack, $instr->[1]);
2363 81         223 next INSTR;
2364              
2365             } elsif($_ eq 'P') {
2366 0         0 my $index = splice @ope_stack, -2, 1; # rval remains top of stack
2367 0         0 $index = floor_idx($index);
2368 0 0       0 if ($index == -1) {
2369 0         0 print STDERR "Non-integer index $index for array\n";
2370 0         0 $return = 3;
2371 0         0 @ope_stack = ();
2372 0         0 @stmt_list=();
2373 0         0 last INSTR;
2374             }
2375 0         0 push @ope_stack, $instr->[1] . '[]' . $index;
2376 0         0 next INSTR;
2377              
2378             } elsif($_ eq 'v') {
2379              
2380             # Variable value : initialized to 0
2381             # '*' is reserved for internal variables
2382              
2383 122         289 my $name = $instr->[1];
2384 122 50 33     614 unless (defined($sym_table{$name})
2385             and $sym_table{$name}{'type'} eq 'var') {
2386 0         0 $sym_table{$name}{'value'} = 0;
2387 0         0 $sym_table{$name}{'type'} = 'var';
2388             }
2389 122         273 push(@ope_stack, $sym_table{$name}{'value'});
2390 122         342 next INSTR;
2391              
2392             } elsif($_ eq 'p') {
2393              
2394             # Array value : initialized to 0
2395 0         0 my ($name, $idx) = ($instr->[1], pop(@ope_stack));
2396 0         0 $idx = floor_idx($idx);
2397 0 0       0 if ($idx == -1) {
2398 0         0 print STDERR "Non-integer index $idx for array\n";
2399 0         0 $return = 3;
2400 0         0 @ope_stack = ();
2401 0         0 @stmt_list=();
2402 0         0 last INSTR;
2403             }
2404              
2405             # debug {"p: $name, $idx.\n"};
2406 0         0 $name .= '[]';
2407 0 0 0     0 unless (defined($sym_table{$name})
2408             and $sym_table{$name}{'type'} eq 'array') {
2409              
2410 0         0 $sym_table{$name} = { type => 'array'};
2411             }
2412 0 0       0 unless ($sym_table{$name}{'value'}[$idx]) {
2413 0         0 $sym_table{$name}{'value'}[$idx] = { type => 'var',
2414             value => 0 };
2415             }
2416 0         0 push(@ope_stack, $sym_table{$name}{'value'}[$idx]{'value'});
2417 0         0 next INSTR;
2418              
2419             } elsif($_ eq '=V') {
2420              
2421             # Attribution of a value to a variable
2422             # ope_stack ends with a NUMBER and an IDENTIFIER
2423 81         208 my $varName = pop(@ope_stack);
2424 81         168 my $value = pop(@ope_stack);
2425 81         413 $sym_table{$varName} = { type => 'var',
2426             value => $value };
2427 81         159 push(@ope_stack, $value);
2428 81         136 $return = 3; # do not print result
2429 81         281 next INSTR;
2430              
2431             } elsif($_ eq '=P') {
2432              
2433 0         0 my $varName = pop(@ope_stack);
2434 0         0 my $value = pop(@ope_stack);
2435 0         0 my ($name, $idx) = split /\[\]/, $varName, 2;
2436 0         0 $name .= '[]';
2437 0 0 0     0 unless (defined($sym_table{$name})
2438             and $sym_table{$name}{'type'} eq 'array')
2439             {
2440 0         0 $sym_table{$name} = { type => 'array',
2441             value => [] };
2442             }
2443 0         0 $sym_table{$name}{'value'}[$idx] = { type => 'var',
2444             value => $value };
2445 0         0 push(@ope_stack, $value);
2446 0         0 $return = 3; # do not print result
2447 0         0 next INSTR;
2448              
2449             } elsif($_ eq 'IF') {
2450             # IF statement
2451              
2452 4         7 my $cond = pop @ope_stack;
2453 4 100       9 if($cond) {
2454 1         7 ($return, $val) = exec_stmt($instr->[1]);
2455 1 50       6 push(@ope_stack, $val), last INSTR if $return;
2456             } else {
2457 3         6 $val = undef;
2458             }
2459              
2460             # debug {"IF: $val.\n"};
2461 3         5 push(@ope_stack, $val);
2462             # debug {"IF: ope_stack=".Dumper(\@ope_stack)};
2463 3         22 next INSTR;
2464              
2465             } elsif($_ eq 'FOR-COND') {
2466             # WHILE and FOR statement
2467              
2468             # debug {"while-cond: stmt_s=".Dumper(\@stmt_s)};
2469              
2470 3         4 my $i_cond = $instr;
2471 3         6 my $i_incr = shift @stmt_s;
2472 3         15 my $i_body = shift @stmt_s;
2473              
2474 3         6 $val = 1;
2475              
2476             # debug { "cond: ".Dumper($i_cond) };
2477              
2478 3         11 LOOP: while(1) {
2479              
2480 16         24 @ope_stack=();
2481 16 50       19 if($#{ $i_cond->[1] } >= 0) {
  16         49  
2482 16         87 ($return, $val) = exec_stmt($i_cond->[1]);
2483             # debug {"results of cond: $return, $val"};
2484 16 50 33     58 push(@ope_stack, $val), last INSTR
2485             if($return == 1 or $return == 2);
2486 16 100       35 last LOOP if $val == 0;
2487             }
2488              
2489             # debug {"while: executing a body\n"};
2490              
2491 14 50       25 if($#{ $i_body->[1] } >= 0) {
  14         33  
2492 14         38 ($return, $val) = exec_stmt($i_body->[1]);
2493 14         21 push(@ope_stack, $val);
2494              
2495 14 100       37 if($return == 1) {
    50          
2496 1         3 last INSTR;
2497             } elsif($return == 2) {
2498 0         0 $return = 0 ;
2499 0         0 last INSTR;
2500             }
2501             }
2502              
2503 13 100       18 if($#{ $i_incr->[1] } >= 0) {
  13         61  
2504             # debug {"for: executing the increment: ".Dumper($i_incr)};
2505 8         14 @ope_stack = ();
2506 8         19 ($return, $val) = exec_stmt($i_incr->[1]);
2507 8         13 push(@ope_stack, $val);
2508 8 50 33     34 last INSTR if($return == 1 or $return == 2);
2509             }
2510              
2511             }
2512 2         5 $return = 3;
2513 2         4 push(@ope_stack, 1); # whatever
2514 2         6 next INSTR;
2515              
2516             } elsif($_ eq 'FUNCTION-CALL') {
2517              
2518             # Function call
2519 6         20 push @backup_sym_table, undef; # Hmmm...
2520              
2521 6         23 my $name = $instr->[1];
2522 6         12 $name .= '()';
2523              
2524 6 50       45 unless($sym_table{$name}) {
2525 0         0 print STDERR "No function $name has been defined\n";
2526 0         0 @ope_stack = (0);
2527 0         0 $return = 3;
2528 0         0 last INSTR;
2529             }
2530              
2531 6 50       21 if($sym_table{$name}{type} eq 'builtin') {
2532             ($return, $val) =
2533 6         13 (1, &{ $sym_table{$name}{value} }(\@ope_stack));
  6         27  
2534             } else {
2535 0         0 ($return, $val) = exec_stmt($sym_table{$name}{'value'});
2536              
2537             # Restore the symbols temporarily pushed in 'a' and 'A' instructions
2538 0     0   0 debug {"restoring backup: ".Dumper(\@backup_sym_table)};
  0         0  
2539              
2540             # pop @backup_sym_table; # The first is undef
2541 0         0 while($var = pop @backup_sym_table) {
2542 0     0   0 debug {"restoring var: ".Dumper($var)};
  0         0  
2543 0 0       0 if($var->{'type'} eq 'undef') {
2544 0         0 delete $sym_table{$var->{'name'}};;
2545             } else {
2546 0         0 $sym_table{$var->{'name'}} = $var->{'entry'};
2547             }
2548             }
2549              
2550             # push @backup_sym_table, undef;
2551             }
2552              
2553             # debug {"result from function $name: $return, $val.\n"};
2554 6         17 push(@ope_stack, $val);
2555              
2556 6 50       17 if($return == 1) {
    0          
    0          
2557 6         10 $return = 0; # so the result will be printed
2558             } elsif($return == 2) {
2559 0         0 print STDERR "No enclosing while or for";
2560 0         0 yy_err_recover();
2561             } elsif($return == 3) {
2562 0         0 $return = 0;
2563             }
2564 6         24 next INSTR;
2565              
2566             } elsif($_ eq 'a' or $_ eq 'A') {
2567              
2568             # Function arguments and auto list declaration
2569             # The difference is that function arguments are initialized from the
2570             # operation stack, while auto variables are initialized to zero
2571 0         0 my ($where, $name) = ($_, $instr->[1]);
2572              
2573 0 0       0 if(defined $sym_table{$name}) {
2574 0     0   0 debug { "backup $name, $sym_table{$name}\n" };
  0         0  
2575             push @backup_sym_table, { name => $name,
2576 0         0 entry => $sym_table{$name} };
2577             } else {
2578 0     0   0 debug { "backup $name, undef \n" };
  0         0  
2579 0         0 push @backup_sym_table, { name => $name,
2580             type => 'undef' };
2581             }
2582 0 0       0 $sym_table{$name} = { type => 'var',
2583             value => ($where eq 'a' ?
2584             shift(@ope_stack) : 0) };
2585              
2586             # debug { "new entry $name in sym table: $sym_table{$name}{'value'}" };
2587 0         0 next INSTR;
2588              
2589             } elsif($_ eq '{}') {
2590              
2591             # Grouped statements
2592 15 50       20 if(scalar @{ $instr->[1] } > 0) {
  15         43  
2593 15         102 ($return, $val) = exec_stmt($instr->[1]);
2594             } else {
2595 0         0 ($return, $val) = (0, 0);
2596             }
2597              
2598 15 100 66     76 push(@ope_stack, $val), last INSTR
2599             if($return eq 1 or $return eq 2);
2600              
2601 14         21 $return = 3;
2602 14         17 push(@ope_stack, $val);
2603 14         27 next INSTR;
2604              
2605             } elsif($_ eq 'STMT') {
2606              
2607 21         32 @ope_stack=();
2608 21 50       51 if(scalar $instr->[1] > 0) {
2609 21         95 ($return, $val) = exec_stmt($instr->[1]);
2610             } else {
2611 0         0 ($return, $val) = (3, undef);
2612             }
2613              
2614 21 100 66     77 @ope_stack = ($val), last INSTR
2615             if($return eq 1 or $return eq 2);
2616              
2617 20         23 $return = 3;
2618 20         31 @ope_stack = ($val);
2619              
2620 20         71 next INSTR;
2621              
2622             } elsif($_ eq 'RETURN') {
2623             # Return statement
2624              
2625             # debug {"returning $instr->[1].\n"};
2626 0 0       0 my $value = ($instr->[1] == 0) ? 0
2627             : pop(@ope_stack);
2628              
2629 0         0 $return = 1;
2630 0         0 @ope_stack = ($value);
2631              
2632 0         0 last INSTR;
2633              
2634             } elsif($_ eq 'BREAK') {
2635             # Break statement
2636              
2637             # debug {"breaking.\n"};
2638              
2639 1         2 $return = 1;
2640 1         3 push(@ope_stack, 0);
2641              
2642 1         3 last INSTR;
2643              
2644             } elsif($_ eq 'PRINT') {
2645             # PRINT statement
2646              
2647 21 50       43 if(scalar @{ $instr->[1] } > 0) {
  21         46  
2648 21         137 ($return, $val) = exec_stmt($instr->[1]);
2649             } else {
2650 0         0 ($return, $val) = (0, 0);
2651             }
2652              
2653 21 50 33     80 push(@ope_stack, $val), last INSTR
2654             if($return eq 1 or $return eq 2);
2655              
2656 21         47 $return = 3;
2657 21         64 next INSTR;
2658              
2659             } elsif($_ eq 'PRINT-STMT') {
2660              
2661 24         35 @ope_stack=();
2662 24 50       47 if(scalar $instr->[1] > 0) {
2663 24         112 ($return, $val) = exec_stmt($instr->[1]);
2664             } else {
2665 0         0 ($return, $val) = (3, undef);
2666             }
2667              
2668 24 50 33     128 last INSTR if($return eq 1 or $return eq 2);
2669              
2670 24         30 $return = 3;
2671              
2672 24         89 print $val;
2673 24         71 next INSTR;
2674              
2675             } elsif($_ eq 'FUNCTION-DEF') {
2676              
2677             # Function definition
2678 0         0 my ($name, $code) = ($instr->[1], $instr->[2]);
2679 0         0 push(@$code, ["RETURN", 0]);
2680 0         0 $sym_table{$name.'()'} = { type => 'func',
2681             value => $code };
2682 0         0 $return = 3;
2683 0         0 push(@ope_stack, 1); # whatever
2684 0         0 next INSTR;
2685              
2686             } elsif($_ eq 'S') {
2687              
2688             # S for string
2689 10         28 $_ = $instr->[1];
2690 10         23 s/ \\a /\a/gx;
2691 10         19 s/ \\b /\b/gx;
2692 10         15 s/ \\f /\f/gx;
2693 10         25 s/ \\n /\n/gx;
2694 10         15 s/ \\r /\r/gx;
2695 10         12 s/ \\t /\t/gx;
2696 10         12 s/ \\q /"/gx; # "
2697 10         16 s/ \\\\ /\\/gx;
2698 10         18 push(@ope_stack, $_);
2699 10         23 next INSTR;
2700              
2701             } else {
2702              
2703 0         0 die "internal error: illegal statement $_";
2704              
2705             }
2706              
2707             }
2708              
2709 236 100       564 if ($return == 3) {
2710 135         222 @ope_stack = ();
2711             } else {
2712 101 50       415 if(scalar @ope_stack != 1) {
2713 0         0 die("internal error: ope_stack = ".join(", ", @ope_stack).".\n");
2714             }
2715              
2716 101         235 $val = pop(@ope_stack);
2717             # debug {"Returning ($return, $val)\n"};
2718             # debug {"ope_stack at e-o-func: ".Dumper(\@ope_stack)};
2719             }
2720              
2721 236         767 return ($return, $val);
2722              
2723             }
2724              
2725             sub floor_idx {
2726 0     0   0 my $idx = shift;
2727 0 0       0 if ($idx =~ m/\A([0-9]+)\.?/) {
2728 0         0 return $1;
2729             }
2730 0         0 return -1;
2731             }
2732              
2733             sub main
2734             {
2735 67     67   120 my $status;
2736 67         118 while(1)
2737             {
2738 70         203 $line = '';
2739             eval {
2740 70         293 clear_flags();
2741 70         465 $status = yyparse();
2742 67         349 1;
2743 70 100       180 } or do {
2744 3         12 yyerror($@);
2745             };
2746              
2747 70 100       31 exit $status if ! $@;
2748             }
2749             }
2750              
2751 67         336 select(STDERR);
2752 67         358 $| = 1;
2753 67         267 select(STDOUT);
2754              
2755 67         380 command_line();
2756 67         248 init_table();
2757 67         269 next_file();
2758 67         331 start_stmt();
2759 67         315 main();
2760              
2761             __END__