bwb_fnc.c

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

   static int init = FALSE;
   int spaces;
   register int i;
   bstring *b;

   /* check for correct number of parameters */

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

   /* initialize nvar if necessary */

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

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

   tbuf[ 0 ] = '\0';
   spaces = (int) var_getnval( &( argv[ 0 ] ));

   /* add spaces to the string */

   for ( i = 0; i < spaces; ++i )
      {
      tbuf[ i ] = ' ';
      tbuf[ i + 1 ] = '\0';
      }

   b = var_getsval( &nvar );
   str_ctob( b, tbuf );

   return &nvar;
   }

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

        FUNCTION:       fnc_environ()

        DESCRIPTION:    This C function implements the BASIC
			ENVIRON$() function, returning the value
			of a specified environment string.

	SYNTAX:		ENVIRON$( variable-string )

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

#if ANSI_C
struct bwb_variable *
fnc_environ( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_environ( argc, argv, unique_id )
   int argc;
   struct bwb_variable *argv;
   int unique_id;
#endif
   {
   char tbuf[ MAXSTRINGSIZE + 1 ];
   char tmp[ MAXSTRINGSIZE + 1 ];
   static struct bwb_variable nvar;
   static int init = FALSE;

   /* initialize the variable if necessary */

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

   /* check for correct number of parameters */

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

   /* resolve the argument and place string value in tbuf */

   str_btoc( tbuf, var_getsval( &( argv[ 0 ] )));

   /* call getenv() then write value to string */

   strcpy( tmp, getenv( tbuf ));
   str_ctob( var_findsval( &nvar, nvar.array_pos ), tmp );

   /* return address of nvar */

   return &nvar;

   }

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

        FUNCTION:       fnc_err()

	DESCRIPTION:    This C function implements the BASIC
			ERR function, returning the error number
			for the most recent error.

			Please note that as of revision level
			2.10, bwBASIC does not utilize a standard
			list of error numbers, so numbers returned
			by this function will not be those found
			in either ANSI or Microsoft or other
			BASIC error tables.

	SYNTAX:		ERR

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

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

   /* initialize nvar if necessary */

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

   * var_findnval( &nvar, nvar.array_pos ) = (bnumber) err_number;

   return &nvar;
   }

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

        FUNCTION:       fnc_erl()

	DESCRIPTION:    This C function implements the BASIC
			ERL function, returning the line number
			for the most recent error.

	SYNTAX:		ERL

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

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

   /* initialize nvar if necessary */

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

   * var_findnval( &nvar, nvar.array_pos ) = (bnumber) err_line;

   return &nvar;
   }

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

        FUNCTION:       fnc_loc()

        DESCRIPTION:    This C function implements the BASIC
			LOC() function. As implemented here,
			this only works for random-acess files.

	SYNTAX:		LOC( device-number )

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

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

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in fnc_loc(): received f_arg <%f> ",
      var_getnval( &( argv[ 0 ] ) ) );
   bwb_debug( bwb_ebuf );
#endif

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

   dev_number = (int) var_getnval( &( argv[ 0 ] ) );

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

   /* note if this is the very beginning of the file */

   if ( dev_table[ dev_number ].loc == 0 )
      {
      * var_findnval( &nvar, nvar.array_pos ) = (bnumber) 0;
      }
   else
      {
      * var_findnval( &nvar, nvar.array_pos ) =
         (bnumber) dev_table[ dev_number ].next_record;
      }

   return &nvar;
   }

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

        FUNCTION:       fnc_eof()

        DESCRIPTION:    This C function implements the BASIC
			EOF() function.

	SYNTAX:		EOF( device-number )

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

#if ANSI_C
struct bwb_variable *
fnc_eof( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_eof( argc, argv, unique_id )
   int argc;
   struct bwb_variable *argv;
   int unique_id;
#endif
   {
   static struct bwb_variable nvar;
   static int init = FALSE;
   int dev_number;
   int cur_pos, end_pos; /* JBV */

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in fnc_loc(): received f_arg <%f> ",
      var_getnval( &( argv[ 0 ] ) ) );
   bwb_debug( bwb_ebuf );
#endif

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

   dev_number = (int) var_getnval( &( argv[ 0 ] ) );

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

   /* note if this is the very beginning of the file */

   if ( dev_table[ dev_number ].mode == DEVMODE_AVAILABLE )
      {
      bwb_error( err_devnum );
      * var_findnval( &nvar, nvar.array_pos ) = (bnumber) TRUE;
      }
   else if ( dev_table[ dev_number ].mode == DEVMODE_CLOSED )
      {
      bwb_error( err_devnum );
      * var_findnval( &nvar, nvar.array_pos ) = (bnumber) TRUE;
      }

   /*------------------------------------------------------*/
   /* feof() finds EOF when you read past the end of file. */
   /* This is not how BASIC works, at least not GWBASIC.   */
   /* The EOF function should return an EOF indication     */
   /* when you are <at> the end of the file, not past it.  */
   /* This routine was modified to reflect this.           */
   /* (JBV, 10/15/95)                                      */
   /*------------------------------------------------------*/

   /*  else if ( feof( dev_table[ dev_number ].cfp ) == 0 ) */
   else if ( ftell( dev_table[ dev_number ].cfp ) !=
   dev_table [ dev_number ].lof )
      {
      * var_findnval( &nvar, nvar.array_pos ) = (bnumber) FALSE;
      }
   else
      {
      * var_findnval( &nvar, nvar.array_pos ) = (bnumber) TRUE;
      }

   return &nvar;
   }

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

        FUNCTION:       fnc_lof()

        DESCRIPTION:    This C function implements the BASIC
			LOF() function.

	SYNTAX:		LOF( device-number )

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

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

/* Following section no longer needed, removed by JBV */
/* #if UNIX_CMDS
   static struct stat statbuf;
   int r;
#endif */

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in fnc_lof(): received f_arg <%f> ",
      var_getnval( &( argv[ 0 ] ) ) );
   bwb_debug( bwb_ebuf );
#endif

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

   dev_number = (int) var_getnval( &( argv[ 0 ] ) );

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

   /* stat the file */

/* Following section no longer needed, removed by JBV */
/* #if UNIX_CMDS

   r = stat( dev_table[ dev_number ].filename, &statbuf );

   if ( r != 0 )
      {
#if PROG_ERRORS
      sprintf( bwb_ebuf, "in fnc_lof(): failed to find file <%s>",
         dev_table[ dev_number ].filename );
      bwb_error( bwb_ebuf );
#else
      sprintf( bwb_ebuf, ERR_OPENFILE,
         dev_table[ dev_number ].filename );
      bwb_error( bwb_ebuf );
#endif
      return NULL;
      }

   * var_findnval( &nvar, nvar.array_pos ) = (bnumber) statbuf.st_size; */

/* #else */  /* Removed by JBV, no longer needed */

   /* * var_findnval( &nvar, nvar.array_pos ) = (bnumber) FALSE; */
   * var_findnval( &nvar, nvar.array_pos ) =
      (bnumber) dev_table[ dev_number ].lof; /* JBV */

/* #endif */  /* Removed by JBV, no longer needed */

   return &nvar;
   }

#endif					/* MS_FUNCS */

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

        FUNCTION:       fnc_test()

        DESCRIPTION:    This is a test function, developed in
                        order to test argument passing to
                        BASIC functions.

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

#if INTENSIVE_DEBUG
#if ANSI_C
struct bwb_variable *
fnc_test( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_test( argc, argv, unique_id )
   int argc;
   struct bwb_variable *argv;
   int unique_id;
#endif
   {
   register int c;
   static struct bwb_variable rvar;
   static char *tbuf;
   static int init = FALSE;

   /* initialize the variable if necessary */

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

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

   sprintf( bwb_ebuf, "TEST function: received %d arguments: \n", argc );
   prn_xprintf( stderr, bwb_ebuf );

   for ( c = 0; c < argc; ++c )
      {
      str_btoc( tbuf, var_getsval( &argv[ c ] ) );
      sprintf( bwb_ebuf, "                  arg %d (%c): <%s> \n", c,
	 argv[ c ].type, tbuf );
      prn_xprintf( stderr, bwb_ebuf );
      }

   return &rvar;

   }
#endif

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

        FUNCTION:       fnc_checkargs()

        DESCRIPTION:    This C function checks the arguments to
			functions.

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

#if PROG_ERRORS
#else
#if ANSI_C
int
fnc_checkargs( int argc, struct bwb_variable *argv, int min, int max )
#else
int
fnc_checkargs( argc, argv, min, max )
   int argc;
   struct bwb_variable *argv;
   int min;
   int max;
#endif
   {

   if ( argc < min )
      {
      bwb_error( err_syntax );
      return FALSE;
      }
   if ( argc > max )
      {
      bwb_error( err_syntax );
      return FALSE;
      }

   return TRUE;

   }
#endif

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

        FUNCTION:       fnc_fncs()

        DESCRIPTION:    This C function is used for debugging
                        purposes; it prints a list of all defined
                        functions.

	SYNTAX:		FNCS

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

#if PERMANENT_DEBUG

#if ANSI_C
struct bwb_line *
bwb_fncs( struct bwb_line *l )
#else
struct bwb_line *
bwb_fncs( l )
   struct bwb_line *l;
#endif
   {
   struct bwb_function *f;

   for ( f = CURTASK fnc_start.next; f != &CURTASK fnc_end; f = f->next )
      {
      sprintf( bwb_ebuf, "%s\t%c \n", f->name, f->type );
      prn_xprintf( stderr, bwb_ebuf );
      }

   return bwb_zline( l );

   }
#endif