bwb_var.c

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

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

        bwb_var.c       Variable-Handling Routines
                        for Bywater BASIC Interpreter

                        Commands:	DIM
                                        COMMON
                                        ERASE
                                        SWAP
					CLEAR

                        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 "bwbasic.h"
#include "bwb_mes.h"

int dim_base = 0;                        	/* set by OPTION BASE */
static int dimmed = FALSE;                      /* has DIM been called? */
static int first, last;				/* first, last for DEFxxx commands */

/* Prototypes for functions visible to this file only */

#if ANSI_C
static int dim_check( struct bwb_variable *v, int *pp );
static int var_defx( struct bwb_line *l, int type );
static int var_letseq( char *buffer, int *position, int *start, int *end );
static size_t dim_unit( struct bwb_variable *v, int *pp );
#else
static int dim_check();
static int var_defx();
static int var_letseq();
static size_t dim_unit();
#endif

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

        FUNCTION:       var_init()

        DESCRIPTION:	This function initializes the internal
			linked list of variables.

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

#if ANSI_C
int
var_init( int task )
#else
int
var_init( task )
   int task;
#endif
   {
   LOCALTASK var_start.next = &(LOCALTASK var_end);
   strcpy( LOCALTASK var_start.name, "<START>" );
   strcpy( LOCALTASK var_end.name, "<END>" );
   return TRUE;
   }

#if COMMON_CMDS

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

        FUNCTION:       bwb_common()

        DESCRIPTION:	This C function implements the BASIC
        		COMMON command.

	SYNTAX:		COMMON variable [, variable...]

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

#if ANSI_C
struct bwb_line *
bwb_common( struct bwb_line *l )
#else
struct bwb_line *
bwb_common( l )
   struct bwb_line *l;
#endif
   {
   register int loop;
   struct bwb_variable *v;
   char tbuf[ MAXSTRINGSIZE + 1 ];

   /* loop while arguments are available */

   loop = TRUE;
   while ( loop == TRUE )
      {

      /* get variable name and find variable */

      bwb_getvarname( l->buffer, tbuf, &( l->position ) );

      if ( ( v = var_find( tbuf ) ) == NULL )
         {
         bwb_error( err_syntax );
         return bwb_zline( l );
         }

      v->common = TRUE;				/* set common flag to true */

      /* check for comma */

      adv_ws( l->buffer, &( l->position ) );
      if ( l->buffer[ l->position ] != ',' )
         {
         return bwb_zline( l );				/* no comma; leave */
         }
      ++( l->position );
      adv_ws( l->buffer, &( l->position ) );

      }

   return bwb_zline( l );

   }

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

        FUNCTION:	bwb_erase()

	DESCRIPTION:    This C function implements the BASIC
			ERASE command.

	SYNTAX:		ERASE variable[, variable]...

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

#if ANSI_C
struct bwb_line *
bwb_erase( struct bwb_line *l )
#else
struct bwb_line *
bwb_erase( l )
   struct bwb_line *l;
#endif
   {
   register int loop;
   struct bwb_variable *v;
   struct bwb_variable *p;		/* previous variable in linked list */
   char tbuf[ MAXSTRINGSIZE + 1 ];
   bstring *sp; /* JBV */
   register int n; /* JBV */

   /* loop while arguments are available */

   loop = TRUE;
   while ( loop == TRUE )
      {

      /* get variable name and find variable */

      bwb_getvarname( l->buffer, tbuf, &( l->position ) );

      if ( ( v = var_find( tbuf ) ) == NULL )
         {
         bwb_error( err_syntax );
         return bwb_zline( l );
         }

      /* be sure the variable is dimensioned */

      if (( v->dimensions < 1 ) || ( v->array_sizes[ 0 ] < 1 ))
	 {
	 bwb_error( err_dimnotarray );
	 return bwb_zline( l );
         }

      /* find previous variable in chain */

      for ( p = &CURTASK var_start; p->next != v; p = p->next )
         {
         ;
         }

      /* reassign linkage */

      p->next = v->next;

      /* deallocate memory */

      /* Revised to FREE pass-thru calls by JBV */
      FREE( v->array_sizes, "bwb_erase" );
      v->array_sizes = NULL; /* JBV */
      FREE( v->array_pos , "bwb_erase");
      v->array_pos = NULL; /* JBV */
      if ( v->type == NUMBER )
	 {
         /* Revised to FREE pass-thru call by JBV */
	 FREE( v->memnum, "bwb_erase" );
	 v->memnum = NULL; /* JBV */
	 }
      else
	 {
		/* Following section added by JBV */
		sp = v->memstr;
		for ( n = 0; n < (int) v->array_units; ++n )
		{
			if ( sp[ n ].sbuffer != NULL )
			{
                                /* Revised to FREE pass-thru call by JBV */
				FREE( sp[ n ].sbuffer, "bwb_erase" );
				sp[ n ].sbuffer = NULL;
			}
			sp[ n ].rab = FALSE;
			sp[ n ].length = 0;
		}
         /* Revised to FREE pass-thru call by JBV */
	 FREE( v->memstr, "bwb_erase" );
	 v->memstr = NULL; /* JBV */
	 }
      /* Revised to FREE pass-thru call by JBV */
      FREE( v, "bwb_erase" );
      v = NULL; /* JBV */

      /* check for comma */

      adv_ws( l->buffer, &( l->position ) );
      if ( l->buffer[ l->position ] != ',' )
         {
         return bwb_zline( l );				/* no comma; leave */
         }
      ++( l->position );
      adv_ws( l->buffer, &( l->position ) );

      }

   return bwb_zline( l );

   }

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

        FUNCTION:	bwb_swap()

	DESCRIPTION:    This C function implements the BASIC
			SWAP command.

	SYNTAX:		SWAP variable, variable

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

#if ANSI_C
struct bwb_line *
bwb_swap( struct bwb_line *l )
#else
struct bwb_line *
bwb_swap( l )
   struct bwb_line *l;
#endif
   {
   struct bwb_variable tmp;                     /* temp holder */
   struct bwb_variable *lhs, *rhs;		/* left and right- hand side of swap statement */
   char tbuf[ MAXSTRINGSIZE + 1 ];

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_swap(): buffer is <%s>",
      &( l->buffer[ l->position ] ) );
   bwb_debug( bwb_ebuf );
#endif

   /* get left variable name and find variable */

   bwb_getvarname( l->buffer, tbuf, &( l->position ) );

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_swap(): tbuf is <%s>", tbuf );
   bwb_debug( bwb_ebuf );
#endif

   if ( ( lhs = var_find( tbuf ) ) == NULL )
      {
      bwb_error( err_syntax );
      return bwb_zline( l );
      }

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_swap(): lhs variable <%s> found",
      lhs->name );
   bwb_debug( bwb_ebuf );
#endif

   /* check for comma */

   adv_ws( l->buffer, &( l->position ) );
   if ( l->buffer[ l->position ] != ',' )
      {
      bwb_error( err_syntax );
      return bwb_zline( l );
      }
   ++( l->position );
   adv_ws( l->buffer, &( l->position ) );

   /* get right variable name */

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_swap(): buffer is now <%s>",
      &( l->buffer[ l->position ] ) );
   bwb_debug( bwb_ebuf );
#endif

   bwb_getvarname( l->buffer, tbuf, &( l->position ) );

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_swap(): tbuf is <%s>", tbuf );
   bwb_debug( bwb_ebuf );
#endif

   if ( ( rhs = var_find( tbuf ) ) == NULL )
      {
      bwb_error( err_syntax );
      return bwb_zline( l );
      }

   /* check to be sure that both variables are of the same type */

   if ( rhs->type != lhs->type )
      {
      bwb_error( err_mismatch );
      return bwb_zline( l );
      }

   /* copy lhs to temp, rhs to lhs, then temp to rhs */

   if ( lhs->type == NUMBER )
      {
      tmp.memnum = lhs->memnum;
      }
   else
      {
      tmp.memstr = lhs->memstr;
      }
   tmp.array_sizes = lhs->array_sizes;
   tmp.array_units = lhs->array_units;
   tmp.array_pos = lhs->array_pos;
   tmp.dimensions = lhs->dimensions;

   if ( lhs->type == NUMBER )
      {
      lhs->memnum = rhs->memnum;
      }
   else
      {
      lhs->memstr = rhs->memstr;
      }
   lhs->array_sizes = rhs->array_sizes;
   lhs->array_units = rhs->array_units;
   lhs->array_pos = rhs->array_pos;
   lhs->dimensions = rhs->dimensions;

   if ( lhs->type = NUMBER )
      {
      rhs->memnum = tmp.memnum;
      }
   else
      {
      rhs->memstr = tmp.memstr;
      }
   rhs->array_sizes = tmp.array_sizes;
   rhs->array_units = tmp.array_units;
   rhs->array_pos = tmp.array_pos;
   rhs->dimensions = tmp.dimensions;

   /* return */

   return bwb_zline( l );

   }

#endif				/* COMMON_CMDS */

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

        FUNCTION:	bwb_clear()

	DESCRIPTION:    This C function implements the BASIC
			CLEAR command.

	SYNTAX:		CLEAR

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

#if ANSI_C
struct bwb_line *
bwb_clear( struct bwb_line *l )
#else
struct bwb_line *
bwb_clear( l )
   struct bwb_line *l;
#endif
   {
   struct bwb_variable *v;
   register int n;
   bstring *sp;
   bnumber *np;

   for ( v = CURTASK var_start.next; v != &CURTASK var_end; v = v->next )
      {
      if ( v->preset != TRUE )
         {
         switch( v->type )
            {
            case NUMBER:
	       np = v->memnum;
	       for ( n = 0; n < (int) v->array_units; ++n )
		  {
		  np[ n ] = (bnumber) 0.0;
		  }
	       break;
	    case STRING:
	       sp = v->memstr;
               for ( n = 0; n < (int) v->array_units; ++n )
                  {
		  if ( sp[ n ].sbuffer != NULL )
		     {
                     /* Revised to FREE pass-thru call by JBV */
		     FREE( sp[ n ].sbuffer, "bwb_clear" );
		     sp[ n ].sbuffer = NULL;
                     }
                  sp[ n ].rab = FALSE;
                  sp[ n ].length = 0;
                  }
               break;
            }
         }
      }

   return bwb_zline( l );

   }

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

	FUNCTION:       var_delcvars()

	DESCRIPTION:    This function deletes all variables
			in memory except those previously marked
			as common.

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

#if ANSI_C
int
var_delcvars( void )
#else
int
var_delcvars()
#endif
   {
   struct bwb_variable *v;
   struct bwb_variable *p;		/* previous variable */
   bstring *sp; /* JBV */
   register int n; /* JBV */

   p = &CURTASK var_start;
   for ( v = CURTASK var_start.next; v != &CURTASK var_end; v = v->next )
      {

      if ( v->common != TRUE )
         {

         /* if the variable is dimensioned, release allocated memory */

         if ( v->dimensions > 0 )
            {

            /* deallocate memory */

            /* Revised to FREE pass-thru calls by JBV */
            FREE( v->array_sizes, "var_delcvars" );
            v->array_sizes = NULL; /* JBV */
            FREE( v->array_pos, "var_delcvars" );
            v->array_pos = NULL; /* JBV */
	    if ( v->type == NUMBER )
	       {
               /* Revised to FREE pass-thru call by JBV */
	       FREE( v->memnum, "var_delcvars" );
	       v->memnum = NULL; /* JBV */
	       }
	    else
	       {
		/* Following section added by JBV */
		sp = v->memstr;
		for ( n = 0; n < (int) v->array_units; ++n )
		{
			if ( sp[ n ].sbuffer != NULL )
			{
                                /* Revised to FREE pass-thru call by JBV */
				FREE( sp[ n ].sbuffer, "var_delcvars" );
				sp[ n ].sbuffer = NULL;
			}
			sp[ n ].rab = FALSE;
			sp[ n ].length = 0;
		}
               /* Revised to FREE pass-thru call by JBV */
	       FREE( v->memstr, "var_delcvars" );
	       v->memstr = NULL; /* JBV */
	       }
            }

         /* reassign linkage */

         p->next = v->next;

         /* deallocate the variable itself */

         /* Revised to FREE pass-thru call by JBV */
         FREE( v, "var_delcvars" );
         v = NULL; /* JBV */

         }

      /* else reset previous variable */

      else
         {
         p = v;
         }

      }

   return TRUE;

   }

#if MS_CMDS

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

        FUNCTION:	bwb_ddbl()

	DESCRIPTION:    This function implements the BASIC
			DEFDBL command.

	SYNTAX:		DEFDBL letter[-letter](, letter[-letter])...

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

#if ANSI_C
struct bwb_line *
bwb_ddbl( struct bwb_line *l )
#else
struct bwb_line *
bwb_ddbl( l )
   struct bwb_line *l;
#endif
   {

   /* call generalized DEF handler with DOUBLE set */

   var_defx( l, NUMBER );

   return bwb_zline( l );

   }

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

        FUNCTION:	bwb_dint()

	DESCRIPTION:    This function implements the BASIC
			DEFINT command.

	SYNTAX:		DEFINT letter[-letter](, letter[-letter])...

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

#if ANSI_C
struct bwb_line *
bwb_dint( struct bwb_line *l )
#else
struct bwb_line *
bwb_dint( l )
   struct bwb_line *l;
#endif
   {

   /* call generalized DEF handler with INTEGER set */

   var_defx( l, NUMBER );

   return bwb_zline( l );

   }

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

        FUNCTION:	bwb_dsng()

	DESCRIPTION:    This function implements the BASIC
			DEFSNG command.

	SYNTAX:		DEFSNG letter[-letter](, letter[-letter])...

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

#if ANSI_C
struct bwb_line *
bwb_dsng( struct bwb_line *l )
#else
struct bwb_line *
bwb_dsng( l )
   struct bwb_line *l;
#endif
   {

   /* call generalized DEF handler with SINGLE set */

   var_defx( l, NUMBER );

   return bwb_zline( l );

   }

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

        FUNCTION:	bwb_dstr()

	DESCRIPTION:    This function implements the BASIC
			DEFSTR command.