bwb_var.c

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

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

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

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

   /* call generalized DEF handler with STRING set */

   var_defx( l, STRING );

   return bwb_zline( l );

   }

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

        FUNCTION:	bwb_mid()

	DESCRIPTION:    This function implements the BASIC
			MID$ command.

			Same as MID$ function, except it will set
			the desired substring and not return its
			value.  Added by JBV 10/95

	SYNTAX:		MID$( string-variable$, start-position-in-string
			[, number-of-spaces ] ) = expression

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

#if ANSI_C
struct bwb_line *
bwb_mid( struct bwb_line *l )
#else
struct bwb_line *
bwb_mid( l )
   struct bwb_line *l;
#endif
   {
   char tbuf[ MAXSTRINGSIZE + 1 ];
   char source_string[ MAXSTRINGSIZE + 1 ];
   struct bwb_variable *v;
   static int pos;
   bstring *d;
   int *pp;
   int n_params;
   int p;
   register int n;
   int startpos, numchars, endpos;
   int source_counter, source_length, target_length;
   int target_terminate;
   struct exp_ese *e;

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_mid(): MID$ command" );
   bwb_debug( bwb_ebuf );
#endif

   /* Get past left parenthesis */
   adv_ws( l->buffer, &( l->position ) );
   ++( l->position );
   adv_ws( l->buffer, &( l->position ) );

   /* Get variable name and find variable */
   bwb_getvarname( l->buffer, tbuf, &( l->position ) );
   v = var_find( tbuf );
   if ( v == NULL )
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "in bwb_mid(): failed to find variable" );
      bwb_error( bwb_ebuf );
#else
      bwb_error( err_syntax );
#endif
      }

   if ( v->type != STRING )
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "in bwb_mid(): assignment must be to string variable" );
      bwb_error( bwb_ebuf );
#else
      bwb_error( err_syntax );
#endif
      }

   /* read subscripts */
   pos = 0;
   if ( ( v->dimensions == 1 ) && ( v->array_sizes[ 0 ] == 1 ))
      {
#if INTENSIVE_DEBUG
      sprintf( bwb_ebuf, "in bwb_mid(): variable <%s> has 1 dimension",
         v->name );
     bwb_debug( bwb_ebuf );
#endif
      n_params = 1;
      pp = &p;
      pp[ 0 ] = dim_base;
      }
   else
      {
#if INTENSIVE_DEBUG
      sprintf( bwb_ebuf, "in bwb_mid(): variable <%s> has > 1 dimensions",
         v->name );
      bwb_debug( bwb_ebuf );
#endif
      dim_getparams( l->buffer, &( l->position ), &n_params, &pp );
      }

   CURTASK exps[ CURTASK expsc ].pos_adv = pos;
   for ( n = 0; n < v->dimensions; ++n )
      {
      v->array_pos[ n ] = pp[ n ];
      }

   /* get bstring pointer */
   d = var_findsval( v, pp );

   /* Get past next comma and white space */
   adv_ws( l->buffer, &( l->position ) );
   ++( l->position );
   adv_ws( l->buffer, &( l->position ) );

   /* Get starting position (expression) */
   adv_element( l->buffer, &( l->position ), tbuf );
   pos = 0;
   e = bwb_exp( tbuf, FALSE, &pos );
   startpos = (int) exp_getnval( e );

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_mid(): startpos <%d> buffer <%lX>",
      startpos, (long) d->sbuffer );
   bwb_debug( bwb_ebuf );
#endif

   /* Get past next comma and white space (if they exist) */
   adv_ws( l->buffer, &( l->position ) );
   if (l->buffer[l->position] == ',')
      {
      target_terminate = 0;
      ++( l->position );
      adv_ws( l->buffer, &( l->position ) );
      adv_element( l->buffer, &( l->position ), tbuf );
      pos = 0;
      e = bwb_exp( tbuf, FALSE, &pos );
      numchars = (int) exp_getnval( e );
      if ( numchars == 0 )
         {
#if PROG_ERRORS
         sprintf( bwb_ebuf, "in bwb_mid(): destination string no. of chars out of range" );
         bwb_error( bwb_ebuf );
#else
         bwb_error( "Argument out of range" );
#endif
         }
      }
   else
      {
      target_terminate = 1;
      numchars = 0;
      }

   if ( numchars < 0 )
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "in bwb_mid(): negative string length" );
      bwb_error( bwb_ebuf );
#else
      bwb_error( "Negative string length" );
#endif
      }

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_mid(): numchars <%d> target_terminate <%d>", numchars, target_terminate );
   bwb_debug( bwb_ebuf );
#endif

   /* Get past equal sign */
   adv_ws( l->buffer, &( l->position ) );
   if (l->buffer[l->position] == ')')
      {
      ++(l->position);
      adv_ws( l->buffer, &( l->position ) );
      }
   ++(l->position);
   adv_ws( l->buffer, &( l->position ) );

   /* Evaluate string expression */
   e = bwb_exp( l->buffer, FALSE, &( l->position ) );
   if ( e->type != STRING )
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "in bwb_mid(): assignment must be from string expression" );
      bwb_error( bwb_ebuf );
#else
      bwb_error( err_syntax );
#endif
      }

   /* Prepare to MID the string */
   str_btoc( source_string, exp_getsval( e ) );
   str_btoc( tbuf, d );
   target_length = strlen( tbuf );
   if ( startpos > ( target_length + 1 ) )
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "in bwb_mid(): non-contiguous string created" );
      bwb_error( bwb_ebuf );
#else
      bwb_error( "Non-contiguous string created" );
#endif
      }

   if ( startpos < 1 )
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "in bwb_mid(): destination string start position out of range" );
      bwb_error( bwb_ebuf );
#else
      bwb_error( "Argument out of range" );
#endif
      }

   source_length = strlen( source_string );
   if ( numchars == 0 ) numchars = source_length;
   endpos = startpos + numchars - 1;

   /* MID the string */
   if ( endpos < startpos ) tbuf[ startpos - 1 ] = '\0';
   else
      {
      source_counter = 0;
      for ( n = startpos - 1; n < endpos; ++n )
         {
         if ( source_counter < source_length )
            tbuf[ n ] = source_string[ source_counter ];
         else
            tbuf[ n ] = ' ';
         ++source_counter;
         }
      /* Terminate if indicated or characters were added */
      if ( ( endpos > target_length ) || ( target_terminate == 1 ) )
         tbuf[ endpos ] = '\0';
      }
   str_ctob( d, tbuf );

#if MULTISEG_LINES
   adv_eos( l->buffer, &( l->position ));
#endif

   return bwb_zline( l );

   }

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

        Function:	var_defx()

	DESCRIPTION:    This function is a generalized DEFxxx handler.

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

#if ANSI_C
static int
var_defx( struct bwb_line *l, int type )
#else
static int
var_defx( l, type )
   struct bwb_line *l;
   int type;
#endif
   {
   int loop;
   register int c;
   static char vname[ 2 ];
   struct bwb_variable *v;

   /* loop while there are variable names to process */

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

      /* check for end of line or line segment */

      adv_ws( l->buffer, &( l->position ) );
      switch( l->buffer[ l->position ] )
         {
         case '\n':
         case '\r':
         case '\0':
         case ':':
            return FALSE;
         }

      /* find a sequence of letters for variables */

      if ( var_letseq( l->buffer, &( l->position ), &first, &last ) == FALSE )
         {
         return FALSE;
         }

      /* loop through the list getting variables */

      for ( c = first; c <= last; ++c )
         {
         vname[ 0 ] = (char) c;
         vname[ 1 ] = '\0';

#if INTENSIVE_DEBUG
         sprintf( bwb_ebuf, "in var_defx(): calling var_find() for <%s>",
            vname );
         bwb_debug( bwb_ebuf );
#endif

         v = var_find( vname );

         /* but var_find() assigns on the basis of name endings
            (so all in this case should be SINGLEs), so we must
            force the type of the variable */

         var_make( v, type );

         }

      }

   return TRUE;

   }

#endif				/* MS_CMDS */

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

        Function:	var_letseq()

	DESCRIPTION:    This function finds a sequence of letters
			for a DEFxxx command.

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

#if ANSI_C
static int
var_letseq( char *buffer, int *position, int *start, int *end )
#else
static int
var_letseq( buffer, position, start, end )
   char *buffer;
   int *position;
   int *start;
   int *end;
#endif
   {

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in var_letseq(): buffer <%s>", &( buffer[ *position ] ));
   bwb_debug( bwb_ebuf );
#endif

   /* advance beyond whitespace */

   adv_ws( buffer, position );

   /* check for end of line */

   switch( buffer[ *position ] )
      {
      case '\0':
      case '\n':
      case '\r':
      case ':':
         return TRUE;
      }

   /* character at this position must be a letter */

   if ( isalpha( buffer[ *position ] ) == 0 )
      {
      bwb_error( err_defchar );
      return FALSE;
      }

   *end = *start = buffer[ *position ];

   /* advance beyond character and whitespace */

   ++( *position );
   adv_ws( buffer, position );

   /* check for hyphen, indicating sequence of more than one letter */

   if ( buffer[ *position ] == '-' )
      {

      ++( *position );

      /* advance beyond whitespace */

      adv_ws( buffer, position );

      /* character at this position must be a letter */

      if ( isalpha( buffer[ *position ] ) == 0 )
         {
         *end = *start;
         }
      else
         {
         *end = buffer[ *position ];
         ++( *position );
         }

      }

   /* advance beyond comma if present */

   if ( buffer[ *position ] == ',' )
      {
      ++( *position );
      }

   return TRUE;
   }

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

	FUNCTION:       bwb_const()

	DESCRIPTION:    This function takes the string in lb
			(the large buffer), finds a string constant
			(beginning and ending with quotation marks),
			and returns it in sb (the small buffer),
			appropriately incrementing the integer
			pointed to by n. The string in lb should NOT
			include the initial quotation mark.

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

#if ANSI_C
int
bwb_const( char *lb, char *sb, int *n )
#else
int
bwb_const( lb, sb, n )
   char *lb;
   char *sb;
   int *n;
#endif
   {
   register int s;

   ++*n;                        /* advance past quotation mark */
   s = 0;

   while ( TRUE )
      {
      switch ( lb[ *n ] )
         {
         case '\"':
            sb[ s ] = 0;
            ++*n;               /* advance past ending quotation mark */
            return TRUE;
         case '\n':
         case '\r':
         case 0:
            sb[ s ] = 0;
            return TRUE;
         default:
            sb[ s ] = lb[ *n ];
            break;
         }

      ++*n;                     /* advance to next character in large buffer */
      ++s;                      /* advance to next position in small buffer */
      sb[ s ] = 0;              /* terminate with 0 */
      }

   }

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

	FUNCTION:       bwb_getvarname()

	DESCRIPTION:    This function takes the string in lb
			(the large buffer), finds a variable name,
			and returns it in sb (the small buffer),
			appropriately incrementing the integer
			pointed to by n.

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

#if ANSI_C
int
bwb_getvarname( char *lb, char *sb, int *n )
#else
int
bwb_getvarname( lb, sb, n )
   char *lb;
   char *sb;
   int *n;
#endif
   {
   register int s;

   s = 0;

   /* advance beyond whitespace */

   adv_ws( lb, n );

   while ( TRUE )
      {
      switch ( lb[ *n ] )
         {
         case ' ':              /* whitespace */
         case '\t':
         case '\n':             /* end of string */
         case '\r':
         case 0:
         case ':':              /* end of expression */
         case ',':
         case ';':
         case '(':              /* beginning of parameter list for dimensioned array */
         case '+':              /* add variables */
         case '=':              /* Don't forget this one (JBV) */
            sb[ s ] = 0;
            return TRUE;
         default:
            sb[ s ] = lb[ *n ];
            break;
         }

      ++*n;                     /* advance to next character in large buffer */
      ++s;                      /* advance to next position in small buffer */
      sb[ s ] = 0;              /* terminate with 0 */

#if INTENSIVE_DEBUG
      sprintf( bwb_ebuf, "in bwb_getvarname(): found <%s>", sb );
      bwb_debug( bwb_ebuf );
#endif
      }

   }

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

        FUNCTION:       var_find()

	DESCRIPTION:    This C function attempts to find a variable
			name matching the argument in buffer. If
			it fails to find a matching name, it
			sets up a new variable with that name.

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

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

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in var_find(): received <%s>", buffer );
   bwb_debug( bwb_ebuf );
#endif

   /* check for a local variable at this EXEC level */

   v = var_islocal( buffer );
   if ( v != NULL )
      {
      return v;
      }

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

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

      if ( strcmp( v->name, buffer ) == 0 )
         {
         switch( v->type )
            {
            case STRING:
            case NUMBER:
               break;
            default:
#if PROG_ERRORS
               sprintf( bwb_ebuf, "in var_find(): inappropriate precision for variable <%s>",
                  v->name );
               bwb_error( bwb_ebuf );
#endif
               break;
            }
#if INTENSIVE_DEBUG
         sprintf( bwb_ebuf, "in var_find(): found global variable <%s>", v->name );
         bwb_debug( bwb_ebuf );
#endif

         return v;
         }

      }

   /* presume this is a new variable, so initialize it... */
   /* check for NULL variable name */

   if ( strlen( buffer ) == 0 )
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "in var_find(): NULL variable name received\n" );
      bwb_error( bwb_ebuf );
#else
      bwb_error( err_syntax );
#endif
      return NULL;
      }

   /* initialize new variable */

   v = var_new( buffer );

   /* set place at beginning of variable chain */

   v->next = CURTASK var_start.next;
   CURTASK var_start.next = v;

   /* normally not a preset */

   v->preset = FALSE;

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in var_find(): initialized new variable <%s> type <%c>, dim <%d>",