bwb_dio.c

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

#endif

      /* check for valid requested device number */

      if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES ))
         {
#if PROG_ERRORS
         bwb_error( "in bwb_close(): Requested device number is out if 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_close(): Requested device number is not in use." );
#else
         bwb_error( err_devnum );
#endif

         return bwb_zline( l );
         }

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

      /* attempt to close the file */

      if ( fclose( dev_table[ req_devnumber ].cfp ) != 0 )
         {
#if PROG_ERRORS
         bwb_error( "in bwb_close(): Failed to close the device" );
#else
         bwb_error( err_dev );
#endif
         return bwb_zline( l );
         }

      /* mark the device in the table as unavailable */

      dev_table[ req_devnumber ].mode = DEVMODE_CLOSED;

      /* Revised to FREE pass-thru call by JBV */
      if ( dev_table[ req_devnumber ].buffer != NULL )
      {
          FREE( dev_table[ req_devnumber ].buffer, "bwb_close" ); /* JBV */
          dev_table[ req_devnumber ].buffer = NULL; /* JBV */
      }

      /* eat up any remaining whitespace */

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

      }

   while ( l->buffer[ l->position ] == ',' || blanket_close == 1); /* JBV */

   /* return next line number in sequence */

   return bwb_zline( l );
   }

#endif 				/* COMMON_CMDS */

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

        FUNCTION:       bwb_chdir()

	DESCRIPTION:    This function implements the BASIC CHDIR
			command to switch logged directories.

	SYNTAX:         CHDIR pathname$

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

#if UNIX_CMDS
#if ANSI_C
struct bwb_line *
bwb_chdir( struct bwb_line *l )
#else
struct bwb_line *
bwb_chdir( l )
   struct bwb_line *l;
#endif
   {
   int r;
   static int position;
   struct exp_ese *e;
   static char *atbuf;
   static int init = FALSE;

   /* get memory for temporary buffers if necessary */

   if ( init == FALSE )
      {
      init = TRUE;

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

   /* get the next element in atbuf */

   adv_element( l->buffer, &( l->position ), atbuf  );

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_chdir(): argument is <%s>", atbuf );
   bwb_debug( bwb_ebuf );
#endif

   /* interpret the argument */

   position = 0;
   e = bwb_exp( atbuf, FALSE, &position );

   if ( e->type != STRING )
      {
      bwb_error( err_argstr );
      return bwb_zline( l );
      }

   /* try to chdir to the requested directory */

   str_btoc( atbuf, &( e->sval ) );
   r = chdir( atbuf );

   /* detect error */

   if ( r == -1 )
      {
      bwb_error( err_opsys );
      return bwb_zline( l );
      }

   return bwb_zline( l );

   }

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

        FUNCTION:       bwb_rmdir()

	DESCRIPTION:    This function implements the BASIC CHDIR
			command to remove a subdirectory.

	SYNTAX:         RMDIR pathname$

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

#if ANSI_C
struct bwb_line *
bwb_rmdir( struct bwb_line *l )
#else
struct bwb_line *
bwb_rmdir( l )
   struct bwb_line *l;
#endif
   {
   int r;
   static int position;
   struct exp_ese *e;
   static char *atbuf;
   static int init = FALSE;

   /* get memory for temporary buffers if necessary */

   if ( init == FALSE )
      {
      init = TRUE;

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

   /* get the next element in atbuf */

   adv_element( l->buffer, &( l->position ), atbuf  );

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_rmdir(): argument is <%s>", atbuf );
   bwb_debug( bwb_ebuf );
#endif

   /* interpret the argument */

   position = 0;
   e = bwb_exp( atbuf, FALSE, &position );

   if ( e->type != STRING )
      {
      bwb_error( err_argstr );
      return bwb_zline( l );
      }

   /* try to remove the requested directory */

   str_btoc( atbuf, &( e->sval ) );
   r = rmdir( atbuf );

   /* detect error */

   if ( r == -1 )
      {
      bwb_error( err_opsys );
      }

   return bwb_zline( l );

   }

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

        FUNCTION:       bwb_mkdir()

	DESCRIPTION:    This function implements the BASIC MKDIR
			command to create a new subdirectory.

	SYNTAX:         MKDIR pathname$

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

#if ANSI_C
struct bwb_line *
bwb_mkdir( struct bwb_line *l )
#else
struct bwb_line *
bwb_mkdir( l )
   struct bwb_line *l;
#endif
   {
   int r;
   static int position;
   struct exp_ese *e;
   static char *atbuf;
   static int init = FALSE;

   /* get memory for temporary buffers if necessary */

   if ( init == FALSE )
      {
      init = TRUE;

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

   /* get the next element in atbuf */

   adv_element( l->buffer, &( l->position ), atbuf  );

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_mkdir(): argument is <%s>", atbuf );
   bwb_debug( bwb_ebuf );
#endif

   /* interpret the argument */

   position = 0;
   e = bwb_exp( atbuf, FALSE, &position );

   if ( e->type != STRING )
      {
      bwb_error( err_argstr );
      return bwb_zline( l );
      }

   /* try to make the requested directory */

   str_btoc( atbuf, &( e->sval ) );
#if MKDIR_ONE_ARG
   r = mkdir( atbuf );
#else
   r = mkdir( atbuf, PERMISSIONS );
#endif

   /* detect error */

   if ( r == -1 )
      {
      bwb_error( err_opsys );
      }

   return bwb_zline( l );

   }

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

        FUNCTION:       bwb_kill()

	DESCRIPTION:    This function implements the BASIC KILL
			command to erase a disk file.

	SYNTAX:         KILL filename

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

#if ANSI_C
struct bwb_line *
bwb_kill( struct bwb_line *l )
#else
struct bwb_line *
bwb_kill( l )
   struct bwb_line *l;
#endif
   {
   int r;
   static int position;
   struct exp_ese *e;
   static char *atbuf;
   static int init = FALSE;

   /* get memory for temporary buffers if necessary */

   if ( init == FALSE )
      {
      init = TRUE;

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

   /* get the next element in atbuf */

   adv_element( l->buffer, &( l->position ), atbuf  );

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_kill(): argument is <%s>", atbuf );
   bwb_debug( bwb_ebuf );
#endif

   /* interpret the argument */

   position = 0;
   e = bwb_exp( atbuf, FALSE, &position );

   if ( e->type != STRING )
      {
      bwb_error( err_argstr );
      return bwb_zline( l );
      }

   /* try to delete the specified file */

   str_btoc( atbuf, &( e->sval ) );
   r = unlink( atbuf );

   /* detect error */

   if ( r == -1 )
      {
      bwb_error( err_opsys );
      }

   return bwb_zline( l );

   }

#endif				/* UNIX_CMDS */

#if COMMON_CMDS

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

        FUNCTION:       bwb_name()

	DESCRIPTION:    This function implements the BASIC NAME
			command to rename a disk file.

	SYNTAX:         NAME old_filename AS new_filename

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

#if ANSI_C
struct bwb_line *
bwb_name( struct bwb_line *l )
#else
struct bwb_line *
bwb_name( l )
   struct bwb_line *l;
#endif
   {
   int r;
   static int position;
   struct exp_ese *e;
   static char *atbuf;
   static char *btbuf;
   static int init = FALSE;

   /* get memory for temporary buffers if necessary */

   if ( init == FALSE )
      {
      init = TRUE;

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

   /* get the first argument in atbuf */

   adv_element( l->buffer, &( l->position ), atbuf  );

   /* interpret the first argument */

   position = 0;
   e = bwb_exp( atbuf, FALSE, &position );

   if ( e->type != STRING )
      {
      bwb_error( err_argstr );
      return bwb_zline( l );
      }

   /* this argument must be copied back to atbuf, else the next
      call to bwb_exp() will overwrite the structure to which e
      refers */

   str_btoc( atbuf, &( e->sval ) );

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_name(): old name is <%s>", atbuf );
   bwb_debug( bwb_ebuf );
#endif

   /* get the second argument in btbuf */

   adv_element( l->buffer, &( l->position ), btbuf  );
   bwb_strtoupper( btbuf );

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_name(): AS string is <%s>", btbuf );
   bwb_debug( bwb_ebuf );
#endif

   if ( strcmp( btbuf, "AS" ) != 0 )
      {
      bwb_error( err_syntax );
      return bwb_zline( l );
      }

   /* get the third argument in btbuf */

   adv_element( l->buffer, &( l->position ), btbuf  );

   /* interpret the third argument */

   position = 0;
   e = bwb_exp( btbuf, FALSE, &position );

   if ( e->type != STRING )
      {
      bwb_error( err_argstr );
      return bwb_zline( l );
      }

   str_btoc( btbuf, &( e->sval ) );

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_name(): new name is <%s>", btbuf );
   bwb_debug( bwb_ebuf );
#endif

   /* try to rename the file */

   r = rename( atbuf, btbuf );

   /* detect error */

   if ( r != 0 )
      {
      bwb_error( err_opsys );
      }

   return bwb_zline( l );

   }

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

        FUNCTION:       bwb_field()

        DESCRIPTION:	This C function implements the BASIC
			FIELD command.

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

#if ANSI_C
struct bwb_line *
bwb_field( struct bwb_line *l )
#else
struct bwb_line *
bwb_field( l )
   struct bwb_line *l;
#endif
   {
   int dev_number;
   int length;
   struct exp_ese *e;
   struct bwb_variable *v;
   bstring *b;
   int current_pos;
   char atbuf[ MAXSTRINGSIZE + 1 ];

   current_pos = 0;

   /* first read device number */

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

   adv_element( l->buffer, &( l->position ), atbuf );

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_field(): device# buffer <%s>", atbuf );
   bwb_debug( bwb_ebuf );
#endif

   pos = 0;
   e = bwb_exp( atbuf, FALSE, &pos );

   if ( e->type != NUMBER )
      {
#if PROG_ERRORS
      bwb_error( "in bwb_field(): Number was expected for device number" );
#else
      bwb_error( err_syntax );
#endif
      return bwb_zline( l );
      }

   dev_number = (int) exp_getnval( e );

#if INTENSIVE_DEBUG
   sprintf( bwb_ebuf, "in bwb_field(): device <%d>", dev_number );
   bwb_debug( bwb_ebuf );
#endif

   /* be sure that the requested device is open */

   if (( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) ||
      ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) )
      {
#if PROG_ERRORS
      bwb_error( "in bwb_field(): Requested device number is not in use." );
#else
      bwb_error( err_devnum );
#endif
      return bwb_zline( l );
      }

   /* loop to read variables */

   do
      {

      /* read the comma and advance beyond it */

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

      /* first find the size of the field */

      adv_element( l->buffer, &( l->position ), atbuf );	/* get element */

      pos = 0;
      e = bwb_exp( atbuf, FALSE, &pos );

      if ( e->type != NUMBER )
         {
#if PROG_ERRORS
         bwb_error( "in bwb_field(): number value for field size not found" );
#else
         bwb_error( err_syntax );
#endif
         return bwb_zline( l );