bwb_prn.c

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

#else
int
prn_precision( v )
   struct bwb_variable *v;
#endif
   {
   int max_precision = 6;
   bnumber nval, d;
   int r;

   /* check for double value */

   if ( v->type == NUMBER )
      {
      max_precision = 12;
      }

   /* get the value in nval */

   nval = (bnumber) fabs( (double) var_getnval( v ) );

   /* cycle through until precision is found */

   d = (bnumber) 1;
   for ( r = 0; r < max_precision; ++r )
      {

#if INTENSIVE_DEBUG
      sprintf( bwb_ebuf, "in prn_precision(): fmod( %f, %f ) = %.12f",
         nval, d, fmod( (double) nval, (double) d ) );
      bwb_debug( bwb_ebuf );
#endif

      if ( fmod( (double) nval, (double) d ) < 0.0000001 ) /* JBV */
         {
         return r;
         }
      d /= 10;
      }

   /* return */

   return r;

   }

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

        FUNCTION:       bwb_debug()

        DESCRIPTION:    This function is called to display
                        debugging messages in Bywater BASIC.
                        It does not break out at the current
                        point (as bwb_error() does).

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

#if PERMANENT_DEBUG

#if ANSI_C
int
bwb_debug( char *message )
#else
int
bwb_debug( message )
   char *message;
#endif
   {
   char tbuf[ MAXSTRINGSIZE + 1 ];

   fflush( stdout );
   fflush( errfdevice );
   if ( prn_col != 1 )
      {
      prn_xprintf( errfdevice, "\n" );
      }
   sprintf( tbuf, "DEBUG %s\n", message );
   prn_xprintf( errfdevice, tbuf );

   return TRUE;
   }
#endif

#if COMMON_CMDS

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

        FUNCTION:       bwb_lerror()

        DESCRIPTION:    This function implements the BASIC ERROR
                        command.

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

#if ANSI_C
struct bwb_line *
bwb_lerror( struct bwb_line *l )
#else
struct bwb_line *
bwb_lerror( l )
   struct bwb_line *l;
#endif
   {
   char tbuf[ MAXSTRINGSIZE + 1 ];
   int n;
   struct exp_ese *e; /* JBV */
   int pos; /* JBV */

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

   /* Check for argument */

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

   /* get the variable name or numerical constant */

   adv_element( l->buffer, &( l->position ), tbuf );
   /* n = atoi( tbuf ); */  /* Removed by JBV */

   /* Added by JBV */
   pos = 0;
   e = bwb_exp( tbuf, FALSE, &pos );
   n = (int) exp_getnval( e );

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_lerror(): error number is <%d> ", n );
   bwb_debug( bwb_ebuf );
#endif

   /* check the line number value */

   if ( ( n < 0 ) || ( n >= N_ERRORS ))
      {
      sprintf( bwb_ebuf, "Error number %d is out of range", n );
      bwb_xerror( bwb_ebuf );
      return bwb_zline( l );
      }

   bwb_xerror( err_table[ n ] );

   return bwb_zline( l );

   }

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

        FUNCTION:       bwb_width()

	DESCRIPTION:    This C function implements the BASIC WIDTH
			command, setting the maximum output width
			for a specified file or output device.

	SYNTAX:		WIDTH [# device-number,] number

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

#if ANSI_C
struct bwb_line *
bwb_width( struct bwb_line *l )
#else
struct bwb_line *
bwb_width( l )
   struct bwb_line *l;
#endif
   {
   int req_devnumber;
   int req_width;
   struct exp_ese *e;
   char tbuf[ MAXSTRINGSIZE + 1 ];
   int pos;

   /* detect device number if present */

   req_devnumber = -1;
   adv_ws( l->buffer, &( l->position ) );

   if ( l->buffer[ l->position ] == '#' )
      {
      ++( l->position );
      adv_element( l->buffer, &( l->position ), tbuf );
      pos = 0;
      e = bwb_exp( tbuf, FALSE, &pos );
      adv_ws( l->buffer, &( l->position ) );
      if ( l->buffer[ l->position ] == ',' )
         {
         ++( l->position );
         }
      else
         {
#if PROG_ERRORS
         bwb_error( "in bwb_width(): no comma after#n" );
#else
         bwb_error( err_syntax );
#endif
         return bwb_zline( l );
         }

      req_devnumber = (int) exp_getnval( e );

      /* check the requested device number */

      if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES ))
         {
#if PROG_ERRORS
         bwb_error( "in bwb_width(): Requested device number is out of range." );
#else
         bwb_error( err_devnum );
#endif
         return bwb_zline( l );
         }

#if INTENSIVE_DEBUG
      sprintf( bwb_ebuf, "in bwb_width(): device number is <%d>",
         req_devnumber );
      bwb_debug( bwb_ebuf );
#endif

      }

   /* read the width requested */

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

   /* check the width */

   if ( ( req_width < 1 ) || ( req_width > 255 ))
      {
#if PROG_ERRORS
      bwb_error( "in bwb_width(): Requested width is out of range (1-255)" );
#else
      bwb_error( err_valoorange );
#endif
      }

   /* assign the width */

   if ( req_devnumber == -1 )
      {
      prn_width = req_width;
      }
   else
      {
      dev_table[ req_devnumber ].width = req_width;
      }

   /* return */

   return bwb_zline( l );
   }

#endif			/* COMMON_CMDS */

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

        FUNCTION:       bwb_error()

        DESCRIPTION:    This function is called to handle errors
                        in Bywater BASIC.  It displays the error
                        message, then calls the break_handler()
                        routine.

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

#if ANSI_C
int
bwb_error( char *message )
#else
int
bwb_error( message )
   char *message;
#endif
   {
   register int e;
   static char tbuf[ MAXSTRINGSIZE + 1 ];	/* must be permanent */
   static struct bwb_line eline;
   int save_elevel;
   struct bwb_line *cur_l;
   int cur_mode;

   /* try to find the error message to identify the error number */

   err_number = -1;			/* just for now */
   err_line = CURTASK number;		/* set error line number */

   for ( e = 0; e < N_ERRORS; ++e )
      {
      if ( message == err_table[ e ] )	/* set error number */
         {
         err_number = e;
         e = N_ERRORS;			/* break out of loop quickly */
         }
      }

   /* set the position in the current line to the end */

   while( is_eol( bwb_l->buffer, &( bwb_l->position ) ) != TRUE )
      {
      ++( bwb_l->position );
      }

   /* if err_gosubl is not set, then use xerror routine */

   if ( strlen( err_gosubl ) == 0 )
      {
      return bwb_xerror( message );
      }

#if INTENSIVE_DEBUG
   fprintf( stderr, "!!!!! USER_CALLED ERROR HANDLER\n" );
#endif

   /* save line and mode */

   cur_l = bwb_l;
   cur_mode = CURTASK excs[ CURTASK exsc ].code;

   /* err_gosubl is set; call user-defined error subroutine */

   sprintf( tbuf, "%s %s", CMD_GOSUB, err_gosubl );
   eline.next = &CURTASK bwb_end;
   eline.position = 0;
   eline.marked = FALSE;
   eline.buffer = tbuf;
   bwb_setexec( &eline, 0, EXEC_NORM );

   /* must be executed now */

   save_elevel = CURTASK exsc;
   bwb_execline();              /* This is a call to GOSUB and will increment
				   the exsc counter above save_elevel */

   while ( CURTASK exsc != save_elevel )        /* loop until return from GOSUB loop */
      {
      bwb_execline();
      }

   cur_l->next->position = 0;
   bwb_setexec( cur_l->next, 0, cur_mode );

   return TRUE;

   }

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

        FUNCTION:       bwb_xerror()

        DESCRIPTION:    This function is called by bwb_error()
                        in Bywater BASIC.  It displays the error
                        message, then calls the break_handler()
                        routine.

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

#if ANSI_C
static int
bwb_xerror( char *message )
#else
static int
bwb_xerror( message )
   char *message;
#endif
   {

   bwx_errmes( message );

   break_handler();

   return FALSE;
   }

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

        FUNCTION:       bwb_esetovar()

        DESCRIPTION:    This function converts the value in expression
			stack 'e' to a bwBASIC variable structure.

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

#if ANSI_C
static struct bwb_variable *
bwb_esetovar( struct exp_ese *e )
#else
static struct bwb_variable *
bwb_esetovar( e )
   struct exp_ese *e;
#endif
   {
   static struct bwb_variable b;

   var_make( &b, e->type );

   switch( e->type )
      {
      case STRING:
         str_btob( var_findsval( &b, b.array_pos ), exp_getsval( e ) );
         break;
      default:
         * var_findnval( &b, b.array_pos ) = e->nval;
         break;
      }

   return &b;

   }

#if COMMON_CMDS

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

        FUNCTION:       bwb_write()

	DESCRIPTION:    This C function implements the BASIC WRITE
			command.

	SYNTAX:		WRITE [# device-number,] element [, element ]....

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

#if ANSI_C
struct bwb_line *
bwb_write( struct bwb_line *l )
#else
struct bwb_line *
bwb_write( l )
   struct bwb_line *l;
#endif
   {
   struct exp_ese *e;
   int req_devnumber;
   int pos;
   FILE *fp;
   char tbuf[ MAXSTRINGSIZE + 1 ];
   int loop;
   static struct bwb_variable nvar;
   static int init = FALSE;

   /* initialize variable if necessary */

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

   /* detect device number if present */

   adv_ws( l->buffer, &( l->position ) );

   if ( l->buffer[ l->position ] == '#' )
      {
      ++( l->position );
      adv_element( l->buffer, &( l->position ), tbuf );
      pos = 0;
      e = bwb_exp( tbuf, FALSE, &pos );
      adv_ws( l->buffer, &( l->position ) );
      if ( l->buffer[ l->position ] == ',' )
         {
         ++( l->position );
         }
      else
         {
#if PROG_ERRORS
         bwb_error( "in bwb_write(): no comma after#n" );
#else
         bwb_error( err_syntax );
#endif
         return bwb_zline( l );
         }

      req_devnumber = (int) exp_getnval( e );

      /* check the requested device number */

      if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES ))
         {
#if PROG_ERRORS
         bwb_error( "in bwb_write(): Requested device number is out of range." );
#else
         bwb_error( err_devnum );
#endif
         return bwb_zline( l );
         }

      if (( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED ) ||
         ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ))
         {
#if PROG_ERRORS
         bwb_error( "in bwb_write(): Requested device number is not open." );
#else
         bwb_error( err_devnum );
#endif

         return bwb_zline( l );
         }

      if ( dev_table[ req_devnumber ].mode != DEVMODE_OUTPUT )
         {
#if PROG_ERRORS
         bwb_error( "in bwb_write(): Requested device is not open for OUTPUT." );
#else
         bwb_error( err_devnum );
#endif

         return bwb_zline( l );
         }

#if INTENSIVE_DEBUG
      sprintf( bwb_ebuf, "in bwb_write(): device number is <%d>",
         req_devnumber );
      bwb_debug( bwb_ebuf );
#endif

      /* look up the requested device in the device table */

      fp = dev_table[ req_devnumber ].cfp;

      }

   else
      {
      fp = stdout;
      }

   /* be sure there is an element to print */

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

   /* loop through elements */

   while ( loop == TRUE )
      {

      /* get the next element */

      e = bwb_exp( l->buffer, FALSE, &( l->position ));

      /* perform type-specific output */

      switch( e->type )
         {
         case STRING:
            xputc( fp, '\"' );
            str_btoc( tbuf, exp_getsval( e ) );
            prn_xprintf( fp, tbuf );
            xputc( fp, '\"' );
#if INTENSIVE_DEBUG
            sprintf( bwb_ebuf, "in bwb_write(): output string element <\"%s\">",
               tbuf );
            bwb_debug( bwb_ebuf );
#endif
            break;
         default:
            * var_findnval( &nvar, nvar.array_pos ) =
               exp_getnval( e );
#if NUMBER_DOUBLE
            sprintf( tbuf, " %.*lf", prn_precision( &nvar ),
               var_getnval( &nvar ) );
#else
            sprintf( tbuf, " %.*f", prn_precision( &nvar ),
               var_getnval( &nvar ) );
#endif
            prn_xprintf( fp, tbuf );
#if INTENSIVE_DEBUG
            sprintf( bwb_ebuf, "in bwb_write(): output numerical element <%s>",
               tbuf );
            bwb_debug( bwb_ebuf );
#endif
            break;
         }				/* end of case for type-specific output */

      /* seek a comma at end of element */

      adv_ws( l->buffer, &( l->position ) );
      if ( l->buffer[ l->position ] == ',' )
         {
         xputc( fp, ',' );
         ++( l->position );
         }

      /* no comma: end the loop */

      else
         {
         loop = FALSE;
         }

      }					/* end of loop through elements */

   /* print LF */

   xputc( fp, '\n' );

   /* return */

   return bwb_zline( l );
   }

#endif