Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/misc/volume40/bwbasic/part09

Text File | 1993-10-29 | 70.6 KB | 2,891 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Ted A. Campbell)
Subject: v40i060:  bwbasic - Bywater BASIC interpreter version 2.10, Part09/15
Message-ID: <[e-mail]>
X-Md4-Signature: 569590ae8237f5f1bec39a8ca3e4e6eb
Sender: [e-mail] (Kent Landfield)
Organization: Sterling Software
Date: Fri, 29 Oct 1993 16:26:59 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Ted A. Campbell)
Posting-number: Volume 40, Issue 60
Archive-name: bwbasic/part09
Environment: UNIX, DOS
Supersedes: bwbasic: Volume 33, Issue 37-47

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then feed it
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# Contents:  bwbasic-2.10/Makefile.in bwbasic-2.10/bwb_fnc.c
#   bwbasic-2.10/bwb_par.c bwbasic-2.10/bwb_str.c
#   bwbasic-2.10/bwbasic.mak bwbasic-2.10/bwbtest/index.txt
#   bwbasic-2.10/bwx_iqc.h bwbasic-2.10/bwx_tty.h
#   bwbasic-2.10/makefile.qcl
# Wrapped by kent@sparky on Thu Oct 21 10:47:50 1993
PATH=/bin:/usr/bin:/usr/ucb:/usr/local/bin:/usr/lbin ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive 9 (of 15)."'
if test -f 'bwbasic-2.10/Makefile.in' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'bwbasic-2.10/Makefile.in'\"
else
  echo shar: Extracting \"'bwbasic-2.10/Makefile.in'\" \(2521 characters\)
  sed "s/^X//" >'bwbasic-2.10/Makefile.in' <<'END_OF_FILE'
X#               Unix Makefile for Bywater BASIC Interpreter
X
Xsrcdir = @srcdir@
XVPATH = @srcdir@
X
XCC = @CC@
X
XINSTALL = @INSTALL@
XINSTALL_PROGRAM = @INSTALL_PROGRAM@
XINSTALL_DATA = @INSTALL_DATA@
X
XDEFS = @DEFS@
X
XCFLAGS = -O
XLDFLAGS = -s
X
Xprefix = /usr/local
Xexec_prefix = $(prefix)
Xbindir = $(exec_prefix)/bin
X
XSHELL = /bin/sh
X
XCFILES=         bwbasic.c bwb_int.c bwb_tbl.c bwb_cmd.c bwb_prn.c\
X                bwb_exp.c bwb_var.c bwb_inp.c bwb_fnc.c bwb_cnd.c\
X                bwb_ops.c bwb_dio.c bwb_str.c bwb_elx.c bwb_mth.c\
X        bwb_stc.c bwb_par.c bwx_tty.c
X
XOFILES=         bwbasic.o bwb_int.o bwb_tbl.o bwb_cmd.o bwb_prn.o\
X                bwb_exp.o bwb_var.o bwb_inp.o bwb_fnc.o bwb_cnd.o\
X                bwb_ops.o bwb_dio.o bwb_str.o bwb_elx.o bwb_mth.o\
X        bwb_stc.o bwb_par.o bwx_tty.o
X
XHFILES=         bwbasic.h bwb_mes.h bwx_tty.h
X
XMISCFILES=    COPYING INSTALL Makefile.in README bwbasic.doc\
X        bwbasic.mak configure.in configure makefile.qcl\
X        bwb_tcc.c bwx_iqc.c bwx_iqc.h
X
XTESTFILES=    \
X    abs.bas          assign.bas    callfunc.bas  callsub.bas    chain1.bas\
X    chain2.bas    dataread.bas  deffn.bas      dim.bas    doloop.bas\
X    dowhile.bas   elseif.bas    end.bas      err.bas    fncallfn.bas\
X    fornext.bas   function.bas  gosub.bas      gotolabl.bas    ifline.bas\
X    index.txt     input.bas        lof.bas      loopuntl.bas    main.bas\
X    mlifthen.bas  on.bas        onerr.bas      onerrlbl.bas    ongosub.bas\
X    opentest.bas  option.bas    putget.bas      random.bas    selcase.bas\
X    snglfunc.bas  stop.bas        term.bas      whilwend.bas    width.bas\
X    writeinp.bas  pascaltr.bas
X
XDISTFILES=    $(CFILES) $(HFILES) $(MISCFILES)
X
Xall: bwbasic
X
Xbwbasic:    $(OFILES)
X        $(CC) $(OFILES) -lm -o $@ $(LDFLAGS)
X
X$(OFILES):      $(HFILES)
X
X.c.o:
X    $(CC) -c $(CPPFLAGS) -I$(srcdir) $(DEFS) $(CFLAGS) $<
X
Xinstall: all
X    $(INSTALL_PROGRAM) bwbasic $(bindir)/bwbasic
X
Xuninstall:
X    rm -f $(bindir)/bwbasic
X
XMakefile: Makefile.in config.status
X    $(SHELL) config.status
Xconfig.status: configure
X    $(SHELL) config.status --recheck
Xconfigure: configure.in
X    cd $(srcdir); autoconf
X
XTAGS:    $(CFILES)
X    etags $(CFILES)
X
Xclean:
X    rm -f *.o bwbasic core
X
Xmostlyclean: clean
X
Xdistclean: clean
X    rm -f Makefile config.status
X
Xrealclean: distclean
X    rm -f TAGS
X
Xdist: $(DISTFILES)
X    echo bwbasic-2.10 > .fname
X    rm -rf `cat .fname`
X    mkdir `cat .fname`
X    ln $(DISTFILES) `cat .fname`
X    mkdir `cat .fname`/bwbtest
X    cd bwbtest; ln $(TESTFILES) ../`cat ../.fname`/bwbtest
X    tar czhf `cat .fname`.tar.gz `cat .fname`
X    rm -rf `cat .fname` .fname
X
X# Prevent GNU make v3 from overflowing arg limit on SysV.
X.NOEXPORT:
END_OF_FILE
  if test 2521 -ne `wc -c <'bwbasic-2.10/Makefile.in'`; then
    echo shar: \"'bwbasic-2.10/Makefile.in'\" unpacked with wrong size!
  fi
  # end of 'bwbasic-2.10/Makefile.in'
fi
if test -f 'bwbasic-2.10/bwb_fnc.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'bwbasic-2.10/bwb_fnc.c'\"
else
  echo shar: Extracting \"'bwbasic-2.10/bwb_fnc.c'\" \(43270 characters\)
  sed "s/^X//" >'bwbasic-2.10/bwb_fnc.c' <<'END_OF_FILE'
X/****************************************************************
X
X        bwb_fnc.c       Interpretation Routines
X            for Predefined Functions
X                        for Bywater BASIC Interpreter
X
X                        Copyright (c) 1993, Ted A. Campbell
X                        Bywater Software
X
X                        email: [e-mail]
X
X        Copyright and Permissions Information:
X
X        All U.S. and international rights are claimed by the author,
X        Ted A. Campbell.
X
X    This software is released under the terms of the GNU General
X    Public License (GPL), which is distributed with this software
X    in the file "COPYING".  The GPL specifies the terms under
X    which users may copy and use the software in this distribution.
X
X    A separate license is available for commercial distribution,
X    for information on which you should contact the author.
X
X****************************************************************/
X
X#define FSTACKSIZE      32
X
X#include <stdio.h>
X#include <ctype.h>
X#include <math.h>
X#include <time.h>
X
X#include "bwbasic.h"
X#include "bwb_mes.h"
X
X#if UNIX_CMDS
X#include <sys/stat.h>
X#endif
X
X#ifndef RAND_MAX            /* added in v1.11 */
X#define RAND_MAX    32767
X#endif
X
Xstatic time_t t;
Xstatic struct tm *lt;
X
X/***************************************************************
X
X        FUNCTION:       fnc_init()
X
X        DESCRIPTION:    This command initializes the function
X                        linked list, placing all predefined functions
X                        in the list.
X
X***************************************************************/
X
X#if ANSI_C
Xint
Xfnc_init( int task )
X#else
Xint
Xfnc_init( task )
X   int task;
X#endif
X   {
X   register int n;
X   struct bwb_function *f;
X
X   strcpy( LOCALTASK fnc_start.name, "FNC_START" );
X   LOCALTASK fnc_start.type = 'X';
X   LOCALTASK fnc_start.vector = fnc_null;
X   strcpy( LOCALTASK fnc_end.name, "FNC_END" );
X   LOCALTASK fnc_end.type = 'x';
X   LOCALTASK fnc_end.vector = fnc_null;
X   LOCALTASK fnc_end.next = &LOCALTASK fnc_end;
X
X   f = &LOCALTASK fnc_start;
X
X   /* now go through each of the preestablished functions and set up
X      links between them; from this point the program address the functions
X      only as a linked list (not as an array) */
X
X   for ( n = 0; n < FUNCTIONS; ++n )
X      {
X      f->next = &( bwb_prefuncs[ n ] );
X      f = f->next;
X      }
X
X   /* link the last pointer to the end; this completes the list */
X
X   f->next = &LOCALTASK fnc_end;
X
X   return TRUE;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_find()
X
X        DESCRIPTION:    This C function attempts to locate
X                        a BASIC function with the specified name.
X                        If successful, it returns a pointer to
X                        the C structure for the BASIC function,
X                        if not successful, it returns NULL.
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_function *
Xfnc_find( char *buffer )
X#else
Xstruct bwb_function *
Xfnc_find( buffer )
X   char *buffer;
X#endif
X   {
X   struct bwb_function * f;
X   register int n;
X   static char *tbuf;
X   static int init = FALSE;
X
X   if ( strlen( buffer ) == 0 )
X      {
X      return NULL;
X      }
X
X   /* get memory for temporary buffer if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
X         {
X#if PROG_ERRORS
X     bwb_error( "in fnc_find(): failed to find memory for tbuf" );
X#else
X     bwb_error( err_getmem );
X#endif
X     }
X      }
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in fnc_find(): called for <%s> ", buffer );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   strcpy( tbuf, buffer );
X   bwb_strtoupper( tbuf );
X
X   for ( f = CURTASK fnc_start.next; f != &CURTASK fnc_end; f = f->next )
X      {
X      if ( strcmp( f->name, tbuf ) == 0 )
X         {
X#if INTENSIVE_DEBUG
X     sprintf( bwb_ebuf, "in fnc_find(): found <%s> ", f->name );
X     bwb_debug( bwb_ebuf );
X#endif
X         return f;
X         }
X      }
X
X   /* search has failed: return NULL */
X
X   return NULL;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_null()
X
X        DESCRIPTION:    This is a null function that can be used
X                        to fill in a required function-structure
X                        pointer when needed.
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_null( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_null( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static int init = FALSE;
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, NUMBER );
X      }
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_tab()
X
X    DESCRIPTION:    This C function implements the BASIC TAB()
X            function, adding tab spaces to a specified
X            column.
X
X            TAB is a core function, i.e., required
X            for ANSI Minimal BASIC.
X
X    SYNTAX:        TAB( number )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_tab( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_tab( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static int init = FALSE;
X   static char t_string[ 4 ];
X   bstring *b;
X
X   /* initialize nvar if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, (int) STRING );
X      }
X
X   /* check for correct number of parameters */
X
X   if ( argc < 1 )
X      {
X#if PROG_ERRORS
X      sprintf( bwb_ebuf, "Not enough parameters (%d) to function TAB().",
X         argc );
X      bwb_error( bwb_ebuf );
X#else
X      bwb_error( err_syntax );
X#endif
X      break_handler();
X      return NULL;
X      }
X   else if ( argc > 1 )
X      {
X#if PROG_ERRORS
X      sprintf( bwb_ebuf, "Too many parameters (%d) to function TAB().",
X         argc );
X      bwb_error( bwb_ebuf );
X#else
X      bwb_error( err_syntax );
X#endif
X      break_handler();
X      return NULL;
X      }
X
X   t_string[ 0 ] = PRN_TAB;
X   t_string[ 1 ] = (char) var_getnval( &( argv[ 0 ] ));
X   t_string[ 2 ] = '\0';
X
X   b = var_getsval( &nvar );
X   str_ctob( b, t_string );
X
X   return &nvar;
X   }
X
X#if COMMON_FUNCS
X
X/***************************************************************
X
X
X        FUNCTION:       fnc_date()
X
X        DESCRIPTION:    This C function implements the BASIC
X                        predefined DATE$ function, returning
X                        a string containing the year, month,
X                        and day of the month.
X
X    SYNTAX:        DATE$
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_date( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_date( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static int init = FALSE;
X   static char *tbuf;
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, STRING );
X      if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
X         {
X#if PROG_ERRORS
X         bwb_error( "in fnc_date(): failed to get memory for tbuf" );
X#else
X         bwb_error( err_getmem );
X#endif
X         }
X      }
X
X   time( &t );
X   lt = localtime( &t );
X
X   sprintf( tbuf, "%02d-%02d-%04d", lt->tm_mon + 1, lt->tm_mday,
X      1900 + lt->tm_year );
X   str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_time()
X
X        DESCRIPTION:    This C function implements the BASIC
X                        predefined TIME$ function, returning a
X                        string containing the hour, minute, and
X                        second count.
X
X    SYNTAX:        TIME$
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_time( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_time( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static char *tbuf;
X   static int init = FALSE;
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, STRING );
X      if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
X         {
X#if PROG_ERRORS
X         bwb_error( "in fnc_time(): failed to get memory for tbuf" );
X#else
X         bwb_error( err_getmem );
X#endif
X         }
X      }
X
X   time( &t );
X   lt = localtime( &t );
X
X   sprintf( tbuf, "%02d:%02d:%02d", lt->tm_hour, lt->tm_min,
X      lt->tm_sec );
X   str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_chr()
X
X        DESCRIPTION:    This C function implements the BASIC
X                        predefined CHR$ function, returning a
X                        string containing the single character
X                        whose ASCII value is the argument to
X                        this function.
X
X    SYNTAX:        CHR$( number )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_chr( int argc, struct bwb_variable *argv, int unique_id  )
X#else
Xstruct bwb_variable *
Xfnc_chr( argc, argv, unique_id  )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   char tbuf[ MAXSTRINGSIZE + 1 ];
X   static int init = FALSE;
X#if TEST_BSTRING
X   bstring *b;
X#endif
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in fnc_chr(): entered function, argc <%d>",
X      argc );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, STRING );
X#if INTENSIVE_DEBUG
X      sprintf( bwb_ebuf, "in fnc_chr(): entered function, initialized nvar" );
X      bwb_debug( bwb_ebuf );
X#endif
X      }
X
X   /* check arguments */
X
X#if PROG_ERRORS
X   if ( argc < 1 )
X      {
X      sprintf( bwb_ebuf, "Not enough arguments to function CHR$()" );
X      bwb_error( bwb_ebuf );
X      return NULL;
X      }
X   else if ( argc > 1 )
X      {
X      sprintf( bwb_ebuf, "Too many parameters (%d) to function CHR$().",
X         argc );
X      bwb_error( bwb_ebuf );
X      return NULL;
X      }
X#else
X   if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
X      {
X      return NULL;
X      }
X#endif
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in fnc_chr(): entered function, checkargs ok" );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   tbuf[ 0 ] = (char) var_getnval( &( argv[ 0 ] ) );
X   tbuf[ 1 ] = '\0';
X   str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
X
X#if TEST_BSTRING
X   b = var_findsval( &nvar, nvar.array_pos );
X   sprintf( bwb_ebuf, "in fnc_chr(): bstring name is <%s>", b->name );
X   bwb_debug( bwb_ebuf );
X#endif
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in fnc_chr(): tbuf[ 0 ] is <%c>", tbuf[ 0 ] );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_len()
X
X    DESCRIPTION:    This C function implements the BASIC LEN()
X            function, returning the length of a
X            specified string in bytes.
X
X    SYNTAX:        LEN( string$ )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_len( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_len( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static int init = FALSE;
X   static char *tbuf;
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, NUMBER );
X      if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
X         {
X#if PROG_ERRORS
X         bwb_error( "in fnc_len(): failed to get memory for tbuf" );
X#else
X         bwb_error( err_getmem );
X#endif
X         }
X      }
X
X   /* check parameters */
X
X#if PROG_ERRORS
X   if ( argc < 1 )
X      {
X      sprintf( bwb_ebuf, "Not enough parameters (%d) to function LEN().",
X         argc );
X      bwb_error( bwb_ebuf );
X      return NULL;
X      }
X   else if ( argc > 1 )
X      {
X      sprintf( bwb_ebuf, "Too many parameters (%d) to function LEN().",
X         argc );
X      bwb_error( bwb_ebuf );
X      return NULL;
X      }
X#else
X   if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
X      {
X      return NULL;
X      }
X#endif
X
X   /* return length as an integer */
X
X   str_btoc( tbuf, var_getsval( &( argv[ 0 ] )) );
X   * var_findnval( &nvar, nvar.array_pos )
X      = (bnumber) strlen( tbuf );
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_pos()
X
X    DESCRIPTION:    This C function implements the BASIC
X            POS() function, returning the current
X            column position for the output device.
X
X    SYNTAX:        POS
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_pos( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_pos( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static int init = FALSE;
X
X   /* initialize nvar if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, (int) NUMBER );
X      }
X
X   * var_findnval( &nvar, nvar.array_pos ) = (bnumber) prn_col;
X
X   return &nvar;
X   }
X
X#endif                    /* COMMON_FUNCS */
X
X#if MS_FUNCS
X
X/***************************************************************
X
X        FUNCTION:       fnc_timer()
X
X        DESCRIPTION:    This C function implements the BASIC
X                        predefined TIMER function
X
X    SYNTAX:        TIMER
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_timer( int argc, struct bwb_variable *argv, int unique_id  )
X#else
Xstruct bwb_variable *
Xfnc_timer( argc, argv, unique_id  )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static time_t now;
X   static int init = FALSE;
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, NUMBER );
X      }
X
X   time( &now );
X   * var_findnval( &nvar, nvar.array_pos )
X      = (float) fmod( (bnumber) now, (bnumber) (60*60*24));
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_mid()
X
X        DESCRIPTION:    This C function implements the BASIC
X                        predefined MID$ function
X
X    SYNTAX:        MID$( string$, start-position-in-string[, number-of-spaces ] )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_mid( int argc, struct bwb_variable *argv, int unique_id  )
X#else
Xstruct bwb_variable *
Xfnc_mid( argc, argv, unique_id  )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   register int c;
X   char target_string[ MAXSTRINGSIZE + 1 ];
X   int target_counter, num_spaces;
X   char tbuf[ MAXSTRINGSIZE + 1 ];
X   static int init = FALSE;
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, STRING );
X      }
X
X   /* check arguments */
X
X#if PROG_ERRORS
X   if ( argc < 2 )
X      {
X      sprintf( bwb_ebuf, "Not enough arguments to function MID$()" );
X      bwb_error( bwb_ebuf );
X      return &nvar;
X      }
X
X   if ( argc > 3 )
X      {
X      sprintf( bwb_ebuf, "Two many arguments to function MID$()" );
X      bwb_error( bwb_ebuf );
X      return &nvar;
X      }
X
X#else
X   if ( fnc_checkargs( argc, argv, 2, 3 ) == FALSE )
X      {
X      return NULL;
X      }
X#endif
X
X   /* get arguments */
X
X   str_btoc( target_string, var_getsval( &( argv[ 0 ] ) ));
X   target_counter = (int) var_getnval( &( argv[ 1 ] ) ) - 1;
X   if ( target_counter > (int) strlen( target_string ))
X      {
X      tbuf[ 0 ] = '\0';
X      str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
X      return &nvar;
X      }
X
X   if ( argc == 3 )
X      {
X      num_spaces = (int) var_getnval( &( argv[ 2 ] ));
X      }
X   else
X      {
X      num_spaces = MAXSTRINGSIZE;
X      }
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in fnc_mid() string <%s> startpos <%d> spaces <%d>",
X      target_string, target_counter, num_spaces );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   c = 0;
X   tbuf[ c ] = '\0';
X   while ( ( c < num_spaces ) && ( target_string[ target_counter ] != '\0' ))
X      {
X      tbuf[ c ] = target_string[ target_counter ];
X      ++c;
X      tbuf[ c ] = '\0';
X      ++target_counter;
X      }
X   str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_left()
X
X        DESCRIPTION:    This C function implements the BASIC
X                        predefined LEFT$ function
X
X    SYNTAX:        LEFT$( string$, number-of-spaces )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_left( int argc, struct bwb_variable *argv, int unique_id  )
X#else
Xstruct bwb_variable *
Xfnc_left( argc, argv, unique_id  )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   register int c;
X   char target_string[ MAXSTRINGSIZE + 1 ];
X   int target_counter, num_spaces;
X   char tbuf[ MAXSTRINGSIZE + 1 ];
X   static int init = FALSE;
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, STRING );
X      }
X
X   /* check arguments */
X
X#if PROG_ERRORS
X   if ( argc < 2 )
X      {
X      sprintf( bwb_ebuf, "Not enough arguments to function LEFT$()" );
X      bwb_error( bwb_ebuf );
X      return &nvar;
X      }
X
X   if ( argc > 2 )
X      {
X      sprintf( bwb_ebuf, "Two many arguments to function LEFT$()" );
X      bwb_error( bwb_ebuf );
X      return &nvar;
X      }
X
X#else
X   if ( fnc_checkargs( argc, argv, 2, 2 ) == FALSE )
X      {
X      return NULL;
X      }
X#endif
X
X   /* get arguments */
X
X   str_btoc( tbuf, var_getsval( &( argv[ 0 ] ) ));
X   target_counter = 0;
X   num_spaces = (int) var_getnval( &( argv[ 1 ] ));
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in fnc_left() string <%s> startpos <%d> spaces <%d>",
X      tbuf, target_counter, num_spaces );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   c = 0;
X   target_string[ 0 ] = '\0';
X   while (( c < num_spaces ) && ( tbuf[ c ] != '\0' ))
X      {
X      target_string[ target_counter ] = tbuf[ c ];
X      ++target_counter;
X      target_string[ target_counter ] = '\0';
X      ++c;
X      }
X   str_ctob( var_findsval( &nvar, nvar.array_pos ), target_string );
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_right()
X
X        DESCRIPTION:    This C function implements the BASIC
X                        predefined RIGHT$ function
X
X    SYNTAX:        RIGHT$( string$, number-of-spaces )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_right( int argc, struct bwb_variable *argv, int unique_id  )
X#else
Xstruct bwb_variable *
Xfnc_right( argc, argv, unique_id  )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   register int c;
X   char target_string[ MAXSTRINGSIZE + 1 ];
X   int target_counter, num_spaces;
X   char tbuf[ MAXSTRINGSIZE + 1 ];
X   static int init = FALSE;
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, STRING );
X      }
X
X   /* check arguments */
X
X#if PROG_ERRORS
X   if ( argc < 2 )
X      {
X      sprintf( bwb_ebuf, "Not enough arguments to function RIGHT$()" );
X      bwb_error( bwb_ebuf );
X      return &nvar;
X      }
X
X   if ( argc > 2 )
X      {
X      sprintf( bwb_ebuf, "Two many arguments to function RIGHT$()" );
X      bwb_error( bwb_ebuf );
X      return &nvar;
X      }
X
X#else
X   if ( fnc_checkargs( argc, argv, 2, 2 ) == FALSE )
X      {
X      return NULL;
X      }
X#endif
X
X   /* get arguments */
X
X   str_btoc( target_string, var_getsval( &( argv[ 0 ] ) ));
X   target_counter = strlen( target_string ) - (int) var_getnval( &( argv[ 1 ] ));
X   num_spaces = MAXSTRINGSIZE;
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in fnc_right() string <%s> startpos <%d> spaces <%d>",
X      target_string, target_counter, num_spaces );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   c = 0;
X   tbuf[ c ] = '\0';
X   while ( ( c < num_spaces ) && ( target_string[ target_counter ] != '\0' ))
X      {
X      tbuf[ c ] = target_string[ target_counter ];
X      ++c;
X      tbuf[ c ] = '\0';
X      ++target_counter;
X      }
X   str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_asc()
X
X        DESCRIPTION:    This function implements the predefined
X            BASIC ASC() function, returning the ASCII
X            number associated with the first character
X            in the string argument.
X
X    SYNTAX:        ASC( string$ )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_asc( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_asc( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static char *tbuf;
X   static int init = FALSE;
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, NUMBER );
X      if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
X         {
X#if PROG_ERRORS
X         bwb_error( "in fnc_asc(): failed to get memory for tbuf" );
X#else
X         bwb_error( err_getmem );
X#endif
X         }
X      }
X
X   /* check parameters */
X
X#if PROG_ERRORS
X   if ( argc < 1 )
X      {
X      sprintf( bwb_ebuf, "Not enough parameters (%d) to function ASC().",
X         argc );
X      bwb_error( bwb_ebuf );
X      return NULL;
X      }
X   else if ( argc > 1 )
X      {
X      sprintf( bwb_ebuf, "Too many parameters (%d) to function ASC().",
X         argc );
X      bwb_error( bwb_ebuf );
X      return NULL;
X      }
X#else
X   if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
X      {
X      return NULL;
X      }
X#endif
X
X   if ( argv[ 0 ].type != STRING )
X      {
X#if PROG_ERRORS
X      sprintf( bwb_ebuf, "Argument to function ASC() must be a string." );
X      bwb_error( bwb_ebuf );
X#else
X      bwb_error( err_mismatch );
X#endif
X      return NULL;
X      }
X
X   /* assign ASCII value of first character in the buffer */
X
X   str_btoc( tbuf, var_findsval( &( argv[ 0 ] ), argv[ 0 ].array_pos ) );
X   * var_findnval( &nvar, nvar.array_pos ) = (bnumber) tbuf[ 0 ];
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in fnc_asc(): string is <%s>",
X      tbuf );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_string()
X
X        DESCRIPTION:    This C function implements the BASIC
X            STRING$() function.
X
X    SYNTAX:        STRING$( number, ascii-value|string$ )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_string( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_string( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   int length;
X   register int i;
X   char c;
X   static char *tbuf;
X   static int init = FALSE;
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, STRING );
X      if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
X         {
X#if PROG_ERRORS
X         bwb_error( "in fnc_string(): failed to get memory for tbuf" );
X#else
X         bwb_error( err_getmem );
X#endif
X         }
X      }
X
X   /* check for correct number of parameters */
X
X#if PROG_ERRORS
X   if ( argc < 2 )
X      {
X      sprintf( bwb_ebuf, "Not enough parameters (%d) to function STRING$().",
X         argc );
X      bwb_error( bwb_ebuf );
X      return NULL;
X      }
X   else if ( argc > 2 )
X      {
X      sprintf( bwb_ebuf, "Too many parameters (%d) to function STRING$().",
X         argc );
X      bwb_error( bwb_ebuf );
X      return NULL;
X      }
X#else
X   if ( fnc_checkargs( argc, argv, 2, 2 ) == FALSE )
X      {
X      return NULL;
X      }
X#endif
X
X   strcpy( nvar.name, "(string$)!" );
X   nvar.type = STRING;
X   tbuf[ 0 ] = '\0';
X   length = (int) var_getnval( &( argv[ 0 ] ));
X
X   if ( argv[ 1 ].type == STRING )
X      {
X      str_btoc( tbuf, var_getsval( &( argv[ 1 ] )));
X      c = tbuf[ 0 ];
X      }
X   else
X      {
X      c = (char) var_getnval( &( argv[ 1 ] ) );
X      }
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in fnc_string(): argument <%s> arg type <%c>, length <%d>",
X      argv[ 1 ].string, argv[ 1 ].type, length );
X   bwb_debug( bwb_ebuf );
X   sprintf( bwb_ebuf, "in fnc_string(): type <%c>, c <0x%x>=<%c>",
X      argv[ 1 ].type, c, c );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   /* add characters to the string */
X
X   for ( i = 0; i < length; ++i )
X      {
X      tbuf[ i ] = c;
X      tbuf[ i + 1 ] = '\0';
X      }
X   str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_instr()
X
X        DESCRIPTION:    This C function implements the BASIC
X            INSTR() function, returning the position
X            in string string-searched$ at which
X            string-pattern$ occurs.
X
X    SYNTAX:        INSTR( [start-position,] string-searched$, string-pattern$ )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_instr( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_instr( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static int init = FALSE;
X   int n_pos, x_pos, y_pos;
X   int start_pos;
X   register int n;
X   char xbuf[ MAXSTRINGSIZE + 1 ];
X   char ybuf[ MAXSTRINGSIZE + 1 ];
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, NUMBER );
X      }
X
X   /* check for correct number of parameters */
X
X#if PROG_ERRORS
X   if ( argc < 2 )
X      {
X      sprintf( bwb_ebuf, "Not enough parameters (%d) to function INSTR().",
X         argc );
X      bwb_error( bwb_ebuf );
X      return NULL;
X      }
X   else if ( argc > 3 )
X      {
X      sprintf( bwb_ebuf, "Too many parameters (%d) to function INSTR().",
X         argc );
X      bwb_error( bwb_ebuf );
X      return NULL;
X      }
X#else
X   if ( fnc_checkargs( argc, argv, 2, 3 ) == FALSE )
X      {
X      return NULL;
X      }
X#endif
X
X   /* determine argument positions */
X
X   if ( argc == 3 )
X      {
X      n_pos = 0;
X      x_pos = 1;
X      y_pos = 2;
X      }
X   else
X      {
X      n_pos = -1;
X      x_pos = 0;
X      y_pos = 1;
X      }
X
X   /* determine starting position */
X
X   if ( n_pos == 0 )
X      {
X      start_pos = (int) var_getnval( &( argv[ n_pos ] ) ) - 1;
X      }
X   else
X      {
X      start_pos = 0;
X      }
X
X   /* get x and y strings */
X
X   str_btoc( xbuf, var_getsval( &( argv[ x_pos ] ) ) );
X   str_btoc( ybuf, var_getsval( &( argv[ y_pos ] ) ) );
X
X   /* now search for match */
X
X   for ( n = start_pos; n < (int) strlen( xbuf ); ++n )
X      {
X      if ( strncmp( &( xbuf[ n ] ), ybuf, strlen( ybuf ) ) == 0 )
X         {
X         * var_findnval( &nvar, nvar.array_pos ) = (bnumber) n + 1;
X         return &nvar;
X         }
X      }
X
X   /* match not found */
X
X   * var_findnval( &nvar, nvar.array_pos ) = (bnumber) 0;
X   return &nvar;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_spc()
X
X    DESCRIPTION:    This C function implements the BASIC
X            SPC() function, returning a string
X            containing a specified number of
X            (blank) spaces.
X
X    SYNTAX:        SPC( number )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_spc( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_spc( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   return fnc_space( argc, argv, unique_id );
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_space()
X
X    DESCRIPTION:    This C function implements the BASIC
X            SPACE() function, returning a string
X            containing a specified number of
X            (blank) spaces.
X
X    SYNTAX:        SPACE$( number )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_space( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_space( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static char *tbuf;
X   static int init = FALSE;
X   int spaces;
X   register int i;
X   bstring *b;
X
X   /* check for correct number of parameters */
X
X   if ( argc < 1 )
X      {
X#if PROG_ERRORS
X      sprintf( bwb_ebuf, "Not enough parameters (%d) to function SPACE$().",
X         argc );
X      bwb_error( bwb_ebuf );
X#else
X      bwb_error( err_syntax );
X#endif
X      break_handler();
X      return NULL;
X      }
X   else if ( argc > 1 )
X      {
X#if PROG_ERRORS
X      sprintf( bwb_ebuf, "Too many parameters (%d) to function SPACE$().",
X         argc );
X      bwb_error( bwb_ebuf );
X#else
X      bwb_error( err_syntax );
X#endif
X      break_handler();
X      return NULL;
X      }
X
X   /* initialize nvar if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, (int) STRING );
X      if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
X         {
X#if PROG_ERRORS
X         bwb_error( "in fnc_space(): failed to get memory for tbuf" );
X#else
X         bwb_error( err_getmem );
X#endif
X         }
X      }
X
X   tbuf[ 0 ] = '\0';
X   spaces = (int) var_getnval( &( argv[ 0 ] ));
X
X   /* add spaces to the string */
X
X   for ( i = 0; i < spaces; ++i )
X      {
X      tbuf[ i ] = ' ';
X      tbuf[ i + 1 ] = '\0';
X      }
X
X   b = var_getsval( &nvar );
X   str_ctob( b, tbuf );
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_environ()
X
X        DESCRIPTION:    This C function implements the BASIC
X            ENVIRON$() function, returning the value
X            of a specified environment string.
X
X    SYNTAX:        ENVIRON$( variable-string )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_environ( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_environ( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   char tbuf[ MAXSTRINGSIZE + 1 ];
X   char tmp[ MAXSTRINGSIZE + 1 ];
X   static struct bwb_variable nvar;
X   static int init = FALSE;
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, STRING );
X      }
X
X   /* check for correct number of parameters */
X
X#if PROG_ERRORS
X   if ( argc < 1 )
X      {
X      sprintf( bwb_ebuf, "Not enough parameters (%d) to function ENVIRON$().",
X         argc );
X      bwb_error( bwb_ebuf );
X      return NULL;
X      }
X   else if ( argc > 1 )
X      {
X      sprintf( bwb_ebuf, "Too many parameters (%d) to function ENVIRON$().",
X         argc );
X      bwb_error( bwb_ebuf );
X      return NULL;
X      }
X#else
X   if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
X      {
X      return NULL;
X      }
X#endif
X
X   /* resolve the argument and place string value in tbuf */
X
X   str_btoc( tbuf, var_getsval( &( argv[ 0 ] )));
X
X   /* call getenv() then write value to string */
X
X   strcpy( tmp, getenv( tbuf ));
X   str_ctob( var_findsval( &nvar, nvar.array_pos ), tmp );
X
X   /* return address of nvar */
X
X   return &nvar;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_err()
X
X    DESCRIPTION:    This C function implements the BASIC
X            ERR function, returning the error number
X            for the most recent error.
X
X            Please note that as of revision level
X            2.10, bwBASIC does not utilize a standard
X            list of error numbers, so numbers returned
X            by this function will not be those found
X            in either ANSI or Microsoft or other
X            BASIC error tables.
X
X    SYNTAX:        ERR
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_err( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_err( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static int init = FALSE;
X
X   /* initialize nvar if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, (int) NUMBER );
X      }
X
X   * var_findnval( &nvar, nvar.array_pos ) = (bnumber) err_number;
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_erl()
X
X    DESCRIPTION:    This C function implements the BASIC
X            ERL function, returning the line number
X            for the most recent error.
X
X    SYNTAX:        ERL
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_erl( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_erl( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static int init = FALSE;
X
X   /* initialize nvar if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, (int) NUMBER );
X      }
X
X   * var_findnval( &nvar, nvar.array_pos ) = (bnumber) err_line;
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_loc()
X
X        DESCRIPTION:    This C function implements the BASIC
X            LOC() function. As implemented here,
X            this only workd for random-acess files.
X
X    SYNTAX:        LOC( device-number )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_loc( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_loc( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static int init = FALSE;
X   int dev_number;
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in fnc_loc(): received f_arg <%f> ",
X      var_getnval( &( argv[ 0 ] ) ) );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   if ( argc < 1 )
X      {
X#if PROG_ERRORS
X      sprintf( bwb_ebuf, "Not enough parameters (%d) to function LOC().",
X         argc );
X      bwb_error( bwb_ebuf );
X#else
X      bwb_error( err_syntax );
X#endif
X      return NULL;
X      }
X   else if ( argc > 1 )
X      {
X#if PROG_ERRORS
X      sprintf( bwb_ebuf, "Too many parameters (%d) to function LOC().",
X         argc );
X      bwb_error( bwb_ebuf );
X#else
X      bwb_error( err_syntax );
X#endif
X      return NULL;
X      }
X
X   dev_number = (int) var_getnval( &( argv[ 0 ] ) );
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, NUMBER );
X      }
X
X   /* note if this is the very beginning of the file */
X
X   if ( dev_table[ dev_number ].loc == 0 )
X      {
X      * var_findnval( &nvar, nvar.array_pos ) = (bnumber) 0;
X      }
X   else
X      {
X      * var_findnval( &nvar, nvar.array_pos ) =
X         (bnumber) dev_table[ dev_number ].next_record;
X      }
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_eof()
X
X        DESCRIPTION:    This C function implements the BASIC
X            EOF() function.
X
X    SYNTAX:        EOF( device-number )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_eof( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_eof( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static int init = FALSE;
X   int dev_number;
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in fnc_loc(): received f_arg <%f> ",
X      var_getnval( &( argv[ 0 ] ) ) );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   if ( argc < 1 )
X      {
X#if PROG_ERRORS
X      sprintf( bwb_ebuf, "Not enough parameters (%d) to function EOF().",
X         argc );
X      bwb_error( bwb_ebuf );
X#else
X      bwb_error( err_syntax );
X#endif
X      return NULL;
X      }
X   else if ( argc > 1 )
X      {
X#if PROG_ERRORS
X      sprintf( bwb_ebuf, "Too many parameters (%d) to function EOF().",
X         argc );
X      bwb_error( bwb_ebuf );
X#else
X      bwb_error( err_syntax );
X#endif
X      return NULL;
X      }
X
X   dev_number = (int) var_getnval( &( argv[ 0 ] ) );
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, NUMBER );
X      }
X
X   /* note if this is the very beginning of the file */
X
X   if ( dev_table[ dev_number ].mode == DEVMODE_AVAILABLE )
X      {
X      bwb_error( err_devnum );
X      * var_findnval( &nvar, nvar.array_pos ) = (bnumber) TRUE;
X      }
X   else if ( dev_table[ dev_number ].mode == DEVMODE_CLOSED )
X      {
X      bwb_error( err_devnum );
X      * var_findnval( &nvar, nvar.array_pos ) = (bnumber) TRUE;
X      }
X   else if ( feof( dev_table[ dev_number ].cfp ) == 0 )
X      {
X      * var_findnval( &nvar, nvar.array_pos ) = (bnumber) FALSE;
X      }
X   else
X      {
X      * var_findnval( &nvar, nvar.array_pos ) = (bnumber) TRUE;
X      }
X
X   return &nvar;
X   }
X
X/***************************************************************
X
X        FUNCTION:       fnc_lof()
X
X        DESCRIPTION:    This C function implements the BASIC
X            LOF() function.
X
X    SYNTAX:        LOF( device-number )
X
X***************************************************************/
X
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_lof( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_lof( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   static struct bwb_variable nvar;
X   static int init = FALSE;
X   int dev_number;
X#if UNIX_CMDS
X   static struct stat statbuf;
X   int r;
X#endif
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in fnc_lof(): received f_arg <%f> ",
X      var_getnval( &( argv[ 0 ] ) ) );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   if ( argc < 1 )
X      {
X#if PROG_ERRORS
X      sprintf( bwb_ebuf, "Not enough parameters (%d) to function LOF().",
X         argc );
X      bwb_error( bwb_ebuf );
X#else
X      bwb_error( err_syntax );
X#endif
X      return NULL;
X      }
X   else if ( argc > 1 )
X      {
X#if PROG_ERRORS
X      sprintf( bwb_ebuf, "Too many parameters (%d) to function LOF().",
X         argc );
X      bwb_error( bwb_ebuf );
X#else
X      bwb_error( err_syntax );
X#endif
X      return NULL;
X      }
X
X   dev_number = (int) var_getnval( &( argv[ 0 ] ) );
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &nvar, NUMBER );
X      }
X
X   /* stat the file */
X
X#if UNIX_CMDS
X
X   r = stat( dev_table[ dev_number ].filename, &statbuf );
X
X   if ( r != 0 )
X      {
X#if PROG_ERRORS
X      sprintf( bwb_ebuf, "in fnc_lof(): failed to find file <%s>",
X         dev_table[ dev_number ].filename );
X      bwb_error( bwb_ebuf );
X#else
X      sprintf( bwb_ebuf, ERR_OPENFILE,
X         dev_table[ dev_number ].filename );
X      bwb_error( bwb_ebuf );
X#endif
X      return NULL;
X      }
X
X   * var_findnval( &nvar, nvar.array_pos ) = (bnumber) statbuf.st_size;
X
X#else
X
X   * var_findnval( &nvar, nvar.array_pos ) = (bnumber) FALSE;
X
X#endif
X
X   return &nvar;
X   }
X
X#endif                    /* MS_FUNCS */
X
X/***************************************************************
X
X        FUNCTION:       fnc_test()
X
X        DESCRIPTION:    This is a test function, developed in
X                        order to test argument passing to
X                        BASIC functions.
X
X***************************************************************/
X
X#if INTENSIVE_DEBUG
X#if ANSI_C
Xstruct bwb_variable *
Xfnc_test( int argc, struct bwb_variable *argv, int unique_id )
X#else
Xstruct bwb_variable *
Xfnc_test( argc, argv, unique_id )
X   int argc;
X   struct bwb_variable *argv;
X   int unique_id;
X#endif
X   {
X   register int c;
X   static struct bwb_variable rvar;
X   static char *tbuf;
X   static int init = FALSE;
X
X   /* initialize the variable if necessary */
X
X   if ( init == FALSE )
X      {
X      init = TRUE;
X      var_make( &rvar, NUMBER );
X      if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
X         {
X#if PROG_ERRORS
X         bwb_error( "in fnc_test(): failed to get memory for tbuf" );
X#else
X         bwb_error( err_getmem );
X#endif
X         }
X      }
X
X   sprintf( bwb_ebuf, "TEST function: received %d arguments: \n", argc );
X   prn_xprintf( stderr, bwb_ebuf );
X
X   for ( c = 0; c < argc; ++c )
X      {
X      str_btoc( tbuf, var_getsval( &argv[ c ] ) );
X      sprintf( bwb_ebuf, "                  arg %d (%c): <%s> \n", c,
X     argv[ c ].type, tbuf );
X      prn_xprintf( stderr, bwb_ebuf );
X      }
X
X   return &rvar;
X
X   }
X#endif
X
X/***************************************************************
X
X        FUNCTION:       fnc_checkargs()
X
X        DESCRIPTION:    This C function checks the arguments to
X            functions.
X
X***************************************************************/
X
X#if PROG_ERRORS
X#else
X#if ANSI_C
Xint
Xfnc_checkargs( int argc, struct bwb_variable *argv, int min, int max )
X#else
Xint
Xfnc_checkargs( argc, argv, min, max )
X   int argc;
X   struct bwb_variable *argv;
X   int min;
X   int max;
X#endif
X   {
X
X   if ( argc < min )
X      {
X      bwb_error( err_syntax );
X      return FALSE;
X      }
X   if ( argc > max )
X      {
X      bwb_error( err_syntax );
X      return FALSE;
X      }
X
X   return TRUE;
X
X   }
X#endif
X
X/***************************************************************
X
X        FUNCTION:       fnc_fncs()
X
X        DESCRIPTION:    This C function is used for debugging
X                        purposes; it prints a list of all defined
X                        functions.
X
X    SYNTAX:        FNCS
X
X***************************************************************/
X
X#if PERMANENT_DEBUG
X
X#if ANSI_C
Xstruct bwb_line *
Xbwb_fncs( struct bwb_line *l )
X#else
Xstruct bwb_line *
Xbwb_fncs( l )
X   struct bwb_line *l;
X#endif
X   {
X   struct bwb_function *f;
X
X   for ( f = CURTASK fnc_start.next; f != &CURTASK fnc_end; f = f->next )
X      {
X      sprintf( bwb_ebuf, "%s\t%c \n", f->name, f->type );
X      prn_xprintf( stderr, bwb_ebuf );
X      }
X
X   return bwb_zline( l );
X
X   }
X#endif
X
END_OF_FILE
  if test 43270 -ne `wc -c <'bwbasic-2.10/bwb_fnc.c'`; then
    echo shar: \"'bwbasic-2.10/bwb_fnc.c'\" unpacked with wrong size!
  fi
  # end of 'bwbasic-2.10/bwb_fnc.c'
fi
if test -f 'bwbasic-2.10/bwb_par.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'bwbasic-2.10/bwb_par.c'\"
else
  echo shar: Extracting \"'bwbasic-2.10/bwb_par.c'\" \(3220 characters\)
  sed "s/^X//" >'bwbasic-2.10/bwb_par.c' <<'END_OF_FILE'
X/***************************************************************
X
X        bwb_par.c       Parallel Action (Multitasking) Routines
X                        for Bywater BASIC Interpreter
X
X            Currently UNDER CONSTRUCTION
X
X                        Copyright (c) 1993, Ted A. Campbell
X                        Bywater Software
X
X                        email: [e-mail]
X
X        Copyright and Permissions Information:
X
X        All U.S. and international rights are claimed by the author,
X        Ted A. Campbell.
X
X    This software is released under the terms of the GNU General
X    Public License (GPL), which is distributed with this software
X    in the file "COPYING".  The GPL specifies the terms under
X    which users may copy and use the software in this distribution.
X
X    A separate license is available for commercial distribution,
X    for information on which you should contact the author.
X
X***************************************************************/
X
X#include <stdio.h>
X
X#include "bwbasic.h"
X#include "bwb_mes.h"
X
X#if PARACT            /* this whole file ignored if FALSE */
X
X/***************************************************************
X
X        FUNCTION:       bwb_newtask()
X
X        DESCRIPTION:    This C function allocates and initializes
X                memory for a new task.
X
X***************************************************************/
X
X#if ANSI_C
Xint
Xbwb_newtask( int task_requested )
X#else
Xint
Xbwb_newtask( task_requested )
X   int task_requested;
X#endif
X   {
X   static char start_buf[] = "\0";
X   static char end_buf[] = "\0";
X   register int c;
X
X   /* find if requested task slot is available */
X
X   if ( bwb_tasks[ task_requested ] != NULL )
X      {
X#if PROG_ERRORS
X      sprintf( bwb_ebuf, "in bwb_newtask(): Slot requested is already in use" );
X      bwb_error( bwb_ebuf );
X#else
X      bwb_error( err_overflow );
X      return -1;
X#endif
X      }
X
X   /* get memory for task structure */
X
X   if ( ( bwb_tasks[ task_requested ] = calloc( 1, sizeof( struct bwb_task ) ) )
X      == NULL )
X      {
X#if PROG_ERRORS
X      bwb_error( "in bwb_newtask(): failed to find memory for task structure" );
X#else
X      bwb_error( err_getmem );
X#endif
X      }
X
X   /* set some initial variables */
X
X   bwb_tasks[ task_requested ]->bwb_start.number = 0;
X   bwb_tasks[ task_requested ]->bwb_start.next = &bwb_tasks[ task_requested ]->bwb_end;
X   bwb_tasks[ task_requested ]->bwb_end.number = MAXLINENO + 1;
X   bwb_tasks[ task_requested ]->bwb_end.next = &bwb_tasks[ task_requested ]->bwb_end;
X   bwb_tasks[ task_requested ]->bwb_start.buffer = start_buf;
X   bwb_tasks[ task_requested ]->bwb_end.buffer = end_buf;
X   bwb_tasks[ task_requested ]->data_line = &bwb_tasks[ task_requested ]->bwb_start;
X   bwb_tasks[ task_requested ]->data_pos = 0;
X   bwb_tasks[ task_requested ]->rescan = TRUE;
X   bwb_tasks[ task_requested ]->exsc = -1;
X   bwb_tasks[ task_requested ]->expsc = 0;
X   bwb_tasks[ task_requested ]->xtxtsc = 0;
X
X   /* Variable and function table initializations */
X
X   var_init( task_requested );             /* initialize variable chain */
X   fnc_init( task_requested );             /* initialize function chain */
X   fslt_init( task_requested );        /* initialize funtion-sub  chain */
X
X   return task_requested;
X
X   }
X
X#endif
X
X
END_OF_FILE
  if test 3220 -ne `wc -c <'bwbasic-2.10/bwb_par.c'`; then
    echo shar: \"'bwbasic-2.10/bwb_par.c'\" unpacked with wrong size!
  fi
  # end of 'bwbasic-2.10/bwb_par.c'
fi
if test -f 'bwbasic-2.10/bwb_str.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'bwbasic-2.10/bwb_str.c'\"
else
  echo shar: Extracting \"'bwbasic-2.10/bwb_str.c'\" \(7352 characters\)
  sed "s/^X//" >'bwbasic-2.10/bwb_str.c' <<'END_OF_FILE'
X/***************************************************************
X
X    bwb_str.c       String-Management Routines
X                        for Bywater BASIC Interpreter
X
X                        Copyright (c) 1993, Ted A. Campbell
X                        Bywater Software
X
X                        email: [e-mail]
X
X        Copyright and Permissions Information:
X
X        All U.S. and international rights are claimed by the author,
X        Ted A. Campbell.
X
X    This software is released under the terms of the GNU General
X    Public License (GPL), which is distributed with this software
X    in the file "COPYING".  The GPL specifies the terms under
X    which users may copy and use the software in this distribution.
X
X    A separate license is available for commercial distribution,
X    for information on which you should contact the author.
X
X***************************************************************/
X
X#include <stdio.h>
X
X#include "bwbasic.h"
X#include "bwb_mes.h"
X
X#if INTENSIVE_DEBUG || TEST_BSTRING
Xstatic char tbuf[ MAXSTRINGSIZE + 1 ];
X#endif
X
X/***************************************************************
X
X        FUNCTION:       str_btob()
X
X        DESCRIPTION:    This C function assigns a bwBASIC string
X            structure to another bwBASIC string
X            structure.
X
X***************************************************************/
X
X#if ANSI_C
Xint
Xstr_btob( bstring *d, bstring *s )
X#else
Xint
Xstr_btob( d, s )
X   bstring *d;
X   bstring *s;
X#endif
X   {
X   char *t;
X   register int i;
X
X#if TEST_BSTRING
X   sprintf( tbuf, "in str_btob(): entry, source b string name is <%s>", s->name );
X   bwb_debug( tbuf );
X   sprintf( tbuf, "in str_btob(): entry, destination b string name is <%s>", d->name );
X   bwb_debug( tbuf );
X#endif
X
X   /* get memory for new buffer */
X
X   if ( ( t = (char *) calloc( s->length + 1, 1 )) == NULL )
X      {
X#if PROG_ERRORS
X      bwb_error( "in str_btob(): failed to get memory for new buffer" );
X#else
X      bwb_error( err_getmem );
X#endif
X      return FALSE;
X      }
X
X   /* write the c string to the b string */
X
X   t[ 0 ] = '\0';
X   for ( i = 0; i < (int) s->length; ++i )
X      {
X      t[ i ] = s->sbuffer[ i ];
X#if INTENSIVE_DEBUG
X      tbuf[ i ] = s->sbuffer[ i ];
X      tbuf[ i + 1 ] = '\0';
X#endif
X      }
X
X   /* deallocate old memory */
X
X#if INTENSIVE_DEBUG
X   if ( d->rab == TRUE )
X      {
X      sprintf( bwb_ebuf, "in str_btob(): reallocating RAB" );
X      bwb_debug( bwb_ebuf );
X      }
X#endif
X
X   if (( d->rab != TRUE ) && ( d->sbuffer != NULL ))
X      {
X#if INTENSIVE_DEBUG
X      sprintf( tbuf, "in str_btob(): deallocating string memory" );
X      bwb_debug ( tbuf );
X#endif
X      free( d->sbuffer );
X      }
X   else
X      {
X      d->rab = (char) FALSE;
X      }
X
X   /* reassign buffer */
X
X   d->sbuffer = t;
X
X   /* reassign length */
X
X   d->length = s->length;
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in str_btob(): exit length <%d> string <%s>",
X      d->length, tbuf );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   /* return */
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:       str_ctob()
X
X        DESCRIPTION:    This C function assigns a null-terminated
X            C string to a bwBASIC string structure.
X
X***************************************************************/
X
X#if ANSI_C
Xint
Xstr_ctob( bstring *s, char *buffer )
X#else
Xint
Xstr_ctob( s, buffer )
X   bstring *s;
X   char *buffer;
X#endif
X   {
X   char *t;
X   register int i;
X
X#if INTENSIVE_DEBUG
X   sprintf( tbuf, "in str_ctob(): entry, c string is <%s>", buffer );
X   bwb_debug( tbuf );
X#endif
X#if TEST_BSTRING
X   sprintf( tbuf, "in str_ctob(): entry, b string name is <%s>", s->name );
X   bwb_debug( tbuf );
X#endif
X
X   /* get memory for new buffer */
X
X   if ( ( t = (char *) calloc( strlen( buffer ) + 1, 1 )) == NULL )
X      {
X#if PROG_ERRORS
X      bwb_error( "in str_ctob(): failed to get memory for new buffer" );
X#else
X      bwb_error( err_getmem );
X#endif
X      return FALSE;
X      }
X
X   /* write the c string to the b string */
X
X   t[ 0 ] = '\0';
X   for ( i = 0; i < (int) strlen( buffer ); ++i )
X      {
X      t[ i ] = buffer[ i ];
X#if INTENSIVE_DEBUG
X      tbuf[ i ] = buffer[ i ];
X      tbuf[ i + 1 ] = '\0';
X#endif
X      }
X
X   /* deallocate old memory */
X
X#if INTENSIVE_DEBUG
X   if ( s->rab == TRUE )
X      {
X      sprintf( bwb_ebuf, "in str_ctob(): reallocating RAB" );
X      bwb_debug( bwb_ebuf );
X      }
X#endif
X
X   if (( s->rab != TRUE ) && ( s->sbuffer != NULL ))
X      {
X      free( s->sbuffer );
X      }
X   else
X      {
X      s->rab = (char) FALSE;
X      }
X
X   /* reassign buffer */
X
X   s->sbuffer = t;
X
X   /* reassign length */
X
X   s->length = (unsigned char) strlen( buffer );
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in str_ctob(): exit length <%d> string <%s>",
X      s->length, tbuf );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   /* return */
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:       str_btoc()
X
X        DESCRIPTION:    This C function assigns a null-terminated
X            C string to a bwBASIC string structure.
X
X***************************************************************/
X
X#if ANSI_C
Xint
Xstr_btoc( char *buffer, bstring *s )
X#else
Xint
Xstr_btoc( buffer, s )
X   char *buffer;
X   bstring *s;
X#endif
X   {
X   register int i;
X
X#if INTENSIVE_DEBUG
X   sprintf( tbuf, "in str_btoc(): entry, b string length is <%d>",
X      s->length );
X   bwb_debug( tbuf );
X#endif
X#if TEST_BSTRING
X   sprintf( tbuf, "in str_btoc(): entry, b string name is <%s>", s->name );
X   bwb_debug( tbuf );
X#endif
X
X   /* write the b string to the c string */
X
X   buffer[ 0 ] = '\0';
X   for ( i = 0; i < (int) s->length; ++i )
X      {
X      buffer[ i ] = s->sbuffer[ i ];
X      buffer[ i + 1 ] = '\0';
X      if ( i >= MAXSTRINGSIZE )
X         {
X         i = s->length + 1;
X         }
X      }
X
X#if INTENSIVE_DEBUG
X   sprintf( tbuf, "in str_btoc(): exit, c string is <%s>", buffer );
X   bwb_debug( tbuf );
X#endif
X
X   /* return */
X
X   return TRUE;
X
X   }
X
X/***************************************************************
X
X        FUNCTION:       str_cat()
X
X        DESCRIPTION:    This C function performs the equivalent
X            of the C strcat() function, using BASIC
X            strings.
X
X***************************************************************/
X
X#if ANSI_C
Xchar *
Xstr_cat( bstring *a, bstring *b )
X#else
Xchar *
Xstr_cat( a, b )
X   bstring *a;
X   bstring *b;
X#endif
X   {
X   char abuf[ MAXSTRINGSIZE + 1 ];
X   char bbuf[ MAXSTRINGSIZE + 1 ];
X   char *r;
X
X   str_btoc( abuf, a );
X   str_btoc( bbuf, b );
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in str_cat(): a <%s> b <%s>", abuf, bbuf );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   strcat( abuf, bbuf );
X   str_ctob( a, abuf );
X
X#if INTENSIVE_DEBUG
X   sprintf( bwb_ebuf, "in str_cat(): returns <%s>", abuf );
X   bwb_debug( bwb_ebuf );
X#endif
X
X   return r;
X   }
X
X/***************************************************************
X
X        FUNCTION:       str_cmp()
X
X    DESCRIPTION:    This C function performs the equivalent
X            of the C strcmp() function, using BASIC
X            strings.
X
X***************************************************************/
X
X#if ANSI_C
Xint
Xstr_cmp( bstring *a, bstring *b )
X#else
Xint
Xstr_cmp( a, b )
X   bstring *a;
X   bstring *b;
X#endif
X   {
X   char abuf[ MAXSTRINGSIZE + 1 ];
X   char bbuf[ MAXSTRINGSIZE + 1 ];
X
X   str_btoc( abuf, a );
X   str_btoc( bbuf, b );
X
X   return strcmp( abuf, bbuf );
X   }
X
X
X
END_OF_FILE
  if test 7352 -ne `wc -c <'bwbasic-2.10/bwb_str.c'`; then
    echo shar: \"'bwbasic-2.10/bwb_str.c'\" unpacked with wrong size!
  fi
  # end of 'bwbasic-2.10/bwb_str.c'
fi
if test -f 'bwbasic-2.10/bwbasic.mak' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'bwbasic-2.10/bwbasic.mak'\"
else
  echo shar: Extracting \"'bwbasic-2.10/bwbasic.mak'\" \(1400 characters\)
  sed "s/^X//" >'bwbasic-2.10/bwbasic.mak' <<'END_OF_FILE'
XPROJ    =BWBASIC
XDEBUG    =0
XCC    =qcl
XCFLAGS_G    = /AL /W3 /Za /DMSDOS
XCFLAGS_D    = /Zd /Gi$(PROJ).mdt /Od
XCFLAGS_R    = /O /Ot /Gs /DNDEBUG
XCFLAGS    =$(CFLAGS_G) $(CFLAGS_R)
XLFLAGS_G    = /CP:0xffff /NOI /NOE /SE:0x80 /ST:0x1fa0
XLFLAGS_D    = /INCR
XLFLAGS_R    =
XLFLAGS    =$(LFLAGS_G) $(LFLAGS_R)
XRUNFLAGS    =
XOBJS_EXT =
XLIBS_EXT =
X
Xall:    $(PROJ).exe
X
Xbwbasic.obj:    bwbasic.c
X
Xbwb_cmd.obj:    bwb_cmd.c
X
Xbwb_cnd.obj:    bwb_cnd.c
X
Xbwb_dio.obj:    bwb_dio.c
X
Xbwb_elx.obj:    bwb_elx.c
X
Xbwb_exp.obj:    bwb_exp.c
X
Xbwb_fnc.obj:    bwb_fnc.c
X
Xbwb_inp.obj:    bwb_inp.c
X
Xbwb_int.obj:    bwb_int.c
X
Xbwb_mth.obj:    bwb_mth.c
X
Xbwb_ops.obj:    bwb_ops.c
X
Xbwb_par.obj:    bwb_par.c
X
Xbwb_prn.obj:    bwb_prn.c
X
Xbwb_stc.obj:    bwb_stc.c
X
Xbwb_str.obj:    bwb_str.c
X
Xbwb_tbl.obj:    bwb_tbl.c
X
Xbwb_var.obj:    bwb_var.c
X
Xbwx_tty.obj:    bwx_tty.c
X
X$(PROJ).exe:    bwbasic.obj bwb_cmd.obj bwb_cnd.obj bwb_dio.obj bwb_elx.obj bwb_exp.obj \
X    bwb_fnc.obj bwb_inp.obj bwb_int.obj bwb_mth.obj bwb_ops.obj bwb_par.obj bwb_prn.obj \
X    bwb_stc.obj bwb_str.obj bwb_tbl.obj bwb_var.obj bwx_tty.obj $(OBJS_EXT)
X    echo >NUL @<<$(PROJ).crf
Xbwbasic.obj +
Xbwb_cmd.obj +
Xbwb_cnd.obj +
Xbwb_dio.obj +
Xbwb_elx.obj +
Xbwb_exp.obj +
Xbwb_fnc.obj +
Xbwb_inp.obj +
Xbwb_int.obj +
Xbwb_mth.obj +
Xbwb_ops.obj +
Xbwb_par.obj +
Xbwb_prn.obj +
Xbwb_stc.obj +
Xbwb_str.obj +
Xbwb_tbl.obj +
Xbwb_var.obj +
Xbwx_tty.obj +
X$(OBJS_EXT)
X$(PROJ).exe
X
X$(LIBS_EXT);
X<<
X    link $(LFLAGS) @$(PROJ).crf
X
Xrun: $(PROJ).exe
X    $(PROJ) $(RUNFLAGS)
X
END_OF_FILE
  if test 1400 -ne `wc -c <'bwbasic-2.10/bwbasic.mak'`; then
    echo shar: \"'bwbasic-2.10/bwbasic.mak'\" unpacked with wrong size!
  fi
  # end of 'bwbasic-2.10/bwbasic.mak'
fi
if test -f 'bwbasic-2.10/bwbtest/index.txt' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'bwbasic-2.10/bwbtest/index.txt'\"
else
  echo shar: Extracting \"'bwbasic-2.10/bwbtest/index.txt'\" \(1141 characters\)
  sed "s/^X//" >'bwbasic-2.10/bwbtest/index.txt' <<'END_OF_FILE'
XTest Programs for bwBASIC:
X-------------------------
X
X___ ___ ABS      BAS
X___ ___ ASSIGN   BAS
X___ ___ CALLFUNC BAS    * STRUCT_CMDS
X___ ___ CALLSUB  BAS    * STRUCT_CMDS
X___ ___ CHAIN1   BAS
X___ ___ CHAIN2   BAS    * called from CHAIN1.BAS
X___ ___ DATAREAD BAS
X___ ___ DEFFN    BAS
X___ ___ DIM      BAS
X___ ___ DOLOOP   BAS    * STRUCT_CMDS
X___ ___ DOWHILE  BAS    * STRUCT_CMDS
X___ ___ ELSEIF   BAS    * STRUCT_CMDS
X___ ___ END      BAS
X___ ___ ERR      BAS
X___ ___ FORNEXT  BAS
X___ ___ FUNCTION BAS
X___ ___ GOSUB    BAS
X___ ___ GOTOLABL BAS    * STRUCT_CMDS
X___ ___ IFLINE   BAS
X___ ___ INPUT    BAS
X___ ___ LOF      BAS    * LOF(): IMPLEMENTATION-SPECIFIC
X___ ___ LOOPUNTL BAS    * STRUCT_CMDS
X___ ___ MAIN     BAS    * STRUCT_CMDS
X___ ___ MLIFTHEN BAS    * STRUCT_CMDS
X___ ___ ON       BAS
X___ ___ ONERR    BAS
X___ ___ ONERRLBL BAS    * STRUCT_CMDS
X___ ___ ONGOSUB  BAS
X___ ___ OPENTEST BAS
X___ ___ OPTION   BAS
X___ ___ PUTGET   BAS    * KILL: IMPLEMENTATION-SPECIFIC
X___ ___ RANDOM   BAS
X___ ___ SELCASE  BAS    * STRUCT_CMDS
X___ ___ SNGLFUNC BAS
X___ ___ STOP     BAS
X___ ___ TERM     BAS
X___ ___ WHILWEND BAS
X___ ___ WIDTH    BAS
X___ ___ WRITEINP BAS
X
END_OF_FILE
  if test 1141 -ne `wc -c <'bwbasic-2.10/bwbtest/index.txt'`; then
    echo shar: \"'bwbasic-2.10/bwbtest/index.txt'\" unpacked with wrong size!
  fi
  # end of 'bwbasic-2.10/bwbtest/index.txt'
fi
if test -f 'bwbasic-2.10/bwx_iqc.h' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'bwbasic-2.10/bwx_iqc.h'\"
else
  echo shar: Extracting \"'bwbasic-2.10/bwx_iqc.h'\" \(1589 characters\)
  sed "s/^X//" >'bwbasic-2.10/bwx_iqc.h' <<'END_OF_FILE'
X/***************************************************************
X
X        bwx_iqc.h       Header File for IBM PC and Compatible
X            Implementation of bwBASIC
X            Using Microsoft QuickC (tm) Compiler
X
X                        Copyright (c) 1993, Ted A. Campbell
X            Bywater Software
X
X                        email: [e-mail]
X
X        Copyright and Permissions Information:
X
X        All U.S. and international rights are claimed by the author,
X        Ted A. Campbell.
X
X    This software is released under the terms of the GNU General
X    Public License (GPL), which is distributed with this software
X    in the file "COPYING".  The GPL specifies the terms under
X    which users may copy and use the software in this distribution.
X
X    A separate license is available for commercial distribution,
X    for information on which you should contact the author.
X
X***************************************************************/
X
X#define IMP_IDSTRING    "IQC"           /* unique ID string for this implementation */
X
X/* Definitions indicating which commands and functions are implemented */
X
X#define IMP_FNCINKEY    1               /* 0 if INKEY$ is not implemented, 1 if it is */
X#define IMP_CMDCLS    1        /* 0 if CLS is not implemented, 1 if it is */
X#define IMP_CMDLOC    1        /* 0 if LOCATE is not implemented, 1 if it is */
X#define IMP_CMDCOLOR    1               /* 0 if COLOR is not implemented, 1 if it is */
X
X#define UNIX_CMDS       TRUE
X#define MKDIR_ONE_ARG    TRUE        /* TRUE if your mkdir has but one argument;
X                       FALSE if it has two */
X#define PERMISSIONS    493        /* permissions to set in Unix-type system */
END_OF_FILE
  if test 1589 -ne `wc -c <'bwbasic-2.10/bwx_iqc.h'`; then
    echo shar: \"'bwbasic-2.10/bwx_iqc.h'\" unpacked with wrong size!
  fi
  # end of 'bwbasic-2.10/bwx_iqc.h'
fi
if test -f 'bwbasic-2.10/bwx_tty.h' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'bwbasic-2.10/bwx_tty.h'\"
else
  echo shar: Extracting \"'bwbasic-2.10/bwx_tty.h'\" \(1648 characters\)
  sed "s/^X//" >'bwbasic-2.10/bwx_tty.h' <<'END_OF_FILE'
X/***************************************************************
X
X        bwx_tty.h       Header file for TTY-style hardware
X            implementation of bwBASIC
X
X            This file may be used as a template
X            for developing more sophisticated
X            hardware implementations
X
X                        Copyright (c) 1993, Ted A. Campbell
X            Bywater Software
X
X                        email: [e-mail]
X
X        Copyright and Permissions Information:
X
X        All U.S. and international rights are claimed by the author,
X        Ted A. Campbell.
X
X    This software is released under the terms of the GNU General
X    Public License (GPL), which is distributed with this software
X    in the file "COPYING".  The GPL specifies the terms under
X    which users may copy and use the software in this distribution.
X
X    A separate license is available for commercial distribution,
X    for information on which you should contact the author.
X
X***************************************************************/
X
X#define IMP_IDSTRING    "TTY"           /* unique ID string for this implementation */
X
X/* Definitions indicating which commands and functions are implemented */
X
X#define IMP_FNCINKEY    0        /* 0 if INKEY$ is not implemented, 1 if it is */
X#define IMP_CMDCLS    0        /* 0 if CLS is not implemented, 1 if it is */
X#define IMP_CMDLOC    0        /* 0 if LOCATE is not implemented, 1 if it is */
X#define IMP_CMDCOLOR    0               /* 0 if COLOR is not implemented, 1 if it is */
X
X#define UNIX_CMDS       FALSE
X#define MKDIR_ONE_ARG   FALSE           /* TRUE if your mkdir has but one argument;
X                       FALSE if it has two */
X#define PERMISSIONS    493        /* permissions to set in Unix-type system */
END_OF_FILE
  if test 1648 -ne `wc -c <'bwbasic-2.10/bwx_tty.h'`; then
    echo shar: \"'bwbasic-2.10/bwx_tty.h'\" unpacked with wrong size!
  fi
  # end of 'bwbasic-2.10/bwx_tty.h'
fi
if test -f 'bwbasic-2.10/makefile.qcl' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'bwbasic-2.10/makefile.qcl'\"
else
  echo shar: Extracting \"'bwbasic-2.10/makefile.qcl'\" \(1449 characters\)
  sed "s/^X//" >'bwbasic-2.10/makefile.qcl' <<'END_OF_FILE'
X#               Microsoft QuickC Makefile for Bywater BASIC Interpreter
X#
X#        This makefile is for line-oriented QuickC only, not for
X#        the QuickC integrated environment. To make the program:
X#        type "nmake -f makefile.qcl".
X#
X#        To implement the bwx_iqc implementation (using specific
X#        features for the IBM PC and compatibles), chainge each
X#        instance of "bwx_tty" to "bwx_iqc".
X#
XPROJ=           bwbasic
XCC=             qcl
X
X#
X#        These are the normal flags I used to compile bwBASIC:
X#
XCFLAGS=         -O -AL -W3 -Za -DMSDOS
X#
X#        The following flags can be used for debugging:
X#
X#CFLAGS=         -Od -AL -W3 -Za -Zr -Zi -DMSDOS
X
XLFLAGS=         /NOE /ST:8192
X
XOFILES=         bwbasic.obj bwb_int.obj bwb_tbl.obj bwb_cmd.obj bwb_prn.obj\
X                bwb_exp.obj bwb_var.obj bwb_inp.obj bwb_fnc.obj bwb_cnd.obj\
X                bwb_ops.obj bwb_dio.obj bwb_str.obj bwb_elx.obj bwb_mth.obj\
X        bwb_stc.obj bwb_par.obj bwx_tty.obj
X
XHFILES=         bwbasic.h bwb_mes.h
X
Xall:            $(PROJ).exe
X
X$(OFILES):      $(HFILES) makefile.qcl
X
X$(PROJ).exe:    $(OFILES)
X        echo >NUL @<<$(PROJ).crf
Xbwbasic.obj +
Xbwb_cmd.obj +
Xbwb_cnd.obj +
Xbwb_fnc.obj +
Xbwb_inp.obj +
Xbwb_int.obj +
Xbwb_prn.obj +
Xbwb_tbl.obj +
Xbwb_var.obj +
Xbwb_exp.obj +
Xbwb_ops.obj +
Xbwb_dio.obj +
Xbwb_str.obj +
Xbwb_elx.obj +
Xbwb_mth.obj +
Xbwb_stc.obj +
Xbwb_par.obj +
Xbwx_tty.obj +
X$(OBJS_EXT)
X$(PROJ).exe
X
X$(LIBS_EXT);
X<<
X        link $(LFLAGS) @$(PROJ).crf
X    erase $(PROJ).crf
X
END_OF_FILE
  if test 1449 -ne `wc -c <'bwbasic-2.10/makefile.qcl'`; then
    echo shar: \"'bwbasic-2.10/makefile.qcl'\" unpacked with wrong size!
  fi
  # end of 'bwbasic-2.10/makefile.qcl'
fi
echo shar: End of archive 9 \(of 15\).
cp /dev/null ark9isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 15 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still must unpack the following archives:
    echo "        " ${MISSING}
fi
exit 0
exit 0 # Just in case...