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_fnc.c
< prev
next >
Wrap
Text File
|
1996-10-10
|
43KB
|
1,909 lines
/****************************************************************
bwb_fnc.c Interpretation Routines
for Predefined Functions
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.
****************************************************************/
#define FSTACKSIZE 32
#include <stdio.h>
#include <ctype.h>
#include <math.h>
#include <time.h>
#include "bwbasic.h"
#include "bwb_mes.h"
#if UNIX_CMDS
#include <sys/stat.h>
#endif
#ifndef RAND_MAX /* added in v1.11 */
#define RAND_MAX 32767
#endif
static time_t t;
static struct tm *lt;
/***************************************************************
FUNCTION: fnc_init()
DESCRIPTION: This command initializes the function
linked list, placing all predefined functions
in the list.
***************************************************************/
#if ANSI_C
int fnc_init( int task )
#else
int
fnc_init( task )
int task;
#endif
{
register int n;
struct bwb_function *f;
strcpy( LOCALTASK fnc_start.name, "FNC_START" );
LOCALTASK fnc_start.type = 'X';
LOCALTASK fnc_start.vector = fnc_null;
strcpy( LOCALTASK fnc_end.name, "FNC_END" );
LOCALTASK fnc_end.type = 'x';
LOCALTASK fnc_end.vector = fnc_null;
LOCALTASK fnc_end.next = &LOCALTASK fnc_end;
f = &LOCALTASK fnc_start;
/* now go through each of the preestablished functions and set up
links between them; from this point the program address the functions
only as a linked list (not as an array) */
for ( n = 0; n < FUNCTIONS; ++n )
{
f->next = &( bwb_prefuncs[ n ] );
f = f->next;
}
/* link the last pointer to the end; this completes the list */
f->next = &LOCALTASK fnc_end;
return TRUE;
}
/***************************************************************
FUNCTION: fnc_find()
DESCRIPTION: This C function attempts to locate
a BASIC function with the specified name.
If successful, it returns a pointer to
the C structure for the BASIC function,
if not successful, it returns NULL.
***************************************************************/
#if ANSI_C
struct bwb_function *
fnc_find( char *buffer )
#else
struct bwb_function *
fnc_find( buffer )
char *buffer;
#endif
{
struct bwb_function * f;
// register int n;
static char *tbuf;
static int init = FALSE;
if ( strlen( buffer ) == 0 )
{
return NULL;
}
/* get memory for temporary buffer if necessary */
if ( init == FALSE )
{
init = TRUE;
if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
{
#if PROG_ERRORS
bwb_error( "in fnc_find(): failed to find memory for tbuf" );
#else
bwb_error( err_getmem );
#endif
}
}
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in fnc_find(): called for <%s> ", buffer );
bwb_debug( bwb_ebuf );
#endif
strcpy( tbuf, buffer );
bwb_strtoupper( tbuf );
for ( f = CURTASK fnc_start.next; f != &CURTASK fnc_end; f = f->next )
{
if ( strcmp( f->name, tbuf ) == 0 )
{
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in fnc_find(): found <%s> ", f->name );
bwb_debug( bwb_ebuf );
#endif
return f;
}
}
/* search has failed: return NULL */
return NULL;
}
/***************************************************************
FUNCTION: fnc_null()
DESCRIPTION: This is a null function that can be used
to fill in a required function-structure
pointer when needed.
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_null( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_null( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
static int init = FALSE;
/* initialize the variable if necessary */
if ( init == FALSE )
{
init = TRUE;
var_make( &nvar, NUMBER );
}
return &nvar;
}
/***************************************************************
FUNCTION: fnc_tab()
DESCRIPTION: This C function implements the BASIC TAB()
function, adding tab spaces to a specified
column.
TAB is a core function, i.e., required
for ANSI Minimal BASIC.
SYNTAX: TAB( number )
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_tab( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_tab( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
static int init = FALSE;
static char t_string[ 4 ];
bstring *b;
/* initialize nvar if necessary */
if ( init == FALSE )
{
init = TRUE;
var_make( &nvar, (int) STRING );
}
/* check for correct number of parameters */
if ( argc < 1 )
{
#if PROG_ERRORS
sprintf( bwb_ebuf, "Not enough parameters (%d) to function TAB().",
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 TAB().",
argc );
bwb_error( bwb_ebuf );
#else
bwb_error( err_syntax );
#endif
break_handler();
return NULL;
}
t_string[ 0 ] = PRN_TAB;
t_string[ 1 ] = (char) var_getnval( &( argv[ 0 ] ));
t_string[ 2 ] = '¥0';
b = var_getsval( &nvar );
str_ctob( b, t_string );
return &nvar;
}
#if COMMON_FUNCS
/***************************************************************
FUNCTION: fnc_date()
DESCRIPTION: This C function implements the BASIC
predefined DATE$ function, returning
a string containing the year, month,
and day of the month.
SYNTAX: DATE$
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_date( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_date( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
static int init = FALSE;
static char *tbuf;
/* initialize the variable if necessary */
if ( init == FALSE )
{
init = TRUE;
var_make( &nvar, STRING );
if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
{
#if PROG_ERRORS
bwb_error( "in fnc_date(): failed to get memory for tbuf" );
#else
bwb_error( err_getmem );
#endif
}
}
time( &t );
lt = localtime( &t );
sprintf( tbuf, "%02d-%02d-%04d", lt->tm_mon + 1, lt->tm_mday,
1900 + lt->tm_year );
str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
return &nvar;
}
/***************************************************************
FUNCTION: fnc_time()
DESCRIPTION: This C function implements the BASIC
predefined TIME$ function, returning a
string containing the hour, minute, and
second count.
SYNTAX: TIME$
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_time( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_time( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
static char *tbuf;
static int init = FALSE;
/* initialize the variable if necessary */
if ( init == FALSE )
{
init = TRUE;
var_make( &nvar, STRING );
if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
{
#if PROG_ERRORS
bwb_error( "in fnc_time(): failed to get memory for tbuf" );
#else
bwb_error( err_getmem );
#endif
}
}
time( &t );
lt = localtime( &t );
sprintf( tbuf, "%02d:%02d:%02d", lt->tm_hour, lt->tm_min,
lt->tm_sec );
str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
return &nvar;
}
/***************************************************************
FUNCTION: fnc_chr()
DESCRIPTION: This C function implements the BASIC
predefined CHR$ function, returning a
string containing the single character
whose ASCII value is the argument to
this function.
SYNTAX: CHR$( number )
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_chr( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_chr( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
char tbuf[ MAXSTRINGSIZE + 1 ];
static int init = FALSE;
#if TEST_BSTRING
bstring *b;
#endif
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in fnc_chr(): entered function, argc <%d>",
argc );
bwb_debug( bwb_ebuf );
#endif
/* initialize the variable if necessary */
if ( init == FALSE )
{
init = TRUE;
var_make( &nvar, STRING );
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in fnc_chr(): entered function, initialized nvar" );
bwb_debug( bwb_ebuf );
#endif
}
/* check arguments */
#if PROG_ERRORS
if ( argc < 1 )
{
sprintf( bwb_ebuf, "Not enough arguments to function CHR$()" );
bwb_error( bwb_ebuf );
return NULL;
}
else if ( argc > 1 )
{
sprintf( bwb_ebuf, "Too many parameters (%d) to function CHR$().",
argc );
bwb_error( bwb_ebuf );
return NULL;
}
#else
if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
{
return NULL;
}
#endif
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in fnc_chr(): entered function, checkargs ok" );
bwb_debug( bwb_ebuf );
#endif
tbuf[ 0 ] = (char) var_getnval( &( argv[ 0 ] ) );
tbuf[ 1 ] = '¥0';
str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
#if TEST_BSTRING
b = var_findsval( &nvar, nvar.array_pos );
sprintf( bwb_ebuf, "in fnc_chr(): bstring name is <%s>", b->name );
bwb_debug( bwb_ebuf );
#endif
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in fnc_chr(): tbuf[ 0 ] is <%c>", tbuf[ 0 ] );
bwb_debug( bwb_ebuf );
#endif
return &nvar;
}
/***************************************************************
FUNCTION: fnc_len()
DESCRIPTION: This C function implements the BASIC LEN()
function, returning the length of a
specified string in bytes.
SYNTAX: LEN( string$ )
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_len( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_len( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
static int init = FALSE;
static char *tbuf;
/* initialize the variable if necessary */
if ( init == FALSE )
{
init = TRUE;
var_make( &nvar, NUMBER );
if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
{
#if PROG_ERRORS
bwb_error( "in fnc_len(): failed to get memory for tbuf" );
#else
bwb_error( err_getmem );
#endif
}
}
/* check parameters */
#if PROG_ERRORS
if ( argc < 1 )
{
sprintf( bwb_ebuf, "Not enough parameters (%d) to function LEN().",
argc );
bwb_error( bwb_ebuf );
return NULL;
}
else if ( argc > 1 )
{
sprintf( bwb_ebuf, "Too many parameters (%d) to function LEN().",
argc );
bwb_error( bwb_ebuf );
return NULL;
}
#else
if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
{
return NULL;
}
#endif
/* return length as an integer */
str_btoc( tbuf, var_getsval( &( argv[ 0 ] )) );
* var_findnval( &nvar, nvar.array_pos )
= (bnumber) strlen( tbuf );
return &nvar;
}
/***************************************************************
FUNCTION: fnc_pos()
DESCRIPTION: This C function implements the BASIC
POS() function, returning the current
column position for the output device.
SYNTAX: POS
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_pos( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_pos( 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) prn_col;
return &nvar;
}
#endif /* COMMON_FUNCS */
#if MS_FUNCS
/***************************************************************
FUNCTION: fnc_timer()
DESCRIPTION: This C function implements the BASIC
predefined TIMER function
SYNTAX: TIMER
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_timer( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_timer( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
static time_t now;
static int init = FALSE;
/* initialize the variable if necessary */
if ( init == FALSE )
{
init = TRUE;
var_make( &nvar, NUMBER );
}
time( &now );
* var_findnval( &nvar, nvar.array_pos )
= (float) fmod( (bnumber) now, (bnumber) (60*60*24));
return &nvar;
}
/***************************************************************
FUNCTION: fnc_mid()
DESCRIPTION: This C function implements the BASIC
predefined MID$ function
SYNTAX: MID$( string$, start-position-in-string[, number-of-spaces ] )
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_mid( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_mid( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
register int c;
char target_string[ MAXSTRINGSIZE + 1 ];
int target_counter, num_spaces;
char tbuf[ MAXSTRINGSIZE + 1 ];
static int init = FALSE;
/* initialize the variable if necessary */
if ( init == FALSE )
{
init = TRUE;
var_make( &nvar, STRING );
}
/* check arguments */
#if PROG_ERRORS
if ( argc < 2 )
{
sprintf( bwb_ebuf, "Not enough arguments to function MID$()" );
bwb_error( bwb_ebuf );
return &nvar;
}
if ( argc > 3 )
{
sprintf( bwb_ebuf, "Two many arguments to function MID$()" );
bwb_error( bwb_ebuf );
return &nvar;
}
#else
if ( fnc_checkargs( argc, argv, 2, 3 ) == FALSE )
{
return NULL;
}
#endif
/* get arguments */
str_btoc( target_string, var_getsval( &( argv[ 0 ] ) ));
target_counter = (int) var_getnval( &( argv[ 1 ] ) ) - 1;
if ( target_counter > (int) strlen( target_string ))
{
tbuf[ 0 ] = '¥0';
str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
return &nvar;
}
if ( argc == 3 )
{
num_spaces = (int) var_getnval( &( argv[ 2 ] ));
}
else
{
num_spaces = MAXSTRINGSIZE;
}
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in fnc_mid() string <%s> startpos <%d> spaces <%d>",
target_string, target_counter, num_spaces );
bwb_debug( bwb_ebuf );
#endif
c = 0;
tbuf[ c ] = '¥0';
while ( ( c < num_spaces ) && ( target_string[ target_counter ] != '¥0' ))
{
tbuf[ c ] = target_string[ target_counter ];
++c;
tbuf[ c ] = '¥0';
++target_counter;
}
str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
return &nvar;
}
/***************************************************************
FUNCTION: fnc_left()
DESCRIPTION: This C function implements the BASIC
predefined LEFT$ function
SYNTAX: LEFT$( string$, number-of-spaces )
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_left( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_left( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
register int c;
char target_string[ MAXSTRINGSIZE + 1 ];
int target_counter, num_spaces;
char tbuf[ MAXSTRINGSIZE + 1 ];
static int init = FALSE;
/* initialize the variable if necessary */
if ( init == FALSE )
{
init = TRUE;
var_make( &nvar, STRING );
}
/* check arguments */
#if PROG_ERRORS
if ( argc < 2 )
{
sprintf( bwb_ebuf, "Not enough arguments to function LEFT$()" );
bwb_error( bwb_ebuf );
return &nvar;
}
if ( argc > 2 )
{
sprintf( bwb_ebuf, "Two many arguments to function LEFT$()" );
bwb_error( bwb_ebuf );
return &nvar;
}
#else
if ( fnc_checkargs( argc, argv, 2, 2 ) == FALSE )
{
return NULL;
}
#endif
/* get arguments */
str_btoc( tbuf, var_getsval( &( argv[ 0 ] ) ));
target_counter = 0;
num_spaces = (int) var_getnval( &( argv[ 1 ] ));
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in fnc_left() string <%s> startpos <%d> spaces <%d>",
tbuf, target_counter, num_spaces );
bwb_debug( bwb_ebuf );
#endif
c = 0;
target_string[ 0 ] = '¥0';
while (( c < num_spaces ) && ( tbuf[ c ] != '¥0' ))
{
target_string[ target_counter ] = tbuf[ c ];
++target_counter;
target_string[ target_counter ] = '¥0';
++c;
}
str_ctob( var_findsval( &nvar, nvar.array_pos ), target_string );
return &nvar;
}
/***************************************************************
FUNCTION: fnc_right()
DESCRIPTION: This C function implements the BASIC
predefined RIGHT$ function
SYNTAX: RIGHT$( string$, number-of-spaces )
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_right( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_right( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
register int c;
char target_string[ MAXSTRINGSIZE + 1 ];
int target_counter, num_spaces;
char tbuf[ MAXSTRINGSIZE + 1 ];
static int init = FALSE;
/* initialize the variable if necessary */
if ( init == FALSE )
{
init = TRUE;
var_make( &nvar, STRING );
}
/* check arguments */
#if PROG_ERRORS
if ( argc < 2 )
{
sprintf( bwb_ebuf, "Not enough arguments to function RIGHT$()" );
bwb_error( bwb_ebuf );
return &nvar;
}
if ( argc > 2 )
{
sprintf( bwb_ebuf, "Two many arguments to function RIGHT$()" );
bwb_error( bwb_ebuf );
return &nvar;
}
#else
if ( fnc_checkargs( argc, argv, 2, 2 ) == FALSE )
{
return NULL;
}
#endif
/* get arguments */
str_btoc( target_string, var_getsval( &( argv[ 0 ] ) ));
target_counter = strlen( target_string ) - (int) var_getnval( &( argv[ 1 ] ));
num_spaces = MAXSTRINGSIZE;
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in fnc_right() string <%s> startpos <%d> spaces <%d>",
target_string, target_counter, num_spaces );
bwb_debug( bwb_ebuf );
#endif
c = 0;
tbuf[ c ] = '¥0';
while ( ( c < num_spaces ) && ( target_string[ target_counter ] != '¥0' ))
{
tbuf[ c ] = target_string[ target_counter ];
++c;
tbuf[ c ] = '¥0';
++target_counter;
}
str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
return &nvar;
}
/***************************************************************
FUNCTION: fnc_asc()
DESCRIPTION: This function implements the predefined
BASIC ASC() function, returning the ASCII
number associated with the first character
in the string argument.
SYNTAX: ASC( string$ )
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_asc( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_asc( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
static char *tbuf;
static int init = FALSE;
/* initialize the variable if necessary */
if ( init == FALSE )
{
init = TRUE;
var_make( &nvar, NUMBER );
if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
{
#if PROG_ERRORS
bwb_error( "in fnc_asc(): failed to get memory for tbuf" );
#else
bwb_error( err_getmem );
#endif
}
}
/* check parameters */
#if PROG_ERRORS
if ( argc < 1 )
{
sprintf( bwb_ebuf, "Not enough parameters (%d) to function ASC().",
argc );
bwb_error( bwb_ebuf );
return NULL;
}
else if ( argc > 1 )
{
sprintf( bwb_ebuf, "Too many parameters (%d) to function ASC().",
argc );
bwb_error( bwb_ebuf );
return NULL;
}
#else
if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
{
return NULL;
}
#endif
if ( argv[ 0 ].type != STRING )
{
#if PROG_ERRORS
sprintf( bwb_ebuf, "Argument to function ASC() must be a string." );
bwb_error( bwb_ebuf );
#else
bwb_error( err_mismatch );
#endif
return NULL;
}
/* assign ASCII value of first character in the buffer */
str_btoc( tbuf, var_findsval( &( argv[ 0 ] ), argv[ 0 ].array_pos ) );
* var_findnval( &nvar, nvar.array_pos ) = (bnumber) tbuf[ 0 ];
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in fnc_asc(): string is <%s>",
tbuf );
bwb_debug( bwb_ebuf );
#endif
return &nvar;
}
/***************************************************************
FUNCTION: fnc_string()
DESCRIPTION: This C function implements the BASIC
STRING$() function.
SYNTAX: STRING$( number, ascii-value|string$ )
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_string( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_string( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
int length;
register int i;
char c;
static char *tbuf;
static int init = FALSE;
/* initialize the variable if necessary */
if ( init == FALSE )
{
init = TRUE;
var_make( &nvar, STRING );
if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
{
#if PROG_ERRORS
bwb_error( "in fnc_string(): failed to get memory for tbuf" );
#else
bwb_error( err_getmem );
#endif
}
}
/* check for correct number of parameters */
#if PROG_ERRORS
if ( argc < 2 )
{
sprintf( bwb_ebuf, "Not enough parameters (%d) to function STRING$().",
argc );
bwb_error( bwb_ebuf );
return NULL;
}
else if ( argc > 2 )
{
sprintf( bwb_ebuf, "Too many parameters (%d) to function STRING$().",
argc );
bwb_error( bwb_ebuf );
return NULL;
}
#else
if ( fnc_checkargs( argc, argv, 2, 2 ) == FALSE )
{
return NULL;
}
#endif
strcpy( nvar.name, "(string$)!" );
nvar.type = STRING;
tbuf[ 0 ] = '¥0';
length = (int) var_getnval( &( argv[ 0 ] ));
if ( argv[ 1 ].type == STRING )
{
str_btoc( tbuf, var_getsval( &( argv[ 1 ] )));
c = tbuf[ 0 ];
}
else
{
c = (char) var_getnval( &( argv[ 1 ] ) );
}
#if INTENSIVE_DEBUG
sprintf( bwb_ebuf, "in fnc_string(): argument <%s> arg type <%c>, length <%d>",
argv[ 1 ].string, argv[ 1 ].type, length );
bwb_debug( bwb_ebuf );
sprintf( bwb_ebuf, "in fnc_string(): type <%c>, c <0x%x>=<%c>",
argv[ 1 ].type, c, c );
bwb_debug( bwb_ebuf );
#endif
/* add characters to the string */
for ( i = 0; i < length; ++i )
{
tbuf[ i ] = c;
tbuf[ i + 1 ] = '¥0';
}
str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
return &nvar;
}
/***************************************************************
FUNCTION: fnc_instr()
DESCRIPTION: This C function implements the BASIC
INSTR() function, returning the position
in string string-searched$ at which
string-pattern$ occurs.
SYNTAX: INSTR( [start-position,] string-searched$, string-pattern$ )
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_instr( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_instr( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
static int init = FALSE;
int n_pos, x_pos, y_pos;
int start_pos;
register int n;
char xbuf[ MAXSTRINGSIZE + 1 ];
char ybuf[ MAXSTRINGSIZE + 1 ];
/* initialize the variable if necessary */
if ( init == FALSE )
{
init = TRUE;
var_make( &nvar, NUMBER );
}
/* check for correct number of parameters */
#if PROG_ERRORS
if ( argc < 2 )
{
sprintf( bwb_ebuf, "Not enough parameters (%d) to function INSTR().",
argc );
bwb_error( bwb_ebuf );
return NULL;
}
else if ( argc > 3 )
{
sprintf( bwb_ebuf, "Too many parameters (%d) to function INSTR().",
argc );
bwb_error( bwb_ebuf );
return NULL;
}
#else
if ( fnc_checkargs( argc, argv, 2, 3 ) == FALSE )
{
return NULL;
}
#endif
/* determine argument positions */
if ( argc == 3 )
{
n_pos = 0;
x_pos = 1;
y_pos = 2;
}
else
{
n_pos = -1;
x_pos = 0;
y_pos = 1;
}
/* determine starting position */
if ( n_pos == 0 )
{
start_pos = (int) var_getnval( &( argv[ n_pos ] ) ) - 1;
}
else
{
start_pos = 0;
}
/* get x and y strings */
str_btoc( xbuf, var_getsval( &( argv[ x_pos ] ) ) );
str_btoc( ybuf, var_getsval( &( argv[ y_pos ] ) ) );
/* now search for match */
for ( n = start_pos; n < (int) strlen( xbuf ); ++n )
{
if ( strncmp( &( xbuf[ n ] ), ybuf, strlen( ybuf ) ) == 0 )
{
* var_findnval( &nvar, nvar.array_pos ) = (bnumber) n + 1;
return &nvar;
}
}
/* match not found */
* var_findnval( &nvar, nvar.array_pos ) = (bnumber) 0;
return &nvar;
}
/***************************************************************
FUNCTION: fnc_spc()
DESCRIPTION: This C function implements the BASIC
SPC() function, returning a string
containing a specified number of
(blank) spaces.
SYNTAX: SPC( number )
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_spc( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_spc( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
return fnc_space( argc, argv, unique_id );
}
/***************************************************************
FUNCTION: fnc_space()
DESCRIPTION: This C function implements the BASIC
SPACE() function, returning a string
containing a specified number of
(blank) spaces.
SYNTAX: SPACE$( number )
***************************************************************/
#if ANSI_C
struct bwb_variable *
fnc_space( int argc, struct bwb_variable *argv, int unique_id )
#else
struct bwb_variable *
fnc_space( argc, argv, unique_id )
int argc;
struct bwb_variable *argv;
int unique_id;
#endif
{
static struct bwb_variable nvar;
static char *tbuf;
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 );
if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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 workd 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;
#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;
}
else if ( feof( dev_table[ dev_number ].cfp ) == 0 )
{
* 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;
#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 */
#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
* var_findnval( &nvar, nvar.array_pos ) = (bnumber) FALSE;
#endif
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 );
if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == 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