bwb_mth.c

这是一个简易的basic语言解释器, 可供我们学习和改进.

/****************************************************************

        bwb_mth.c       Mathematical Functions
                        for Bywater BASIC Interpreter

                        Copyright (c) 1993, Ted A. Campbell
                        Bywater Software

                        email: [e-mail]

        Copyright and Permissions Information:

        All U.S. and international rights are claimed by the author,
        Ted A. Campbell.

	This software is released under the terms of the GNU General
	Public License (GPL), which is distributed with this software
	in the file "COPYING".  The GPL specifies the terms under
	which users may copy and use the software in this distribution.

	A separate license is available for commercial distribution,
	for information on which you should contact the author.

****************************************************************/

/*---------------------------------------------------------------*/
/* NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, */
/* 11/1995 ([e-mail]).                                  */
/*---------------------------------------------------------------*/

#include <stdio.h>
#include <ctype.h>
#include <math.h>
#include <time.h>

#include "bwbasic.h"
#include "bwb_mes.h"

#ifndef RAND_MAX			/* added in v1.11 */
#define RAND_MAX	32767
#endif

#if ANSI_C
bnumber round_int( bnumber x );
#else
bnumber round_int();
#endif

#if MS_FUNCS
union un_integer
   {
   int the_integer;
   unsigned char the_chars[ sizeof( int ) ];
   } an_integer;

union un_single
   {
   float the_float;
   unsigned char the_chars[ sizeof( float) ];
   } a_float;

union un_double
   {
   double the_double;
   unsigned char the_chars[ sizeof( double ) ];
   } a_double;
#endif

#if COMPRESS_FUNCS

/***************************************************************

	FUNCTION:       fnc_core()

	DESCRIPTION:    This C function implements all core
			BASIC functions if COMPRESS_FUNCS is
			TRUE.  This method saves program space.

***************************************************************/

#if ANSI_C
struct bwb_variable *
fnc_core( int argc, struct bwb_variable *argv, int unique_id  )
#else
struct bwb_variable *
fnc_core( argc, argv, unique_id  )
   int argc;
   struct bwb_variable *argv;
   int unique_id;
#endif
   {
   static struct bwb_variable nvar;
   static int init = FALSE;
   bnumber nval;

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in fnc_core(): entered function" );
   bwb_debug( bwb_ebuf );
#endif

   /* initialize the variable if necessary */

   if ( init == FALSE )
      {
      init = TRUE;
      strncpy( nvar.name, "(core var)", MAXVARNAMESIZE );
#if INTENSIVE_DEBUG
      sprintf( bwb_ebuf, "in fnc_core(): ready to make local variable <%s>",
	 nvar.name );
      bwb_debug( bwb_ebuf );
#endif
      var_make( &nvar, NUMBER );
      }

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in fnc_core(): received f_arg <%f> nvar type <%c>",
      var_getnval( &( argv[ 0 ] ) ), nvar.type );
   bwb_debug( bwb_ebuf );
#endif

   /* check for number of arguments as appropriate */

   switch ( unique_id )
      {
      case F_RND:                       /* no arguments necessary for RND */
	 break;
      default:
#if PROG_ERRORS
	 if ( argc < 1 )
	    {
	    sprintf( bwb_ebuf, "Not enough parameters (%d) to core function.",
	       argc );
	    bwb_error( bwb_ebuf );
	    return NULL;
	    }
	 else if ( argc > 1 )
	    {
	    sprintf( bwb_ebuf, "Too many parameters (%d) to core function.",
	       argc );
	    bwb_error( bwb_ebuf );
	    return NULL;
	    }
#else
	 if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
	    {
	    return NULL;
	    }
#endif
      }

   /* assign values */

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in fnc_core(): nvar type <%c>; calling findnval()",
      nvar.type );
   bwb_debug( bwb_ebuf );
#endif

   switch( unique_id )
      {
      case F_ABS:
         /* Added double recast here (JBV) */
	 * var_findnval( &nvar, nvar.array_pos ) =
	    (bnumber) fabs( (double) var_getnval( &( argv[ 0 ] ) ) );
	 break;
      case F_ATN:
	 * var_findnval( &nvar, nvar.array_pos )
	    = (bnumber) atan( (double) var_getnval( &( argv[ 0 ] ) ) );
	 break;
      case F_COS:
	 * var_findnval( &nvar, nvar.array_pos )
	    = (bnumber) cos( (double) var_getnval( &( argv[ 0 ] ) ) );
	 break;
      case F_EXP:
         /* Added double recast here (JBV) */
	 * var_findnval( &nvar, nvar.array_pos )
	    = (bnumber) exp( (double) var_getnval( &( argv[ 0 ] ) ) );
	 break;
      case F_INT:
	 * var_findnval( &nvar, nvar.array_pos )
	    = (bnumber) floor( (double) var_getnval( &( argv[ 0 ] ) ) );
	 break;
      case F_LOG:
	 * var_findnval( &nvar, nvar.array_pos )
	    = (bnumber) log( (double) var_getnval( &( argv[ 0 ] ) ) );
	 break;
      case F_RND:
         /* Added bnumber recast here (JBV) */
	 * var_findnval( &nvar, nvar.array_pos )
	    = (bnumber) ( (float) rand() / RAND_MAX );
	 break;
      case F_SGN:
	 nval = var_getnval( &( argv[ 0 ] ));
	 if ( nval == (bnumber) 0.0 )
	    {
	    * var_findnval( &nvar, nvar.array_pos ) = (bnumber) 0;
	    }
	 else if ( nval > (bnumber) 0.0 )
	    {
	    * var_findnval( &nvar, nvar.array_pos ) = (bnumber) 1;
	    }
	 else
	    {
	    * var_findnval( &nvar, nvar.array_pos ) = (bnumber) -1;
	    }
	 break;
      case F_SIN:
	 * var_findnval( &nvar, nvar.array_pos )
	    = (bnumber) sin( (double) var_getnval( &( argv[ 0 ] ) ) );
	 break;
      case F_SQR:
	 * var_findnval( &nvar, nvar.array_pos )
	    = (bnumber) sqrt( (double) var_getnval( &( argv[ 0 ] ) ) );
	 break;
      case F_TAN:
	 * var_findnval( &nvar, nvar.array_pos )
	    = (bnumber) tan( (double) var_getnval( &( argv[ 0 ] ) ) );
	 break;
      }

   return &nvar;

   }

#else

/***************************************************************

        FUNCTION:       fnc_abs()

        DESCRIPTION:    This C function implements the BASIC
                        predefined ABS function, returning the
                        absolute value of the argument.

	SYNTAX:		ABS( number )

***************************************************************/

#if ANSI_C
struct bwb_variable *
fnc_abs( int argc, struct bwb_variable *argv, int unique_id  )
#else
struct bwb_variable *
fnc_abs( argc, argv, unique_id  )
   int argc;
   struct bwb_variable *argv;
   int unique_id;
#endif
   {
   static struct bwb_variable nvar;
   static int init = FALSE;

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in fnc_abs(): entered function" );
   bwb_debug( bwb_ebuf );
#endif

   /* initialize the variable if necessary */

   if ( init == FALSE )
      {
      init = TRUE;
      strncpy( nvar.name, "(abs var)", MAXVARNAMESIZE );
#if INTENSIVE_DEBUG
      sprintf( bwb_ebuf, "in fnc_abs(): ready to make local variable <%s>",
         nvar.name );
      bwb_debug( bwb_ebuf );
#endif
      var_make( &nvar, NUMBER );
      }

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in fnc_abs(): received f_arg <%f> nvar type <%c>",
      var_getnval( &( argv[ 0 ] ) ), nvar.type );
   bwb_debug( bwb_ebuf );
#endif

#if PROG_ERRORS
   if ( argc < 1 )
      {
      sprintf( bwb_ebuf, "Not enough parameters (%d) to function ABS().",
         argc );
      bwb_error( bwb_ebuf );
      return NULL;
      }
   else if ( argc > 1 )
      {
      sprintf( bwb_ebuf, "Too many parameters (%d) to function ABS().",
         argc );
      bwb_error( bwb_ebuf );
      return NULL;
      }
#else
   if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
      {
      return NULL;
      }
#endif

   /* assign values */

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in fnc_abs(): nvar type <%c>; calling finnval()",
      nvar.type );
   bwb_debug( bwb_ebuf );
#endif

   /* Added double recast here (JBV) */
   * var_findnval( &nvar, nvar.array_pos ) = 
      (bnumber) fabs( (double) var_getnval( &( argv[ 0 ] ) ) );

   return &nvar;

   }

/***************************************************************

        FUNCTION:       fnc_rnd()

        DESCRIPTION:    This C function implements the BASIC
                        predefined RND function, returning a
                        pseudo-random number in the range
                        0 to 1.  It is affected by the RANDOMIZE
                        command statement.

	SYNTAX:		RND( number )

***************************************************************/

#if ANSI_C
struct bwb_variable *
fnc_rnd( int argc, struct bwb_variable *argv, int unique_id  )
#else
struct bwb_variable *
fnc_rnd( argc, argv, unique_id  )
   int argc;
   struct bwb_variable *argv;
   int unique_id;
#endif
   {
   static struct bwb_variable nvar;
   static int init = FALSE;

   /* initialize the variable if necessary */

   if ( init == FALSE )
      {
      init = TRUE;
      var_make( &nvar, NUMBER );
      }

   /* Added bnumber recast here (JBV) */
   * var_findnval( &nvar, nvar.array_pos )
      = (bnumber) ( (float) rand() / RAND_MAX );

   return &nvar;
   }

/***************************************************************

        FUNCTION:       fnc_atn()

	DESCRIPTION:    This C function implements the BASIC
                        predefined ATN function, returning the
                        arctangent of the argument.

	SYNTAX:		ATN( number )

***************************************************************/

#if ANSI_C
struct bwb_variable *
fnc_atn( int argc, struct bwb_variable *argv, int unique_id  )
#else
struct bwb_variable *
fnc_atn( argc, argv, unique_id  )
   int argc;
   struct bwb_variable *argv;
   int unique_id;
#endif
   {
   static struct bwb_variable nvar;
   static int init = FALSE;

   /* initialize the variable if necessary */

   if ( init == FALSE )
      {
      init = TRUE;
      var_make( &nvar, NUMBER );
      }

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in fnc_atn(): received f_arg <%f> ",
      var_getnval( &( argv[ 0 ] ) ) );
   bwb_debug( bwb_ebuf );
#endif

#if PROG_ERRORS
   if ( argc < 1 )
      {
      sprintf( bwb_ebuf, "Not enough parameters (%d) to function ATN().",
         argc );
      bwb_error( bwb_ebuf );
      return NULL;
      }
   else if ( argc > 1 )
      {
      sprintf( bwb_ebuf, "Too many parameters (%d) to function ATN().",
         argc );
      bwb_error( bwb_ebuf );
      return NULL;
      }
#else
   if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
      {
      return NULL;
      }
#endif

   /* assign values */

   * var_findnval( &nvar, nvar.array_pos ) 
      = (bnumber) atan( (double) var_getnval( &( argv[ 0 ] ) ) );

   return &nvar;

   }

/***************************************************************

        FUNCTION:       fnc_cos()

        DESCRIPTION:    This C function implements the BASIC
                        predefined COS function, returning the
                        cosine of the argument.

	SYNTAX:		COS( number )

***************************************************************/

#if ANSI_C
struct bwb_variable *
fnc_cos( int argc, struct bwb_variable *argv, int unique_id  )
#else
struct bwb_variable *
fnc_cos( argc, argv, unique_id  )
   int argc;
   struct bwb_variable *argv;
   int unique_id;
#endif
   {
   static struct bwb_variable nvar;
   static int init = FALSE;

   /* initialize the variable if necessary */

   if ( init == FALSE )
      {
      init = TRUE;
      var_make( &nvar, NUMBER );
      }

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in fnc_cos(): received f_arg <%f> ",
      var_getnval( &( argv[ 0 ] ) ) );
   bwb_debug( bwb_ebuf );
#endif

#if PROG_ERRORS
   if ( argc < 1 )
      {
      sprintf( bwb_ebuf, "Not enough parameters (%d) to function COS().",
         argc );
      bwb_error( bwb_ebuf );
      return NULL;
      }
   else if ( argc > 1 )
      {
      sprintf( bwb_ebuf, "Too many parameters (%d) to function COS().",
         argc );
      bwb_error( bwb_ebuf );
      return NULL;
      }
#else
   if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
      {
      return NULL;
      }
#endif

   /* assign values */

   * var_findnval( &nvar, nvar.array_pos ) 
      = (bnumber) cos( (double) var_getnval( &( argv[ 0 ] ) ) );

   return &nvar;

   }

/***************************************************************

        FUNCTION:       fnc_log()

        DESCRIPTION:    This C function implements the BASIC
                        predefined LOG function, returning the
                        natural logarithm of the argument.

	SYNTAX:		LOG( number )

***************************************************************/