bwb_mth.c

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

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

   /* initialize the variable if necessary */

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

      /* Revised to CALLOC pass-thru call by JBV */
      if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_val" )) == NULL )
         {
#if PROG_ERRORS
         bwb_error( "in fnc_val(): failed to get memory for tbuf" );
#else
         bwb_error( err_getmem );
#endif
         }
      }

   /* check arguments */

#if PROG_ERRORS
   if ( argc < 1 )
      {
      sprintf( bwb_ebuf, "Not enough arguments to function VAL()" );
      bwb_error( bwb_ebuf );
      return NULL;
      }
   else if ( argc > 1 )
      {
      sprintf( bwb_ebuf, "Too many parameters (%d) to function VAL().",
         argc );
      bwb_error( bwb_ebuf );
      return NULL;
      }

#else
   if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
      {
      return NULL;
      }
#endif

   if ( argv[ 0 ].type != STRING )
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "Argument to function VAL() must be a string." );
      bwb_error( bwb_ebuf );
#else
      bwb_error( err_mismatch );
#endif
      return NULL;
      }

   /* read the value */

   str_btoc( tbuf, var_getsval( &( argv[ 0 ] ) ));
   if ( strlen( tbuf ) == 0 ) /* JBV */
      *var_findnval( &nvar, nvar.array_pos ) = (bnumber) 0;
   else
#if NUMBER_DOUBLE
   sscanf( tbuf, "%lf",
       var_findnval( &nvar, nvar.array_pos ) );
#else
   sscanf( tbuf, "%f",
       var_findnval( &nvar, nvar.array_pos ) );
#endif

   return &nvar;
   }

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

        FUNCTION:       fnc_str()

	DESCRIPTION:    This C function implements the BASIC
			STR$() function, returning an ASCII string
			with the decimal value of the numerical argument.

	SYNTAX:		STR$( number )

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

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

   /* initialize the variable if necessary */

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

      /* Revised to CALLOC pass-thru call by JBV */
      if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_str" )) == NULL )
         {
#if PROG_ERRORS
         bwb_error( "in fnc_str(): failed to get memory for tbuf" );
#else
         bwb_error( err_getmem );
#endif
         }
      }

   /* check parameters */

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

   /* format as decimal number */

   sprintf( tbuf, " %.*f", prn_precision( &( argv[ 0 ] ) ), 
      var_getnval( &( argv[ 0 ] ) ) ); 
   str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );

   return &nvar;
   }

#endif                          /* COMMON_FUNCS */

#if MS_FUNCS

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

        FUNCTION:       fnc_hex()

	DESCRIPTION:    This C function implements the BASIC
			HEX$() function, returning a string
			containing the hexadecimal value of
			the numerical argument.

	SYNTAX:		HEX$( number )

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

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

   /* initialize the variable if necessary */

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

      /* Revised to CALLOC pass-thru call by JBV */
      if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_hex" )) == NULL )
         {
#if PROG_ERRORS
         bwb_error( "in fnc_hex(): failed to get memory for tbuf" );
#else
         bwb_error( err_getmem );
#endif
         }
      }

   /* check parameters */

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

   /* format as hex integer */

   sprintf( tbuf, "%X", (int) trnc_int( (bnumber) var_getnval( &( argv[ 0 ] )) ) );
   str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
   return &nvar;
   }

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

        FUNCTION:       fnc_oct()

        DESCRIPTION:	This C function implements the BASIC
			OCT$() function, returning a string
			with the octal value of the numerical
			argument.

	SYNTAX:		OCT$( number )

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

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

   /* initialize the variable if necessary */

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

      /* Revised to CALLOC pass-thru call by JBV */
      if ( ( tbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "fnc_oct" )) == NULL )
         {
#if PROG_ERRORS
         bwb_error( "in fnc_oct(): failed to get memory for tbuf" );
#else
         bwb_error( err_getmem );
#endif
         }
      }

   /* check parameters */

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

   /* format as octal integer */

   /* Revised by JBV */
   /* sprintf( tbuf, "%o", (int) var_getnval( &( argv[ 0 ] ) ) ); */
   sprintf( tbuf, "%o", (int) trnc_int( (bnumber) var_getnval( &( argv[ 0 ] )) ) );
   str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
   return &nvar;
   }

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

        FUNCTION:       fnc_mki()

        DESCRIPTION:    This C function implements the BASIC
                        predefined MKI$() function.

	NOTE:		As implemented in bwBASIC, this is a
			pseudo-function, since bwBASIC does
			not recognize precision levels.

	SYNTAX:		MKI$( number )

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

#if ANSI_C
struct bwb_variable *
fnc_mki( int argc, struct bwb_variable *argv, int unique_id  )
#else
struct bwb_variable *
fnc_mki( argc, argv, unique_id  )
   int argc;
   struct bwb_variable *argv;
   int unique_id;
#endif
   {
   register int i;
   static struct bwb_variable nvar;
   bstring *b;
   static char tbuf[ sizeof( int ) ];
   static int init = FALSE;

   /* initialize the variable if necessary */

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

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

   /* assign values */

   an_integer.the_integer = (int) var_getnval( &( argv[ 0 ] ) );

   for ( i = 0; i < sizeof( int ); ++i )
      {
      tbuf[ i ] = an_integer.the_chars[ i ];
      tbuf[ i + 1 ] = '\0';
      }
   b = var_getsval( &nvar );
   b->length = sizeof( int );
   b->sbuffer = tbuf;
   b->rab = FALSE;

   return &nvar;
   }

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

        FUNCTION:       fnc_mkd()

        DESCRIPTION:    This C function implements the BASIC
                        predefined MKD$() function.

	NOTE:		As implemented in bwBASIC, this is a
			pseudo-function, since bwBASIC does
			not recognize precision levels.

	SYNTAX:		MKD$( number )

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

#if ANSI_C
struct bwb_variable *
fnc_mkd( int argc, struct bwb_variable *argv, int unique_id  )
#else
struct bwb_variable *
fnc_mkd( argc, argv, unique_id  )
   int argc;
   struct bwb_variable *argv;
   int unique_id;
#endif
   {
   register int i;
   static struct bwb_variable nvar;
   bstring *b;
   static char tbuf[ sizeof ( double ) ];
   static int init = FALSE;

   /* initialize the variable if necessary */

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

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

   /* assign values */

   a_double.the_double = var_getnval( &( argv[ 0 ] ) );

   for ( i = 0; i < sizeof ( double ); ++i )
      {
      tbuf[ i ] = a_double.the_chars[ i ];
      tbuf[ i + 1 ] = '\0';
      }
   b = var_getsval( &nvar );
   b->length = sizeof( double );
   b->sbuffer = tbuf;
   b->rab = FALSE;

   return &nvar;
   }

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

        FUNCTION:       fnc_mks()

        DESCRIPTION:    This C function implements the BASIC
                        predefined MKS$() function.

	NOTE:		As implemented in bwBASIC, this is a
			pseudo-function, since bwBASIC does
			not recognize precision levels.

	SYNTAX:		MKS$( number )

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

#if ANSI_C
struct bwb_variable *
fnc_mks( int argc, struct bwb_variable *argv, int unique_id  )
#else
struct bwb_variable *
fnc_mks( argc, argv, unique_id  )
   int argc;
   struct bwb_variable *argv;
   int unique_id;
#endif
   {
   register int i;
   static struct bwb_variable nvar;
   static char tbuf[ 5 ];
   bstring *b;
   static int init = FALSE;