bwb_var.c

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

#if INTENSIVE_DEBUG
   for ( n = 0; n < *n_params; ++n )
      {
      sprintf( bwb_ebuf, "in dim_getparams(): Parameter <%d>: <%d>",
         n, params[ n ] );
      bwb_debug( bwb_ebuf );
      }
#endif

   /* return params stack */

   *pp = params;

   return TRUE;

   }

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

        FUNCTION:       bwb_option()

        DESCRIPTION:    This function implements the BASIC OPTION
                        BASE statement, designating the base (1 or
                        0) for addressing DIM arrays.

	SYNTAX:		OPTION BASE number

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

#if ANSI_C
struct bwb_line *
bwb_option( struct bwb_line *l )
#else
struct bwb_line *
bwb_option( l )
   struct bwb_line *l;
#endif
   {
   register int n;
   int newval;
   struct exp_ese *e;
   struct bwb_variable *current;
   char tbuf[ MAXSTRINGSIZE ];

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

   /* If DIM has already been called, do not allow OPTION BASE */

   if ( dimmed != FALSE )
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "at line %d: OPTION BASE must be called before DIM.",
         l->number );
      bwb_error( bwb_ebuf );
#else
      bwb_error( err_obdim );
#endif
      return bwb_zline( l );
      }

   /* capitalize first element in tbuf */

   adv_element( l->buffer, &( l->position ), tbuf );
   for ( n = 0; tbuf[ n ] != '\0'; ++n )
      {
      if ( islower( tbuf[ n ] ) != FALSE )
         {
         tbuf[ n ] = (char) toupper( tbuf[ n ] );
         }
      }

   /* check for BASE statement */

   if ( strncmp( tbuf, "BASE", (size_t) 4 ) != 0 )
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "at line %d: Unknown statement <%s> following OPTION.",
         l->number, tbuf );
      bwb_error( bwb_ebuf );
#else
      bwb_error( err_syntax );
#endif
      return bwb_zline( l );
      }

   /* Get new value from argument. */

   adv_ws( l->buffer, &( l->position ) );
   e = bwb_exp( l->buffer, FALSE, &( l->position ) );
   newval = (int) exp_getnval( e );

   /* Test the new value. */

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_option(): New value received is <%d>.", newval );
   bwb_debug( bwb_ebuf );
#endif

   if ( ( newval < 0 ) || ( newval > 1 ) )
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "at line %d: value for OPTION BASE must be 1 or 0.",
         l->number );
      bwb_error( bwb_ebuf );
#else
      bwb_error( err_valoorange );
#endif
      return bwb_zline( l );
      }

   /* Set the new value. */

   dim_base = newval;

   /* run through the variable list and change any positions that had
      set 0 before OPTION BASE was run */

   for ( current = CURTASK var_start.next; current != &CURTASK var_end; current = current->next )
      {
      current->array_pos[ 0 ] = dim_base;
      }

   /* Return. */

   return bwb_zline( l );

   }

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

        FUNCTION:       var_findnval()

        DESCRIPTION:    This function returns the address of
                        the number for the variable <v>.  If
                        <v> is a dimensioned array, the address
                        returned is for the double at the
                        position indicated by the integer array
                        <pp>.

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


#if ANSI_C
bnumber *
var_findnval( struct bwb_variable *v, int *pp )
#else
bnumber *
var_findnval( v, pp )
   struct bwb_variable *v;
   int *pp;
#endif
   {
   size_t offset;
   bnumber *p;
#if INTENSIVE_DEBUG
   register int n;
#endif

   /* Check for appropriate type */

   if ( v->type != NUMBER )
      {
#if PROG_ERRORS
      sprintf ( bwb_ebuf, "in var_findnval(): Variable <%s> is not a number.",
         v->name );
      bwb_error( bwb_ebuf );
#else
      bwb_error( err_mismatch );
#endif
      return NULL;
      }

   /* Check subscripts */

   if ( dim_check( v, pp ) == FALSE )
      {
      return NULL;
      }

   /* Calculate and return the address of the dimensioned array */

   offset = dim_unit( v, pp );

#if INTENSIVE_DEBUG
   for ( n = 0; n < v->dimensions; ++n )
      {
      sprintf( bwb_ebuf,
         "in var_findnval(): dimensioned variable pos <%d> <%d>.",
         n, pp[ n ] );
      bwb_debug( bwb_ebuf );
      }
#endif

   p = v->memnum;
   return (p + offset);

   }

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

        FUNCTION:       var_findsval()

        DESCRIPTION:    This function returns the address of
                        the string for the variable <v>.  If
                        <v> is a dimensioned array, the address
                        returned is for the string at the
                        position indicated by the integer array
                        <pp>.

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

#if ANSI_C
bstring *
var_findsval( struct bwb_variable *v, int *pp )
#else
bstring *
var_findsval( v, pp )
   struct bwb_variable *v;
   int *pp;
#endif
   {
   size_t offset;
   bstring *p;

#if INTENSIVE_DEBUG
   register int n;

   sprintf( bwb_ebuf, "in var_findsval(): entered, var <%s>", v->name );
   bwb_debug( bwb_ebuf );
#endif

   /* Check for appropriate type */

   if ( v->type != STRING )
      {
#if PROG_ERRORS
      sprintf ( bwb_ebuf, "in var_findsval(): Variable <%s> is not a string.", v->name );
      bwb_error( bwb_ebuf );
#else
      bwb_error( err_mismatch );
#endif
      return NULL;
      }

   /* Check subscripts */

   if ( dim_check( v, pp ) == FALSE )
      {
      return NULL;
      }

   /* Calculate and return the address of the dimensioned array */

   offset = dim_unit( v, pp );

#if INTENSIVE_DEBUG
   for ( n = 0; n < v->dimensions; ++n )
      {
      sprintf( bwb_ebuf,
         "in var_findsval(): dimensioned variable pos <%d> val <%d>.",
         n, pp[ n ] );
      bwb_debug( bwb_ebuf );
      }
#endif

   p = v->memstr;
   return (p + offset);

   }

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

        FUNCTION:       dim_check()

        DESCRIPTION:    This function checks subscripts of a
                        specific variable to be sure that they
                        are within the correct range.

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

#if ANSI_C
static int
dim_check( struct bwb_variable *v, int *pp )
#else
static int
dim_check( v, pp )
   struct bwb_variable *v;
   int *pp;
#endif
   {
   register int n;

   /* Check for dimensions */

   if ( v->dimensions < 1 )
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "in dim_check(): var <%s> dimensions <%d>",
         v->name, v->dimensions );
      bwb_error( bwb_ebuf );
#else
      bwb_error( err_valoorange );
#endif
      return FALSE;
      }

   /* Check for validly allocated array */

   if (( v->type == NUMBER ) && ( v->memnum == NULL ))
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "in dim_check(): numerical var <%s> memnum not allocated",
	 v->name );
      bwb_error( bwb_ebuf );
#else
      bwb_error( err_valoorange );
#endif
      return FALSE;
      }

   if (( v->type == STRING ) && ( v->memstr == NULL ))
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "in dim_check(): string var <%s> memstr not allocated",
	 v->name );
      bwb_error( bwb_ebuf );
#else
      bwb_error( err_valoorange );
#endif
      return FALSE;
      }

   /* Now check subscript values */

   for ( n = 0; n < v->dimensions; ++n )
      {
      if ( ( pp[ n ] < dim_base ) || ( ( pp[ n ] - dim_base )
         > v->array_sizes[ n ] ))
         {
#if PROG_ERRORS
         sprintf( bwb_ebuf, "in dim_check(): array subscript var <%s> pos <%d> val <%d> out of range <%d>-<%d>.",
            v->name, n, pp[ n ], dim_base, v->array_sizes[ n ]  );
         bwb_error( bwb_ebuf );
#else
         bwb_error( err_valoorange );
#endif
         return FALSE;
         }
      }

   /* No problems found */

   return TRUE;

   }

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

        FUNCTION:       var_make()

        DESCRIPTION:	This function initializes a variable,
        		allocating necessary memory for it.

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

#if ANSI_C
int
var_make( struct bwb_variable *v, int type )
#else
int
var_make( v, type )
   struct bwb_variable *v;
   int type;
#endif
   {
   size_t data_size;
   bstring *b;
   bstring *sp; /* JBV */
   register int n; /* JBV */
#if TEST_BSTRING
   static int tnumber = 0;
#endif

   switch( type )
      {
      case STRING:
         v->type = STRING;
         data_size = sizeof( bstring );
         break;
      default:
         v->type = NUMBER;
         data_size = sizeof( bnumber );
         break;
      }

   /* get memory for array */

   /* First kleanup the joint (JBV) */
   if (v->memnum != NULL)
   {
       /* Revised to FREE pass-thru call by JBV */
       FREE(v->memnum, "var_make");
       v->memnum = NULL;
   }
   if (v->memstr != NULL)
   {
       /* Remember to deallocate those far-flung branches! (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_make" );
               sp[ n ].sbuffer = NULL;
           }
           sp[ n ].rab = FALSE;
           sp[ n ].length = 0;
       }
       /* Revised to FREE pass-thru call by JBV */
       FREE(v->memstr, "var_make");
       v->memstr = NULL;
   }
   /* Revised to FREE pass-thru calls by JBV */
   if (v->array_sizes != NULL)
   {
       FREE(v->array_sizes, "var_make");
       v->array_sizes = NULL; /* JBV */
   }
   if (v->array_pos != NULL)
   {
       FREE(v->array_pos, "var_make");
       v->array_pos = NULL; /* JBV */
   }

   if ( v->type == NUMBER )
      {
      /* Revised to CALLOC pass-thru call by JBV */
      if ( ( v->memnum = CALLOC( 2, sizeof( bnumber ), "var_make" )) == NULL )
	 {
	 bwb_error( err_getmem );
	 return FALSE;
	 }
      }
   else
      {
      /* Revised to CALLOC pass-thru call by JBV */
      if ( ( v->memstr = CALLOC( 2, sizeof( bstring ), "var_make" )) == NULL )
	 {
	 bwb_error( err_getmem );
	 return FALSE;
	 }
      }

   /* get memory for array_sizes and array_pos */

   /* Revised to CALLOC pass-thru call by JBV */
   if ( ( v->array_sizes = (int *) CALLOC( 2, sizeof( int ), "var_make" )) == NULL )
      {
      bwb_error( err_getmem );
      return FALSE;
      }

   /* Revised to CALLOC pass-thru call by JBV */
   if ( ( v->array_pos = (int *) CALLOC( 2, sizeof( int ), "var_make" )) == NULL )
      {
      bwb_error( err_getmem );
      return FALSE;
      }

   v->array_pos[ 0 ] = dim_base;
   v->array_sizes[ 0 ] = 1;
   v->dimensions = 1;
   v->common = FALSE;
   v->array_units = 1;

   if ( type == STRING )
      {
      b = var_findsval( v, v->array_pos );
      b->rab = FALSE;
      }

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in var_make(): made variable <%s> type <%c> pos[ 0 ] <%d>",
      v->name, v->type, v->array_pos[ 0 ] );
   bwb_debug( bwb_ebuf );
#endif

#if TEST_BSTRING
   if ( type == STRING )
      {
      b = var_findsval( v, v->array_pos );
      sprintf( b->name, "bstring# %d", tnumber );
      ++tnumber;
      sprintf( bwb_ebuf, "in var_make(): new string variable <%s>",
         b->name );
      bwb_debug( bwb_ebuf );
      }
#endif

   return TRUE;

   }

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

	FUNCTION:       var_islocal()

	DESCRIPTION:    This function determines whether the string
			pointed to by 'buffer' has the name of
			a local variable at the present EXEC stack
			level.

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

#if ANSI_C
extern struct bwb_variable *
var_islocal( char *buffer )
#else
struct bwb_variable *
var_islocal( buffer )
   char *buffer;
#endif
   {
   struct bwb_variable *v;

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in var_islocal(): check for local variable <%s> EXEC level <%d>",
      buffer, CURTASK exsc );
   bwb_debug( bwb_ebuf );
#endif

   /* run through the local variable list and try to find a match */

   for ( v = CURTASK excs[ CURTASK exsc ].local_variable; v != NULL; v = v->next )
      {

#if INTENSIVE_DEBUG
      sprintf( bwb_ebuf, "in var_islocal(): checking var <%s> level <%d>...",
         v->name, CURTASK exsc );
      bwb_debug( bwb_ebuf );
#endif

      if ( strcmp( v->name, buffer ) == 0 )
         {

#if PROG_ERRORS
         switch( v->type )
            {
            case STRING:
            case NUMBER:
               break;
            default:
               sprintf( bwb_ebuf, "in var_islocal(): inappropriate precision for variable <%s>",
                  v->name );
               bwb_error( bwb_ebuf );
               break;
            }
#endif

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

         return v;
         }

      }

   /* search failed, return NULL */

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in var_islocal(): Failed to find local variable <%s> level <%d>",
      buffer, CURTASK exsc );
   bwb_debug( bwb_ebuf );
#endif

   return NULL;

   }

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

        FUNCTION:       bwb_vars()

        DESCRIPTION:    This function implements the Bywater-
        		specific debugging command VARS, which
        		gives a list of all variables defined
        		in memory.

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

#if PERMANENT_DEBUG

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

   /* run through the variable list and print variables */

   for ( v = CURTASK var_start.next; v != &CURTASK var_end; v = v->next )
      {
      sprintf( bwb_ebuf, "variable <%s>\t", v->name );
      prn_xprintf( stdout, bwb_ebuf );
      switch( v->type )
         {
         case STRING:
            str_btoc( tbuf, var_getsval( v ) );
	    sprintf( bwb_ebuf, "STRING\tval: <%s>\n", tbuf );
	    prn_xprintf( stdout, bwb_ebuf );
            break;
         case NUMBER:
#if NUMBER_DOUBLE
	    sprintf( bwb_ebuf, "NUMBER\tval: <%lf>\n", var_getnval( v ) );
	    prn_xprintf( stdout, bwb_ebuf );
#else
	    sprintf( bwb_ebuf, "NUMBER\tval: <%f>\n", var_getnval( v ) );
	    prn_xprintf( stdout, bwb_ebuf );
#endif
            break;
         default:
	    sprintf( bwb_ebuf, "ERROR: type is <%c>", (char) v->type );
	    prn_xprintf( stdout, bwb_ebuf );
            break;
         }
      }

   return bwb_zline( l );
   }

#endif