home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / interpre / bwbasic / source / bwb_fnc.c < prev    next >
C/C++ Source or Header  |  1992-10-27  |  52KB  |  1,906 lines
  1. /****************************************************************
  2.  
  3.         bwb_fnc.c       Function Interpretation Routines
  4.                         for Bywater BASIC Interpreter
  5.  
  6.                         Copyright (c) 1992, Ted A. Campbell
  7.  
  8.                         Bywater Software
  9.                         P. O. Box 4023
  10.                         Duke Station
  11.                         Durham, NC  27706
  12.  
  13.                         email: tcamp@acpub.duke.edu
  14.  
  15.         Copyright and Permissions Information:
  16.  
  17.         All U.S. and international copyrights are claimed by the
  18.         author. The author grants permission to use this code
  19.         and software based on it under the following conditions:
  20.         (a) in general, the code and software based upon it may be
  21.         used by individuals and by non-profit organizations; (b) it
  22.         may also be utilized by governmental agencies in any country,
  23.         with the exception of military agencies; (c) the code and/or
  24.         software based upon it may not be sold for a profit without
  25.         an explicit and specific permission from the author, except
  26.         that a minimal fee may be charged for media on which it is
  27.         copied, and for copying and handling; (d) the code must be
  28.         distributed in the form in which it has been released by the
  29.         author; and (e) the code and software based upon it may not
  30.         be used for illegal activities.
  31.  
  32. ****************************************************************/
  33.  
  34. #define FSTACKSIZE      32
  35.  
  36. #include <stdio.h>
  37. #include <stdlib.h>
  38. #include <ctype.h>
  39. #include <string.h>
  40. #include <math.h>
  41. #include <time.h>
  42. #include "bwbasic.h"
  43. #include "bwb_mes.h"
  44.  
  45. static time_t t;
  46. static struct tm *lt;
  47.  
  48. struct bwb_function fnc_start, fnc_end;
  49.  
  50. int ufsc = -1;                   /* user function stack counter */
  51.  
  52. struct bwb_function bwb_prefuncs[ FUNCTIONS ] =
  53.    {
  54.    { "ABS",     DOUBLE,         1,  (struct user_fnc *) NULL,  fnc_abs,        (struct bwb_function *) NULL    },
  55.    { "DATE$",   STRING,         0,  (struct user_fnc *) NULL,  fnc_date,       (struct bwb_function *) NULL    },
  56.    { "TIME$",   STRING,         0,  (struct user_fnc *) NULL,  fnc_time,       (struct bwb_function *) NULL    },
  57.    { "ATN",     DOUBLE,         1,  (struct user_fnc *) NULL,  fnc_atn,        (struct bwb_function *) NULL    },
  58.    { "COS",     DOUBLE,         1,  (struct user_fnc *) NULL,  fnc_cos,        (struct bwb_function *) NULL    },
  59.    { "LOG",     DOUBLE,         1,  (struct user_fnc *) NULL,  fnc_log,        (struct bwb_function *) NULL    },
  60.    { "SIN",     DOUBLE,         1,  (struct user_fnc *) NULL,  fnc_sin,        (struct bwb_function *) NULL    },
  61.    { "SQR",     DOUBLE,         1,  (struct user_fnc *) NULL,  fnc_sqr,        (struct bwb_function *) NULL    },
  62.    { "TAN",     DOUBLE,         1,  (struct user_fnc *) NULL,  fnc_tan,        (struct bwb_function *) NULL    },
  63.    { "SGN",     DOUBLE,         1,  (struct user_fnc *) NULL,  fnc_sgn,        (struct bwb_function *) NULL    },
  64.    { "INT",     DOUBLE,         1,  (struct user_fnc *) NULL,  fnc_int,        (struct bwb_function *) NULL    },
  65.    { "RND",     DOUBLE,         0,  (struct user_fnc *) NULL,  fnc_rnd,        (struct bwb_function *) NULL    },
  66.    { "CHR$",    DOUBLE,         0,  (struct user_fnc *) NULL,  fnc_chr,        (struct bwb_function *) NULL    },
  67.    { "TAB",     STRING,        1,  (struct user_fnc *) NULL,  fnc_tab,        (struct bwb_function *) NULL    },
  68.    { "SPC",     STRING,        1,  (struct user_fnc *) NULL,  fnc_spc,        (struct bwb_function *) NULL    },
  69.    { "SPACE$",  STRING,        1,  (struct user_fnc *) NULL,  fnc_space,      (struct bwb_function *) NULL    },
  70.    { "STRING$", STRING,        1,  (struct user_fnc *) NULL,  fnc_string,     (struct bwb_function *) NULL    },
  71.    { "MID$",    STRING,        3,  (struct user_fnc *) NULL,  fnc_mid,        (struct bwb_function *) NULL    },
  72.    { "LEFT$",   STRING,        2,  (struct user_fnc *) NULL,  fnc_left,       (struct bwb_function *) NULL    },
  73.    { "RIGHT$",  STRING,        2,  (struct user_fnc *) NULL,  fnc_right,      (struct bwb_function *) NULL    },
  74.    { "TIMER",   SINGLE,         0,  (struct user_fnc *) NULL,  fnc_timer,      (struct bwb_function *) NULL    },
  75.    { "VAL",     INTEGER,        1,  (struct user_fnc *) NULL,  fnc_val,        (struct bwb_function *) NULL    },
  76.    { "POS",     INTEGER,        0,  (struct user_fnc *) NULL,  fnc_pos,        (struct bwb_function *) NULL    },
  77.    { "ERR",     INTEGER,        0,  (struct user_fnc *) NULL,  fnc_err,        (struct bwb_function *) NULL    },
  78.    { "ERL",     INTEGER,        0,  (struct user_fnc *) NULL,  fnc_erl,        (struct bwb_function *) NULL    },
  79.    { "LEN",     INTEGER,        1,  (struct user_fnc *) NULL,  fnc_len,        (struct bwb_function *) NULL    },
  80.    { "LOC",     INTEGER,        1,  (struct user_fnc *) NULL,  fnc_loc,        (struct bwb_function *) NULL    },
  81.    { "LOF",     DOUBLE,         1,  (struct user_fnc *) NULL,  fnc_lof,        (struct bwb_function *) NULL    },
  82.    { "EOF",     DOUBLE,         1,  (struct user_fnc *) NULL,  fnc_eof,        (struct bwb_function *) NULL    },
  83.    { "CSNG",    SINGLE,         1,  (struct user_fnc *) NULL,  fnc_csng,       (struct bwb_function *) NULL    },
  84.    { "EXP",     SINGLE,         1,  (struct user_fnc *) NULL,  fnc_exp,        (struct bwb_function *) NULL    },
  85.    { "INSTR",   INTEGER,        1,  (struct user_fnc *) NULL,  fnc_instr,      (struct bwb_function *) NULL    },
  86.    { "STR$",    STRING,         1,  (struct user_fnc *) NULL,  fnc_str,        (struct bwb_function *) NULL    },
  87.    { "HEX$",    STRING,         1,  (struct user_fnc *) NULL,  fnc_hex,        (struct bwb_function *) NULL    },
  88.    { "OCT$",    STRING,         1,  (struct user_fnc *) NULL,  fnc_oct,        (struct bwb_function *) NULL    },
  89.    { "CINT",    SINGLE,         1,  (struct user_fnc *) NULL,  fnc_cint,       (struct bwb_function *) NULL    },
  90.    { "ASC",     SINGLE,         1,  (struct user_fnc *) NULL,  fnc_asc,        (struct bwb_function *) NULL    },
  91.    { "ENVIRON$",STRING,         1,  (struct user_fnc *) NULL,  fnc_environ,    (struct bwb_function *) NULL    },
  92.    #if INTENSIVE_DEBUG
  93.    { "TEST",    DOUBLE,         2,  (struct user_fnc *) NULL,  fnc_test,       (struct bwb_function *) NULL    },
  94.    #endif
  95.    { "MKD$",    STRING,         1,  (struct user_fnc *) NULL,  fnc_mkd,        (struct bwb_function *) NULL    },
  96.    { "MKI$",    STRING,         1,  (struct user_fnc *) NULL,  fnc_mki,        (struct bwb_function *) NULL    },
  97.    { "MKS$",    STRING,         1,  (struct user_fnc *) NULL,  fnc_mks,        (struct bwb_function *) NULL    },
  98.    { "CVD",     DOUBLE,         1,  (struct user_fnc *) NULL,  fnc_cvd,        (struct bwb_function *) NULL    },
  99.    { "CVS",     SINGLE,         1,  (struct user_fnc *) NULL,  fnc_cvs,        (struct bwb_function *) NULL    },
  100.    { "CVI",     INTEGER,        1,  (struct user_fnc *) NULL,  fnc_cvi,        (struct bwb_function *) NULL    }
  101.    };
  102.  
  103. /***************************************************************
  104.  
  105.         FUNCTION:       fnc_init()
  106.  
  107.         DESCRIPTION:    This command initializes the function
  108.                         linked list, placing all predefined functions
  109.                         in the list.
  110.  
  111. ***************************************************************/
  112.  
  113. int
  114. fnc_init()
  115.    {
  116.    register int n;
  117.    struct bwb_function *f;
  118.  
  119.    strcpy( fnc_start.name, "FNC_START" );
  120.    fnc_start.type = 'X';
  121.    fnc_start.vector = fnc_null;
  122.    strcpy( fnc_end.name, "FNC_END" );
  123.    fnc_end.type = 'x';
  124.    fnc_end.vector = fnc_null;
  125.    fnc_end.next = &fnc_end;
  126.  
  127.    f = &fnc_start;
  128.  
  129.    /* now go through each of the preestablished functions and set up
  130.       links between them; from this point the program address the functions
  131.       only as a linked list (not as an array) */
  132.  
  133.    for ( n = 0; n < FUNCTIONS; ++n )
  134.       {
  135.       f->next = &( bwb_prefuncs[ n ] );
  136.       f = f->next;
  137.       }
  138.  
  139.    /* link the last pointer to the end; this completes the list */
  140.  
  141.    f->next = &fnc_end;
  142.  
  143.    return TRUE;
  144.    }
  145.  
  146. /***************************************************************
  147.  
  148.         FUNCTION:       fnc_find()
  149.  
  150.         DESCRIPTION:    This C function attempts to locate
  151.                         a BASIC function with the specified name.
  152.                         If successful, it returns a pointer to
  153.                         the C structure for the BASIC function,
  154.                         if not successful, it returns NULL.
  155.  
  156. ***************************************************************/
  157.  
  158. struct bwb_function *
  159. fnc_find( char *buffer )
  160.    {
  161.    struct bwb_function * f;
  162.    register int n;
  163.    static char *tbuf;
  164.    static int init = FALSE;
  165.  
  166.    /* get memory for temporary buffer if necessary */
  167.  
  168.    if ( init == FALSE )
  169.       {
  170.       init = TRUE;
  171.       if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  172.          {
  173.          bwb_error( err_getmem );
  174.          }
  175.       }
  176.  
  177.    #if INTENSIVE_DEBUG
  178.    sprintf( bwb_ebuf, "in fnc_find(): called for <%s> ", buffer );
  179.    bwb_debug( bwb_ebuf );
  180.    #endif
  181.  
  182.    for ( n = 0; buffer[ n ] != 0; ++n )
  183.       {
  184.       if ( islower( buffer[ n ] ) )
  185.          {
  186.          tbuf[ n ] = toupper( buffer[ n ] );
  187.          }
  188.       else
  189.          {
  190.          tbuf[ n ] = buffer[ n ];
  191.          }
  192.       }
  193.    tbuf[ n ] = 0;
  194.  
  195.    for ( f = fnc_start.next; f != &fnc_end; f = f->next )
  196.       {
  197.       if ( strcmp( f->name, tbuf ) == 0 )
  198.          {
  199.          #if INTENSIVE_DEBUG
  200.          sprintf( bwb_ebuf, "in fnc_find(): found <%s> ", f->name );
  201.          bwb_debug( bwb_ebuf );
  202.          #endif
  203.          return f;
  204.          }
  205.       }
  206.  
  207.    /* search has failed: return NULL */
  208.  
  209.    return NULL;
  210.  
  211.    }
  212.  
  213. /***************************************************************
  214.  
  215.         FUNCTION:       bwb_deffn()
  216.  
  217.         DESCRIPTION:    This C function implements the BASIC
  218.                         DEF FNxx statement.
  219.  
  220. ***************************************************************/
  221.  
  222. struct bwb_line *
  223. bwb_deffn( struct bwb_line *l )
  224.    {
  225.    register int n;
  226.    int loop, arguments, p;
  227.    struct bwb_function *f, *fncpos;
  228.    static char *tbuf;
  229.    static int init = FALSE;
  230.  
  231.    /* get memory for temporary buffer if necessary */
  232.  
  233.    if ( init == FALSE )
  234.       {
  235.       init = TRUE;
  236.       if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  237.          {
  238.          bwb_error( err_getmem );
  239.          }
  240.       }
  241.  
  242.    #if INTENSIVE_DEBUG
  243.    sprintf( bwb_ebuf, "in bwb_deffn(): entered function." );
  244.    bwb_debug( bwb_ebuf );
  245.    #endif
  246.  
  247.    /* test for appropriate function name */
  248.  
  249.    exp_getvfname( &( l->buffer[ l->startpos ] ), tbuf );     /* name in tbuf */
  250.  
  251.    for ( n = 0; tbuf[ n ] != '\0'; ++n )
  252.       {
  253.       if ( islower( tbuf[ n ] ) != FALSE )
  254.          {
  255.          tbuf[ n ] = toupper( tbuf[ n ] );
  256.          }
  257.       }
  258.  
  259.    if ( strncmp( tbuf, "FN", (size_t) 2 ) != 0 )
  260.       {
  261.       #if PROG_ERRORS
  262.       sprintf( bwb_ebuf, "at line %d: User-defined function name must begin with FN.",
  263.          l->number );
  264.       bwb_error( bwb_ebuf );
  265.       #else
  266.       bwb_error( err_syntax );
  267.       #endif
  268.       l->next->position = 0;
  269.       return l->next;
  270.       }
  271.  
  272.    #if INTENSIVE_DEBUG
  273.    sprintf( bwb_ebuf, "in bwb_deffn(): function name is <%s>", tbuf );
  274.    bwb_debug( bwb_ebuf );
  275.    #endif
  276.  
  277.    /* Allocate memory for a new function structure */
  278.  
  279.    if ( ( f = (struct bwb_function *) calloc( (size_t) 1, sizeof( struct bwb_function ) )) == NULL )
  280.       {
  281.       #if PROG_ERRORS
  282.       sprintf( bwb_ebuf, "Failed to find memory for function structure." );
  283.       bwb_error( bwb_ebuf );
  284.       #else
  285.       bwb_error( err_getmem );
  286.       #endif
  287.       l->next->position = 0;
  288.       return l->next;
  289.       }
  290.  
  291.    /* Allocate memory for a user function structure */
  292.  
  293.    if ( ( f->ufnc = (struct user_fnc *) calloc( (size_t) 1, sizeof( struct user_fnc ) )) == NULL )
  294.       {
  295.       #if PROG_ERRORS
  296.       sprintf( bwb_ebuf, "Failed to find memory for function structure." );
  297.       bwb_error( bwb_ebuf );
  298.       #else
  299.       bwb_error( err_getmem );
  300.       #endif
  301.       l->next->position = 0;
  302.       return l->next;
  303.       }
  304.  
  305.    /* Set some values for the new function */
  306.  
  307.    strncpy( f->name, tbuf, (size_t) MAXVARNAMESIZE );
  308.  
  309.    switch( f->name[ strlen( f->name ) - 1 ] )
  310.       {
  311.       case STRING:
  312.       case DOUBLE:
  313.       case INTEGER:
  314.          f->type = f->name[ strlen( f->name ) - 1 ];
  315.          break;
  316.       default:
  317.          f->type = SINGLE;
  318.          break;
  319.       }
  320.  
  321.    f->vector = NULL;
  322.    f->arguments = 0;
  323.  
  324.    /* determine if there are arguments */
  325.  
  326.    loop = TRUE;
  327.    arguments = FALSE;
  328.    l->position += strlen( f->name );
  329.    while( loop == TRUE )
  330.       {
  331.  
  332.       switch( l->buffer[ l->position ] )
  333.          {
  334.          case ' ':                      /* whitespace */
  335.          case '\t':
  336.             ++l->position;
  337.             break;
  338.          case '(':                      /* begin parenthesis = arguments */
  339.             ++l->position;
  340.             loop = FALSE;
  341.             arguments = TRUE;
  342.             break;
  343.          case '\n':                     /* unexpected end of line */
  344.          case '\r':
  345.          case '\0':
  346.             #if PROG_ERRORS
  347.             sprintf( bwb_ebuf, "at line %d: Unexpected end of line", l->number );
  348.             bwb_error( bwb_ebuf );
  349.             #else
  350.             bwb_error( err_syntax );
  351.             #endif
  352.             l->next->position = 0;
  353.             return l->next;
  354.          default:                       /* any other character = no arguments */
  355.             loop = FALSE;
  356.             break;
  357.          }
  358.  
  359.       }
  360.  
  361.    /* identify arguments */
  362.  
  363.    if ( arguments == TRUE )
  364.       {
  365.  
  366.       loop = TRUE;
  367.       f->arguments = 0;                              /* use as counter */
  368.       p = 0;
  369.       f->ufnc->user_vns[ f->arguments ][ 0 ] = '\0';
  370.       while ( loop == TRUE )
  371.          {
  372.          switch( l->buffer[ l->position ] )
  373.             {
  374.             case ' ':                           /* whitespace */
  375.             case '\t':
  376.                ++l->position;
  377.                break;
  378.             case '\0':                          /* unexpected end of line */
  379.             case '\n':
  380.             case '\r':
  381.                #if PROG_ERRORS
  382.                sprintf( bwb_ebuf, "at line %d: Unexpected end of line.",
  383.                   l->number );
  384.                bwb_error( bwb_ebuf );
  385.                #else
  386.                bwb_error( err_syntax );
  387.                #endif
  388.                l->next->position = 0;
  389.                return l->next;
  390.             case ')':                           /* end of argument list */
  391.                ++f->arguments;                  /* returns total number of arguments */
  392.                ++l->position;                   /* advance beyond parenthesis */
  393.                loop = FALSE;
  394.                break;
  395.  
  396.             case ',':                           /* end of one argument */
  397.  
  398.                ++f->arguments;
  399.                ++l->position;
  400.                p = 0;
  401.                f->ufnc->user_vns[ f->arguments ][ 0 ] = '\0';
  402.                break;
  403.             default:
  404.  
  405.                f->ufnc->user_vns[ f->arguments ][ p ] = l->buffer[ l->position ];
  406.                ++l->position;
  407.                ++p;
  408.                f->ufnc->user_vns[ f->arguments ][ p ] = '\0';
  409.                break;
  410.             }
  411.          }
  412.  
  413.       }
  414.  
  415.    /* else no arguments were found */
  416.  
  417.    else
  418.       {
  419.       f->arguments = 0;
  420.       }
  421.  
  422.    #if INTENSIVE_DEBUG
  423.    for ( n = 0; n < f->arguments; ++n )
  424.       {
  425.       sprintf( bwb_ebuf, "in bwb_deffn(): argument <%d> name <%s>.",
  426.          n, f->ufnc->user_vns[ n ] );
  427.       bwb_debug( bwb_ebuf );
  428.       }
  429.    #endif
  430.  
  431.    /* find the string to be interpreted */
  432.  
  433.    loop = TRUE;
  434.    arguments = FALSE;
  435.    while( loop == TRUE )
  436.       {
  437.       switch( l->buffer[ l->position ] )
  438.          {
  439.          case '\0':                     /* unexpected end of line */
  440.          case '\n':
  441.          case '\r':
  442.             #if PROG_ERRORS
  443.             sprintf( bwb_ebuf, "at line %d: Unexpected end of line.",
  444.                l->number );
  445.             bwb_error( bwb_ebuf );
  446.             #else
  447.             bwb_error( err_syntax );
  448.             #endif
  449.             l->next->position = 0;
  450.             return l->next;
  451.          case ' ':                      /* whitespace */
  452.          case '\t':
  453.             ++l->position;
  454.             break;
  455.  
  456.          case '=':
  457.             ++l->position;
  458.             arguments = TRUE;
  459.             break;
  460.          default:
  461.             loop = FALSE;
  462.             break;
  463.          }
  464.       }
  465.  
  466.    /* if the equals sign was not detected, return error */
  467.  
  468.    if ( arguments == FALSE )
  469.       {
  470.       #if PROG_ERRORS
  471.       sprintf( bwb_ebuf, "at line %d: Assignment operator (=) not found.",
  472.          l->number );
  473.       bwb_error( bwb_ebuf );
  474.       #else
  475.       bwb_error( err_syntax );
  476.       #endif
  477.       l->next->position = 0;
  478.       return l->next;
  479.       }
  480.  
  481.    /* write the string to be interpreted to the user function structure */
  482.  
  483.    strncpy( f->ufnc->int_line, &( l->buffer[ l->position ] ),
  484.       (size_t) MAXSTRINGSIZE );
  485.  
  486.    #if INTENSIVE_DEBUG
  487.    sprintf( bwb_ebuf, "in bwb_deffn(): line <%s>", f->ufnc->int_line );
  488.    bwb_debug( bwb_ebuf );
  489.    #endif
  490.  
  491.    /* Place the new function in the function linked list */
  492.  
  493.    for ( fncpos = &fnc_start; fncpos->next != &fnc_end; fncpos = fncpos->next )
  494.       {
  495.       ;
  496.       }
  497.    fncpos->next = f;
  498.    f->next = &fnc_end;
  499.  
  500.    /* return */
  501.  
  502.    l->next->position = 0;
  503.    return l->next;
  504.  
  505.    }
  506.  
  507. /***************************************************************
  508.  
  509.         FUNCTION:       fnc_intufnc()
  510.  
  511.         DESCRIPTION:    This C function interprets a user-defined
  512.                         BASIC function.
  513.  
  514. ***************************************************************/
  515.  
  516. struct bwb_variable *
  517. fnc_intufnc( int argc, struct bwb_variable *argv, struct bwb_function *f )
  518.    {
  519.    register int n;
  520.    int l_position, f_position;
  521.    int written;
  522.    bstring *b;
  523.    struct exp_ese *e;
  524.    static struct bwb_variable nvar;
  525.  
  526.    #if INTENSIVE_DEBUG
  527.    sprintf( nvar.name, "intufnc variable" );
  528.    #endif
  529.  
  530.    /* increment the user function stack counter */
  531.  
  532.    if ( ufsc >= UFNCSTACKSIZE )
  533.       {
  534.       #if PROG_ERRORS
  535.       sprintf( bwb_ebuf, "exceeded user-defined function stack, level <%d>",
  536.          ufsc );
  537.       bwb_error( bwb_ebuf );
  538.       #else
  539.       bwb_error( err_overflow );
  540.       #endif
  541.       }
  542.  
  543.    ++ufsc;
  544.  
  545.    #if INTENSIVE_DEBUG
  546.    sprintf( bwb_ebuf, "in fnc_intufnc(): interpreting user function <%s>",
  547.       f->name );
  548.    bwb_debug( bwb_ebuf );
  549.    #endif
  550.  
  551.    /* print arguments to strings */
  552.  
  553.    for ( n = 1; n <= argc; ++n )
  554.       {
  555.       switch( argv[ n - 1 ].type )
  556.          {
  557.          case DOUBLE:
  558.             sprintf( ufs[ ufsc ].args[ n - 1 ], "(%f)",
  559.                var_getdval( &( argv[ n - 1 ] ) ));
  560.             break;
  561.          case SINGLE:
  562.             sprintf( ufs[ ufsc ].args[ n - 1 ], "(%f)",
  563.                var_getfval( &( argv[ n - 1 ] ) ));
  564.             break;
  565.          case INTEGER:
  566.             sprintf( ufs[ ufsc ].args[ n - 1 ], "(%d)",
  567.                var_getival( &( argv[ n - 1 ] ) ));
  568.             break;
  569.          case STRING:
  570.             b = var_getsval( &( argv[ n - 1 ] ) );
  571.             str_btoc( bwb_ebuf, b );
  572.             sprintf( ufs[ ufsc ].args[ n - 1 ], "\"%s\"",
  573.                bwb_ebuf );
  574.             break;
  575.          default:
  576.             #if PROG_ERRORS
  577.             sprintf( bwb_ebuf, "Unidentified variable type in argument to user function." );
  578.             bwb_error( bwb_ebuf );
  579.             #else
  580.             bwb_error( err_mismatch );
  581.             #endif
  582.             return &nvar;
  583.             }
  584.       }
  585.  
  586.    #if INTENSIVE_DEBUG
  587.    for ( n = 1; n <= argc; ++n )
  588.       {
  589.       sprintf( bwb_ebuf, "in fnc_intufnc(): arg string %d: <%s>.",
  590.          n - 1, ufs[ ufsc ].args[ n - 1 ] );
  591.       bwb_debug ( bwb_ebuf );
  592.       }
  593.    #endif
  594.  
  595.    /* copy the interpreted line to the buffer, substituting variable ufs[ ufsc ].args */
  596.  
  597.    ufs[ ufsc ].l_buffer[ 0 ] = '\0';
  598.    l_position = 0;
  599.    for ( f_position = 0; f->ufnc->int_line[ f_position ] != '\0'; ++f_position )
  600.       {
  601.       written = FALSE;
  602.       for ( n = 0; n < argc; ++n )
  603.          {
  604.          if ( strncmp( &( f->ufnc->int_line[ f_position ] ), f->ufnc->user_vns[ n ],
  605.             (size_t) strlen( f->ufnc->user_vns[ n ] ) ) == 0 )
  606.             {
  607.             strcat( ufs[ ufsc ].l_buffer, ufs[ ufsc ].args[ n ] );
  608.             written = TRUE;
  609.             f_position += strlen( f->ufnc->user_vns[ n ] + 1 );
  610.             l_position += strlen( ufs[ ufsc ].args[ n ] );
  611.             }
  612.  
  613.          }
  614.       if ( written == FALSE )
  615.          {
  616.          ufs[ ufsc ].l_buffer[ l_position ] = f->ufnc->int_line[ f_position ];
  617.          ++l_position;
  618.          ufs[ ufsc ].l_buffer[ l_position ] = '\0';
  619.          }
  620.       }
  621.  
  622.    #if INTENSIVE_DEBUG
  623.    sprintf( bwb_ebuf, "in fnc_intufnc(): reconstructed line: <%s>",
  624.       ufs[ ufsc ].l_buffer );
  625.    bwb_debug( bwb_ebuf );
  626.    #endif
  627.  
  628.    /* parse */
  629.  
  630.    ufs[ ufsc ].position = 0;
  631.    e = bwb_exp( ufs[ ufsc ].l_buffer, FALSE,
  632.       &( ufs[ ufsc ].position ) );
  633.  
  634.    var_make( &nvar, e->type );
  635.  
  636.    switch( e->type )
  637.       {
  638.       case DOUBLE:
  639.          * var_finddval( &nvar, nvar.array_pos ) = exp_getdval( e );
  640.          break;
  641.       case INTEGER:
  642.          * var_findival( &nvar, nvar.array_pos ) = exp_getival( e );
  643.          break;
  644.       case STRING:
  645.          str_btob( var_findsval( &nvar, nvar.array_pos ), 
  646.             exp_getsval( e ) );
  647.          break;
  648.       default:
  649.          * var_findfval( &nvar, nvar.array_pos ) = exp_getfval( e );
  650.          break;
  651.       }
  652.  
  653.    /* decrement the user function stack counter */
  654.  
  655.    --ufsc;
  656.  
  657.    return &nvar;
  658.  
  659.    }
  660.  
  661. /***************************************************************
  662.  
  663.         FUNCTION:       fnc_null()
  664.  
  665.         DESCRIPTION:    This is a null function that can be used
  666.                         to fill in a required function-structure
  667.                         pointer when needed.
  668.  
  669. ***************************************************************/
  670.  
  671. struct bwb_variable *
  672. fnc_null( int argc, struct bwb_variable *argv )
  673.    {
  674.    static struct bwb_variable nvar;
  675.    static int init = FALSE;
  676.  
  677.    /* initialize the variable if necessary */
  678.  
  679.    if ( init == FALSE )
  680.       {
  681.       init = TRUE;
  682.       var_make( &nvar, INTEGER );
  683.       }
  684.  
  685.    return &nvar;
  686.    }
  687.  
  688. /***************************************************************
  689.  
  690.  
  691.         FUNCTION:       fnc_date()
  692.  
  693.         DESCRIPTION:    This C function implements the BASIC
  694.                         predefined DATE$ function, returning
  695.                         a string containing the year, month,
  696.                         and day of the month.
  697.  
  698. ***************************************************************/
  699.  
  700. struct bwb_variable *
  701. fnc_date( int argc, struct bwb_variable *argv )
  702.    {
  703.    static struct bwb_variable nvar;
  704.    static int init = FALSE;
  705.    static char *tbuf;
  706.  
  707.    /* initialize the variable if necessary */
  708.  
  709.    if ( init == FALSE )
  710.       {
  711.       init = TRUE;
  712.       var_make( &nvar, STRING );
  713.       if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  714.          {
  715.          bwb_error( err_getmem );
  716.          }
  717.       }
  718.  
  719.    time( &t );
  720.    lt = localtime( &t );
  721.  
  722.    sprintf( tbuf, "%02d-%02d-%04d", lt->tm_mon + 1, lt->tm_mday,
  723.       1900 + lt->tm_year );
  724.    str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
  725.  
  726.    return &nvar;
  727.    }
  728.  
  729. /***************************************************************
  730.  
  731.         FUNCTION:       fnc_time()
  732.  
  733.         DESCRIPTION:    This C function implements the BASIC
  734.                         predefined TIME$ function, returning a
  735.                         string containing the hour, minute, and
  736.                         second count.
  737.  
  738. ***************************************************************/
  739.  
  740. struct bwb_variable *
  741. fnc_time( int argc, struct bwb_variable *argv )
  742.    {
  743.    static struct bwb_variable nvar;
  744.    static char *tbuf;
  745.    static int init = FALSE;
  746.  
  747.    /* initialize the variable if necessary */
  748.  
  749.    if ( init == FALSE )
  750.       {
  751.       init = TRUE;
  752.       var_make( &nvar, STRING );
  753.       if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  754.          {
  755.          bwb_error( err_getmem );
  756.          }
  757.       }
  758.  
  759.    time( &t );
  760.    lt = localtime( &t );
  761.  
  762.    sprintf( tbuf, "%02d:%02d:%02d", lt->tm_hour, lt->tm_min,
  763.       lt->tm_sec );
  764.    str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
  765.  
  766.    return &nvar;
  767.    }
  768.  
  769. /***************************************************************
  770.  
  771.         FUNCTION:       fnc_test()
  772.  
  773.         DESCRIPTION:    This is a test function, developed in
  774.                         order to test argument passing to
  775.                         BASIC functions.
  776.  
  777. ***************************************************************/
  778.  
  779. #if INTENSIVE_DEBUG
  780. struct bwb_variable *
  781. fnc_test( int argc, struct bwb_variable *argv )
  782.    {
  783.    register int c;
  784.    static struct bwb_variable rvar;
  785.    static char *tbuf;
  786.    static int init = FALSE;
  787.  
  788.    /* initialize the variable if necessary */
  789.  
  790.    if ( init == FALSE )
  791.       {
  792.       init = TRUE;
  793.       var_make( &rvar, SINGLE );
  794.       if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  795.          {
  796.          bwb_error( err_getmem );
  797.          }
  798.       }
  799.  
  800.    fprintf( stdout, "TEST function: received %d arguments: \n", argc );
  801.  
  802.    for ( c = 0; c < argc; ++c )
  803.       {
  804.       str_btoc( tbuf, var_getsval( &argv[ c ] ) );
  805.       fprintf( stdout, "                  arg %d (%c): <%s> \n", c,
  806.          argv[ c ].type, tbuf );
  807.       }
  808.  
  809.    return &rvar;
  810.  
  811.    }
  812. #endif
  813.  
  814. /***************************************************************
  815.  
  816.         FUNCTION:       fnc_rnd()
  817.  
  818.         DESCRIPTION:    This C function implements the BASIC
  819.                         predefined RND function, returning a
  820.                         pseudo-random number in the range
  821.                         0 to 1.  It is affected by the RANDOMIZE
  822.                         command statement.
  823.  
  824. ***************************************************************/
  825.  
  826. struct bwb_variable *
  827. fnc_rnd( int argc, struct bwb_variable *argv  )
  828.    {
  829.    static struct bwb_variable nvar;
  830.    static int init = FALSE;
  831.  
  832.    /* initialize the variable if necessary */
  833.  
  834.    if ( init == FALSE )
  835.       {
  836.       init = TRUE;
  837.       var_make( &nvar, SINGLE );
  838.       }
  839.  
  840.    * var_findfval( &nvar, nvar.array_pos ) = (float) rand() / RAND_MAX;
  841.  
  842.    return &nvar;
  843.    }
  844.  
  845. /***************************************************************
  846.  
  847.         FUNCTION:       fnc_chr()
  848.  
  849.         DESCRIPTION:    This C function implements the BASIC
  850.                         predefined CHR$ function, returning a
  851.                         string containing the single character
  852.                         whose ASCII value is the argument to
  853.                         this function.
  854.  
  855. ***************************************************************/
  856.  
  857. struct bwb_variable *
  858. fnc_chr( int argc, struct bwb_variable *argv  )
  859.    {
  860.    static struct bwb_variable nvar;
  861.    char tbuf[ MAXSTRINGSIZE + 1 ];
  862.    static int init = FALSE;
  863.    #if TEST_BSTRING
  864.    bstring *b;
  865.    #endif
  866.  
  867.    #if INTENSIVE_DEBUG
  868.    sprintf( bwb_ebuf, "in fnc_chr(): entered function, argc <%d>",
  869.       argc );
  870.    bwb_debug( bwb_ebuf );
  871.    #endif
  872.  
  873.    /* initialize the variable if necessary */
  874.  
  875.    if ( init == FALSE )
  876.       {
  877.       init = TRUE;
  878.       var_make( &nvar, STRING );
  879.       #if INTENSIVE_DEBUG
  880.       sprintf( bwb_ebuf, "in fnc_chr(): entered function, initialized nvar" );
  881.       bwb_debug( bwb_ebuf );
  882.       #endif
  883.       }
  884.  
  885.    /* check arguments */
  886.  
  887.    #if PROG_ERRORS
  888.    if ( argc < 1 )
  889.       {
  890.       sprintf( bwb_ebuf, "Not enough arguments to function CHR$()" );
  891.       bwb_error( bwb_ebuf );
  892.       return NULL;
  893.       }
  894.    else if ( argc > 1 )
  895.       {
  896.       sprintf( bwb_ebuf, "Too many parameters (%d) to function CHR$().",
  897.          argc );
  898.       bwb_error( bwb_ebuf );
  899.       return NULL;
  900.       }
  901.    #else
  902.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  903.       {
  904.       return NULL;
  905.       }
  906.    #endif
  907.  
  908.    #if INTENSIVE_DEBUG
  909.    sprintf( bwb_ebuf, "in fnc_chr(): entered function, checkargs ok" );
  910.    bwb_debug( bwb_ebuf );
  911.    #endif
  912.  
  913.    tbuf[ 0 ] = (char) var_getival( &( argv[ 0 ] ) );
  914.    tbuf[ 1 ] = '\0';
  915.    str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
  916.  
  917.    #if TEST_BSTRING
  918.    b = var_findsval( &nvar, nvar.array_pos );
  919.    sprintf( bwb_ebuf, "in fnc_chr(): bstring name is <%s>", b->name );
  920.    bwb_debug( bwb_ebuf );
  921.    #endif
  922.    #if INTENSIVE_DEBUG
  923.    sprintf( bwb_ebuf, "in fnc_chr(): tbuf[ 0 ] is <%c>", tbuf[ 0 ] );
  924.    bwb_debug( bwb_ebuf );
  925.    #endif
  926.  
  927.    return &nvar;
  928.    }
  929.  
  930. /***************************************************************
  931.  
  932.         FUNCTION:       fnc_mid()
  933.  
  934.         DESCRIPTION:    This C function implements the BASIC
  935.                         predefined MID$ function
  936.  
  937. ***************************************************************/
  938.  
  939. struct bwb_variable *
  940. fnc_mid( int argc, struct bwb_variable *argv  )
  941.    {
  942.    static struct bwb_variable nvar;
  943.    register int c;
  944.    char target_string[ MAXSTRINGSIZE + 1 ];
  945.    int target_counter, num_spaces;
  946.    char tbuf[ MAXSTRINGSIZE + 1 ];
  947.    static int init = FALSE;
  948.  
  949.    /* initialize the variable if necessary */
  950.  
  951.    if ( init == FALSE )
  952.       {
  953.       init = TRUE;
  954.       var_make( &nvar, STRING );
  955.       }
  956.  
  957.    /* check arguments */
  958.  
  959.    #if PROG_ERRORS
  960.    if ( argc < 2 )
  961.       {
  962.       sprintf( bwb_ebuf, "Not enough arguments to function MID$()" );
  963.       bwb_error( bwb_ebuf );
  964.       return &nvar;
  965.       }
  966.  
  967.    if ( argc > 3 )
  968.       {
  969.       sprintf( bwb_ebuf, "Two many arguments to function MID$()" );
  970.       bwb_error( bwb_ebuf );
  971.       return &nvar;
  972.       }
  973.  
  974.    #else
  975.    if ( fnc_checkargs( argc, argv, 2, 3 ) == FALSE )
  976.       {
  977.       return NULL;
  978.       }
  979.    #endif
  980.  
  981.    /* get arguments */
  982.  
  983.    str_btoc( target_string, var_getsval( &( argv[ 0 ] ) ));
  984.    target_counter = var_getival( &( argv[ 1 ] ) ) - 1;
  985.    if ( target_counter > strlen( target_string ))
  986.       {
  987.       tbuf[ 0 ] = '\0';
  988.       str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
  989.       return &nvar;
  990.       }
  991.  
  992.    if ( argc == 3 )
  993.       {
  994.       num_spaces = var_getival( &( argv[ 2 ] ));
  995.       }
  996.    else
  997.       {
  998.       num_spaces = MAXSTRINGSIZE;
  999.       }
  1000.  
  1001.    #if INTENSIVE_DEBUG
  1002.    sprintf( bwb_ebuf, "in fnc_mid() string <%s> startpos <%d> spaces <%d>",
  1003.       target_string, target_counter, num_spaces );
  1004.    bwb_debug( bwb_ebuf );
  1005.    #endif
  1006.  
  1007.    c = 0;
  1008.    tbuf[ c ] = '\0';
  1009.    while ( ( c < num_spaces ) && ( target_string[ target_counter ] != '\0' ))
  1010.       {
  1011.       tbuf[ c ] = target_string[ target_counter ];
  1012.       ++c;
  1013.       tbuf[ c ] = '\0';
  1014.       ++target_counter;
  1015.       }
  1016.    str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
  1017.  
  1018.    return &nvar;
  1019.    }
  1020.  
  1021. /***************************************************************
  1022.  
  1023.         FUNCTION:       fnc_left()
  1024.  
  1025.         DESCRIPTION:    This C function implements the BASIC
  1026.                         predefined LEFT$ function
  1027.  
  1028. ***************************************************************/
  1029.  
  1030. struct bwb_variable *
  1031. fnc_left( int argc, struct bwb_variable *argv  )
  1032.    {
  1033.    static struct bwb_variable nvar;
  1034.    register int c;
  1035.    char target_string[ MAXSTRINGSIZE + 1 ];
  1036.    int target_counter, num_spaces;
  1037.    char tbuf[ MAXSTRINGSIZE + 1 ];
  1038.    static int init = FALSE;
  1039.  
  1040.    /* initialize the variable if necessary */
  1041.  
  1042.    if ( init == FALSE )
  1043.       {
  1044.       init = TRUE;
  1045.       var_make( &nvar, STRING );
  1046.       }
  1047.  
  1048.    /* check arguments */
  1049.  
  1050.    #if PROG_ERRORS
  1051.    if ( argc < 2 )
  1052.       {
  1053.       sprintf( bwb_ebuf, "Not enough arguments to function LEFT$()" );
  1054.       bwb_error( bwb_ebuf );
  1055.       return &nvar;
  1056.       }
  1057.  
  1058.    if ( argc > 2 )
  1059.       {
  1060.       sprintf( bwb_ebuf, "Two many arguments to function LEFT$()" );
  1061.       bwb_error( bwb_ebuf );
  1062.       return &nvar;
  1063.       }
  1064.  
  1065.    #else
  1066.    if ( fnc_checkargs( argc, argv, 2, 2 ) == FALSE )
  1067.       {
  1068.       return NULL;
  1069.       }
  1070.    #endif
  1071.  
  1072.    /* get arguments */
  1073.  
  1074.    str_btoc( tbuf, var_getsval( &( argv[ 0 ] ) ));
  1075.    target_counter = 0;
  1076.    num_spaces = var_getival( &( argv[ 1 ] ));
  1077.  
  1078.    #if INTENSIVE_DEBUG
  1079.    sprintf( bwb_ebuf, "in fnc_left() string <%s> startpos <%d> spaces <%d>",
  1080.       tbuf, target_counter, num_spaces );
  1081.    bwb_debug( bwb_ebuf );
  1082.    #endif
  1083.  
  1084.    c = 0;
  1085.    target_string[ 0 ] = '\0';
  1086.    while (( c < num_spaces ) && ( tbuf[ c ] != '\0' ))
  1087.       {
  1088.       target_string[ target_counter ] = tbuf[ c ];
  1089.       ++target_counter;
  1090.       target_string[ target_counter ] = '\0';
  1091.       ++c;
  1092.       }
  1093.    str_ctob( var_findsval( &nvar, nvar.array_pos ), target_string );
  1094.  
  1095.    return &nvar;
  1096.    }
  1097.  
  1098. /***************************************************************
  1099.  
  1100.         FUNCTION:       fnc_right()
  1101.  
  1102.         DESCRIPTION:    This C function implements the BASIC
  1103.                         predefined RIGHT$ function
  1104.  
  1105. ***************************************************************/
  1106.  
  1107. struct bwb_variable *
  1108. fnc_right( int argc, struct bwb_variable *argv  )
  1109.    {
  1110.    static struct bwb_variable nvar;
  1111.    register int c;
  1112.    char target_string[ MAXSTRINGSIZE + 1 ];
  1113.    int target_counter, num_spaces;
  1114.    char tbuf[ MAXSTRINGSIZE + 1 ];
  1115.    static int init = FALSE;
  1116.  
  1117.    /* initialize the variable if necessary */
  1118.  
  1119.    if ( init == FALSE )
  1120.       {
  1121.       init = TRUE;
  1122.       var_make( &nvar, STRING );
  1123.       }
  1124.  
  1125.    /* check arguments */
  1126.  
  1127.    #if PROG_ERRORS
  1128.    if ( argc < 2 )
  1129.       {
  1130.       sprintf( bwb_ebuf, "Not enough arguments to function RIGHT$()" );
  1131.       bwb_error( bwb_ebuf );
  1132.       return &nvar;
  1133.       }
  1134.  
  1135.    if ( argc > 2 )
  1136.       {
  1137.       sprintf( bwb_ebuf, "Two many arguments to function RIGHT$()" );
  1138.       bwb_error( bwb_ebuf );
  1139.       return &nvar;
  1140.       }
  1141.  
  1142.    #else
  1143.    if ( fnc_checkargs( argc, argv, 2, 2 ) == FALSE )
  1144.       {
  1145.       return NULL;
  1146.       }
  1147.    #endif
  1148.  
  1149.    /* get arguments */
  1150.  
  1151.    str_btoc( target_string, var_getsval( &( argv[ 0 ] ) ));
  1152.    target_counter = strlen( target_string ) - var_getival( &( argv[ 1 ] ));
  1153.    num_spaces = MAXSTRINGSIZE;
  1154.  
  1155.    #if INTENSIVE_DEBUG
  1156.    sprintf( bwb_ebuf, "in fnc_right() string <%s> startpos <%d> spaces <%d>",
  1157.       target_string, target_counter, num_spaces );
  1158.    bwb_debug( bwb_ebuf );
  1159.    #endif
  1160.  
  1161.    c = 0;
  1162.    tbuf[ c ] = '\0';
  1163.    while ( ( c < num_spaces ) && ( target_string[ target_counter ] != '\0' ))
  1164.       {
  1165.       tbuf[ c ] = target_string[ target_counter ];
  1166.       ++c;
  1167.       tbuf[ c ] = '\0';
  1168.       ++target_counter;
  1169.       }
  1170.    str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
  1171.  
  1172.    return &nvar;
  1173.    }
  1174.  
  1175. /***************************************************************
  1176.  
  1177.         FUNCTION:       fnc_timer()
  1178.  
  1179.         DESCRIPTION:    This C function implements the BASIC
  1180.                         predefined TIMER function
  1181.  
  1182. ***************************************************************/
  1183.  
  1184. struct bwb_variable *
  1185. fnc_timer( int argc, struct bwb_variable *argv  )
  1186.    {
  1187.    static struct bwb_variable nvar;
  1188.    static time_t now;
  1189.    static int init = FALSE;
  1190.  
  1191.    /* initialize the variable if necessary */
  1192.  
  1193.    if ( init == FALSE )
  1194.       {
  1195.       init = TRUE;
  1196.       var_make( &nvar, SINGLE );
  1197.       }
  1198.  
  1199.    time( &now );
  1200.    * var_findfval( &nvar, nvar.array_pos )
  1201.       = (float) fmod( (double) now, (double) (60*60*24));
  1202.  
  1203.    return &nvar;
  1204.    }
  1205.  
  1206. /***************************************************************
  1207.  
  1208.         FUNCTION:       fnc_val()
  1209.  
  1210.         DESCRIPTION:
  1211.  
  1212. ***************************************************************/
  1213.  
  1214. struct bwb_variable *
  1215. fnc_val( int argc, struct bwb_variable *argv )
  1216.    {
  1217.    static struct bwb_variable nvar;
  1218.    static char *tbuf;
  1219.    static int init = FALSE;
  1220.  
  1221.    /* initialize the variable if necessary */
  1222.  
  1223.    if ( init == FALSE )
  1224.       {
  1225.       init = TRUE;
  1226.       var_make( &nvar, SINGLE );
  1227.       if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  1228.          {
  1229.          bwb_error( err_getmem );
  1230.          }
  1231.       }
  1232.  
  1233.    /* check arguments */
  1234.  
  1235.    #if PROG_ERRORS
  1236.    if ( argc < 1 )
  1237.       {
  1238.       sprintf( bwb_ebuf, "Not enough arguments to function VAL()" );
  1239.       bwb_error( bwb_ebuf );
  1240.       return NULL;
  1241.       }
  1242.    else if ( argc > 1 )
  1243.       {
  1244.       sprintf( bwb_ebuf, "Too many parameters (%d) to function VAL().",
  1245.          argc );
  1246.       bwb_error( bwb_ebuf );
  1247.       return NULL;
  1248.       }
  1249.  
  1250.    #else
  1251.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  1252.       {
  1253.       return NULL;
  1254.       }
  1255.    #endif
  1256.  
  1257.    else if ( argv[ 0 ].type != STRING )
  1258.       {
  1259.       #if PROG_ERRORS
  1260.       sprintf( bwb_ebuf, "Argument to function VAL() must be a string.",
  1261.          argc );
  1262.       bwb_error( bwb_ebuf );
  1263.       #else
  1264.       bwb_error( err_mismatch );
  1265.       #endif
  1266.       return NULL;
  1267.       }
  1268.  
  1269.    /* read the value */
  1270.  
  1271.    str_btoc( tbuf, var_getsval( &( argv[ 0 ] ) ));
  1272.    sscanf( tbuf, "%f",
  1273.        var_findfval( &nvar, nvar.array_pos ) );
  1274.  
  1275.    return &nvar;
  1276.    }
  1277.  
  1278. /***************************************************************
  1279.  
  1280.         FUNCTION:       fnc_len()
  1281.  
  1282.         DESCRIPTION:
  1283.  
  1284. ***************************************************************/
  1285.  
  1286. struct bwb_variable *
  1287. fnc_len( int argc, struct bwb_variable *argv )
  1288.    {
  1289.    static struct bwb_variable nvar;
  1290.    static int init = FALSE;
  1291.    static char *tbuf;
  1292.  
  1293.    /* initialize the variable if necessary */
  1294.  
  1295.    if ( init == FALSE )
  1296.       {
  1297.       init = TRUE;
  1298.       var_make( &nvar, INTEGER );
  1299.       if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  1300.          {
  1301.          bwb_error( err_getmem );
  1302.          }
  1303.       }
  1304.  
  1305.    /* check parameters */
  1306.  
  1307.    #if PROG_ERRORS
  1308.    if ( argc < 1 )
  1309.       {
  1310.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function LEN().",
  1311.          argc );
  1312.       bwb_error( bwb_ebuf );
  1313.       return NULL;
  1314.       }
  1315.    else if ( argc > 1 )
  1316.       {
  1317.       sprintf( bwb_ebuf, "Too many parameters (%d) to function LEN().",
  1318.          argc );
  1319.       bwb_error( bwb_ebuf );
  1320.       return NULL;
  1321.       }
  1322.    #else
  1323.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  1324.       {
  1325.       return NULL;
  1326.       }
  1327.    #endif
  1328.  
  1329.    /* return length as an integer */
  1330.  
  1331.    str_btoc( tbuf, var_getsval( &( argv[ 0 ] )) );
  1332.    * var_findival( &nvar, nvar.array_pos )
  1333.       = strlen( tbuf );
  1334.  
  1335.    return &nvar;
  1336.    }
  1337.  
  1338. /***************************************************************
  1339.  
  1340.         FUNCTION:       fnc_hex()
  1341.  
  1342.         DESCRIPTION:
  1343.  
  1344. ***************************************************************/
  1345.  
  1346. struct bwb_variable *
  1347. fnc_hex( int argc, struct bwb_variable *argv )
  1348.    {
  1349.    static struct bwb_variable nvar;
  1350.    static char *tbuf;
  1351.    static int init = FALSE;
  1352.  
  1353.    /* initialize the variable if necessary */
  1354.  
  1355.    if ( init == FALSE )
  1356.       {
  1357.       init = TRUE;
  1358.       var_make( &nvar, STRING );
  1359.       if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  1360.          {
  1361.          bwb_error( err_getmem );
  1362.          }
  1363.       }
  1364.  
  1365.    /* check parameters */
  1366.  
  1367.    #if PROG_ERRORS
  1368.    if ( argc < 1 )
  1369.       {
  1370.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function HEX$().",
  1371.          argc );
  1372.       bwb_error( bwb_ebuf );
  1373.       return NULL;
  1374.       }
  1375.    else if ( argc > 1 )
  1376.       {
  1377.       sprintf( bwb_ebuf, "Too many parameters (%d) to function HEX$().",
  1378.          argc );
  1379.       bwb_error( bwb_ebuf );
  1380.       return NULL;
  1381.       }
  1382.    #else
  1383.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  1384.       {
  1385.       return NULL;
  1386.       }
  1387.    #endif
  1388.  
  1389.    /* format as hex integer */
  1390.  
  1391.    sprintf( tbuf, "%X", (int) trnc_int( (double) var_getfval( &( argv[ 0 ] )) ) );
  1392.    str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
  1393.    return &nvar;
  1394.    }
  1395.  
  1396. /***************************************************************
  1397.  
  1398.         FUNCTION:       fnc_oct()
  1399.  
  1400.         DESCRIPTION:    This C function implements the BASIC
  1401.             OCT$() function.
  1402.  
  1403. ***************************************************************/
  1404.  
  1405. struct bwb_variable *
  1406. fnc_oct( int argc, struct bwb_variable *argv )
  1407.    {
  1408.    static struct bwb_variable nvar;
  1409.    static char *tbuf;
  1410.    static int init = FALSE;
  1411.  
  1412.    /* initialize the variable if necessary */
  1413.  
  1414.    if ( init == FALSE )
  1415.       {
  1416.       init = TRUE;
  1417.       var_make( &nvar, STRING );
  1418.       if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  1419.          {
  1420.          bwb_error( err_getmem );
  1421.          }
  1422.       }
  1423.  
  1424.    /* check parameters */
  1425.  
  1426.    #if PROG_ERRORS
  1427.    if ( argc < 1 )
  1428.       {
  1429.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function OCT$().",
  1430.          argc );
  1431.       bwb_error( bwb_ebuf );
  1432.       return NULL;
  1433.       }
  1434.    else if ( argc > 1 )
  1435.       {
  1436.       sprintf( bwb_ebuf, "Too many parameters (%d) to function OCT$().",
  1437.          argc );
  1438.       bwb_error( bwb_ebuf );
  1439.       return NULL;
  1440.       }
  1441.    #else
  1442.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  1443.       {
  1444.       return NULL;
  1445.       }
  1446.    #endif
  1447.  
  1448.    /* format as octal integer */
  1449.  
  1450.    sprintf( tbuf, "%o", var_getival( &( argv[ 0 ] ) ) );
  1451.    str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
  1452.    return &nvar;
  1453.    }
  1454.  
  1455. /***************************************************************
  1456.  
  1457.         FUNCTION:       fnc_asc()
  1458.  
  1459.         DESCRIPTION:    This function implements the predefined
  1460.             BASIC ASC() function.
  1461.  
  1462. ***************************************************************/
  1463.  
  1464. struct bwb_variable *
  1465. fnc_asc( int argc, struct bwb_variable *argv )
  1466.    {
  1467.    static struct bwb_variable nvar;
  1468.    static char *tbuf;
  1469.    static int init = FALSE;
  1470.  
  1471.    /* initialize the variable if necessary */
  1472.  
  1473.    if ( init == FALSE )
  1474.       {
  1475.       init = TRUE;
  1476.       var_make( &nvar, INTEGER );
  1477.       if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  1478.          {
  1479.          bwb_error( err_getmem );
  1480.          }
  1481.       }
  1482.  
  1483.    /* check parameters */
  1484.  
  1485.    #if PROG_ERRORS
  1486.    if ( argc < 1 )
  1487.       {
  1488.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function ASC().",
  1489.          argc );
  1490.       bwb_error( bwb_ebuf );
  1491.       return NULL;
  1492.       }
  1493.    else if ( argc > 1 )
  1494.       {
  1495.       sprintf( bwb_ebuf, "Too many parameters (%d) to function ASC().",
  1496.          argc );
  1497.       bwb_error( bwb_ebuf );
  1498.       return NULL;
  1499.       }
  1500.    #else
  1501.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  1502.       {
  1503.       return NULL;
  1504.       }
  1505.    #endif
  1506.  
  1507.    if ( argv[ 0 ].type != STRING )
  1508.       {
  1509.       #if PROG_ERRORS
  1510.       sprintf( bwb_ebuf, "Argument to function ASC() must be a string.",
  1511.          argc );
  1512.       bwb_error( bwb_ebuf );
  1513.       #else
  1514.       bwb_error( err_mismatch );
  1515.       #endif
  1516.       return NULL;
  1517.       }
  1518.  
  1519.    /* assign ASCII value of first character in the buffer */
  1520.  
  1521.    str_btoc( tbuf, var_findsval( &( argv[ 0 ] ), argv[ 0 ].array_pos ) );
  1522.    * var_findival( &nvar, nvar.array_pos ) = (int) tbuf[ 0 ];
  1523.  
  1524.    #if INTENSIVE_DEBUG
  1525.    sprintf( bwb_ebuf, "in fnc_asc(): string is <%s>",
  1526.       tbuf );
  1527.    bwb_debug( bwb_ebuf );
  1528.    #endif
  1529.  
  1530.    return &nvar;
  1531.    }
  1532.  
  1533. /***************************************************************
  1534.  
  1535.         FUNCTION:       fnc_string()
  1536.  
  1537.         DESCRIPTION:    This C function implements the BASIC
  1538.             STRING$() function.
  1539.  
  1540. ***************************************************************/
  1541.  
  1542. struct bwb_variable *
  1543. fnc_string( int argc, struct bwb_variable *argv )
  1544.    {
  1545.    static struct bwb_variable nvar;
  1546.    int length;
  1547.    register int i;
  1548.    char c;
  1549.    struct bwb_variable *v;
  1550.    static char *tbuf;
  1551.    static int init = FALSE;
  1552.  
  1553.    /* initialize the variable if necessary */
  1554.  
  1555.    if ( init == FALSE )
  1556.       {
  1557.       init = TRUE;
  1558.       var_make( &nvar, STRING );
  1559.       if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  1560.          {
  1561.          bwb_error( err_getmem );
  1562.          }
  1563.       }
  1564.  
  1565.    /* check for correct number of parameters */
  1566.  
  1567.    #if PROG_ERRORS
  1568.    if ( argc < 2 )
  1569.       {
  1570.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function STRING$().",
  1571.          argc );
  1572.       bwb_error( bwb_ebuf );
  1573.       return NULL;
  1574.       }
  1575.    else if ( argc > 2 )
  1576.       {
  1577.       sprintf( bwb_ebuf, "Too many parameters (%d) to function STRING$().",
  1578.          argc );
  1579.       bwb_error( bwb_ebuf );
  1580.       return NULL;
  1581.       }
  1582.    #else
  1583.    if ( fnc_checkargs( argc, argv, 2, 2 ) == FALSE )
  1584.       {
  1585.       return NULL;
  1586.       }
  1587.    #endif
  1588.  
  1589.    strcpy( nvar.name, "(string$)!" );
  1590.    nvar.type = STRING;
  1591.    tbuf[ 0 ] = '\0';
  1592.    length = var_getival( &( argv[ 0 ] ));
  1593.  
  1594.    if ( argv[ 1 ].type == STRING )
  1595.       {
  1596.       str_btoc( tbuf, var_getsval( &( argv[ 1 ] )));
  1597.       c = tbuf[ 0 ];
  1598.       }
  1599.    else
  1600.       {
  1601.       c = (char) var_getival( &( argv[ 1 ] ) );
  1602.       }
  1603.  
  1604.    #if INTENSIVE_DEBUG
  1605.    sprintf( bwb_ebuf, "in fnc_string(): argument <%s> arg type <%c>, length <%d>",
  1606.       argv[ 1 ].string, argv[ 1 ].type, length );
  1607.    bwb_debug( bwb_ebuf );
  1608.    sprintf( bwb_ebuf, "in fnc_string(): type <%c>, c <0x%x>=<%c>",
  1609.       argv[ 1 ].type, c, c );
  1610.    bwb_debug( bwb_ebuf );
  1611.    #endif
  1612.  
  1613.    /* add characters to the string */
  1614.  
  1615.    for ( i = 0; i < length; ++i )
  1616.       {
  1617.       tbuf[ i ] = c;
  1618.       tbuf[ i + 1 ] = '\0';
  1619.       }
  1620.    str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
  1621.  
  1622.    return &nvar;
  1623.    }
  1624.  
  1625. /***************************************************************
  1626.  
  1627.         FUNCTION:       fnc_environ()
  1628.  
  1629.         DESCRIPTION:    This C function implements the BASIC
  1630.             ENVIRON$() function.
  1631.  
  1632. ***************************************************************/
  1633.  
  1634. struct bwb_variable *
  1635. fnc_environ( int argc, struct bwb_variable *argv )
  1636.    {
  1637.    char tbuf[ MAXSTRINGSIZE + 1 ];
  1638.    char tmp[ MAXSTRINGSIZE + 1 ];
  1639.    static struct bwb_variable nvar;
  1640.    static int init = FALSE;
  1641.  
  1642.    /* initialize the variable if necessary */
  1643.  
  1644.    if ( init == FALSE )
  1645.       {
  1646.       init = TRUE;
  1647.       var_make( &nvar, STRING );
  1648.       }
  1649.  
  1650.    /* check for correct number of parameters */
  1651.  
  1652.    #if PROG_ERRORS
  1653.    if ( argc < 1 )
  1654.       {
  1655.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function ENVIRON$().",
  1656.          argc );
  1657.       bwb_error( bwb_ebuf );
  1658.       return NULL;
  1659.       }
  1660.    else if ( argc > 1 )
  1661.       {
  1662.       sprintf( bwb_ebuf, "Too many parameters (%d) to function ENVIRON$().",
  1663.          argc );
  1664.       bwb_error( bwb_ebuf );
  1665.       return NULL;
  1666.       }
  1667.    #else
  1668.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  1669.       {
  1670.       return NULL;
  1671.       }
  1672.    #endif
  1673.  
  1674.    /* resolve the argument and place string value in tbuf */
  1675.  
  1676.    str_btoc( tbuf, var_getsval( &( argv[ 0 ] )));
  1677.  
  1678.    /* call getenv() then write value to string */
  1679.  
  1680.    strcpy( tmp, getenv( tbuf ));
  1681.    str_ctob( var_findsval( &nvar, nvar.array_pos ), tmp );
  1682.  
  1683.    /* return address of nvar */
  1684.  
  1685.    return &nvar;
  1686.  
  1687.    }
  1688.  
  1689. /***************************************************************
  1690.  
  1691.         FUNCTION:       fnc_instr()
  1692.  
  1693.         DESCRIPTION:    
  1694.  
  1695. ***************************************************************/
  1696.  
  1697. struct bwb_variable *
  1698. fnc_instr( int argc, struct bwb_variable *argv )
  1699.    {
  1700.    static struct bwb_variable nvar;
  1701.    static int init = FALSE;
  1702.    int n_pos, x_pos, y_pos;
  1703.    int start_pos;
  1704.    register int n;
  1705.    char xbuf[ MAXSTRINGSIZE + 1 ];
  1706.    char ybuf[ MAXSTRINGSIZE + 1 ];
  1707.  
  1708.    /* initialize the variable if necessary */
  1709.  
  1710.    if ( init == FALSE )
  1711.       {
  1712.       init = TRUE;
  1713.       var_make( &nvar, INTEGER );
  1714.       }
  1715.  
  1716.    /* check for correct number of parameters */
  1717.  
  1718.    #if PROG_ERRORS
  1719.    if ( argc < 2 )
  1720.       {
  1721.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function INSTR().",
  1722.          argc );
  1723.       bwb_error( bwb_ebuf );
  1724.       return NULL;
  1725.       }
  1726.    else if ( argc > 3 )
  1727.       {
  1728.       sprintf( bwb_ebuf, "Too many parameters (%d) to function INSTR().",
  1729.          argc );
  1730.       bwb_error( bwb_ebuf );
  1731.       return NULL;
  1732.       }
  1733.    #else
  1734.    if ( fnc_checkargs( argc, argv, 2, 3 ) == FALSE )
  1735.       {
  1736.       return NULL;
  1737.       }
  1738.    #endif
  1739.  
  1740.    /* determine argument positions */
  1741.  
  1742.    if ( argc == 3 )
  1743.       {
  1744.       n_pos = 0;
  1745.       x_pos = 1;
  1746.       y_pos = 2;
  1747.       }
  1748.    else
  1749.       {
  1750.       n_pos = -1;
  1751.       x_pos = 0;
  1752.       y_pos = 1;
  1753.       }
  1754.  
  1755.    /* determine starting position */
  1756.  
  1757.    if ( n_pos == 0 )
  1758.       {
  1759.       start_pos = var_getival( &( argv[ n_pos ] ) ) - 1;
  1760.       }
  1761.    else
  1762.       {
  1763.       start_pos = 0;
  1764.       }
  1765.  
  1766.    /* get x and y strings */
  1767.  
  1768.    str_btoc( xbuf, var_getsval( &( argv[ x_pos ] ) ) );
  1769.    str_btoc( ybuf, var_getsval( &( argv[ y_pos ] ) ) );
  1770.  
  1771.    /* now search for match */
  1772.  
  1773.    for ( n = start_pos; n < strlen( xbuf ); ++n )
  1774.       {
  1775.       if ( strncmp( &( xbuf[ n ] ), ybuf, strlen( ybuf ) ) == 0 )
  1776.          {
  1777.          * var_findival( &nvar, nvar.array_pos ) = n + 1;
  1778.          return &nvar;
  1779.          }
  1780.       }
  1781.  
  1782.    /* match not found */
  1783.       
  1784.    * var_findival( &nvar, nvar.array_pos ) = 0;
  1785.    return &nvar;
  1786.  
  1787.    }
  1788.  
  1789. /***************************************************************
  1790.  
  1791.         FUNCTION:       fnc_str()
  1792.  
  1793.         DESCRIPTION:    
  1794.  
  1795. ***************************************************************/
  1796.  
  1797. struct bwb_variable *
  1798. fnc_str( int argc, struct bwb_variable *argv )
  1799.    {
  1800.    static struct bwb_variable nvar;
  1801.    static char *tbuf;
  1802.    static int init = FALSE;
  1803.  
  1804.    /* initialize the variable if necessary */
  1805.  
  1806.    if ( init == FALSE )
  1807.       {
  1808.       init = TRUE;
  1809.       var_make( &nvar, STRING );
  1810.       if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  1811.          {
  1812.          bwb_error( err_getmem );
  1813.          }
  1814.       }
  1815.  
  1816.    /* check parameters */
  1817.  
  1818.    #if PROG_ERRORS
  1819.    if ( argc < 1 )
  1820.       {
  1821.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function STR$().",
  1822.          argc );
  1823.       bwb_error( bwb_ebuf );
  1824.       return NULL;
  1825.       }
  1826.    else if ( argc > 1 )
  1827.       {
  1828.       sprintf( bwb_ebuf, "Too many parameters (%d) to function STR$().",
  1829.          argc );
  1830.       bwb_error( bwb_ebuf );
  1831.       return NULL;
  1832.       }
  1833.    #else
  1834.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  1835.       {
  1836.       return NULL;
  1837.       }
  1838.    #endif
  1839.  
  1840.    /* format as decimal number */
  1841.  
  1842.    sprintf( tbuf, " %.*f", prn_precision( &( argv[ 0 ] ) ), 
  1843.       var_getfval( &( argv[ 0 ] ) ) ); 
  1844.    str_ctob( var_findsval( &nvar, nvar.array_pos ), tbuf );
  1845.  
  1846.    return &nvar;
  1847.    }
  1848.  
  1849. /***************************************************************
  1850.  
  1851.         FUNCTION:       fnc_checkargs()
  1852.  
  1853.         DESCRIPTION:    This C function checks the arguments to
  1854.             functions.
  1855.  
  1856. ***************************************************************/
  1857.  
  1858. #if PROG_ERRORS
  1859. #else
  1860. int
  1861. fnc_checkargs( int argc, struct bwb_variable *argv, int min, int max )
  1862.    {
  1863.  
  1864.    if ( argc < min )
  1865.       {
  1866.       bwb_error( err_syntax );
  1867.       return FALSE;
  1868.       }
  1869.    if ( argc > max )
  1870.       {
  1871.       bwb_error( err_syntax );
  1872.       return FALSE;
  1873.       }
  1874.  
  1875.    return TRUE;
  1876.  
  1877.    }
  1878. #endif
  1879.  
  1880. /***************************************************************
  1881.  
  1882.         FUNCTION:       fnc_fncs()
  1883.  
  1884.         DESCRIPTION:    This C function is used for debugging
  1885.                         purposes; it prints a list of all defined
  1886.                         functions.
  1887.  
  1888. ***************************************************************/
  1889.  
  1890. #if PERMANENT_DEBUG
  1891. struct bwb_line *
  1892. bwb_fncs( struct bwb_line *l )
  1893.    {
  1894.    struct bwb_function *f;
  1895.  
  1896.    for ( f = fnc_start.next; f != &fnc_end; f = f->next )
  1897.       {
  1898.       fprintf( stdout, "%s\t%c \n", f->name, f->type );
  1899.       }
  1900.  
  1901.    l->next->position = 0;
  1902.    return l->next;
  1903.  
  1904.    }
  1905. #endif
  1906.