Crawly Crypt Collection 1/crawlyvol1.bin/apps/spread/opusprg/opussrc/e.pas

Pascal/Delphi Source File | 1988-05-16 | 75KB | 1,858 lines

{$M+}
{$E+}

PROGRAM Mock;

{$I i:\opus.i}
{$I i:\gctv.inc}

{$I d:\pascal\opus\xbios.def}

PROCEDURE STRIP_NUM ( VAR num_str : LorFstr;
                      VAR str     : LorFstr;
                      VAR str_pos,
                          len     : INTEGER );
   EXTERNAL;
FUNCTION TRANSLATE_CELL ( VAR str      : LorFstr;    { cell_str or formula  }
                          VAR str_pos  : INTEGER;    { position; 1 for cell }
                              len      : INTEGER;    { length of string     }
                          VAR row,col  : INTEGER;
                          VAR row_rel,               { relative reference?  }
                              col_rel  : BOOLEAN ) : StatusType;
   EXTERNAL;
PROCEDURE ALL_LISTS ( action : INTEGER; ptr : CellPtr; row,col : INTEGER );
   EXTERNAL;
FUNCTION VALID_NUMBER ( VAR num_str : LorFstr ) : StatusType;
   EXTERNAL;
FUNCTION STRING_TO_REAL ( VAR string_real : STR30 ) : REAL;
   EXTERNAL;
FUNCTION REQUEST_MEMORY ( what : ReqType ) : BOOLEAN;
   EXTERNAL;
FUNCTION LOCATE_CELL ( row,col : INTEGER ) : CellPtr;
   EXTERNAL;
FUNCTION NEW_CELL ( row,col : INTEGER ) : CellPtr;
   EXTERNAL;
PROCEDURE DELETE_CELL ( r,c      : INTEGER;
                        free_dep : BOOLEAN  );
   EXTERNAL;
PROCEDURE FIND_SCREEN_POS (     row,col             : INTEGER;
                            VAR l_scr_row,l_scr_col : INTEGER );
   EXTERNAL;
PROCEDURE CELL_ON_SCREEN ( draw_or_toggle,row,col : INTEGER; force : BOOLEAN );
   EXTERNAL;
FUNCTION ASSIGNED ( row,col : INTEGER; VAR ptr : CellPtr ) : AssignedStatus;
   EXTERNAL;
PROCEDURE Set_Mouse ( a : Mouse_Type );
   EXTERNAL;

PROCEDURE ERROR_MESSAGE ( VAR str     : LorFstr;
                          error       : StatusType;
                          str_pos,len : INTEGER     );
   EXTERNAL;

{ following are EXP & LN functions to use instead of library, since lib is
  only accurate to 6-9 digits. These are reasonably quick and accurate to 10+
  digits. Use range reduction to get a number favorable for power-series
  calculations, then laws of exponents/logarithms for final result. }

FUNCTION MY_EXP ( x : REAL ) : REAL;
   VAR n,whole_num,i      : INTEGER;
       sum,prod,frac,term : REAL;
       neg                : BOOLEAN;
   BEGIN
       i := 1; { index into e_table }
       prod := 1;
       whole_num := TRUNC(x); { got the integer part }
       neg := whole_num < 0;
       frac := x-whole_num; { keeps sign of x }
       whole_num := ABS(whole_num);
       WHILE whole_num <> 0 DO BEGIN
          IF whole_num & 1 <> 0 THEN { LSB set? }
             IF neg THEN
                prod := prod/e_table[i]
             ELSE
                prod := prod*e_table[i];
          whole_num := ShR(whole_num,1); { prepare to test next bit }
          i := i+1
       END;
       { so now, e^(x - x MOD 1) has been calculated. ( MOD being a REAL mod )
         Next calculate e^(x MOD 1), which will satisfy |x| < 1, using the
         MacLaurin series }
       n := 0 ;
       sum := 1;
       term := 1;
       REPEAT
          n := n+1;
          term := term*frac/n;
          sum := sum+term
       UNTIL ABS(term/sum) < 5E-12;
       { and finally combine prod & sum }
       my_exp := prod*sum
   END; { MY_EXP }

FUNCTION MY_LN ( x : REAL ) : REAL;
   VAR j,c2,c10,sign  : INTEGER;
       sum,term,power : REAL;
   BEGIN
       { First, normalize the number so that 0.5 < x < 1.0, so we can use the
         series described below. }
       IF x = 1 THEN
          my_ln := 0
       ELSE BEGIN
          c10 := 0;
          WHILE x > 1 DO BEGIN
             x := x/10;
             c10 := c10+1 { have to 'multiply' later so positive c10 }
          END;
          WHILE x < 0.1 DO BEGIN
             x := x*10;
             c10 := c10-1 { have to 'divide' later so negative c10 }
          END;
          c2 := 0;
          WHILE x < 0.5 DO BEGIN
             x := x*2;
             c2 := c2-1;
          END;
          sum := 0;
          IF x < 1 THEN BEGIN
             { since we're between 0.5 and 1.0, we must subtract one from x so
               we in fact calculate ln(x), using the series which GIVES
               ln(1+x) }
             x := x-1;
             { Now calculate the Taylor series
                 ln(1+X) = X-(1/2X^2)+(1/3X^3)-(1/4X^4)...,
               valid in the interval -1 < X <= -1,
               where incr = a term in the series, until
               ABS(incr/sum) < 5E-12, since a maximum of ten digits are
               available in the fractional part of the mantissa. Caveat: since
               the series include terms that alternate in sign, significant
               cancellation error can occur with numbers like 1.00001. The lib
               provides 5 digits. The worst case for this one is about 7 digit
               precision. The real problem is that the lib mult/div routines
               apparently work with a number format identical to the one
               "visible" TO us, 6 bytes. It SHOULD work with an expanded prec
               number and round the final result }
             j := 1;
             sign := 1;
             power := x;
             REPEAT
                term := 1/j*power;
                sum := sum+term;
                sign := -sign;
                j := (abs(j)+1)*sign;
                power := power*x
             UNTIL ABS(term/sum) < 5E-12
          END;
          my_ln := sum+c10*Ln10+c2*Ln2 { combine }
       END
   END; { MY_LN }

PROCEDURE EVALUATE_FORMULA ( row,col  : INTEGER;
                             force,
                             new_form : BOOLEAN;
                             cell     : CellPtr );

   LABEL 1,2;
   VAR str_pos,len     : INTEGER;
       result,old_num  : REAL;
       dep             : DepPtr;
       stat,old_status : StatusType;
       ptr             : CellPtr;

(*************************************************************************)
(* EVALUATE_FORMULA is the parent proc; see body of it for details       *)
(*************************************************************************)

PROCEDURE FULL_EXPR ( VAR str      : LorFstr;
                      do_it        : BOOLEAN;
                      VAR result   : REAL );
   FORWARD;
FUNCTION CHECK_BOOLOP ( VAR str      : LorFstr;
                        VAR bool_op  : BoolOps;
                        VAR stat     : StatusType ) : BOOLEAN;
   FORWARD;
FUNCTION EVAL_BOOLOP ( VAR bool_op : BoolOps;
                       VAR arg_1,
                           arg_2   : REAL ) : BOOLEAN;
   FORWARD;
PROCEDURE VAL_EXPR ( VAR str      : LorFstr;
                     do_it        : BOOLEAN;
                     VAR result   : REAL );
   FORWARD;
PROCEDURE TERM ( VAR str      : LorFstr;
                 do_it        : BOOLEAN;
                 VAR result   : REAL );
   FORWARD;
PROCEDURE FACTOR ( VAR str     : LorFstr;
                   do_it,
                   get_neg     : BOOLEAN;
                   VAR result  : REAL );
   FORWARD;
PROCEDURE EXPONENTIATION_EXPR ( VAR str      : LorFstr;
                                do_it,
                                get_neg      : BOOLEAN;
                                VAR result   : REAL );
   FORWARD;
PROCEDURE EVAL_FUNCTION ( VAR str      : LorFstr;
                          do_it        : BOOLEAN;
                          VAR result   : REAL;
                          func_code    : AllFunctions );
   FORWARD;
PROCEDURE DO_SINGLE ( VAR str      : LorFstr;
                      do_it        : BOOLEAN;
                      VAR result   : REAL;
                      func_code    : AllFunctions );
   FORWARD;
PROCEDURE DO_MULTIPLE ( VAR str      : LorFstr;
                        do_it        : BOOLEAN;
                        VAR result   : REAL;
                        func_code    : AllFunctions );
   FORWARD;
PROCEDURE DO_DOUBLE ( VAR str      : LorFstr;
                      do_it        : BOOLEAN;
                      VAR result   : REAL;
                      func_code    : AllFunctions );
   FORWARD;
PROCEDURE DO_AGGREGATE ( VAR str      : LorFstr;
                         do_it        : BOOLEAN;
                         VAR result   : REAL;
                         func_code    : AllFunctions );
   FORWARD;
PROCEDURE DO_FINANCIAL ( VAR str      : LorFstr;
                         do_it        : BOOLEAN;
                         VAR result   : REAL;
                         func_code    : AllFunctions );
   FORWARD;
PROCEDURE DO_LOOKUP ( VAR str      : LorFstr;
                      do_it        : BOOLEAN;
                      VAR result   : REAL;
                      func_code    : AllFunctions );
   FORWARD;
PROCEDURE IF_EXPR ( VAR str      : LorFstr;
                    do_it        : BOOLEAN;
                    VAR result   : REAL );
   FORWARD;

PROCEDURE ITS_PENDING;
   BEGIN
      cell^.format := cell^.format & no_recalc_mask & not_pending_mask;
      GOTO 2
   END;

PROCEDURE DO_ERROR ( VAR str : LorFstr );
   { only invoke error-dialog if a new formula is being parsed }
   BEGIN
       IF new_form THEN BEGIN
          Set_Mouse(M_Arrow);
          error_message(str,stat,str_pos,len);
          Set_Mouse(M_Bee)
       END;
       GOTO 1
   END; { DO_ERROR }

FUNCTION FIND_FUNCTION ( VAR str       : STR10;
                         VAR func_code : AllFunctions ) : BOOLEAN;
   { binary search for function name in array functions }
   VAR low,mid,high : INTEGER;
   BEGIN
       find_function := FALSE;
       low := 1;
       high := n_functions;
       WHILE low <= high DO BEGIN
          mid := ( low+high ) DIV 2;
          IF str < functions[mid].func_name THEN
             high := mid-1
          ELSE IF str > functions[mid].func_name THEN
             low := mid+1
          ELSE BEGIN
             find_function := TRUE;
             func_code := functions[mid].func_type;
             low := high+1; { break }
          END
       END
   END; { FIND_FUNCTION }

PROCEDURE GET_RANGE ( VAR str             : LorFstr;
                      do_it               : BOOLEAN;
                      VAR s_r,s_c,e_r,e_c : INTEGER );
   { <cellrange> ::= <cellref>:<cellref> }
   VAR i,j        : INTEGER;
       dummy,quit : BOOLEAN;
       ptr        : CellPtr;
   BEGIN
       IF str_pos < len THEN
          IF str[str_pos] IN up_case+['$'] THEN BEGIN
             stat := translate_cell(str,str_pos,len,s_r,s_c,dummy,dummy);
             IF stat = OK THEN
                IF str_pos < len THEN
                   IF str[str_pos] <> ':' THEN
                      stat := SyntaxErr
                   ELSE BEGIN
                      str_pos := str_pos+1;
                      stat := translate_cell(str,str_pos,len,e_r,e_c,
                                             dummy,dummy);
                      IF stat = OK THEN
                         IF (s_r > e_r) OR (s_c > e_c) THEN
                            stat := BadRef
                         ELSE IF do_it THEN
                            IF natural THEN
                               FOR i := s_r TO e_r DO BEGIN
                                   ptr := data[i];
                                   quit := FALSE;
                                   WHILE (ptr <> NIL) AND (NOT quit) DO BEGIN
                                      IF (ptr^.c >= s_c) AND
                                         (ptr^.c <= e_c) THEN
                                         IF ptr^.class = Expr THEN
                                            IF ptr^.format &
                                               pending_mask <> 0 THEN
                                               its_pending
                                            ELSE IF ptr^.format & recalc_mask = 0
                                            THEN BEGIN
                                               evaluate_formula(i,ptr^.c,
                                                                force,FALSE,
                                                                ptr);
                                               IF ptr^.format & recalc_mask = 0
                                               THEN
                                                  its_pending
                                            END
                                            ELSE
                                         ELSE
                                      ELSE IF ptr^.c > e_c THEN
                                         quit := TRUE;
                                      ptr := ptr^.next
                                   END
                               END
                            ELSE
                         ELSE
                      ELSE
                   END
                ELSE
                   stat := SyntaxErr
             ELSE
          END
          ELSE
             stat := SyntaxErr
       ELSE
          stat := SyntaxErr;
       IF stat <> OK THEN
          do_error(str)
   END; { GET_RANGE }

FUNCTION ADD_OP ( a_char : CHAR; VAR op : CHAR ) : BOOLEAN;
   BEGIN
       op := a_char;
       add_op := (a_char = '+') OR (a_char = '-')
   END; { ADD_OP }
FUNCTION MUL_OP ( a_char : CHAR; VAR op : CHAR ) : BOOLEAN;
   BEGIN
       op := a_char;
       mul_op := (a_char = '*') OR (a_char = '/')
   END; { ADD_OP }


{ some general crash-proofing routines; NOT exhaustive }

FUNCTION CHECK_EXP ( what : REAL ) : BOOLEAN;
   BEGIN
       IF ABS(what) < 85 THEN
          check_exp := TRUE
       ELSE
          check_exp := FALSE
   END; { CHECK_EXP }

FUNCTION CHECK_SQUARE ( what : REAL ) : BOOLEAN;
   BEGIN
       IF (ABS(what) > MaxSquare) OR
          (
            (ABS(what) < MinSquare) AND
            (what <> 0)
          ) THEN
          check_square := FALSE
       ELSE
          check_square := TRUE
   END; { CHECK_SQUARE }

FUNCTION FRACTION ( what            : REAL;
                    VAR str         : LorFstr ) : REAL;
   BEGIN
       what := ABS(what);
       IF what > Long_Maxint THEN BEGIN
          stat := Overflow;
          do_error(str)
       END
       ELSE
          fraction := what-LONG_TRUNC(what)
   END; { FRACTION }

FUNCTION ODD_REAL ( what            : REAL;
                    VAR str         : LorFstr ) : BOOLEAN;
   BEGIN
       IF fraction(what/2.0,str) > 0.25 THEN
          odd_real := TRUE                  { really should be = 0.5, but  }
       ELSE                                 { best to account for rounding }
          odd_real := FALSE                 { errors! }
   END; { ODD_REAL }

{ in general, status is checked at the end of all routines that can modify it,
  and if it isn't = OK, a jump is made to do_error, and evaluation is stopped
  at that point. Thus, when one routine calls another, if the "callee" returns,
  status is guaranteed to be OK and no checking of this by the "caller" is
  neccessary. Also, this ensures that the error returned is the "first" one
  encountered, which may not be the case if handled less rigorously. }

PROCEDURE FULL_EXPR;
   {
     <fullexpr> ::= <valexpr> | <valexpr><boolop><valexpr>

     expr, val_expr, term, & factor are set up so that
     all arithmetic operations and functions preceding and following
     a boolop are executed before the conditional is tested, so that in
     effect, the boolop has lowest precedence of all, and  1+2+3<1+2*5 means
     6 < 11. Note that expr like 1<2<3 won't be flagged as an error unless
     str_pos < len is checked upon return to evaluate_formula, since this
     routine can't look for this because it may be called by factor, and we
     wouldn't want to prematurely end with an error! }
   VAR result_1 : REAL;
       bool_op  : BoolOps;
   BEGIN
       val_expr(str,do_it,result);
       IF str_pos < len THEN
          IF check_boolop(str,bool_op,stat) THEN BEGIN
             val_expr(str,do_it,result_1);
             IF do_it THEN
                IF eval_boolop(bool_op,result,result_1) THEN
                   result := 1.0
                ELSE
                   result := 0.0
          END;
       IF stat <> OK THEN
          do_error(str)
   END; { FULL_EXPR }

FUNCTION CHECK_BOOLOP;
   { called by full_expr; at least 2 chars in str }
   BEGIN
       check_boolop := TRUE;
       IF str[str_pos] = '=' THEN BEGIN
          bool_op := Equal;
          str_pos := str_pos+1
       END
       ELSE IF str[str_pos] = '>' THEN
          IF str[str_pos+1] = '=' THEN BEGIN
             bool_op := GreaterOrEqual;
             str_pos := str_pos+2
          END
          ELSE BEGIN
             bool_op := Greater;
             str_pos := str_pos+1
          END
       ELSE IF str[str_pos] = '<' THEN
          IF str[str_pos+1] = '=' THEN BEGIN
             bool_op := LesserOrEqual;
             str_pos := str_pos+2
          END
          ELSE IF str[str_pos+1] = '>' THEN BEGIN
             bool_op := NotEqual;
             str_pos := str_pos+2
          END
          ELSE BEGIN
             bool_op := Lesser;
             str_pos := str_pos+1
          END
       ELSE
          check_boolop := FALSE
   END; { CHECK_BOOLOP }

FUNCTION EVAL_BOOLOP;
   BEGIN
       CASE bool_op OF
          Equal          : eval_boolop := arg_1 = arg_2;
          NotEqual       : eval_boolop := arg_1 <> arg_2;
          Lesser         : eval_boolop := arg_1 < arg_2;
          LesserOrEqual  : eval_boolop := arg_1 <= arg_2;
          Greater        : eval_boolop := arg_1 > arg_2;
          GreaterOrEqual : eval_boolop := arg_1 >= arg_2
       END
   END; { EVAL_BOOLOP }

PROCEDURE VAL_EXPR;
   (*
     <valexpr> ::= <term> { <addop><term> }
   *)
   VAR result_1 : REAL;
       continue : BOOLEAN;
       op       : CHAR;
   BEGIN
       term(str,do_it,result);
       continue := TRUE;
       WHILE (str_pos < len) AND (continue) DO
          IF add_op(str[str_pos],op) THEN BEGIN
             str_pos := str_pos+1;
             term(str,do_it,result_1);
             IF do_it THEN
                IF op = '+' THEN
                   result := result+result_1
                ELSE
                   result := result-result_1
          END
          ELSE
             continue := FALSE; { break }
       IF stat <> OK THEN
          do_error(str)
   END; { VAL_EXPR }

PROCEDURE TERM;
   (*
     <term> ::= <factor> { <mulop><factor> }
   *)
   VAR result_1 : REAL;
       continue : BOOLEAN;
       op       : CHAR;
   BEGIN
       factor(str,do_it,FALSE,result);
       continue := TRUE;
       WHILE (str_pos < len) AND (continue) DO
          IF mul_op(str[str_pos],op) THEN BEGIN
             str_pos := str_pos+1;
             factor(str,do_it,FALSE,result_1);
             IF do_it THEN
                IF op = '*' THEN
                   result := result*result_1
                ELSE IF result_1 = 0.0 THEN
                   stat := DivBy0
                ELSE
                   result := result/result_1
          END
          ELSE
             continue := FALSE; { break }
       IF stat <> OK THEN
          do_error(str)
   END; { TERM }

PROCEDURE FACTOR;
   {
     <factor> ::= real | <cell ref> | <function call> | (<expr>) |
                  <exponentiation expr> | -<factor>
     <exponentiation expr> ::= <factor><^><factor> }
   VAR old_pos,row,col,temp_len : INTEGER;
       dummy,a_cell             : BOOLEAN;
       func_code                : AllFunctions;
       ptr                      : CellPtr;
   BEGIN
       { the things which come under the initial IF's scope all look for
         character patterns that indicate the start of a factor, a factor
         representing the fundamental data "chunk-size" the evaluator handles.
         And as can be seen from the grammar, all the operands indeed reduce
         to a factor, in one of its forms. In sum, a factor is an entity that
         is meant to be taken as a single number; in 1+2*3, 1,2,3 are factors,
         but 1+2 & 2*3 are NOT, while in 1*(2+3), 1,2,3 are factors but so is
         (2+3). Hence precedence is maintained. However, the
         exponentiation operator has highest precedence, so can't look for it
         in val_expr or term. And since the two operands joined by this op
         are meant to be taken as single numbers, it makes sense to define this
         type of expr as above, and check for the exp. op whenever a factor is
         retrieved. This is done at the end of this proc. Note that expressions
         such as 3^4^5 are perfectly legal and are evaluated right-to-left,
         so that 3 is raised to the 5th power of 4, NOT the the power 20, as
         is the case for (3^4)^5. Last point(!). If a^b is a factor, what
         happens if -a^b? Well, - expects a factor, and since a factor = a^b,
         we erroneously get negation AFTER the exponentiation. So, include
         a boolean to be passed to exponentiation_expr to indicate whether
         factor was called from the unary minus operator, and if so, DON'T
         look for ^. Rather, upon return to unary minus code, the factor is
         negated, and THEN we look for ^. }

       IF str_pos > len THEN
          stat := SyntaxErr
       ELSE IF str[str_pos] IN digits+['.'] THEN BEGIN
          strip_num(num_str,str,str_pos,len);
          IF (new_form) OR (cell^.status < Full) THEN
             stat := valid_number(num_str);
          IF (stat = OK) AND (do_it) THEN BEGIN
             result := string_to_real(num_str);
             IF num_str = 'OVERFLOW' THEN
                stat := Overflow
             ELSE IF str_pos <= len THEN
                IF str[str_pos] = '%' THEN BEGIN
                   result := result/100;
                   str_pos := str_pos+1
                END
          END
          ELSE IF NOT do_it THEN
             IF str_pos <= len THEN
                IF str[str_pos] = '%' THEN
                   str_pos := str_pos+1
                ELSE
             ELSE
          ELSE
       END
       ELSE IF str_pos < len THEN
          IF str[str_pos] IN up_case+['$'] THEN BEGIN
             a_cell := FALSE;
             IF (str[str_pos] = '$') OR (str[str_pos+1] IN digits+['$']) THEN
                a_cell := TRUE
             ELSE IF str_pos+1 < len THEN
                IF (str[str_pos+1] IN up_case) AND
                   (str[str_pos+2] IN digits+['$']) THEN
                   a_cell := TRUE;
             IF a_cell THEN BEGIN
                stat := translate_cell(str,str_pos,len,row,col,dummy,dummy);
                IF (stat = OK) AND (do_it) THEN BEGIN
                   ptr := locate_cell(row,col);
                   IF ptr <> NIL THEN
                      WITH ptr^ DO
                         IF class <> Labl THEN BEGIN
                            IF (class = Expr) AND (natural) THEN
                               IF format & pending_mask <> 0 THEN
                                  its_pending
                               ELSE IF format & recalc_mask = 0 THEN BEGIN
                                  evaluate_formula(row,col,force,FALSE,ptr);
                                  IF format & recalc_mask = 0 THEN
                                     its_pending
                               END;
                            IF status = Full THEN
                               result := num
                            ELSE IF status = Empty THEN
                               result := 0
                            ELSE
                               stat := status
                         END
                         ELSE
                            result := 0
                   ELSE
                      result := 0
                END
                ELSE
             END
             ELSE BEGIN { function name? }
                old_pos := str_pos;
                WHILE (str[str_pos] IN up_case) AND (str_pos < len) DO
                   str_pos := str_pos+1;
                { when done, str_pos = pos following "name" }
                temp_len := str_pos-old_pos;
                IF (temp_len > 7) OR (temp_len < 2) OR
                   (str_pos = len) THEN
                   stat := SyntaxErr
                ELSE BEGIN
                   temp := COPY(str,old_pos,temp_len);
                   IF find_function(temp,func_code) THEN
                      eval_function(str,do_it,result,func_code )
                   ELSE
                      stat := SyntaxErr
                END
             END
          END
          ELSE BEGIN
             str_pos := str_pos+1;
             CASE str[str_pos-1] OF
                '(' : BEGIN
                   { something in parentheses can be a 'full' expression,
                     so we can have things like (1+COS(2*A1))/2 and
                     A1>(A2+A3)*5 }
                   full_expr(str,do_it,result);
                   IF str_pos <= len THEN
                      IF str[str_pos] <> ')' THEN
                         stat := SyntaxErr
                      ELSE
                         str_pos := str_pos+1
                   ELSE
                      stat := SyntaxErr
                END;
                '-' : BEGIN
                   { use factor because negation such as -5+3 would result in
                     evaluation as if it were written -(5+3), possible if
                     full_expr was used, giving an addop higher precedence than
                     the negation op. Note that 3^-3 is handled correctly. }
                   factor(str,do_it,TRUE,result);
                   IF do_it THEN
                      result := -result
                END;
                OTHERWISE : stat := SyntaxErr
             END { CASE }
          END
       ELSE { str_pos did = len; a number was the only valid possibility }
          stat := SyntaxErr; { and it has already been looked for }
       IF stat <> OK THEN
          do_error(str)
       ELSE
          exponentiation_expr(str,do_it,get_neg,result)
   END; { FACTOR }

PROCEDURE EXPONENTIATION_EXPR;
   { <exponentiation expr> ::= <factor>^<factor> }
   { stat guaranteed to be OK; only one call to this, in FACTOR }
   VAR sign               : INTEGER;
       result_1,work_real : REAL;
   BEGIN
       IF NOT get_neg THEN
          IF str_pos < len THEN
             IF str[str_pos] = '^' THEN BEGIN
                str_pos := str_pos+1;
                factor(str,do_it,FALSE,result_1);
                IF do_it THEN
                   IF result = 0.0 THEN { check for crash }
                      stat := Undefined
                   ELSE IF result < 0.0 THEN BEGIN
                      IF fraction(result_1,str) <> 0.0 THEN
                         stat := Undefined  { can't do -2^8.5; what would }
                      ELSE BEGIN            { the sign be? }
                         IF odd_real(result_1,str) THEN
                            sign := -1
                         ELSE
                            sign := 1;
                         IF check_exp(result_1*my_ln(ABS(result))) THEN
                            result := sign*my_exp(result_1*my_ln(ABS(result)))
                         ELSE
                            stat := Overflow
                      END
                   END
                   ELSE IF check_exp(result_1*my_ln(result)) THEN
                      result := my_exp(result_1*my_ln(result))
                   ELSE
                      stat := Overflow
             END;
       IF stat <> OK THEN
          do_error(str)
   END; { EXPONENTIATION_EXPR }

PROCEDURE EVAL_FUNCTION;
   BEGIN
       IF str_pos > len THEN
          stat := SyntaxErr
       ELSE IF str[str_pos] <> '(' THEN
          stat := SyntaxErr
       ELSE BEGIN
          str_pos := str_pos+1;
          IF func_code IN Single THEN
             do_single(str,do_it,result,func_code)
          ELSE IF func_code IN Double THEN
             do_double(str,do_it,result,func_code)
          ELSE IF func_code IN Multiple THEN
             do_multiple(str,do_it,result,func_code)
          ELSE IF func_code IN Aggregate THEN
             do_aggregate(str,do_it,result,func_code)
          ELSE IF func_code IN Financial THEN
             do_financial(str,do_it,result,func_code)
          ELSE IF func_code IN LookUp THEN
             do_lookup(str,do_it,result,func_code)
          ELSE IF func_code = IfOp THEN
             if_expr(str,do_it,result);
          IF str_pos > len THEN
             stat := SyntaxErr
          ELSE IF str[str_pos] <> ')' THEN
             stat := SyntaxErr
          ELSE
             str_pos := str_pos+1
       END;
       IF stat <> OK THEN
          do_error(str)
   END; { EVAL_FUNCTION }

(**************************************************************************)
(* Single/No Argument Functions: Transcendental, Conversion, Factorial... *)
(**************************************************************************)

PROCEDURE DO_SINGLE;
   { simple_function ::= <functname()> | <functname(fullexpr)> }
   VAR i,limit     : INTEGER;
       mag_num,temp : REAL;
   BEGIN
       (*********************************************)
       (* functions with no arguments; result = f() *)
       (*********************************************)
       IF func_code = PiOp THEN
          IF do_it THEN
             result := pi
          ELSE
       (*************************************************)
       (* functions with single argument; result = f(x) *)
       (*************************************************)
       ELSE BEGIN
          full_expr(str,do_it,result);
          IF do_it THEN BEGIN
             mag_num := ABS(result);
             CASE func_code OF
                (***************************)
                (* transfer-like functions *)
                (***************************)
                AbsOp :
                   result := mag_num;
                DegOp :
                   result := result*DegPerRad;
                RadOp :
                   result := result/DegPerRad;
                (******************)
                (* trig functions *)
                (******************)
                SinOp :
                   result := SIN(result);
                CosOp :
                   result := COS(result);
                TanOp :
                   IF COS(result) <> 0 THEN { best to use Pascal rather  }
                                            { than magnum<>halfpi; avoid }
                      result := SIN(result)/COS(result) { roundoff error }
                   ELSE
                      stat := Undefined;
                AsinOp :
                   IF (mag_num > 1) OR
                      ((result <> 0) AND (mag_num < MinSquare)) THEN
                      stat := Undefined
                   ELSE IF mag_num = 1 THEN
                      result := HalfPi*result
                   ELSE
                      result := ArcTan(result/SQRT(1-result*result));
                ACosOp :
                   IF (mag_num > 1) OR
                      ((result <> 0) AND (mag_num < MinSquare)) THEN
                      stat := Undefined
                   ELSE IF mag_num = 1 THEN
                      result := 0
                   ELSE
                      result := -ArcTan(result/SQRT(1-result*result))+
                                 HalfPi;
                AtanOp :
                   result := ArcTan(result);
                (*******************)
                (* power functions *)
                (*******************)
                LogOp :
                   IF result > 0 THEN
                      result := my_ln(result)/ln10
                   ELSE
                      stat := Undefined;
                LnOp  :
                   IF result > 0 THEN
                      result := my_ln(result)
                   ELSE
                      stat := Undefined;
                ExpOp :
                   IF check_exp(result) THEN
                      result := my_exp(result)
                   ELSE
                      stat := Overflow;
                SqrOp :
                   IF NOT check_square(mag_num) THEN
                      stat := Overflow
                   ELSE
                      result := SQR(result);
                SqrtOp :
                   IF result >= 0 THEN
                      result := SQRT(result)
                   ELSE
                      stat := Undefined;
                (*****************)
                (* miscellaneous *)
                (*****************)
                FacOp :
                   IF result > 33 THEN
                      stat := Overflow
                   ELSE IF result < 0 THEN
                      stat := Undefined
                   ELSE IF result <> ROUND(result) THEN
                      stat := Undefined { we don't do gamma functions }
                   ELSE BEGIN
                      limit := ROUND(result);
                      temp := 1;
                      FOR i := 2 TO limit DO
                          temp := temp*i;
                      result := temp
                   END;
                NotOp :
                   IF result = 0 THEN
                      result := 1
                   ELSE
                      result := 0
             END { CASE }
          END { IF do_it }
       END; { ELSE; func_code <> pi }
   END; { DO_SINGLE }

(***********************************************)
(* Functions with 2 arguments                  *)
(* <funct> ::= funcname(<fullexpr>,<fullexpr>) *)
(***********************************************)

PROCEDURE DO_DOUBLE;
   VAR rmag2                    : INTEGER;
       temp,arg1,arg2,mag1,mag2 : REAL;
   BEGIN
       full_expr(str,do_it,arg1);
       IF str_pos < len THEN
          IF str[str_pos] <> ',' THEN
             stat := SyntaxErr
          ELSE BEGIN
             str_pos := str_pos+1;
             full_expr(str,do_it,arg2);
             IF do_it THEN BEGIN
                mag1 := ABS(arg1);
                mag2 := ABS(arg2);
                CASE func_code OF
                   DivOp : { integer division }
                      IF arg2 = 0 THEN
                         stat := DivBy0
                      ELSE IF (mag1 > Long_Maxint) OR (mag2 > Long_Maxint) THEN
                         stat := Overflow
                      ELSE
                         result := LONG_TRUNC(arg1) DIV LONG_TRUNC(arg2);
                   ModOp : { REAL modulo function }
                      IF arg2 = 0 THEN
                         stat := DivBy0
                      ELSE IF mag1/mag2 > Long_Maxint THEN
                         stat := Overflow
                      ELSE
                         result := arg1-LONG_TRUNC(arg1/arg2)*arg2;
                   RoundOp,TruncOp :
                      IF mag2 > 10 THEN
                         stat := Overflow
                      ELSE BEGIN
                         rmag2 := ROUND(mag2);
                         IF arg2 > 0 THEN
                            temp := arg1*PwrOfTen(rmag2)
                         ELSE
                            temp := arg1/PwrOfTen(rmag2);
                         IF ABS(temp) > Long_Maxint THEN
                            stat := Overflow
                         ELSE IF arg2 > 0 THEN
                            IF func_code = RoundOp THEN
                               result := LONG_ROUND(temp)/PwrOfTen(rmag2)
                            ELSE
                               result := LONG_TRUNC(temp)/PwrOfTen(rmag2)
                         ELSE IF func_code = RoundOp THEN
                            result := LONG_ROUND(temp)*PwrOfTen(rmag2)
                         ELSE
                            result := LONG_TRUNC(temp)*PwrOfTen(rmag2)
                      END;
                      RandOp : BEGIN
                        result := ABS(Random_Number/16777215.0);
                        IF ABS(result*(arg2-arg1+1)) > Long_Maxint THEN
                           stat := Overflow
                        ELSE
                           result := arg1+result*(arg2-arg1);
                      END
                END { CASE }
             END { IF do_it }
          END { ELSE }
       ELSE
          stat := SyntaxErr;
       IF stat <> OK THEN
          do_error(str)
   END; { DO_DOUBLE }

PROCEDURE DO_MULTIPLE;
   VAR count,i : INTEGER;
       quit    : BOOLEAN;
       args    : ARRAY [1..20] OF REAL;
   BEGIN
       quit := FALSE;
       count := 1;
       full_expr(str,do_it,args[count]);
       IF str_pos < len THEN
          IF str[str_pos] <> ',' THEN
             stat := SyntaxErr
          ELSE BEGIN
             WHILE (str_pos < len) AND (NOT quit) AND (stat = OK) DO
                IF str[str_pos] = ',' THEN BEGIN
                   str_pos := str_pos+1;
                   count := count+1;
                   full_expr(str,do_it,args[count])
                END
                ELSE IF str_pos > len THEN
                   stat := SyntaxErr
                ELSE
                   quit := TRUE;
             IF (stat = OK) AND (do_it) THEN
                IF func_code = AndOp THEN BEGIN
                   result := 1;
                   FOR i := 1 TO count DO
                       IF args[i] = 0 THEN
                          result := 0
                       ELSE
                END
                ELSE IF func_code = OrOp THEN BEGIN
                   result := 0;
                   FOR i := 1 TO count DO
                       IF args[i] <> 0 THEN
                          result := 1
                       ELSE
                END
          END
       ELSE
          stat := SyntaxErr;
       IF stat <> OK THEN
          do_error(str)
   END; { DO_MULTIPLE }

(*************************************************************)
(* Aggregate/Statistical Functions; main routine is DO_STATS *)
(*************************************************************)

PROCEDURE DO_MAX_MIN ( s_r,s_c,e_r,e_c : INTEGER;
                       VAR str         : LorFstr;
                       VAR result      : REAL;
                       func_code       : AllFunctions );
   VAR i,j        : INTEGER;
       found,quit : BOOLEAN;
       a          : AssignedStatus;
       ptr,dummy  : CellPtr;
   BEGIN
       found := FALSE;
       i := s_r;
       { first get a value within the range }
       WHILE (i <= e_r) AND (NOT found) DO BEGIN
          ptr := data[i];
          WHILE (ptr <> NIL) AND (NOT found) DO BEGIN
             IF (ptr^.c >= s_c) AND (ptr^.c <= e_c) THEN BEGIN
                a := assigned(i,ptr^.c,dummy);
                IF a = Value THEN BEGIN
                   result := ptr^.num;
                   found := TRUE
                END
             END;
             ptr := ptr^.next
          END;
          i := i+1;
       END;
       IF NOT found THEN { no value in range }
          stat := GenError
       ELSE
          FOR i := s_r TO e_r DO BEGIN
              quit := FALSE;
              ptr := data[i];
              WHILE (ptr <> NIL) AND (NOT (quit)) DO BEGIN
                 IF (ptr^.c >= s_c) AND (ptr^.c <= e_c) THEN BEGIN
                    a := assigned(i,ptr^.c,dummy);
                    IF a = Value THEN
                       IF func_code = MaxOp THEN
                          IF ptr^.num > result THEN
                             result := ptr^.num
                          ELSE
                       ELSE { MinOp }
                          IF ptr^.num < result THEN
                             result := ptr^.num
                 END
                 ELSE IF ptr^.c > e_c THEN
                    quit := TRUE;
                 ptr := ptr^.next
              END
          END;
       IF stat <> OK THEN
          do_error(str)
   END; { DO_MAX_MIN }

PROCEDURE DO_SUM_AND_MULT ( s_r,s_c,e_r,e_c : INTEGER;
                            VAR str         : LorFstr;
                            VAR result      : REAL;
                            VAR count       : INTEGER;
                            action          : SumSqrProd );
   { returns the _____ of cells with AssignedStatus = Value within a range:
         1. SUM (Sum) , 2. SUM of SQUARES (SumSquares), 3. PRODUCT (Product). }
   VAR i         : INTEGER;
       quit      : BOOLEAN;
       a         : AssignedStatus;
       ptr,dummy : CellPtr;
   BEGIN
       IF action = Product THEN
          result := 1
       ELSE
          result := 0;
       count := 0;
       i := s_r;
       WHILE (i <= e_r) AND (stat = OK) DO BEGIN
          quit := FALSE;
          ptr := data[i];
          WHILE (ptr <> NIL) AND (NOT quit) DO BEGIN
             IF (ptr^.c >= s_c) AND (ptr^.c <= e_c) THEN BEGIN
                a := assigned(i,ptr^.c,dummy);
                IF a = Value THEN BEGIN
                   count := count+1;
                   IF action = Product THEN
                      result := result*ptr^.num
                   ELSE IF action = Sum THEN
                      result := result+ptr^.num
                   ELSE IF check_square(ptr^.num) THEN
                      result := result+SQR(ptr^.num)
                   ELSE
                      stat := Overflow
                END
                ELSE IF a = Error THEN
                   stat := ptr^.status
             END
             ELSE IF ptr^.c > e_c THEN
                quit := TRUE;
             ptr := ptr^.next
          END;
          i := i+1
       END;
       IF stat <> OK THEN
          do_error(str)
   END; { DO_SUM_AND_MULT }

PROCEDURE DO_REGRESSION ( ys_r,ys_c,ye_r,ye_c : INTEGER;
                          VAR str             : LorFstr;
                          do_it               : BOOLEAN;
                          VAR result          : REAL;
                          func_code           : AllFunctions );
   { Note: the arrays needn't be adjacent, oriented in the same direction, or
           even linear in shape; however, they must both contain the same
           number of Value = AssignedStatus, and its the users duty to ensure
           that the correspondence between items is what he wants. Sums are
           done in ROW-MAJOR order, so for arrays spanning > 1 column:
               A   B |  C   D
           1   1   5 |  10  14
           2   2   6 |  11  15
           3   3   7 |  12  16
           4   4   8 |  13  17

           A1 relates to C1, B2 relates to D2, etc. if called as
           func(A1:B4,C1:D4). Thus have to use an iterative method to traverse
           range, rather than a simple list traversal, to make the routine
           reasonable }
   VAR i,j,xs_r,xs_c,xe_r,xe_c,y_n,x_n,n    : INTEGER;
       y_sum,y_sumsqr,x_sum,x_sumsqr,xy_sum,
       denom,slope,y_int,predict_arg        : REAL;
       ptr                                  : CellPtr;
   PROCEDURE DO_XYSUM ( VAR xy_sum : REAL );
      { guaranteed to be = # values in y and x arrays; use both y_done & x_done
        even though they both must be out of data at the same time, in order
        to clarify things. So, user can have arrays where there isn't explicit
        1-1 coorespondence between items; matching of items is on a
        column-major basis }
      VAR y_r,y_c,x_r,x_c,y_row,y_col,x_row,x_col : INTEGER;
          y_done,x_done,y_found,x_found           : BOOLEAN;
          ptrx,ptry                               : CellPtr;
      BEGIN
          xy_sum := 0;
          y_done := FALSE;
          x_done := FALSE;
          y_r := ys_r;
          y_c := ys_c;
          x_r := xs_r;
          x_c := xs_c;
          REPEAT
             y_found := FALSE;
             x_found := FALSE;
             { get a y-value }
             WHILE (NOT y_found) AND (NOT y_done) DO BEGIN
                IF assigned(y_r,y_c,ptry) = Value THEN BEGIN
                   y_found := TRUE;
                   y_row := y_r;
                   y_col := y_c;
                END;
                IF y_r = ye_r THEN BEGIN { last row? }
                   y_r := ys_r;          { make it first row }
                   IF y_c = ye_c THEN    { last col? }
                      y_done := TRUE     { we're through }
                   ELSE
                      y_c := y_c+1       { no we're not! }
                END
                ELSE
                   y_r := y_r+1          { down a row }
             END;
             { go for x-value }
             WHILE (NOT x_found) AND (NOT x_done) DO BEGIN
                IF assigned(x_r,x_c,ptrx) = Value THEN BEGIN
                   x_found := TRUE;
                   x_row := x_r;
                   x_col := x_c;
                END;
                IF x_r = xe_r THEN BEGIN
                   x_r := xs_r;
                   IF x_c = xe_c THEN
                      x_done := TRUE
                   ELSE
                      x_c := x_c+1
                END
                ELSE
                   x_r := x_r+1
             END;
             IF (y_found) AND (x_found) THEN
                xy_sum := xy_sum+ptry^.num*ptrx^.num
          UNTIL (y_done) AND (x_done)
      END; { DO_XYSUM }
   BEGIN { DO_REGRESSION }
       IF str_pos < len THEN
          IF str[str_pos] <> ',' THEN
             stat := SyntaxErr
          ELSE BEGIN
             str_pos := str_pos+1;
             get_range(str,do_it,xs_r,xs_c,xe_r,xe_c);
             IF func_code = PredVOp THEN
                IF str_pos < len THEN
                   IF str[str_pos] <> ',' THEN
                      stat := SyntaxErr
                   ELSE BEGIN
                      str_pos := str_pos+1;
                      full_expr(str,do_it,predict_arg);
                   END
                ELSE
                   stat := SyntaxErr;
             IF stat = OK THEN BEGIN
                do_sum_and_mult(ys_r,ys_c,ye_r,ye_c,str,y_sum,y_n,Sum);
                do_sum_and_mult(xs_r,xs_c,xe_r,xe_c,str,x_sum,x_n,Sum);
                IF NOT check_square(x_sum) THEN
                   stat := Overflow
                ELSE IF (y_n <> x_n) OR (y_n < 2) THEN
                   stat := Undefined
                ELSE BEGIN
                   n := y_n;
                   do_sum_and_mult(ys_r,ys_c,ye_r,ye_c,str,
                                   y_sumsqr,n,SumSquares);
                   do_sum_and_mult(xs_r,xs_c,xe_r,xe_c,str,
                                   x_sumsqr,n,SumSquares);
                   do_xysum(xy_sum);
                   IF (func_code = LinROp) OR
                      (func_code = PredVOp) THEN BEGIN
                      denom := n*x_sumsqr-SQR(x_sum);
                      IF denom = 0 THEN
                         stat := DivBy0
                      ELSE BEGIN
                         slope := (n*xy_sum-x_sum*y_sum)/denom;
                         y_int := (y_sum*x_sumsqr-x_sum*xy_sum)/denom;
                         IF func_code = PredVOp THEN
                            result := slope*predict_arg+y_int { y = mx+b }
                         ELSE BEGIN
                            result := slope;
                            IF col < n_cols THEN BEGIN
                               delete_cell(row,col+1,FALSE);
                               ptr := new_cell(row,col+1);
                               ptr^.num := y_int;
                               ptr^.status := Full;
                               cell_on_screen(1,row,col+1,TRUE)
                            END
                         END
                      END
                   END
                   ELSE IF NOT check_square(y_sum) THEN
                      stat := Overflow
                   ELSE BEGIN { CorrOp }
                      denom := (x_sumsqr-n*SQR(x_sum/n)) *
                               (y_sumsqr-n*SQR(y_sum/n));
                      IF denom = 0 THEN
                         stat := DivBy0
                      ELSE IF denom < 0 THEN
                         stat := Undefined
                      ELSE BEGIN
                         denom := SQRT(denom);
                         result := (xy_sum-n*x_sum/n*y_sum/n)/denom
                      END
                   END
                END
             END
          END
       ELSE
          stat := SyntaxErr;
       IF stat <> OK THEN
          do_error(str)
   END; { DO_REGRESSION }

PROCEDURE DO_STATS ( s_r,s_c,e_r,e_c : INTEGER;
                     VAR str         : LorFstr;
                     do_it           : BOOLEAN;
                     VAR result      : REAL;
                     func_code       : AllFunctions );
   VAR i,j,count : INTEGER;
       result_1  : REAL;
   BEGIN
       CASE func_code OF
          (**************************************)
          (* Arithmetic aggregate functions     *)
          (* <arith> ::= funcname(<cellrange>)  *)
          (**************************************)
          SumOp,MeanOp : BEGIN
             do_sum_and_mult(s_r,s_c,e_r,e_c,str,result,count,Sum);
             IF func_code = MeanOp THEN
                IF count = 0 THEN
                   stat := DivBy0
                ELSE
                   result := result/count
          END;
          ProdOp : BEGIN
             do_sum_and_mult(s_r,s_c,e_r,e_c,str,result,count,Product);
             IF count = 0 THEN
                result := 0
          END;
          (****************************************)
          (* Sample Statistics ( NOT population ) *)
          (* <stat> ::= funcname(<cellrange>)     *)
          (****************************************)
          VarOp,SdevOp,SerrOp : BEGIN
             do_sum_and_mult(s_r,s_c,e_r,e_c,str,result,count,Sum);
             IF count < 2 THEN
                stat := Undefined
             ELSE IF NOT check_square(result) THEN
                stat := Overflow
             ELSE BEGIN
                do_sum_and_mult(s_r,s_c,e_r,e_c,str,result_1,count,SumSquares);
                IF count*result_1-SQR(result) < 0 THEN
                   stat := Undefined
                ELSE BEGIN
                   result := SQRT(
                                   (count*result_1-SQR(result)) /
                                   (count*(count-1))
                                 );
                   IF func_code = VarOp THEN
                      IF check_square(result) THEN
                         result := SQR(result)
                      ELSE
                         stat := Overflow
                   ELSE IF func_code = SerrOp THEN
                      result := result/SQRT(count)
                END
             END
          END;
          (****************************************************************)
          (* Linear Regression functions                                  *)
          (* <Linreg> & <Corr> ::= funcname(<y-cellrange>,<x-cellrange>)  *)
          (* <Trend> ::= funcname(<y-cellrange>,<x-cellrange>,<fullexpr>) *)
          (****************************************************************)
          LinROp,PredVOp,CorrOp :
             do_regression(s_r,s_c,e_r,e_c,str,do_it,result,func_code);
       END; { CASE }
       IF stat <> OK THEN
          do_error(str)
   END; { DO_STATS }

PROCEDURE DO_AGGREGATE;
   VAR s_r,s_c,e_r,e_c,i,j : INTEGER;
       quit                : BOOLEAN;
       ptr,dummy           : CellPtr;
   BEGIN
       { checks for str_pos > len }
       get_range(str,do_it,s_r,s_c,e_r,e_c);
       { if returns, stat = ok }
       IF do_it THEN
          CASE func_code OF
             CountOp : BEGIN
                result := 0;
                FOR i := s_r TO e_r DO BEGIN
                    quit := FALSE;
                    ptr := data[i];
                    WHILE (ptr <> NIL) AND (NOT quit) DO BEGIN
                       IF (ptr^.c >= s_c) AND (ptr^.c <= e_c) THEN
                          IF assigned(i,ptr^.c,dummy) = Value THEN
                             result := result+1
                          ELSE
                       ELSE IF ptr^.c > e_c THEN
                          quit := TRUE;
                       ptr := ptr^.next
                    END;
                END
             END;
             MaxOp,
             MinOp :
                do_max_min(s_r,s_c,e_r,e_c,str,result,func_code);
             SumOp,
             MeanOp,
             ProdOp,
             VarOp,
             SdevOp,
             SerrOp,
             LinROp,
             CorrOp,
             PredVOp :
                do_stats(s_r,s_c,e_r,e_c,str,do_it,result,func_code)

          END { CASE }
       ELSE IF func_code IN [LinROp..PredVOp] THEN { additional args }
          IF str_pos < len THEN
             IF str[str_pos] <> ',' THEN
                stat := SyntaxErr
             ELSE BEGIN
                str_pos := str_pos+1;
                get_range(str,do_it,s_r,s_c,e_r,e_c);
                IF func_code = PredVOp THEN
                   IF str_pos < len THEN
                      IF str[str_pos] <> ',' THEN
                         stat := SyntaxErr
                      ELSE BEGIN
                         str_pos := str_pos+1;
                         full_expr(str,do_it,result)
                      END
                   ELSE
                      stat := SyntaxErr
             END
          ELSE
             stat := SyntaxErr;
       IF stat <> OK THEN
          do_error(str)
   END; { DO_AGGREGATE }

PROCEDURE DO_FINANCIAL;
   TYPE
        Parms    = RECORD
                      parm    : REAL;
                      present : BOOLEAN
                   END;
        ArgArray = ARRAY [1..6] OF Parms;
   VAR
        i    : INTEGER;
        cont : BOOLEAN;
        arg  : ArgArray;
   FUNCTION POWER ( a,y : REAL ) : REAL;
      { efficiently and more accurately then e^xlny calc an integer power;
        used by the Financial functions PV, FV, PMT, NPER }
      VAR n   : LONG_INTEGER;
          b,c : REAL;
      BEGIN
          IF ABS(y) >= Long_MaxInt THEN
             stat := Overflow
          ELSE BEGIN
             n := ABS(LONG_ROUND(y));
             b := 1;
             c := a;
             WHILE n <> 0 DO BEGIN
                IF n & 1 <> 0 THEN
                   b := b*c;
                IF check_square(c) THEN
                   c := SQR(c)
                ELSE BEGIN
                   stat := Overflow;
                   do_error(str)
                END;
                n := ShR(n,1)
             END;
             IF y >= 0 THEN
                power := b
             ELSE
                power := 1/b
          END;
          IF stat <> OK THEN
             do_error(str)
      END; { POWER }
   PROCEDURE EVAL;
      VAR temp,rate : REAL;
      BEGIN
          rate := 1+arg[1].parm;
          CASE func_code OF
             PvOp : { ( rate , nper , rent , fv , type ) }
                IF (NOT arg[1].present) OR (NOT arg[2].present) THEN
                   stat := SyntaxErr
                ELSE IF arg[1].parm <= 0 THEN
                   stat := Undefined
                ELSE IF arg[3].present THEN { annuity }
                   IF arg[4].present THEN
                      stat := SyntaxErr
                   ELSE BEGIN
                      { ordinary annuity by default }
                      result := arg[3].parm*(1-power(rate,
                                   -arg[2].parm))/arg[1].parm;
                      IF arg[5].present THEN
                         IF arg[5].parm < 1 THEN { annuity due }
                            result := arg[3].parm*((1-power(rate,
                                         1-arg[2].parm))/arg[1].parm+1)
                   END
                ELSE IF arg[4].present THEN { compound interest }
                   IF arg[5].present THEN { type is meaningless }
                      stat := SyntaxErr
                   ELSE
                      result := arg[4].parm/power(rate,arg[2].parm)
                ELSE
                   stat := SyntaxErr;
             { end of PvOp }
             FvOp : { ( rate , nper , rent , fv , type ) }
                IF (NOT arg[1].present) OR (NOT arg[2].present) THEN
                   stat := SyntaxErr
                ELSE IF arg[1].parm <= 0 THEN
                   stat := Undefined
                ELSE IF arg[3].present THEN { annuity }
                   IF arg[4].present THEN
                      stat := SyntaxErr
                   ELSE BEGIN
                      { ordinary annuity by default }
                      result := arg[3].parm*
                                 (power(rate,arg[2].parm)-1)/arg[1].parm;
                      IF arg[5].present THEN
                         IF arg[5].parm < 1 THEN { annuity due }
                            result := arg[3].parm*((power(rate,
                                          arg[2].parm+1)-1)/arg[1].parm-1)
                   END
                ELSE IF arg[4].present THEN { compound interest }
                   IF arg[5].present THEN { type is meaningless }
                      stat := SyntaxErr
                   ELSE
                      result := arg[4].parm*power(rate,arg[2].parm)
                ELSE
                   stat := SyntaxErr;
             { end of FvOp }
             NperOp : BEGIN { ( rate , pmt , pv , fv , type ) }
                IF (NOT arg[1].present) OR
                   ((NOT arg[2].present) AND (arg[5].present)) THEN
                   stat := SyntaxErr
                ELSE IF (arg[1].parm <= 0) OR
                        ((arg[2].present) AND (arg[2].parm = 0)) THEN
                   stat := Undefined
                ELSE IF (arg[3].present) AND (arg[4].present) THEN
                   { nper to get from pv to fv, i.e. compound interest }
                   IF (arg[2].present) OR (arg[5].present) THEN
                      stat := SyntaxErr
                   ELSE IF arg[3].parm = 0 THEN
                      stat := Undefined
                   ELSE IF arg[4].parm/arg[3].parm <= 0 THEN
                      stat := Undefined
                   ELSE
                      result := my_ln(arg[4].parm/arg[3].parm)/my_ln(rate)
                ELSE IF arg[2].present THEN { annuity }
                   IF arg[3].present THEN { present value }
                      IF (NOT arg[5].present) OR { default is ordinary }
                         ((arg[5].present) AND (arg[5].parm > 0)) THEN BEGIN
                         temp := arg[3].parm*arg[1].parm/arg[2].parm;
                         IF temp >= 1 THEN
                            stat := Undefined
                         ELSE
                            result := -my_ln(1-temp)/my_ln(rate)
                      END
                      ELSE BEGIN { annuity due }
                         temp := arg[1].parm*(arg[3].parm/arg[2].parm-1);
                         IF temp >= 1 THEN
                            stat := SyntaxErr
                         ELSE
                            result := 1-my_ln(1-temp)/my_ln(rate)
                      END
                   ELSE IF arg[4].present THEN { future value }
                      { ordinary by default }
                      IF (NOT arg[5].present) OR
                         ((arg[5].present) AND (arg[5].parm > 0)) THEN BEGIN
                         temp := arg[4].parm*arg[1].parm/arg[2].parm;
                         IF temp <= -1 THEN
                            stat := Undefined
                         ELSE
                            result := my_ln(temp+1)/my_ln(rate)
                      END
                      ELSE BEGIN { annuity due }
                         temp := arg[1].parm*(arg[4].parm/arg[2].parm+1);
                         IF temp <= -1 THEN
                            stat := Undefined
                         ELSE
                            result := my_ln(temp+1)/my_ln(rate)-1
                      END
                   ELSE
                      stat := SyntaxErr
                ELSE
                   stat := SyntaxErr;
                IF stat = OK THEN
                   IF ABS(result) <= Long_MaxInt THEN
                      result := LONG_ROUND(result)
             END;{ CASE NperOp }
             PmtOp : { ( rate , nper , pv , fv , type ) }
                IF (NOT arg[1].present) OR (NOT arg[2].present) OR
                   ((arg[3].present) AND (arg[4].present)) THEN
                   stat := SyntaxErr
                ELSE IF arg[1].parm <= 0 THEN
                   stat := Undefined
                ELSE IF arg[3].present THEN
                   { ordinary annuity by default }
                   IF (NOT arg[5].present) OR
                      ((arg[5].present) AND (arg[5].parm > 0)) THEN BEGIN
                      temp := power(rate,-arg[2].parm);
                      IF temp = 1 THEN
                         stat := Undefined
                      ELSE
                         result := arg[3].parm/((1-temp)/arg[1].parm)
                   END
                   ELSE BEGIN { annuity due }
                      temp := power(rate,1-arg[2].parm);
                      IF temp = 1 THEN
                         stat := Undefined
                      ELSE
                         result := arg[3].parm/((1-temp)/arg[1].parm+1)
                   END
                ELSE IF arg[4].present THEN { future value }
                   { ordinary by default }
                   IF (NOT arg[5].present) OR
                      ((arg[5].present) AND (arg[5].parm > 0)) THEN BEGIN
                      temp := power(rate,arg[2].parm);
                      IF temp = 1 THEN
                         stat := Undefined
                      ELSE
                         result := arg[4].parm/((temp-1)/arg[1].parm)
                   END
                   ELSE BEGIN { annuity due }
                      temp := power(rate,arg[2].parm+1);
                      IF temp = 1 THEN
                         stat := Undefined
                      ELSE
                         result := arg[4].parm/((temp-1)/arg[1].parm-1)
                   END
                ELSE
                   stat := SyntaxErr
          END { CASE }
      END; { EVAL }
   BEGIN { DO_FINANCIAL }
       FOR i := 1 TO 5 DO
           arg[i].present := FALSE;
       i := 1;
       cont := TRUE;
       WHILE (cont) AND (i <= 5) DO BEGIN
          IF str_pos > len THEN
             stat := SyntaxErr
          ELSE
             CASE str[str_pos] OF
                ',' : BEGIN
                   str_pos := str_pos+1;
                   IF str_pos <= len THEN
                      IF str[str_pos] = ')' THEN
                         stat := SyntaxErr
                END;
                ')' : cont := FALSE;
                OTHERWISE : BEGIN
                   full_expr(str,do_it,arg[i].parm);
                   arg[i].present := TRUE;
                   IF str_pos < len THEN
                      IF str[str_pos] = ',' THEN
                         str_pos := str_pos+1
                      ELSE IF str[str_pos] <> ')' THEN
                         stat := SyntaxErr
                END
             END; { CASE }
          IF stat <> OK THEN
             do_error(str);
          i := i+1
       END;
       IF do_it THEN
          eval;
       IF stat <> OK THEN
          do_error(str)
   END; { DO_FINANCIAL }

PROCEDURE DO_LOOKUP;
   VAR index,s_r,s_c,e_r,e_c,i,row,col : INTEGER;
       tag,temp                        : REAL;
       found,equal                     : BOOLEAN;
       a                               : AssignedStatus;
       ptr                             : CellPtr;
   BEGIN
       full_expr(str,do_it,tag);
       IF func_code = IndexOp THEN
          IF (tag < -MaxInt) OR (tag > MaxInt) THEN
             stat := OutOfRange;
       IF (str_pos < len) AND (stat = OK) THEN
          IF str[str_pos] <> ',' THEN
             stat := SyntaxErr
          ELSE BEGIN
             str_pos := str_pos+1;
             full_expr(str,do_it,temp);
             IF (temp < -MaxInt) OR (temp > MaxInt) THEN
                stat := OutOfRange
             ELSE IF str_pos < len THEN
                IF str[str_pos] <> ',' THEN
                   stat := SyntaxErr
                ELSE BEGIN
                   str_pos := str_pos+1;
                   index := ROUND(temp);
                   IF index < 1 THEN
                      stat := OutOfRange
                   ELSE BEGIN
                      get_range(str,do_it,s_r,s_c,e_r,e_c);
                      IF func_code = VLookUpOp THEN
                         IF s_c+index-1 > e_c THEN
                            stat := OutOfRange
                         ELSE
                      ELSE IF func_code = HLookUpOp THEN
                         IF s_r+index-1 > e_r THEN
                            stat := OutOfRange
                         ELSE
                      ELSE BEGIN { IndexOp }
                         row := ROUND(tag);
                         col := index;
                         IF (row < 1) OR (col < 1) OR
                            (row > e_r-s_r+1) OR (col > e_c-s_c+1) THEN
                            stat := OutOfRange
                      END;
                      IF (do_it) AND (stat = OK) THEN
                         IF func_code = VLookUpOp THEN BEGIN
                            found := FALSE;
                            equal := FALSE;
                            i := s_r;
                            WHILE (NOT found) AND (i <= e_r) DO BEGIN
                               a := assigned(i,s_c,ptr);
                               IF a = Value THEN
                                  IF ptr^.num >= tag THEN BEGIN
                                     found := TRUE;
                                     IF ptr^.num = tag THEN
                                        equal := TRUE
                                  END;
                               i := i+1
                            END;
                            IF (equal) OR (NOT found) THEN
                               i := i-1
                            ELSE
                               i := i-2;
                            found := FALSE;
                            WHILE (NOT found) AND (i >= s_r) DO BEGIN
                               a := assigned(i,s_c,ptr);
                               IF a = Value THEN BEGIN
                                  found := TRUE;
                                  a := assigned(i,s_c+index-1,ptr);
                                  IF a = Value THEN
                                     result := ptr^.num
                                  ELSE IF a = Error THEN
                                     stat := ptr^.status
                                  ELSE
                                     result := 0
                               END;
                               i := i-1
                            END;
                            IF NOT found THEN
                               stat := OutOfRange
                         END
                         ELSE IF func_code = HLookUpOp THEN BEGIN
                            found := FALSE;
                            equal := FALSE;
                            i := s_c;
                            WHILE (NOT found) AND (i <= e_c) DO BEGIN
                               a := assigned(s_r,i,ptr);
                               IF a = Value THEN
                                  IF ptr^.num > tag THEN BEGIN
                                     found := TRUE;
                                     IF ptr^.num = tag THEN
                                        equal := TRUE
                                  END;
                               i := i+1
                            END;
                            IF (equal) OR (NOT found) THEN
                               i := i-1
                            ELSE
                               i := i-2;
                            found := FALSE;
                            WHILE (NOT found) AND (i >= s_c) DO BEGIN
                               a := assigned(s_r,i,ptr);
                               IF a = Value THEN BEGIN
                                  found := TRUE;
                                  a := assigned(s_r+index-1,i,ptr);
                                  IF a = Value THEN
                                     result := ptr^.num
                                  ELSE IF a = Error THEN
                                     stat := ptr^.status
                                  ELSE
                                     result := 0
                               END;
                               i := i-1
                            END;
                            IF NOT found THEN
                               stat := OutOfRange
                         END
                         ELSE BEGIN { IndexOp }
                            a := assigned(s_r+row-1,s_c+col-1,ptr);
                            IF a = Value THEN
                               result := ptr^.num
                            ELSE IF a = Error THEN
                               stat := ptr^.status
                            ELSE
                               result := 0
                         END
                   END
                END
             ELSE
                stat := SyntaxErr
          END;
       IF stat <> OK THEN
          do_error(str)
   END; { DO_LOOKUP }

PROCEDURE IF_EXPR;
   { <ifexpr> ::= IF(<fullexpr>,<fullexpr>,<fullexpr>) }
   VAR T_result,F_result : REAL;
   BEGIN
       IF str_pos < len THEN BEGIN
          full_expr(str,do_it,result);
          IF str_pos < len THEN
             IF str[str_pos] <> ',' THEN
                stat := SyntaxErr
             ELSE BEGIN
                str_pos := str_pos+1;
                { first action; must "pseudo-evaluate" if the boolean expr
                  was FALSE in order to get str_pos to the correct pos. }
                full_expr(str,result<>0,T_result);
                IF str_pos < len THEN
                   IF (str[str_pos] <> ',') THEN
                      stat := SyntaxErr
                   ELSE BEGIN { alternate action; ditto as for 1st }
                      str_pos := str_pos+1;
                      full_expr(str,result=0,F_result);
                      IF do_it THEN
                         IF result <> 0 THEN
                            result := T_result
                         ELSE
                            result := F_result
                   END
                ELSE
                   stat := SyntaxErr
             END
          ELSE { can't call this an error }
       END
       ELSE { str_pos did = len }
          stat := SyntaxErr;
       IF stat <> OK THEN
          do_error(str)
   END; { IF_EXPR }


(**************************************************************************)
(* EVALUATE_FORMULA, the parent, begins here. Had to make the other       *)
(*     routines local to this one so that if an error is encountered, can *)
(*     abort to a label in this routine.                                  *)
(**************************************************************************)

{ class of cell passed here should be Expr, but NIL str and recalc flag are
  checked to be certain }

   BEGIN { EVALUATE_FORMULA }
      IF cell^.str <> NIL THEN BEGIN
         cell^.format := cell^.format | pending_mask;
         str_pos := 1;
         stat := OK;
         result := 0;
         WITH cell^ DO BEGIN
            len := LENGTH(str^);
            full_expr(str^,TRUE,result);
1:          cell^.format := (cell^.format | recalc_mask) & not_pending_mask;
            old_num := num;
            old_status := status;
            IF (str_pos <= len) AND (stat = OK) THEN BEGIN
               stat := SyntaxErr;
               IF new_form THEN BEGIN
                  Set_Mouse(M_Arrow);
                  error_message(str^,stat,str_pos,len);
                  Set_Mouse(M_Bee)
               END
            END;               { Catch things like 1 < A1 < 2,   }
                               { as FULL_EXPR only looks for the }
            IF stat = OK THEN  { 1st clause. Can't check there   }
               status := Full  { because some valid expr may be  }
            ELSE               { left, following the boolean...  }
               status := stat;
                               { NOTE: all cells dependent on this  }
            num := result;     { will assume its status if an error }
            IF format & perc_mask <> 0 THEN
               num := num/100;
            IF (auto_recalc) AND
               ((old_num <> num) OR (old_status <> status)) THEN BEGIN
               dep := sub;
               WHILE dep <> NIL DO BEGIN
                  ptr := locate_cell(dep^.r,dep^.c);
                  IF ptr <> NIL THEN
                     IF (ptr^.class = Expr) AND
                        (ptr^.format & recalc_mask = 0) AND
                        (ptr^.format & pending_mask = 0) THEN
                        evaluate_formula(dep^.r,dep^.c,force,FALSE,ptr);
                  dep := dep^.next
               END;
            END { IF }
         END; { WITH }
         IF (row <> data_row) OR (col <> data_col) THEN
            IF (old_num <> cell^.num) OR (old_status <> cell^.status) THEN
               cell_on_screen(1,row,col,TRUE)
      END
      ELSE { str did = NIL }
         cell^.format := cell^.format | recalc_mask;
2: END; { EVALUATE_FORMULA }


BEGIN
END.