home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HyperLib 1997 Winter - Disc 1
/
HYPERLIB-1997-Winter-CD1.ISO.7z
/
HYPERLIB-1997-Winter-CD1.ISO
/
オンラインウェア
/
PRG
/
bwbasic-2.10.sit
/
bwbasic-2.10
/
bwb_dio.c
< prev
next >
Wrap
Text File
|
1996-10-10
|
41KB
|
1,834 lines
/***************************************************************
bwb_dio.c Device Input/Output Routines
for Bywater BASIC Interpreter
Copyright (c) 1993, Ted A. Campbell
Bywater Software
email: tcamp@delphi.com
Copyright and Permissions Information:
All U.S. and international rights are claimed by the author,
Ted A. Campbell.
This software is released under the terms of the GNU General
Public License (GPL), which is distributed with this software
in the file "COPYING". The GPL specifies the terms under
which users may copy and use the software in this distribution.
A separate license is available for commercial distribution,
for information on which you should contact the author.
***************************************************************/
#include <stdio.h>
#include "bwbasic.h"
#include "bwb_mes.h"
#if HAVE_SYSSTAT
#include <sys/stat.h>
#endif
#ifndef SEEK_SET
#define SEEK_SET 0
#endif
#if INTENSIVE_DEBUG
#define RANDOM_FILLCHAR 'X'
#else
#define RANDOM_FILLCHAR ' '
#endif
#if COMMON_CMDS
struct dev_element *dev_table; /* table of devices */
#endif
static struct bwb_variable *vv
;
static int pos;
static int req_devnumber;
static int rlen;
static int mode;
#if ANSI_C
static struct bwb_line *dio_lrset( struct bwb_line *l, int rset );
static int dio_flush( int dev_number );
#else
static struct bwb_line *dio_lrset();
static int dio_flush();
#endif
#if COMMON_CMDS
/***************************************************************
FUNCTION: bwb_open()
DESCRIPTION: This function implements the BASIC OPEN
command to open a stream for device input/output.
SYNTAX: 1. OPEN "I"|"O"|"R", [#]n, filename [,rlen]
2. OPEN filename [FOR INPUT|OUTPUT|APPEND|] AS [#]n [LEN=n]
***************************************************************/
#if ANSI_C
struct bwb_line *
bwb_open( struct bwb_line *l )
#else
struct bwb_line *
bwb_open( l )
struct bwb_line *l;
#endif
{
FILE *fp;
struct exp_ese *e;
int previous_buffer;
char atbuf[ MAXSTRINGSIZE + 1 ];
char first[ MAXSTRINGSIZE + 1 ];
char devname[ MAXSTRINGSIZE + 1 ];
/* initialize */
mode = req_devnumber = rlen = -1;
previous_buffer = FALSE;
/* get the first expression element up to comma or whitespace */
adv_element( l->buffer, &( l->position ), atbuf );
/* parse the first expression element */
pos = 0;
e = bwb_exp( atbuf, FALSE, &pos );
str_btoc( first, exp_getsval( e ) );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_open(): first element is <%s>",
first );
bwb_debug( bwb_ebuf );
#endif
/* test for syntactical form: if a comma follows the first element,
then the syntax is form 1 (the old CP/M BASIC format); otherwise we
presume form 2 */
adv_ws( l->buffer, &( l->position ) );
/* Parse syntax Form 1 (OPEN "x",#n, devname...) */
if ( l->buffer[ l->position ] == ',' )
{
/* parse the next element to get the device number */
++( l->position ); /* advance beyond comma */
adv_ws( l->buffer, &( l->position ) );
if ( l->buffer[ l->position ] == '#' )
{
++( l->position );
adv_ws( l->buffer, &( l->position ) );
}
adv_element( l->buffer, &( l->position ), atbuf );
pos = 0;
e = bwb_exp( atbuf, FALSE, &pos );
if ( e->type == STRING )
{
#if PROG_ERRORS
bwb_error( "String where number was expected for device number" );
#else
bwb_error( err_syntax );
#endif
return bwb_zline( l );
}
req_devnumber = (int) exp_getnval( e );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_open(): syntax 1, req dev number is %d",
req_devnumber );
bwb_debug( bwb_ebuf );
#endif
/* parse the next element to get the devname */
adv_ws( l->buffer, &( l->position ) ); /* advance past whitespace */
++( l->position ); /* advance past comma */
adv_element( l->buffer, &( l->position ), atbuf );
pos = 0;
e = bwb_exp( atbuf, FALSE, &pos );
if ( e->type != STRING )
{
#if PROG_ERRORS
bwb_error( "in bwb_open(): number where string was expected for devname" );
#else
bwb_error( err_syntax );
#endif
return bwb_zline( l );
}
str_btoc( devname, exp_getsval( e ) );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_open(): syntax 1, devname <%s>",
devname );
bwb_debug( bwb_ebuf );
#endif
/* see if there is another element; if so, parse it to get the
record length */
adv_ws( l->buffer, &( l->position ) );
if ( l->buffer[ l->position ] == ',' )
{
++( l->position ); /* advance beyond comma */
adv_element( l->buffer, &( l->position ), atbuf );
pos = 0;
e = bwb_exp( atbuf, FALSE, &pos );
if ( e->type == STRING )
{
#if PROG_ERRORS
bwb_error( "String where number was expected for record length" );
#else
bwb_error( err_syntax );
#endif
return bwb_zline( l );
}
rlen = (int) exp_getnval( e );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_open(): syntax 1, record length is %d",
rlen );
bwb_debug( bwb_ebuf );
#endif
}
/* the first letter of the first should indicate the
type of file opening requested: test this letter,
then parse accordingly */
/* open file for sequential INPUT */
if ( ( first[ 0 ] == 'i' ) || ( first[ 0 ] == 'I' ))
{
mode = DEVMODE_INPUT;
}
/* open file for sequential OUTPUT */
else if ( ( first[ 0 ] == 'o' ) || ( first[ 0 ] == 'O' ))
{
mode = DEVMODE_OUTPUT;
}
/* open file for RANDOM access input and output */
else if ( ( first[ 0 ] == 'r' ) || ( first[ 0 ] == 'R' ))
{
mode = DEVMODE_RANDOM;
}
/* error: none of the appropriate modes found */
else
{
#if PROG_ERRORS
sprintf( bwb_ebuf, "in bwb_open(): invalid mode" );
bwb_error( bwb_ebuf );
#else
bwb_error( err_syntax );
#endif
}
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_open(): syntax 1, mode is %d", mode );
bwb_debug( bwb_ebuf );
#endif
}
/* Parse syntax Form 2 (OPEN devname FOR mode AS#n ... ) */
else
{
/* save the devname from first */
strcpy( devname, first );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_open(): syntax 2, devname <%s>",
devname );
bwb_debug( bwb_ebuf );
#endif
/* get the next element */
adv_element( l->buffer, &( l->position ), atbuf );
/* check for "FOR mode" statement */
bwb_strtoupper( atbuf );
if ( strcmp( atbuf, "FOR" ) == 0 )
{
adv_element( l->buffer, &( l->position ), atbuf );
bwb_strtoupper( atbuf );
if ( strcmp( atbuf, "INPUT" ) == 0 )
{
mode = DEVMODE_INPUT;
}
else if ( strcmp( atbuf, "OUTPUT" ) == 0 )
{
mode = DEVMODE_OUTPUT;
}
else if ( strcmp( atbuf, "APPEND" ) == 0 )
{
mode = DEVMODE_RANDOM;
}
else
{
#if PROG_ERRORS
bwb_error( "in bwb_open(): Invalid device i/o mode specified" );
#else
bwb_error( err_syntax );
#endif
return bwb_zline( l );
}
/* get the next element */
adv_element( l->buffer, &( l->position ), atbuf );
}
else
{
mode = DEVMODE_RANDOM;
}
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_open(): syntax 2, mode is %d", mode );
bwb_debug( bwb_ebuf );
#endif
/* This leaves us with the next element in the atbuf: it
should read "AS" */
bwb_strtoupper( atbuf );
if ( strcmp( atbuf, "AS" ) != 0 )
{
#if PROG_ERRORS
bwb_error( "in bwb_open(): expected AS statement" );
#else
bwb_error( err_syntax );
#endif
return bwb_zline( l );
}
/* get the next element */
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_open(): string to parse for req dev number <%s>",
atbuf );
bwb_debug( bwb_ebuf );
#endif
pos = 0;
e = bwb_exp( atbuf, FALSE, &pos );
if ( e->type == STRING )
{
#if PROG_ERRORS
bwb_error( "String where number was expected for record length" );
#else
bwb_error( err_syntax );
#endif
return bwb_zline( l );
}
req_devnumber = (int) exp_getnval( e );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_open(): syntax 2, req dev number is %d",
req_devnumber );
bwb_debug( bwb_ebuf );
#endif
/* Check for LEN = n statement */
adv_element( l->buffer, &( l->position ), atbuf );
bwb_strtoupper( atbuf );
if ( strncmp( atbuf, "LEN", (size_t) 3 ) == 0 )
{
pos = l->position - strlen( atbuf );
while( ( l->buffer[ pos ] != '=' ) && ( l->buffer[ pos ] != '¥0' ))
{
++pos;
}
if ( l->buffer[ pos ] == '¥0' )
{
#if PROG_ERRORS
bwb_error( "Failed to find equals sign after LEN element" );
#else
bwb_error( err_syntax );
#endif
return bwb_zline( l );
}
++pos; /* advance past equal sign */
e = bwb_exp( l->buffer, FALSE, &pos );
if ( e->type == STRING )
{
#if PROG_ERRORS
bwb_error( "String where number was expected for record length" );
#else
bwb_error( err_syntax );
#endif
return bwb_zline( l );
}
rlen = (int) exp_getnval( e );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_open(): syntax 2, record length is %d",
rlen );
bwb_debug( bwb_ebuf );
#endif
}
} /* end of syntax 2 */
/* check for valid requested device number */
if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES ))
{
#if PROG_ERRORS
bwb_error( "in bwb_open(): 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 )
{
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_open(): using previously closed file (and buffer)" );
bwb_debug( bwb_ebuf );
#endif
previous_buffer = TRUE;
}
if ( ( dev_table[ req_devnumber ].mode != DEVMODE_CLOSED ) &&
( dev_table[ req_devnumber ].mode != DEVMODE_AVAILABLE ) )
{
#if PROG_ERRORS
bwb_error( "in bwb_open(): Requested device number is already in use." );
#else
bwb_error( err_devnum );
#endif
return bwb_zline( l );
}
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_open(): ready to open device <%s> mode <%d>",
devname, mode );
bwb_debug( bwb_ebuf );
#endif
/* attempt to open the file */
switch( mode )
{
case DEVMODE_OUTPUT:
fp = fopen( devname, "w" );
break;
case DEVMODE_INPUT:
fp = fopen( devname, "r" );
break;
case DEVMODE_APPEND:
fp = fopen( devname, "a" );
break;
case DEVMODE_RANDOM:
fp = fopen( devname, "r+" );
if ( fp == NULL )
{
fp = fopen( devname, "w" );
fclose( fp );
fp = fopen( devname, "r+" );
}
break;
}
/* check for valid file opening */
if ( fp == NULL )
{
#if PROG_ERRORS
sprintf( bwb_ebuf, "Failed to open device <%s>", devname );
bwb_error( bwb_ebuf );
#else
bwb_error( err_dev );
#endif
return bwb_zline( l );
}
/* assign values to device table */
dev_table[ req_devnumber ].mode = mode;
dev_table[ req_devnumber ].cfp = fp;
dev_table[ req_devnumber ].reclen = rlen;
dev_table[ req_devnumber ].next_record = 1;
dev_table[ req_devnumber ].loc = 0;
strcpy( dev_table[ req_devnumber ].filename, devname );
/* allocate a character buffer for random access */
if (( mode == DEVMODE_RANDOM ) && ( previous_buffer != TRUE ))
{
if ( ( dev_table[ req_devnumber ].buffer = calloc( rlen + 1, 1 )) == NULL )
{
#if PROG_ERRORS
bwb_error( "in bwb_open(): failed to find memory for device buffer" );
#else
bwb_error( err_getmem );
#endif
return bwb_zline( l );
}
dio_flush( req_devnumber );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_open(): allocated new random-access buffer" );
bwb_debug( bwb_ebuf );
#endif
}
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_open(): file is open now; end of function" );
bwb_debug( bwb_ebuf );
#endif
/* return next line number in sequence */
return bwb_zline( l );
}
/***************************************************************
FUNCTION: bwb_close()
DESCRIPTION: This function implements the BASIC CLOSE
command to close a stream for device input/output.
SYNTAX: CLOSE [#]n [,[#]n...]
***************************************************************/
#if ANSI_C
struct bwb_line *
bwb_close( struct bwb_line *l )
#else
struct bwb_line *
bwb_close( l )
struct bwb_line *l;
#endif
{
struct exp_ese *e;
char atbuf[ MAXSTRINGSIZE + 1 ];
/* loop to get device numbers to close */
do
{
adv_ws( l->buffer, &( l->position ) );
if ( l->buffer[ l->position ] =='#' )
{
++( l->position );
}
adv_element( l->buffer, &( l->position ), atbuf );
pos = 0;
e = bwb_exp( atbuf, FALSE, &pos );
if ( e->type == STRING )
{
#if PROG_ERRORS
bwb_error( "String where number was expected for device number" );
#else
bwb_error( err_syntax );
#endif
return bwb_zline( l );
}
req_devnumber = (int) exp_getnval( e );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_close(): requested device number <%d>",
req_devnumber );
bwb_debug( bwb_ebuf );
#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;
/* eat up any remaining whitespace */
adv_ws( l->buffer, &( l->position ) );
}
while ( l->buffer[ l->position ] == ',' );
/* 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;
if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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;
if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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;
if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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;
if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 );
{
short err;
extern short gCurrentVRefNum;
c2pstr(atbuf);
err = FSDelete((StringPtr)atbuf,gCurrentVRefNum);
if (err != noErr ) {
r = -1 ;
}
}
/* 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;
if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
{
#if PROG_ERRORS
bwb_error( "in bwb_name(): failed to find memory for atbuf" );
#else
bwb_error( err_getmem );
#endif
}
if ( ( btbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 *vv
;
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 );
}
length = (int) exp_getnval( e );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_field(): device <%d> length <%d> buf <%s>",
dev_number, length, &( l->buffer[ l->position ] ) );
bwb_debug( bwb_ebuf );
#endif
/* read the AS */
adv_element( l->buffer, &( l->position ), atbuf ); /* get element */
bwb_strtoupper( atbuf );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_field(): AS element <%s>", atbuf );
bwb_debug( bwb_ebuf );
#endif
if ( strncmp( atbuf, "AS", 2 ) != 0 )
{
#if PROG_ERRORS
bwb_error( "in bwb_field(): AS statement not found" );
#else
bwb_error( err_syntax );
#endif
return bwb_zline( l );
}
/* read the string variable name */
adv_element( l->buffer, &( l->position ), atbuf ); /* get element */
vv
= var_find( atbuf );
if ( vv
->type != STRING )
{
#if PROG_ERRORS
bwb_error( "in bwb_field(): string variable name not found" );
#else
bwb_error( err_syntax );
#endif
return bwb_zline( l );
}
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_field(): device <%d> var <%s> length <%d>",
dev_number, vv
->name, length );
bwb_debug( bwb_ebuf );
#endif
/* check for overflow of record length */
if ( ( current_pos + length ) > dev_table[ dev_number ].reclen )
{
#if PROG_ERRORS
bwb_error( "in bwb_field(): record length exceeded" );
#else
bwb_error( err_overflow );
#endif
return bwb_zline( l );
}
/* set buffer */
b = var_findsval( vv
, vv
->array_pos );
#if DONTDOTHIS
if ( b->sbuffer != NULL )
{
free( b->sbuffer );
}
#endif
b->sbuffer = dev_table[ dev_number ].buffer + current_pos;
b->length = (unsigned char) length;
b->rab = TRUE;
current_pos += length;
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_field(): buffer <%lXh> var <%s> buffer <%lXh>",
(long) dev_table[ dev_number ].buffer, vv
->name, (long) b->buffer );
bwb_debug( bwb_ebuf );
#endif
/* eat up any remaining whitespace */
adv_ws( l->buffer, &( l->position ) );
}
while ( l->buffer[ l->position ] == ',' );
/* return */
return bwb_zline( l );
}
/***************************************************************
FUNCTION: bwb_lset()
DESCRIPTION: This C function implements the BASIC
LSET command.
SYNTAX: LSET string-variable$ = expression
***************************************************************/
#if ANSI_C
struct bwb_line *
bwb_lset( struct bwb_line *l )
#else
struct bwb_line *
bwb_lset( l )
struct bwb_line *l;
#endif
{
return dio_lrset( l, FALSE );
}
/***************************************************************
FUNCTION: bwb_rset()
DESCRIPTION: This C function implements the BASIC
RSET command.
SYNTAX: RSET string-variable$ = expression
***************************************************************/
#if ANSI_C
struct bwb_line *
bwb_rset( struct bwb_line *l )
#else
struct bwb_line *
bwb_rset( l )
struct bwb_line *l;
#endif
{
return dio_lrset( l, TRUE );
}
/***************************************************************
FUNCTION: dio_lrset()
DESCRIPTION: This C function implements the BASIC
RSET and LSET commands.
***************************************************************/
#if ANSI_C
static struct bwb_line *
dio_lrset( struct bwb_line *l, int rset )
#else
static struct bwb_line *
dio_lrset( l, rset )
struct bwb_line *l;
int rset;
#endif
{
char varname[ MAXVARNAMESIZE + 1 ];
bstring *d, *s;
int *pp;
int n_params;
int p;
register int n, i;
int startpos;
struct exp_ese *e;
/* find the variable name */
bwb_getvarname( l->buffer, varname, &( l->position ));
vv
= var_find( varname );
if ( vv
== NULL )
{
#if PROG_ERRORS
sprintf( bwb_ebuf, "in dio_lrset(): failed to find variable" );
bwb_error( bwb_ebuf );
#else
bwb_error( err_syntax );
#endif
}
if ( vv
->type != STRING )
{
#if PROG_ERRORS
sprintf( bwb_ebuf, "in dio_lrset(): assignment must be to string variable" );
bwb_error( bwb_ebuf );
#else
bwb_error( err_syntax );
#endif
}
/* read subscripts */
pos = 0;
if ( ( vv
->dimensions == 1 ) && ( vv
->array_sizes[ 0 ] == 1 ))
{
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in dio_lrset(): variable <%s> has 1 dimension",
vv
->name );
bwb_debug( bwb_ebuf );
#endif
n_params = 1;
pp = &p;
pp[ 0 ] = dim_base;
}
else
{
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in dio_lrset(): variable <%s> has > 1 dimensions",
vv
->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 < vv
->dimensions; ++n )
{
vv
->array_pos[ n ] = pp[ n ];
}
/* get bstring pointer */
d = var_findsval( vv
, pp );
/* find equals sign */
adv_ws( l->buffer, &( l->position ));
if ( l->buffer[ l->position ] != '=' )
{
#if PROG_ERRORS
sprintf( bwb_ebuf, "in dio_lrset(): failed to find equal sign" );
bwb_error( bwb_ebuf );
#else
bwb_error( err_syntax );
#endif
}
++( l->position );
adv_ws( l->buffer, &( l->position ));
/* read remainder of line to get value */
e = bwb_exp( l->buffer, FALSE, &( l->position ) );
s = exp_getsval( e );
/* set starting position */
startpos = 0;
if ( rset == TRUE )
{
if ( s->length < d->length )
{
startpos = d->length - s->length;
}
}
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in dio_lrset(): startpos <%d> buffer <%lX>",
startpos, (long) d->buffer );
bwb_debug( bwb_ebuf );
#endif
/* write characters to new position */
i = 0;
for ( n = startpos; ( i < (int) s->length ) && ( n < (int) d->length ); ++n )
{
d->sbuffer[ n ] = s->sbuffer[ i ];
++i;
}
/* return */
return bwb_zline( l );
}
/***************************************************************
FUNCTION: bwb_get()
DESCRIPTION: This C function implements the BASIC
GET command.
SYNTAX: GET [#] device-number [, record-number]
***************************************************************/
#if ANSI_C
struct bwb_line *
bwb_get( struct bwb_line *l )
#else
struct bwb_line *
bwb_get( l )
struct bwb_line *l;
#endif
{
int dev_number;
int rec_number;
register int i;
struct exp_ese *e;
char atbuf[ MAXSTRINGSIZE + 1 ];
/* first read device number */
adv_ws( l->buffer, &( l->position ) );
if ( l->buffer[ l->position ] =='#' )
{
++( l->position );
}
adv_element( l->buffer, &( l->position ), atbuf );
pos = 0;
e = bwb_exp( atbuf, FALSE, &pos );
if ( e->type != NUMBER )
{
#if PROG_ERRORS
bwb_error( "in bwb_get(): 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_get(): 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_get(): Requested device number is not in use." );
#else
bwb_error( err_devnum );
#endif
return bwb_zline( l );
}
/* see if there is a comma (and record number) */
adv_ws( l->buffer, &( l->position ) );
if ( l->buffer[ l->position ] == ',' ) /* yes, there is a comma */
{
++( l->position );
/* get the record number element */
adv_element( l->buffer, &( l->position ), atbuf );
pos = 0;
e = bwb_exp( atbuf, FALSE, &pos );
rec_number = (int) exp_getnval( e );
}
else /* no record number given */
{
rec_number = dev_table[ dev_number ].next_record;
}
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_get(): record number <%d>", rec_number );
bwb_debug( bwb_ebuf );
#endif
/* wind the c file up to the proper point */
if ( fseek( dev_table[ dev_number ].cfp,
(long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ),
SEEK_SET ) != 0 )
{
#if PROG_ERRORS
sprintf( bwb_ebuf, "in bwb_get(): fseek() failed, rec number <%d> offset <%ld>",
rec_number, (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ) );
bwb_error( bwb_ebuf );
#else
bwb_error( err_dev );
#endif
return bwb_zline( l );
}
/* read the requested bytes into the buffer */
for ( i = 0; i < dev_table[ dev_number ].reclen; ++i )
{
dev_table[ dev_number ].buffer[ i ] =
(char) fgetc( dev_table[ dev_number ].cfp );
++( dev_table[ dev_number ].loc );
}
/* increment (or reset) the current record */
dev_table[ dev_number ].next_record = rec_number + 1;
return bwb_zline( l );
}
/***************************************************************
FUNCTION: bwb_put()
DESCRIPTION: This C function implements the BASIC
PUT command.
SYNTAX: PUT [#] device-number [, record-number]
***************************************************************/
#if ANSI_C
struct bwb_line *
bwb_put( struct bwb_line *l )
#else
struct bwb_line *
bwb_put( l )
struct bwb_line *l;
#endif
{
int dev_number;
int rec_number;
register int i;
struct exp_ese *e;
char atbuf[ MAXSTRINGSIZE + 1 ];
/* first read device number */
adv_ws( l->buffer, &( l->position ) );
if ( l->buffer[ l->position ] =='#' )
{
++( l->position );
}
adv_element( l->buffer, &( l->position ), atbuf );
dev_number = atoi( atbuf );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_put(): 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_put(): Requested device number is not in use." );
#else
bwb_error( err_devnum );
#endif
return bwb_zline( l );
}
/* see if there is a comma (and record number) */
adv_ws( l->buffer, &( l->position ) );
if ( l->buffer[ l->position ] == ',' ) /* yes, there is a comma */
{
++( l->position );
/* get the record number element */
adv_element( l->buffer, &( l->position ), atbuf );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_put(): rec no buffer <%s>", atbuf );
bwb_debug( bwb_ebuf );
#endif
pos = 0;
e = bwb_exp( atbuf, FALSE, &pos );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_put(): return type <%c>", e->type );
bwb_debug( bwb_ebuf );
#endif
rec_number = (int) exp_getnval( e );
}
else /* no record number given */
{
rec_number = dev_table[ dev_number ].next_record;
}
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_put(): record number <%d>", rec_number );
bwb_debug( bwb_ebuf );
#endif
/* wind the c file up to the proper point */
if ( fseek( dev_table[ dev_number ].cfp,
(long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ),
SEEK_SET ) != 0 )
{
#if PROG_ERRORS
sprintf( bwb_ebuf, "in bwb_get(): fseek() failed, rec number <%d> offset <%ld>",
rec_number, (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ) );
bwb_error( bwb_ebuf );
#else
bwb_error( err_dev );
#endif
return bwb_zline( l );
}
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in bwb_put(): ready to write to file, buffer <%lXh>",
(long) dev_table[ dev_number ].buffer );
bwb_debug( bwb_ebuf );
prn_xprintf( stderr, "Buffer: <" );
#endif
/* write the requested bytes to the file */
for ( i = 0; i < dev_table[ dev_number ].reclen; ++i )
{
fputc( dev_table[ dev_number ].buffer[ i ],
dev_table[ dev_number ].cfp );
#if INTENSIVE_DEBUG
xputc( stderr, dev_table[ dev_number ].buffer[ i ] );
#endif
++( dev_table[ dev_number ].loc );
}
#if INTENSIVE_DEBUG
prn_xprintf( stderr, ">¥n" );
sprintf( bwb_ebuf, "in bwb_put(): write to file complete" );
bwb_debug( bwb_ebuf );
#endif
/* flush the buffer */
dio_flush( dev_number );
/* increment (or reset) the current record */
dev_table[ dev_number ].next_record = rec_number + 1;
return bwb_zline( l );
}
/***************************************************************
FUNCTION: dio_flush()
DESCRIPTION: This C function flushes the random-access
buffer associated with file dev_number.
***************************************************************/
#if ANSI_C
static int
dio_flush( int dev_number )
#else
static int
dio_flush( dev_number )
int dev_number;
#endif
{
register int n;
if ( dev_table[ dev_number ].mode != DEVMODE_RANDOM )
{
#if PROG_ERRORS
sprintf( bwb_ebuf, "in dio_flush(): only random-access buffers can be flushed" );
bwb_error( bwb_ebuf );
#else
bwb_error( err_dev );
#endif
}
/* fill buffer with blanks (or 'X' for test) */
for ( n = 0; n < dev_table[ req_devnumber ].reclen; ++n )
{
dev_table[ req_devnumber ].buffer[ n ] = RANDOM_FILLCHAR;
}
return TRUE;
}
#endif /* COMMON_CMDS */