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