Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/misc/volume33/bwbasic/part02

Text File | 1992-11-03 | 60.0 KB | 2,232 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Ted A. Campbell)
Subject:  v33i038:  bwbasic - Bywater BASIC interpreter version 1.10, Part02/11
Message-ID: <[e-mail]>
X-Md4-Signature: 21de9fc68d3a550e63e545c954aab183
Date: Thu, 5 Nov 1992 03:50:01 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Ted A. Campbell)
Posting-number: Volume 33, Issue 38
Archive-name: bwbasic/part02
Environment: ANSI-C

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then feed it
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# Contents:  bwb_ops.c
# Wrapped by kent@sparky on Wed Nov  4 21:34:22 1992
PATH=/bin:/usr/bin:/usr/ucb:/usr/local/bin:/usr/lbin ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive 2 (of 11)."'
if test -f 'bwb_ops.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'bwb_ops.c'\"
else
  echo shar: Extracting \"'bwb_ops.c'\" \(57586 characters\)
  sed "s/^X//" >'bwb_ops.c' <<'END_OF_FILE'
X/****************************************************************
X
X        bwb_ops.c       Expression Parsing Operations
X                        for Bywater BASIC Interpreter
X
X                        Copyright (c) 1992, Ted A. Campbell
X
X                        Bywater Software
X                        P. O. Box 4023
X                        Duke Station
X                        Durham, NC  27706
X
X                        email: [e-mail]
X
X        Copyright and Permissions Information:
X
X        All U.S. and international copyrights are claimed by the
X        author. The author grants permission to use this code
X        and software based on it under the following conditions:
X        (a) in general, the code and software based upon it may be
X        used by individuals and by non-profit organizations; (b) it
X        may also be utilized by governmental agencies in any country,
X        with the exception of military agencies; (c) the code and/or
X        software based upon it may not be sold for a profit without
X        an explicit and specific permission from the author, except
X        that a minimal fee may be charged for media on which it is
X        copied, and for copying and handling; (d) the code must be
X        distributed in the form in which it has been released by the
X        author; and (e) the code and software based upon it may not
X        be used for illegal activities.
X
X****************************************************************/
X
X#include <stdio.h>
X#include <stdlib.h>
X#include <string.h>
X#include <ctype.h>
X#include <math.h>
X
X#include "bwbasic.h"
X#include "bwb_mes.h"
X
X/* declarations for functions visible in this file only */
X
Xstatic int op_oplevel( int level );
Xstatic int op_add( int level, int precision );
Xstatic int op_subtract( int level, int precision );
Xstatic int op_multiply( int level, int precision );
Xstatic int op_divide( int level, int precision );
Xstatic int op_assign( int level, int precision );
Xstatic int op_equals( int level, int precision );
Xstatic int op_lessthan( int level, int precision );
Xstatic int op_greaterthan( int level, int precision );
Xstatic int op_lteq( int level, int precision );
Xstatic int op_gteq( int level, int precision );
Xstatic int op_notequal( int level, int precision );
Xstatic int op_modulus( int level, int precision );
Xstatic int op_exponent( int level, int precision );
Xstatic int op_intdiv( int level, int precision );
Xstatic int op_or( int level, int precision );
Xstatic int op_and( int level, int precision );
Xstatic int op_not( int level, int precision );
Xstatic int op_xor( int level, int precision );
Xstatic int op_islevelstr( int level );
Xstatic int op_getprecision( int level );
Xstatic int op_isoperator( int operation );
Xstatic int op_pulldown( int how_far );
X
Xstatic int op_level;
X
X/***************************************************************
X
X        FUNCTION:   exp_operation()
X
X        DESCRIPTION:  This function performs whatever operations
X        are necessary at the end of function bwb_exp.
X
X***************************************************************/
X
Xint
Xexp_operation( int entry_level )
X   {
X   register int precedence;
X   int operator;
X
X   #if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in exp_operation(): entered function." );
X   bwb_debug( bwb_ebuf );
X   #endif
X
X   /* cycle through all levels of precedence and perform required
X      operations */
X
X   for ( precedence = 0; precedence <= MAX_PRECEDENCE; ++precedence )
X      {
X
X      /* Operation loop: cycle through every level above entry level
X         and perform required operations as needed */
X
X      op_level = entry_level + 1;
X      while( ( op_level < exp_esc )
X         && ( op_isoperator( exp_es[ op_level ].operation ) == FALSE ))
X         {
X         ++op_level;
X         }
X
X      while ( ( op_level > entry_level ) && ( op_level < exp_esc ) )
X         {
X
X         /* see if the operation at this level is an operator with the
X            appropriate precedence level by running through the table
X            of operators */
X
X         for ( operator = 0; operator < N_OPERATORS; ++operator )
X            {
X
X            if ( exp_ops[ operator ].operation == exp_es[ op_level ].operation )
X               {
X
X               /* check for appropriate level of precedence */
X
X               if ( exp_ops[ operator ].precedence == precedence )
X                  {
X
X                  #if INTENSIVE_DEBUG
X                  sprintf( bwb_ebuf, "in exp_operation(): level <%d> operation <%d>",
X                     op_level, exp_es[ op_level ].operation );
X                  bwb_debug( bwb_ebuf );
X                  #endif
X
X                  op_oplevel( op_level );     /* perform the operation */
X
X                  }
X               }
X            }
X
X         /* advance level if appropriate; one must check, however, since
X            the op_oplevel() function may have decremented exp_esc */
X
X         if ( op_level < exp_esc )
X            {
X            ++op_level;
X
X            #if INTENSIVE_DEBUG
X            sprintf( bwb_ebuf, "in exp_operation() first increment op_level to <%d>",
X               op_level );
X            bwb_debug( bwb_ebuf );
X            #endif
X
X            while ( ( op_isoperator( exp_es [ op_level ].operation ) == FALSE )
X               && ( op_level < exp_esc ) )
X               {
X               ++op_level;
X
X               #if INTENSIVE_DEBUG
X               sprintf( bwb_ebuf, "in exp_operation() further increment op_level to <%d>",
X                  op_level );
X               bwb_debug( bwb_ebuf );
X               #endif
X
X               }
X            }                           /* end of increment of op_level */
X
X         }                              /* end of for loop for stack levels */
X
X      }                                 /* end of for loop for precedence levels */
X
X   return TRUE;
X
X   }                                    /* end of function exp_operation() */
X
X
X/***************************************************************
X
X        FUNCTION:   op_oplevel()
X
X        DESCRIPTION:  This function performs a specific operation
X        at a specific level.
X
X***************************************************************/
X
Xint
Xop_oplevel( int level )
X   {
X   int precision;
X
X   /* set the precision */
X
X   if ( ( precision = op_getprecision( level ) ) == OP_ERROR )
X      {
X      #if PROG_ERRORS
X      sprintf( bwb_ebuf, "exp_operation(): failed to set precision." );
X      bwb_error( bwb_ebuf );
X      #else
X      bwb_error( err_mismatch );            /*** ??? ***/
X      #endif
X      op_pulldown( 2 );
X      }
X
X   /* precision is set correctly */
X
X   else
X      {
X      #if INTENSIVE_DEBUG
X      sprintf( bwb_ebuf, "in op_oplevel(): level <%d>, precision <%c>",
X         level, precision );
X      bwb_debug( bwb_ebuf );
X      #endif
X
X      switch ( exp_es[ level ].operation )
X         {
X         case OP_ADD:
X            op_add( level, precision );
X            break;
X
X         case OP_SUBTRACT:
X            op_subtract( level, precision );
X            break;
X
X         case OP_MULTIPLY:
X            op_multiply( level, precision );
X            break;
X
X         case OP_DIVIDE:
X            op_divide( level, precision );
X            break;
X
X         case OP_ASSIGN:
X            op_assign( level, precision );
X            break;
X
X         case OP_EQUALS:
X            op_equals( level, precision );
X            break;
X
X         case OP_LESSTHAN:
X            op_lessthan( level, precision );
X            break;
X
X         case OP_GREATERTHAN:
X            op_greaterthan( level, precision );
X            break;
X
X         case OP_LTEQ:
X            op_lteq( level, precision );
X            break;
X
X         case OP_GTEQ:
X            op_gteq( level, precision );
X            break;
X
X         case OP_NOTEQUAL:
X            op_notequal( level, precision );
X            break;
X
X         case OP_MODULUS:
X            op_modulus( level, precision );
X            break;
X
X         case OP_INTDIVISION:
X            op_intdiv( level, precision );
X            break;
X
X         case OP_OR:
X            op_or( level, precision );
X            break;
X
X         case OP_AND:
X            op_and( level, precision );
X            break;
X
X         case OP_NOT:
X            op_not( level, precision );
X            break;
X
X         case OP_XOR:
X            op_xor( level, precision );
X            break;
X
X         case OP_EXPONENT:
X            op_exponent( level, precision );
X            break;
X
X         default:
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "PROGRAMMING ERROR: operator <%d> not (yet) supported." );
X            op_pulldown( 2 );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_syntax );
X            #endif
X            break;
X         }                              /* end of case statement for operators */
X      }                                 /* end of else statement, precision set */
X
X   return TRUE;
X
X   }                                    /* end of function op_oplevel() */
X
X/***************************************************************
X
X        FUNCTION:   op_isoperator()
X
X        DESCRIPTION:  This function detects whether its argument
X        is an operator.
X
X***************************************************************/
X
Xint
Xop_isoperator( int operation )
X   {
X   register int c;
X
X   for( c = 0; c < N_OPERATORS; ++c )
X      {
X      if ( operation == exp_ops[ c ].operation )
X         {
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_isoperator(): found match <%s>",
X            exp_ops[ c ].symbol );
X         bwb_debug( bwb_ebuf );
X         #endif
X
X         return TRUE;
X         }
X      }
X
X   /* test failed; return FALSE */
X
X   #if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in op_isoperator(): no match found for operation <%d>",
X      operation );
X   bwb_debug( bwb_ebuf );
X   #endif
X
X   return FALSE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_add()
X
X        DESCRIPTION:  This function adds two numbers or
X        concatenates two strings.
X
X***************************************************************/
X
Xint
Xop_add( int level, int precision )
X   {
X   int error_condition;
X
X   error_condition = FALSE;
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be strings for
X            string addition; if not, report an error */
X
X         if (  ( op_islevelstr( level - 1 ) != TRUE )
X            || ( op_islevelstr( level + 1 ) != TRUE ) )
X            {
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "in op_add(): Type mismatch in string addition." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_mismatch );
X            #endif
X            error_condition = TRUE;
X            }
X
X         /* concatenate the two strings */
X
X         if ( error_condition == FALSE )
X            {
X
X            #if INTENSIVE_DEBUG
X            sprintf( bwb_ebuf, "in op_add(): try exp_getsval(), level <%d> op <%d> type <%c>:",
X               level - 1, exp_es[ level - 1 ].operation, exp_es[ level - 1 ].type );
X            bwb_debug( bwb_ebuf );
X            exp_getsval( &( exp_es[ level - 1 ] ));
X            sprintf( bwb_ebuf, "in op_add(): try exp_getsval(), level <%d> op <%d> type <%c>:",
X               level + 1, exp_es[ level + 1 ].operation, exp_es[ level + 1 ].type );
X            bwb_debug( bwb_ebuf );
X            exp_getsval( &( exp_es[ level + 1 ] ));
X            sprintf( bwb_ebuf, "in op_add(): string addition, exp_getsval()s completed" );
X            bwb_debug( bwb_ebuf );
X            #endif
X
X            str_cat( exp_getsval( &( exp_es[ level - 1 ] ) ),
X               exp_getsval( &( exp_es[ level + 1 ] ) ) );
X            }
X         exp_es[ level - 1 ].operation = CONST_STRING;
X
X         break;
X
X      case DOUBLE:
X         exp_es[ level - 1 ].dval
X            = exp_getdval( &( exp_es[ level - 1 ] ))
X            + exp_getdval( &( exp_es[ level + 1 ] ));
X         exp_es[ level - 1 ].operation = NUMBER;
X         break;
X
X      case SINGLE:
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_add(): single, (level <%d>) <%f> + <%f> (level <%d>",
X            level - 1, exp_getfval( &( exp_es[ level - 1 ] )),
X            exp_getfval( &( exp_es[ level + 1 ] )), level + 1 );
X         bwb_debug( bwb_ebuf );
X         #endif
X
X         exp_es[ level - 1 ].fval
X            = exp_getfval( &( exp_es[ level - 1 ] ))
X            + exp_getfval( &( exp_es[ level + 1 ] ));
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_add(): single, = <%f>",
X            exp_es[ level - 1 ].fval );
X         bwb_debug( bwb_ebuf );
X         #endif
X
X         exp_es[ level - 1 ].operation = NUMBER;
X         break;
X
X      case INTEGER:
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_add(): Integer precision." );
X         bwb_debug ( bwb_ebuf );
X         sprintf( bwb_ebuf, "in op_add(): precisions: lhs <%d> rhs <%d>.",
X            exp_es[ level - 1 ].type,
X            exp_es[ level + 1 ].type );
X         bwb_debug ( bwb_ebuf );
X         #endif
X
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            + exp_getival( &( exp_es[ level + 1 ] ));
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_add(): integer addition, result is <%d>",
X            exp_es[ level - 1 ].ival );
X         bwb_debug( bwb_ebuf );
X         #endif
X
X         exp_es[ level - 1 ].operation = NUMBER;
X         break;
X      }
X
X   /* set variable to requested precision */
X
X   exp_es[ level - 1 ].type = (char) precision;
X
X   #if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in op_add() returns with operation <%d> type <%c>",
X      exp_es[ level - 1 ].operation, exp_es[ level - 1 ].type );
X   bwb_debug( bwb_ebuf );
X   #endif
X
X   /* decrement the stack twice */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_subtract()
X
X        DESCRIPTION:  This function subtracts the number on
X        the left from the number on the right.
X
X
X***************************************************************/
X
Xint
Xop_subtract( int level, int precision )
X   {
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be numbers for
X            string addition; if not, report an error */
X
X         #if PROG_ERRORS
X         sprintf( bwb_ebuf, "Strings cannot be subtracted." );
X         bwb_error( bwb_ebuf );
X         #else
X         bwb_error( err_mismatch );
X         #endif
X
X         break;
X
X      case DOUBLE:
X         exp_es[ level - 1 ].dval
X            = exp_getdval( &( exp_es[ level - 1 ] ))
X            - exp_getdval( &( exp_es[ level + 1 ] ));
X         break;
X
X      case SINGLE:
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_subtract(): Single precision." );
X         bwb_debug ( bwb_ebuf );
X         sprintf( bwb_ebuf, "in op_subtract(): precisions: lhs <%d> rhs <%d>.",
X            exp_es[ level - 1 ].type,
X            exp_es[ level + 1 ].type );
X         bwb_debug ( bwb_ebuf );
X         sprintf( bwb_ebuf, "in op_subtract(): values: lhs <%f> rhs <%f>.",
X            exp_getfval( &( exp_es[ level - 1 ] )),
X            exp_getfval( &( exp_es[ level + 1 ] )) );
X         bwb_debug ( bwb_ebuf );
X         #endif
X
X         exp_es[ level - 1 ].fval
X            = exp_getfval( &( exp_es[ level - 1 ] ))
X            - exp_getfval( &( exp_es[ level + 1 ] ));
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_subtract(): SINGLE subtraction, result is <%f>",
X            exp_es[ level - 1 ].fval );
X         bwb_debug( bwb_ebuf );
X         #endif
X
X         break;
X
X      case INTEGER:
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_subtract(): Integer precision." );
X         bwb_debug ( bwb_ebuf );
X         sprintf( bwb_ebuf, "in op_subtract(): precisions: lhs <%d> rhs <%d>.",
X            exp_es[ level - 1 ].type,
X            exp_es[ level + 1 ].type );
X         bwb_debug ( bwb_ebuf );
X         #endif
X
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            - exp_getival( &( exp_es[ level + 1 ] ));
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_subtract(): integer subtraction, result is <%d>",
X            exp_es[ level - 1 ].ival );
X         bwb_debug( bwb_ebuf );
X         #endif
X
X         break;
X      }
X
X   /* set variable to requested precision */
X
X   exp_es[ level - 1 ].type = (char) precision;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack twice */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_multiply()
X
X        DESCRIPTION:  This function multiplies the number on
X        the left from the number on the right.
X
X***************************************************************/
X
Xint
Xop_multiply( int level, int precision )
X   {
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be numbers for
X            string addition; if not, report an error */
X
X         #if PROG_ERRORS
X         sprintf( bwb_ebuf, "Strings cannot be multiplied." );
X         bwb_error( bwb_ebuf );
X         #else
X         bwb_error( err_mismatch );
X         #endif
X
X         break;
X
X      case DOUBLE:
X         exp_es[ level - 1 ].dval
X            = exp_getdval( &( exp_es[ level - 1 ] ))
X            * exp_getdval( &( exp_es[ level + 1 ] ));
X         break;
X
X      case SINGLE:
X         exp_es[ level - 1 ].fval
X            = exp_getfval( &( exp_es[ level - 1 ] ))
X            * exp_getfval( &( exp_es[ level + 1 ] ));
X         break;
X
X      case INTEGER:
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            * exp_getival( &( exp_es[ level + 1 ] ));
X         break;
X      }
X
X   /* set variable to requested precision */
X
X   exp_es[ level - 1 ].type = (char) precision;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack twice */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_divide()
X
X        DESCRIPTION:  This function divides the number on
X        the left by the number on the right.
X
X***************************************************************/
X
Xint
Xop_divide( int level, int precision )
X   {
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be numbers for
X            string addition; if not, report an error */
X
X         #if PROG_ERRORS
X         sprintf( bwb_ebuf, "Strings cannot be divided." );
X         bwb_error( bwb_ebuf );
X         #else
X         bwb_error( err_mismatch );
X         #endif
X
X         break;
X
X      case DOUBLE:
X         if ( exp_getdval( &( exp_es[ level + 1 ] ))
X            == 0.0 )
X            {
X            exp_es[ level - 1 ].dval = -1.0;
X            op_pulldown( 2 );
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "Divide by 0." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_dbz );
X            #endif
X            return FALSE;
X            }
X         exp_es[ level - 1 ].dval
X            = exp_getdval( &( exp_es[ level - 1 ] ))
X            / exp_getdval( &( exp_es[ level + 1 ] ));
X         break;
X
X      case SINGLE:
X         if ( exp_getfval( &( exp_es[ level + 1 ] ))
X            == (float) 0.0 )
X            {
X            exp_es[ level - 1 ].fval = (float) -1.0;
X            op_pulldown( 2 );
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "Divide by 0." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_dbz );
X            #endif
X            return FALSE;
X            }
X         exp_es[ level - 1 ].fval
X            = exp_getfval( &( exp_es[ level - 1 ] ))
X            / exp_getfval( &( exp_es[ level + 1 ] ));
X         break;
X
X      case INTEGER:
X         if ( exp_getival( &( exp_es[ level + 1 ] ))
X            == 0 )
X            {
X            exp_es[ level - 1 ].ival = -1;
X            op_pulldown( 2 );
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "Divide by 0." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_dbz );
X            #endif
X            return FALSE;
X            }
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            / exp_getival( &( exp_es[ level + 1 ] ));
X         break;
X      }
X
X   /* set variable to requested precision */
X
X   exp_es[ level - 1 ].type = (char) precision;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack twice */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_assign()
X
X        DESCRIPTION:  This function assigns the value in the
X        right hand side to the variable in the left hand side.
X
X***************************************************************/
X
Xint
Xop_assign( int level, int precision )
X   {
X   bstring *s, *d;
X
X   /* Make sure the position one level below is a variable */
X
X   if ( exp_es[ level - 1 ].operation != VARIABLE )
X      {
X      op_pulldown( 2 );
X      #if PROG_ERRORS
X      sprintf( bwb_ebuf, "in op_assign(): Assignment must be to variable: level -1 <%d> op <%d>",
X         level - 1, exp_es[ level - 1 ].operation );
X      bwb_error( bwb_ebuf );
X      #else
X      bwb_error( err_syntax );
X      #endif
X      return FALSE;
X      }
X
X   #if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in op_assign(): entered function level <%d>",
X      level );
X   bwb_debug( bwb_ebuf );
X   #endif
X
X  /* if the assignment is numerical, then the precision should be set
X     to that of the variable on the left-hand side of the assignment */
X
X   if ( precision != STRING )
X      {
X      precision = (int) exp_es[ level - 1 ].type;
X      }
X
X   switch( precision )
X      {
X      case STRING:
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_assign(): try exp_getsval(), level <%d> op <%d> type <%c>:",
X            level - 1, exp_es[ level - 1 ].operation, exp_es[ level - 1 ].type );
X         bwb_debug( bwb_ebuf );
X         exp_getsval( &( exp_es[ level - 1 ] ));
X         sprintf( bwb_ebuf, "in op_assign(): try exp_getsval(), level <%d> op <%d> type <%c>:",
X            level + 1, exp_es[ level + 1 ].operation, exp_es[ level + 1 ].type );
X         bwb_debug( bwb_ebuf );
X         exp_getsval( &( exp_es[ level + 1 ] ));
X         sprintf( bwb_ebuf, "in op_assign(): string addition, exp_getsval()s completed" );
X         bwb_debug( bwb_ebuf );
X         #endif
X
X         str_btob( exp_getsval( &( exp_es[ level - 1 ] )),
X                   exp_getsval( &( exp_es[ level + 1 ] )) );
X         break;
X
X      case DOUBLE:
X         * var_finddval( exp_es[ level - 1 ].xvar,
X            exp_es[ level - 1 ].xvar->array_pos )  =
X            exp_es[ level - 1 ].dval =
X            exp_getdval( &( exp_es[ level + 1 ] ) );
X         break;
X
X      case SINGLE:
X         * var_findfval( exp_es[ level - 1 ].xvar,
X            exp_es[ level - 1 ].xvar->array_pos )  =
X            exp_es[ level - 1 ].fval =
X            exp_getfval( &( exp_es[ level + 1 ] ) );
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_assign(): SINGLE assignment var <%s> val <%f>",
X            exp_es[ level - 1 ].xvar->name, exp_getfval( &( exp_es[ level - 1 ] )) );
X         bwb_debug( bwb_ebuf );
X         #endif
X         break;
X
X      case INTEGER:
X         * var_findival( exp_es[ level - 1 ].xvar,
X            exp_es[ level - 1 ].xvar->array_pos )  =
X            exp_es[ level - 1 ].ival =
X            exp_getival( &( exp_es[ level + 1 ] ) );
X         break;
X
X      default:
X         #if PROG_ERRORS
X         sprintf( bwb_ebuf, "in op_assign(): Variable before assignment operator has unidentified type." );
X         bwb_error( bwb_ebuf );
X         #else
X         bwb_error( err_mismatch );
X         #endif
X         return FALSE;
X
X      }
X
X   /* set variable to requested precision */
X
X   exp_es[ level - 1 ].type = (char) precision;
X
X   /* decrement the stack twice */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_equals()
X
X        DESCRIPTION:  This function compares two values and
X        returns an integer value: TRUE if they are the same
X        and FALSE if they are not.
X
X***************************************************************/
X
Xint
Xop_equals( int level, int precision )
X   {
X   int error_condition;
X   bstring b;
X   bstring *bp;
X
X   error_condition = FALSE;
X   b.rab = FALSE;
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be strings for
X            string addition; if not, report an error */
X
X         if (  ( op_islevelstr( level - 1 ) != TRUE )
X            || ( op_islevelstr( level + 1 ) != TRUE ) )
X            {
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "in op_equals(): Type mismatch in string comparison." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_mismatch );
X            #endif
X            error_condition = TRUE;
X            }
X
X         /* compare the two strings */
X
X         if ( error_condition == FALSE )
X            {
X            bp = exp_getsval( &( exp_es[ level - 1 ] ));
X            b.length = bp->length;
X            b.buffer = bp->buffer;
X            if ( str_cmp( &b,
X               exp_getsval( &( exp_es[ level + 1 ] )) ) == 0 )
X               {
X               exp_es[ level - 1 ].ival = TRUE;
X               }
X            else
X               {
X               exp_es[ level - 1 ].ival = FALSE;
X               }
X            }
X         break;
X
X      case DOUBLE:
X         if ( exp_getdval( &( exp_es[ level - 1 ] ))
X            == exp_getdval( &( exp_es[ level + 1 ] )) )
X            {
X
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X
X      case SINGLE:
X         if ( exp_getfval( &( exp_es[ level - 1 ] ))
X            == exp_getfval( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X
X      case INTEGER:
X         if ( exp_getival( &( exp_es[ level - 1 ] ))
X            == exp_getival( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X      }
X
X   /* set variable to integer and operation to NUMBER:
X      this must be done at the end, since at the beginning it
X      might cause op_islevelstr() to return a false error */
X
X   exp_es[ level - 1 ].type = INTEGER;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_lessthan()
X
X        DESCRIPTION:  This function compares two values and
X        returns an integer value: TRUE if the left hand value
X        is less than the right, and FALSE if it is not.
X
X***************************************************************/
X
Xint
Xop_lessthan( int level, int precision )
X   {
X   int error_condition;
X
X   error_condition = FALSE;
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be numbers for
X            string addition; if not, report an error */
X
X         if (  ( op_islevelstr( level - 1 ) != TRUE )
X            || ( op_islevelstr( level + 1 ) != TRUE ) )
X            {
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "Type mismatch in string comparison." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_mismatch );
X            #endif
X            error_condition = TRUE;
X            }
X
X         /* compare the two strings */
X
X         if ( error_condition == FALSE )
X            {
X            if ( str_cmp( exp_getsval( &( exp_es[ level - 1 ] )),
X               exp_getsval( &( exp_es[ level + 1 ] )) ) < 0 )
X               {
X               exp_es[ level - 1 ].ival = TRUE;
X               }
X            else
X               {
X               exp_es[ level - 1 ].ival = FALSE;
X               }
X            }
X         break;
X
X      case DOUBLE:
X         if ( exp_getdval( &( exp_es[ level - 1 ] ))
X            < exp_getdval( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X
X      case SINGLE:
X         if ( exp_getfval( &( exp_es[ level - 1 ] ))
X            < exp_getfval( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X
X      case INTEGER:
X         if ( exp_getival( &( exp_es[ level - 1 ] ))
X            < exp_getival( &( exp_es[ level + 1 ] )) )
X            {
X
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X      }
X
X   /* set variable to integer and operation to NUMBER:
X      this must be done at the end, since at the beginning it
X      might cause op_islevelstr() to return a false error */
X
X   exp_es[ level - 1 ].type = INTEGER;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_greaterthan()
X
X        DESCRIPTION:  This function compares two values and
X        returns an integer value: TRUE if the left hand value
X        is greater than the right, and FALSE if it is not.
X
X***************************************************************/
X
Xint
Xop_greaterthan( int level, int precision )
X   {
X   int error_condition;
X
X   error_condition = FALSE;
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be numbers for
X            string addition; if not, report an error */
X
X         if (  ( op_islevelstr( level - 1 ) != TRUE )
X            || ( op_islevelstr( level + 1 ) != TRUE ) )
X            {
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "Type mismatch in string comparison." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_mismatch );
X            #endif
X            error_condition = TRUE;
X            }
X
X         /* compare the two strings */
X
X         if ( error_condition == FALSE )
X            {
X            if ( str_cmp( exp_getsval( &( exp_es[ level - 1 ] )),
X               exp_getsval( &( exp_es[ level + 1 ] )) ) > 0 )
X               {
X               exp_es[ level - 1 ].ival = TRUE;
X               }
X            else
X               {
X               exp_es[ level - 1 ].ival = FALSE;
X               }
X            }
X         break;
X
X      case DOUBLE:
X         if ( exp_getdval( &( exp_es[ level - 1 ] ))
X            > exp_getdval( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X
X      case SINGLE:
X         if ( exp_getfval( &( exp_es[ level - 1 ] ))
X            > exp_getfval( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X
X      case INTEGER:
X         if ( exp_getival( &( exp_es[ level - 1 ] ))
X            > exp_getival( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X      }
X
X   /* set variable to integer and operation to NUMBER:
X      this must be done at the end, since at the beginning it
X      might cause op_islevelstr() to return a false error */
X
X   exp_es[ level - 1 ].type = INTEGER;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_lteq()
X
X        DESCRIPTION:  This function compares two values and
X        returns an integer value: TRUE if the left hand value
X        is less than or equal to the right, and FALSE if it is not.
X
X***************************************************************/
X
Xint
Xop_lteq( int level, int precision )
X   {
X   int error_condition;
X
X   error_condition = FALSE;
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be numbers for
X            string addition; if not, report an error */
X
X         if (  ( op_islevelstr( level - 1 ) != TRUE )
X            || ( op_islevelstr( level + 1 ) != TRUE ) )
X            {
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "Type mismatch in string comparison." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_mismatch );
X            #endif
X            error_condition = TRUE;
X            }
X
X         /* compare the two strings */
X
X         if ( error_condition == FALSE )
X            {
X            if ( str_cmp( exp_getsval( &( exp_es[ level - 1 ] )),
X               exp_getsval( &( exp_es[ level + 1 ] )) ) <= 0 )
X               {
X               exp_es[ level - 1 ].ival = TRUE;
X               }
X            else
X               {
X               exp_es[ level - 1 ].ival = FALSE;
X               }
X            }
X         break;
X
X      case DOUBLE:
X         if ( exp_getdval( &( exp_es[ level - 1 ] ))
X            <= exp_getdval( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X
X      case SINGLE:
X
X         if ( exp_getfval( &( exp_es[ level - 1 ] ))
X            <= exp_getfval( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X
X      case INTEGER:
X         if ( exp_getival( &( exp_es[ level - 1 ] ))
X            <= exp_getival( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X      }
X
X   /* set variable to integer and operation to NUMBER:
X      this must be done at the end, since at the beginning it
X      might cause op_islevelstr() to return a false error */
X
X   exp_es[ level - 1 ].type = INTEGER;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_gteq()
X
X        DESCRIPTION:  This function compares two values and
X        returns an integer value: TRUE if the left hand value
X        is greater than or equal to the right, and FALSE if
X        it is not.
X
X***************************************************************/
X
Xint
Xop_gteq( int level, int precision )
X   {
X   int error_condition;
X
X   error_condition = FALSE;
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be numbers for
X            string addition; if not, report an error */
X
X         if (  ( op_islevelstr( level - 1 ) != TRUE )
X            || ( op_islevelstr( level + 1 ) != TRUE ) )
X            {
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "Type mismatch in string comparison." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_mismatch );
X            #endif
X            error_condition = TRUE;
X            }
X
X         /* compare the two strings */
X
X         if ( error_condition == FALSE )
X            {
X            if ( str_cmp( exp_getsval( &( exp_es[ level - 1 ] )),
X               exp_getsval( &( exp_es[ level + 1 ] )) ) >= 0 )
X               {
X               exp_es[ level - 1 ].ival = TRUE;
X               }
X            else
X               {
X               exp_es[ level - 1 ].ival = FALSE;
X               }
X            }
X         break;
X
X      case DOUBLE:
X         if ( exp_getdval( &( exp_es[ level - 1 ] ))
X            >= exp_getdval( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X
X      case SINGLE:
X         if ( exp_getfval( &( exp_es[ level - 1 ] ))
X            >= exp_getfval( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X
X      case INTEGER:
X         if ( exp_getival( &( exp_es[ level - 1 ] ))
X            >= exp_getival( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X      }
X
X   /* set variable to integer and operation to NUMBER:
X      this must be done at the end, since at the beginning it
X      might cause op_islevelstr() to return a false error */
X
X   exp_es[ level - 1 ].type = INTEGER;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_notequal()
X
X        DESCRIPTION:  This function compares two values and
X        returns an integer value: TRUE if they are not the
X        same and FALSE if they are.
X
X***************************************************************/
X
Xint
Xop_notequal( int level, int precision )
X   {
X   int error_condition;
X
X   error_condition = FALSE;
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be numbers for
X            string addition; if not, report an error */
X
X         if (  ( op_islevelstr( level - 1 ) != TRUE )
X            || ( op_islevelstr( level + 1 ) != TRUE ) )
X            {
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "Type mismatch in string comparison." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_mismatch );
X            #endif
X            error_condition = TRUE;
X            }
X
X         /* compare the two strings */
X
X         if ( error_condition == FALSE )
X
X            {
X            if ( str_cmp( exp_getsval( &( exp_es[ level - 1 ] )),
X               exp_getsval( &( exp_es[ level + 1 ] )) ) != 0 )
X               {
X               exp_es[ level - 1 ].ival = TRUE;
X               }
X            else
X               {
X               exp_es[ level - 1 ].ival = FALSE;
X               }
X            }
X         break;
X
X      case DOUBLE:
X         if ( exp_getdval( &( exp_es[ level - 1 ] ))
X            != exp_getdval( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X
X      case SINGLE:
X         if ( exp_getfval( &( exp_es[ level - 1 ] ))
X            != exp_getfval( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X
X      case INTEGER:
X         if ( exp_getival( &( exp_es[ level - 1 ] ))
X            != exp_getival( &( exp_es[ level + 1 ] )) )
X            {
X            exp_es[ level - 1 ].ival = TRUE;
X            }
X         else
X            {
X            exp_es[ level - 1 ].ival = FALSE;
X            }
X         break;
X      }
X
X   /* set variable to integer and operation to NUMBER:
X      this must be done at the end, since at the beginning it
X      might cause op_islevelstr() to return a false error */
X
X   exp_es[ level - 1 ].type = INTEGER;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_modulus()
X
X        DESCRIPTION:  This function divides the number on
X        the left by the number on the right and return the
X        remainder.
X
X***************************************************************/
X
Xint
Xop_modulus( int level, int precision )
X   {
X   static double iportion;
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be numbers for
X            string addition; if not, report an error */
X
X         #if PROG_ERRORS
X         sprintf( bwb_ebuf, "Strings cannot be divided." );
X         bwb_error( bwb_ebuf );
X         #else
X         bwb_error( err_syntax );
X         #endif
X
X         break;
X
X      case DOUBLE:
X         if ( exp_getdval( &( exp_es[ level + 1 ] ))
X            == 0.0 )
X            {
X            exp_es[ level - 1 ].dval = -1.0;
X            op_pulldown( 2 );
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "Divide by 0." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_dbz );
X            #endif
X            return FALSE;
X            }
X         exp_es[ level ].dval
X            = exp_getdval( &( exp_es[ level - 1 ] ))
X            / exp_getdval( &( exp_es[ level + 1 ] ));
X         modf( exp_es[ level ].dval, &iportion );
X         exp_es[ level - 1 ].dval
X            = exp_getdval( &( exp_es[ level - 1 ] ))
X            - ( exp_getdval( &( exp_es[ level + 1 ] ))
X            * iportion );
X         break;
X
X      case SINGLE:
X         if ( exp_getfval( &( exp_es[ level + 1 ] ))
X            == (float) 0.0 )
X            {
X            exp_es[ level - 1 ].fval = (float) -1.0;
X            op_pulldown( 2 );
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "Divide by 0." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_dbz );
X            #endif
X            return FALSE;
X            }
X         exp_es[ level ].fval
X            = exp_getfval( &( exp_es[ level - 1 ] ))
X            / exp_getfval( &( exp_es[ level + 1 ] ));
X         modf( (double) exp_es[ level ].fval, &iportion );
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_modulus(): integer portion is %f",
X            iportion );
X         bwb_debug( bwb_ebuf );
X         #endif
X
X         exp_es[ level - 1 ].fval
X            = exp_getfval( &( exp_es[ level - 1 ] ))
X            - ( exp_getfval( &( exp_es[ level + 1 ] ))
X            * (float) iportion );
X         break;
X
X      case INTEGER:
X         if ( exp_getival( &( exp_es[ level + 1 ] ))
X            == 0 )
X            {
X            exp_es[ level - 1 ].ival = -1;
X            op_pulldown( 2 );
X
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "Divide by 0." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_dbz );
X            #endif
X            return FALSE;
X            }
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            % exp_getival( &( exp_es[ level + 1 ] ));
X         break;
X      }
X
X   /* set variable to requested precision */
X
X   exp_es[ level - 1 ].type = (char) precision;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack twice */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_exponent()
X
X        DESCRIPTION:  This function divides the number on
X        the left by the number on the right and return the
X        remainder.
X
X***************************************************************/
X
Xint
Xop_exponent( int level, int precision )
X   {
X
X   #if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in op_exponent(): entered function level <%d>.",
X      level );
X   bwb_debug ( bwb_ebuf );
X   #endif
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be numbers for
X            string addition; if not, report an error */
X
X         #if PROG_ERRORS
X         sprintf( bwb_ebuf, "Strings cannot be taken as exponents." );
X         bwb_error( bwb_ebuf );
X         #else
X         bwb_error( err_mismatch );
X         #endif
X
X         break;
X
X      case DOUBLE:
X         exp_es[ level - 1 ].dval
X           = pow( exp_getdval( &( exp_es[ level - 1 ] )),
X                  exp_getdval( &( exp_es[ level + 1 ] )) );
X         break;
X
X      case SINGLE:
X         exp_es[ level - 1 ].fval
X           = (float) pow( exp_getdval( &( exp_es[ level - 1 ] )),
X                  exp_getdval( &( exp_es[ level + 1 ] )) );
X         break;
X
X      case INTEGER:
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_exponent(): Integer precision." );
X         bwb_debug ( bwb_ebuf );
X         sprintf( bwb_ebuf, "in op_exponent(): lhs <%f> rhs <%f>.",
X            exp_getdval( &( exp_es[ level - 1 ] )),
X            exp_getdval( &( exp_es[ level + 1 ] )) );
X         bwb_debug ( bwb_ebuf );
X         #endif
X
X         exp_es[ level - 1 ].ival
X           = (int) pow( exp_getdval( &( exp_es[ level - 1 ] )),
X                  exp_getdval( &( exp_es[ level + 1 ] )) );
X         break;
X      }
X
X   /* set variable to requested precision */
X
X   exp_es[ level - 1 ].type = (char) precision;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack twice */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_intdiv()
X
X        DESCRIPTION:  This function divides the number on
X        the left by the number on the right and returns the
X        result as an integer.
X
X***************************************************************/
X
Xint
Xop_intdiv( int level, int precision )
X   {
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be numbers for
X            string addition; if not, report an error */
X
X         #if PROG_ERRORS
X         sprintf( bwb_ebuf, "Strings cannot be divided." );
X         bwb_error( bwb_ebuf );
X         #else
X         bwb_error( err_mismatch );
X         #endif
X
X         break;
X
X      default:
X         if ( exp_getival( &( exp_es[ level + 1 ] ))
X            == 0 )
X            {
X            exp_es[ level - 1 ].ival = -1;
X            op_pulldown( 2 );
X            #if PROG_ERRORS
X            sprintf( bwb_ebuf, "Divide by 0." );
X            bwb_error( bwb_ebuf );
X            #else
X            bwb_error( err_dbz );
X            #endif
X            return FALSE;
X            }
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_intdiv(): <%d> / <%d>",
X            exp_getival( &( exp_es[ level - 1 ] )),
X            exp_getival( &( exp_es[ level + 1 ] )) );
X         bwb_debug( bwb_ebuf );
X         #endif
X
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            / exp_getival( &( exp_es[ level + 1 ] ));
X         break;
X      }
X
X   /* set variable to requested precision */
X
X   exp_es[ level - 1 ].type = INTEGER;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack twice */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_or()
X
X        DESCRIPTION:  This function compares two integers and
X        performs a logical NOT on them, returning the result
X        as an integer.
X
X***************************************************************/
X
Xint
Xop_or( int level, int precision )
X   {
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be numbers for
X            logical comparison; if not, report an error */
X
X         #if PROG_ERRORS
X         sprintf( bwb_ebuf, "Strings cannot be compared logically." );
X         bwb_error( bwb_ebuf );
X         #else
X         bwb_error( err_mismatch );
X         #endif
X
X         break;
X
X      case DOUBLE:
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            | exp_getival( &( exp_es[ level + 1 ] ));
X         break;
X
X      case SINGLE:
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            | exp_getival( &( exp_es[ level + 1 ] ));
X         break;
X
X      case INTEGER:
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            | exp_getival( &( exp_es[ level + 1 ] ));
X         break;
X      }
X
X   /* set variable type to integer */
X
X   exp_es[ level - 1 ].type = INTEGER;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack twice */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_and()
X
X        DESCRIPTION:  This function compares two integers and
X        performs a logical NOT on them, returning the result
X        as an integer.
X
X***************************************************************/
X
Xint
Xop_and( int level, int precision )
X   {
X
X   switch( precision )
X      {
X      case STRING:
X
X
X         /* both sides of the operation should be numbers for
X            logical comparison; if not, report an error */
X
X         #if PROG_ERRORS
X         sprintf( bwb_ebuf, "Strings cannot be compared logically." );
X         bwb_error( bwb_ebuf );
X         #else
X         bwb_error( err_mismatch );
X         #endif
X
X         break;
X
X      case DOUBLE:
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            & exp_getival( &( exp_es[ level + 1 ] ));
X         break;
X
X      case SINGLE:
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            & exp_getival( &( exp_es[ level + 1 ] ));
X         break;
X
X      case INTEGER:
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            & exp_getival( &( exp_es[ level + 1 ] ));
X         break;
X      }
X
X   /* set variable type to integer */
X
X   exp_es[ level - 1 ].type = INTEGER;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack twice */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_not()
X
X        DESCRIPTION:  This function compares two integers and
X        performs a logical NOT on them, returning the result
X        as an integer.
X
X***************************************************************/
X
Xint
Xop_not( int level, int precision )
X   {
X   unsigned char r;
X
X   switch( precision )
X      {
X      case STRING:
X
X
X         /* both sides of the operation should be numbers for
X            logical comparison; if not, report an error */
X
X         #if PROG_ERRORS
X         sprintf( bwb_ebuf, "Strings cannot be compared logically." );
X         bwb_error( bwb_ebuf );
X         #else
X         bwb_error( err_mismatch );
X         #endif
X
X         break;
X
X      default:
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_not(): argument is <%d>, precision <%c>",
X            (unsigned int) exp_getival( &( exp_es[ level + 1 ] )), precision );
X         bwb_debug( bwb_ebuf );
X         #endif
X
X         exp_es[ level ].ival =
X            ~( exp_getival( &( exp_es[ level + 1 ] )) );
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_not(): result is <%d>, precision <%c>",
X            (int) r, precision );
X         bwb_debug( bwb_ebuf );
X         #endif
X
X         break;
X      }
X
X   /* set variable type to integer */
X
X   exp_es[ level ].type = INTEGER;
X   exp_es[ level ].operation = NUMBER;
X
X   /* decrement the stack once */
X
X   op_pulldown( 1 );
X
X   #if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in op_not(): exp_esc <%d>, level <%d> result <%d>",
X      exp_esc, level, exp_es[ exp_esc ].ival );
X   bwb_debug( bwb_ebuf );
X   #endif
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_xor()
X
X        DESCRIPTION:  This function compares two integers and
X        performs a logical NOT on them, returning the result
X        as an integer.
X
X***************************************************************/
X
Xint
Xop_xor( int level, int precision )
X   {
X
X   switch( precision )
X      {
X      case STRING:
X
X         /* both sides of the operation should be numbers for
X            logical comparison; if not, report an error */
X
X         #if PROG_ERRORS
X         sprintf( bwb_ebuf, "Strings cannot be compared logically." );
X         bwb_error( bwb_ebuf );
X         #else
X         bwb_error( err_mismatch );
X         #endif
X
X         break;
X
X      case DOUBLE:
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            ^ exp_getival( &( exp_es[ level + 1 ] ));
X         break;
X
X      case SINGLE:
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            ^ exp_getival( &( exp_es[ level + 1 ] ));
X         break;
X
X      case INTEGER:
X         exp_es[ level - 1 ].ival
X            = exp_getival( &( exp_es[ level - 1 ] ))
X            ^ exp_getival( &( exp_es[ level + 1 ] ));
X         break;
X      }
X
X   /* set variable type to integer */
X
X   exp_es[ level - 1 ].type = INTEGER;
X   exp_es[ level - 1 ].operation = NUMBER;
X
X   /* decrement the stack twice */
X
X   op_pulldown( 2 );
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_islevelstr()
X
X        DESCRIPTION:  This function determines whether the
X        operation at a specified level involves a string
X        constant or variable.
X
X***************************************************************/
X
Xint
Xop_islevelstr( int level )
X   {
X
X   /* first see if the level holds a string constant */
X
X   if ( exp_es[ level ].operation == CONST_STRING )
X      {
X
X      #if INTENSIVE_DEBUG
X      sprintf( bwb_ebuf, "in op_islevelstr(): string detected at level <%d>.",
X         level );
X      bwb_debug( bwb_ebuf );
X      #endif
X
X      return TRUE;
X      }
X
X   /* see if the level holds a string variable */
X
X   if ( exp_es[ level ].operation == VARIABLE )
X      {
X      if ( exp_es[ level ].xvar->type == STRING )
X         {
X
X         #if INTENSIVE_DEBUG
X         sprintf( bwb_ebuf, "in op_islevelstr(): string detected at level <%d>.",
X            level );
X         bwb_debug( bwb_ebuf );
X         #endif
X
X         return TRUE;
X         }
X      }
X
X   /* test has failed, return FALSE */
X
X   #if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in op_islevelstr(): string not detected at level <%d>.",
X      level );
X   bwb_debug( bwb_ebuf );
X   #endif
X
X   return FALSE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_getprecision()
X
X        DESCRIPTION:  This function finds the precision for
X        an operation by comparing the precision at this level
X        and that two levels below.
X
X***************************************************************/
X
Xint
Xop_getprecision( int level )
X   {
X
X   /* first test for string value */
X
X   if (  ( exp_es[ level + 1 ].type == STRING )
X      || ( exp_es[ level - 1 ].type == STRING ) )
X      {
X      return STRING;
X      }
X
X   /* Both are numbers, so we should be able to find a suitable
X      precision level by starting with the top and moving down;
X      check first for double precision */
X
X   if (  ( exp_es[ level + 1 ].type == DOUBLE )
X      || ( exp_es[ level - 1 ].type == DOUBLE ) )
X      {
X      return DOUBLE;
X      }
X
X   /* check next for single precision */
X
X   if (  ( exp_es[ level + 1 ].type == SINGLE )
X      || ( exp_es[ level - 1 ].type == SINGLE ) )
X      {
X      return SINGLE;
X      }
X
X   /* test integer precision */
X
X   if (  ( exp_es[ level + 1 ].type == INTEGER )
X      && ( exp_es[ level - 1 ].type == INTEGER ) )
X      {
X      return INTEGER;
X      }
X
X   /* else error */
X
X   #if PROG_ERRORS
X   sprintf( bwb_ebuf, "in op_getprecision(): invalid precision level." );
X   bwb_error( bwb_ebuf );
X   #else
X   bwb_error( err_syntax );
X   #endif
X
X   return FALSE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:   op_pulldown()
X
X        DESCRIPTION:  This function pulls the expression stack
X        down a specified number of levels, decrementing the
X        expression stack counter (bycalling dec_esc()) and
X        decrementing the current "level" of operation processing.
X
X***************************************************************/
X
Xint
Xop_pulldown( int how_far )
X   {
X   int level;
X   register int c;
X
X   #if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in op_pulldown(): pull down e stack <%d> place(s)",
X      how_far );
X   bwb_debug( bwb_ebuf );
X   #endif
X
X   /* first pull down the actual variables themselves */
X
X   level = op_level + ( 2 - how_far );
X   while ( exp_esc >= ( level + how_far ) )
X      {
X
X      memcpy( &exp_es[ level ], &exp_es[ level + how_far ],
X         (size_t) ( sizeof( struct exp_ese )) );
X      ++level;
X
X      }
X
X   /* decrement the expression stack counter */
X
X   for ( c = 0; c < how_far; ++c )
X      {
X
X      if ( dec_esc() == TRUE )
X         {
X         --op_level;
X         }
X      else
X         {
X         return FALSE;
X         }
X
X      }
X
X   return TRUE;
X
X   }
X
END_OF_FILE
  if test 57586 -ne `wc -c <'bwb_ops.c'`; then
    echo shar: \"'bwb_ops.c'\" unpacked with wrong size!
  fi
  # end of 'bwb_ops.c'
fi
echo shar: End of archive 2 \(of 11\).
cp /dev/null ark2isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 11 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still must unpack the following archives:
    echo "        " ${MISSING}
fi
exit 0
exit 0 # Just in case...