home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / bwbasic.zip / src / bwb_mth.c < prev    next >
C/C++ Source or Header  |  1993-04-27  |  28KB  |  1,220 lines
  1. /****************************************************************
  2.  
  3.         bwb_mth.c       Mathematical Functions
  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. #include <stdio.h>
  35. #include <stdlib.h>
  36. #include <ctype.h>
  37. #include <string.h>
  38. #include <math.h>
  39. #include <time.h>
  40.  
  41. #include "bwbasic.h"
  42. #include "bwb_mes.h"
  43.  
  44. union un_integer
  45.    {
  46.    int the_integer;
  47.    unsigned char the_chars[ sizeof( int ) ];
  48.    } an_integer;
  49.  
  50. union un_single
  51.    {
  52.    float the_float;
  53.    unsigned char the_chars[ sizeof( float) ];
  54.    } a_float;
  55.  
  56. union un_double
  57.    {
  58.    double the_double;
  59.    unsigned char the_chars[ sizeof( double ) ];
  60.    } a_double;
  61.  
  62. /***************************************************************
  63.  
  64.         FUNCTION:       fnc_abs()
  65.  
  66.         DESCRIPTION:    This C function implements the BASIC
  67.                         predefined ABS function, returning the
  68.                         absolute value of the argument.
  69.  
  70. ***************************************************************/
  71.  
  72. struct bwb_variable *
  73. fnc_abs( int argc, struct bwb_variable *argv  )
  74.    {
  75.    static struct bwb_variable nvar;
  76.    static int init = FALSE;
  77.  
  78.    #if INTENSIVE_DEBUG
  79.    sprintf( bwb_ebuf, "in fnc_abs(): entered function" );
  80.    bwb_debug( bwb_ebuf );
  81.    #endif
  82.  
  83.    /* initialize the variable if necessary */
  84.  
  85.    if ( init == FALSE )
  86.       {
  87.       init = TRUE;
  88.       strncpy( nvar.name, "(abs var)", MAXVARNAMESIZE );
  89.       #if INTENSIVE_DEBUG
  90.       sprintf( bwb_ebuf, "in fnc_abs(): ready to make local variable <%s>",
  91.          nvar.name );
  92.       bwb_debug( bwb_ebuf );
  93.       #endif
  94.       var_make( &nvar, SINGLE );
  95.       }
  96.  
  97.    #if INTENSIVE_DEBUG
  98.    sprintf( bwb_ebuf, "in fnc_abs(): received f_arg <%f> nvar type <%c>",
  99.       var_getdval( &( argv[ 0 ] ) ), nvar.type );
  100.    bwb_debug( bwb_ebuf );
  101.    #endif
  102.  
  103.    #if PROG_ERRORS
  104.    if ( argc < 1 )
  105.       {
  106.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function ABS().",
  107.          argc );
  108.       bwb_error( bwb_ebuf );
  109.       return NULL;
  110.       }
  111.    else if ( argc > 1 )
  112.       {
  113.       sprintf( bwb_ebuf, "Too many parameters (%d) to function ABS().",
  114.          argc );
  115.       bwb_error( bwb_ebuf );
  116.       return NULL;
  117.       }
  118.    #else
  119.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  120.       {
  121.       return NULL;
  122.       }
  123.    #endif
  124.  
  125.    /* assign values */
  126.  
  127.    #if INTENSIVE_DEBUG
  128.    sprintf( bwb_ebuf, "in fnc_abs(): nvar type <%c>; calling findval()",
  129.       nvar.type );
  130.    bwb_debug( bwb_ebuf );
  131.    #endif
  132.  
  133.    * var_findfval( &nvar, nvar.array_pos ) = 
  134.       (float) fabs( var_getdval( &( argv[ 0 ] ) ) );
  135.  
  136.    return &nvar;
  137.  
  138.    }
  139.  
  140. /***************************************************************
  141.  
  142.         FUNCTION:       fnc_atn()
  143.  
  144.         DESCRIPTION:    This C function implements the BASIC
  145.  
  146.                         predefined ATN function, returning the
  147.                         arctangent of the argument.
  148.  
  149. ***************************************************************/
  150.  
  151. struct bwb_variable *
  152. fnc_atn( int argc, struct bwb_variable *argv  )
  153.    {
  154.    static struct bwb_variable nvar;
  155.    static int init = FALSE;
  156.  
  157.    /* initialize the variable if necessary */
  158.  
  159.    if ( init == FALSE )
  160.       {
  161.       init = TRUE;
  162.       var_make( &nvar, DOUBLE );
  163.       }
  164.  
  165.    #if INTENSIVE_DEBUG
  166.    sprintf( bwb_ebuf, "in fnc_atn(): received f_arg <%f> ",
  167.       var_getdval( &( argv[ 0 ] ) ) );
  168.    bwb_debug( bwb_ebuf );
  169.    #endif
  170.  
  171.    #if PROG_ERRORS
  172.    if ( argc < 1 )
  173.       {
  174.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function ATN().",
  175.          argc );
  176.       bwb_error( bwb_ebuf );
  177.       return NULL;
  178.       }
  179.    else if ( argc > 1 )
  180.       {
  181.       sprintf( bwb_ebuf, "Too many parameters (%d) to function ATN().",
  182.          argc );
  183.       bwb_error( bwb_ebuf );
  184.       return NULL;
  185.       }
  186.    #else
  187.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  188.       {
  189.       return NULL;
  190.       }
  191.    #endif
  192.  
  193.    /* assign values */
  194.  
  195.    * var_finddval( &nvar, nvar.array_pos ) 
  196.       = atan( var_getdval( &( argv[ 0 ] ) ) );
  197.  
  198.    return &nvar;
  199.  
  200.    }
  201.  
  202. /***************************************************************
  203.  
  204.         FUNCTION:       fnc_cos()
  205.  
  206.         DESCRIPTION:    This C function implements the BASIC
  207.                         predefined COS function, returning the
  208.                         cosine of the argument.
  209.  
  210. ***************************************************************/
  211.  
  212. struct bwb_variable *
  213. fnc_cos( int argc, struct bwb_variable *argv  )
  214.    {
  215.    static struct bwb_variable nvar;
  216.    static int init = FALSE;
  217.  
  218.    /* initialize the variable if necessary */
  219.  
  220.    if ( init == FALSE )
  221.       {
  222.       init = TRUE;
  223.       var_make( &nvar, DOUBLE );
  224.       }
  225.  
  226.    #if INTENSIVE_DEBUG
  227.    sprintf( bwb_ebuf, "in fnc_cos(): received f_arg <%f> ",
  228.       var_getdval( &( argv[ 0 ] ) ) );
  229.    bwb_debug( bwb_ebuf );
  230.    #endif
  231.  
  232.    #if PROG_ERRORS
  233.    if ( argc < 1 )
  234.       {
  235.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function COS().",
  236.          argc );
  237.       bwb_error( bwb_ebuf );
  238.       return NULL;
  239.       }
  240.    else if ( argc > 1 )
  241.       {
  242.       sprintf( bwb_ebuf, "Too many parameters (%d) to function COS().",
  243.          argc );
  244.       bwb_error( bwb_ebuf );
  245.       return NULL;
  246.       }
  247.    #else
  248.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  249.       {
  250.       return NULL;
  251.       }
  252.    #endif
  253.  
  254.    /* assign values */
  255.  
  256.    * var_finddval( &nvar, nvar.array_pos ) 
  257.       = cos( var_getdval( &( argv[ 0 ] ) ) );
  258.  
  259.    return &nvar;
  260.  
  261.    }
  262.  
  263. /***************************************************************
  264.  
  265.         FUNCTION:       fnc_log()
  266.  
  267.         DESCRIPTION:    This C function implements the BASIC
  268.                         predefined LOG function, returning the
  269.                         natural logarithm of the argument.
  270.  
  271. ***************************************************************/
  272.  
  273. struct bwb_variable *
  274. fnc_log( int argc, struct bwb_variable *argv  )
  275.    {
  276.    static struct bwb_variable nvar;
  277.    static int init = FALSE;
  278.  
  279.    /* initialize the variable if necessary */
  280.  
  281.    if ( init == FALSE )
  282.       {
  283.       init = TRUE;
  284.       var_make( &nvar, DOUBLE );
  285.       }
  286.  
  287.    #if INTENSIVE_DEBUG
  288.    sprintf( bwb_ebuf, "in fnc_log(): received f_arg <%f> ",
  289.       var_getdval( &( argv[ 0 ] ) ) );
  290.    bwb_debug( bwb_ebuf );
  291.    #endif
  292.  
  293.    #if PROG_ERRORS
  294.    if ( argc < 1 )
  295.       {
  296.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function LOG().",
  297.          argc );
  298.       bwb_error( bwb_ebuf );
  299.       return NULL;
  300.       }
  301.    else if ( argc > 1 )
  302.       {
  303.       sprintf( bwb_ebuf, "Too many parameters (%d) to function LOG().",
  304.          argc );
  305.       bwb_error( bwb_ebuf );
  306.       return NULL;
  307.       }
  308.    #else
  309.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  310.       {
  311.       return NULL;
  312.       }
  313.    #endif
  314.  
  315.    /* assign values */
  316.  
  317.    * var_finddval( &nvar, nvar.array_pos ) 
  318.       = log( var_getdval( &( argv[ 0 ] ) ) );
  319.  
  320.    return &nvar;
  321.    }
  322.  
  323. /***************************************************************
  324.  
  325.         FUNCTION:       fnc_sin()
  326.  
  327.         DESCRIPTION:    This C function implements the BASIC
  328.                         predefined SIN function, returning
  329.                         the sine of the argument.
  330.  
  331. ***************************************************************/
  332.  
  333. struct bwb_variable *
  334. fnc_sin( int argc, struct bwb_variable *argv  )
  335.    {
  336.    static struct bwb_variable nvar;
  337.    static int init = FALSE;
  338.  
  339.    /* initialize the variable if necessary */
  340.  
  341.    if ( init == FALSE )
  342.       {
  343.       init = TRUE;
  344.       var_make( &nvar, DOUBLE );
  345.       }
  346.  
  347.    #if INTENSIVE_DEBUG
  348.    sprintf( bwb_ebuf, "in fnc_sin(): received f_arg <%f> ",
  349.       var_getdval( &( argv[ 0 ] ) ) );
  350.    bwb_debug( bwb_ebuf );
  351.    #endif
  352.  
  353.    #if PROG_ERRORS
  354.    if ( argc < 1 )
  355.       {
  356.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function SIN().",
  357.          argc );
  358.       bwb_error( bwb_ebuf );
  359.       return NULL;
  360.       }
  361.  
  362.    else if ( argc > 1 )
  363.       {
  364.       sprintf( bwb_ebuf, "Too many parameters (%d) to function SIN().",
  365.          argc );
  366.       bwb_error( bwb_ebuf );
  367.       return NULL;
  368.       }
  369.    #else
  370.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  371.       {
  372.       return NULL;
  373.       }
  374.    #endif
  375.  
  376.    /* assign values */
  377.  
  378.    * var_finddval( &nvar, nvar.array_pos ) 
  379.       = sin( var_getdval( &( argv[ 0 ] ) ) );
  380.  
  381.    return &nvar;
  382.  
  383.    }
  384.  
  385.  
  386. /***************************************************************
  387.  
  388.         FUNCTION:       fnc_sqr()
  389.  
  390.         DESCRIPTION:    This C function implements the BASIC
  391.                         predefined SQR function, returning
  392.                         the square root of the argument.
  393.  
  394. ***************************************************************/
  395.  
  396. struct bwb_variable *
  397. fnc_sqr( int argc, struct bwb_variable *argv  )
  398.    {
  399.    static struct bwb_variable nvar;
  400.    static int init = FALSE;
  401.  
  402.    /* initialize the variable if necessary */
  403.  
  404.    if ( init == FALSE )
  405.       {
  406.       init = TRUE;
  407.       var_make( &nvar, DOUBLE );
  408.       }
  409.  
  410.    #if INTENSIVE_DEBUG
  411.    sprintf( bwb_ebuf, "in fnc_sqr(): received f_arg <%f> ",
  412.       var_getdval( &( argv[ 0 ] ) ) );
  413.    bwb_debug( bwb_ebuf );
  414.    #endif
  415.  
  416.    #if PROG_ERRORS
  417.    if ( argc < 1 )
  418.       {
  419.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function SQR().",
  420.          argc );
  421.       bwb_error( bwb_ebuf );
  422.       return NULL;
  423.       }
  424.    else if ( argc > 1 )
  425.       {
  426.       sprintf( bwb_ebuf, "Too many parameters (%d) to function SQR().",
  427.          argc );
  428.       bwb_error( bwb_ebuf );
  429.       return NULL;
  430.       }
  431.    #else
  432.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  433.       {
  434.       return NULL;
  435.       }
  436.    #endif
  437.  
  438.    /* assign values */
  439.  
  440.    * var_finddval( &nvar, nvar.array_pos ) 
  441.       = sqrt( var_getdval( &( argv[ 0 ] ) ) );
  442.  
  443.    return &nvar;
  444.  
  445.    }
  446.  
  447. /***************************************************************
  448.  
  449.         FUNCTION:       fnc_tan()
  450.  
  451.         DESCRIPTION:    This C function implements the BASIC
  452.                         predefined TAN function, returning the
  453.                         tangent of the argument.
  454.  
  455. ***************************************************************/
  456.  
  457. struct bwb_variable *
  458. fnc_tan( int argc, struct bwb_variable *argv  )
  459.    {
  460.    static struct bwb_variable nvar;
  461.    static int init = FALSE;
  462.  
  463.    /* initialize the variable if necessary */
  464.  
  465.    if ( init == FALSE )
  466.       {
  467.       init = TRUE;
  468.       var_make( &nvar, DOUBLE );
  469.       }
  470.  
  471.    #if INTENSIVE_DEBUG
  472.    sprintf( bwb_ebuf, "in fnc_tan(): received f_arg <%f> ",
  473.       var_getdval( &( argv[ 0 ] ) ) );
  474.    bwb_debug( bwb_ebuf );
  475.    #endif
  476.  
  477.    #if PROG_ERRORS
  478.    if ( argc < 1 )
  479.       {
  480.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function TAN().",
  481.          argc );
  482.       bwb_error( bwb_ebuf );
  483.       return NULL;
  484.       }
  485.    else if ( argc > 1 )
  486.       {
  487.       sprintf( bwb_ebuf, "Too many parameters (%d) to function TAN().",
  488.          argc );
  489.       bwb_error( bwb_ebuf );
  490.       return NULL;
  491.       }
  492.    #else
  493.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  494.       {
  495.       return NULL;
  496.       }
  497.    #endif
  498.  
  499.    /* assign values */
  500.  
  501.    * var_finddval( &nvar, nvar.array_pos ) 
  502.       = tan( var_getdval( &( argv[ 0 ] ) ) );
  503.  
  504.    return &nvar;
  505.  
  506.    }
  507.  
  508.  
  509. /***************************************************************
  510.  
  511.         FUNCTION:       fnc_sgn()
  512.  
  513.         DESCRIPTION:    This C function implements the BASIC
  514.                         predefined SGN function, returning 0
  515.                         if the argument is 0, -1 if the argument
  516.                         is less than 0, or 1 if the argument
  517.                         is more than 0.
  518.  
  519. ***************************************************************/
  520.  
  521. struct bwb_variable *
  522. fnc_sgn( int argc, struct bwb_variable *argv  )
  523.    {
  524.    static struct bwb_variable nvar;
  525.    double dval;
  526.    static int init = FALSE;
  527.  
  528.    /* initialize the variable if necessary */
  529.  
  530.    if ( init == FALSE )
  531.       {
  532.       init = TRUE;
  533.       var_make( &nvar, INTEGER );
  534.       }
  535.  
  536.    #if INTENSIVE_DEBUG
  537.    sprintf( bwb_ebuf, "in fnc_sgn(): received f_arg <%f> ",
  538.       var_getdval( &( argv[ 0 ] ) ) );
  539.    bwb_debug( bwb_ebuf );
  540.    #endif
  541.  
  542.    #if PROG_ERRORS
  543.    if ( argc < 1 )
  544.       {
  545.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function SGN().",
  546.          argc );
  547.       bwb_error( bwb_ebuf );
  548.       return NULL;
  549.       }
  550.    else if ( argc > 1 )
  551.       {
  552.       sprintf( bwb_ebuf, "Too many parameters (%d) to function SGN().",
  553.          argc );
  554.       bwb_error( bwb_ebuf );
  555.       return NULL;
  556.       }
  557.    #else
  558.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  559.       {
  560.       return NULL;
  561.       }
  562.    #endif
  563.  
  564.    /* assign values */
  565.  
  566.    dval = var_getdval( &( argv[ 0 ] ));
  567.  
  568.    if ( dval == 0.0 )
  569.       {
  570.       * var_findival( &nvar, nvar.array_pos ) = 0;
  571.       }
  572.    else if ( dval > 0.0 )
  573.       {
  574.       * var_findival( &nvar, nvar.array_pos ) = 1;
  575.       }
  576.    else
  577.       {
  578.       * var_findival( &nvar, nvar.array_pos ) = -1;
  579.       }
  580.  
  581.    return &nvar;
  582.    }
  583.  
  584. /***************************************************************
  585.  
  586.         FUNCTION:       fnc_int()
  587.  
  588.         DESCRIPTION:    This C function implements the BASIC
  589.                         predefined INT function, returning an
  590.                         less than or equal to the argument.
  591.  
  592. ***************************************************************/
  593.  
  594. struct bwb_variable *
  595. fnc_int( int argc, struct bwb_variable *argv  )
  596.    {
  597.    static struct bwb_variable nvar;
  598.    static int init = FALSE;
  599.  
  600.    /* initialize the variable if necessary */
  601.  
  602.    if ( init == FALSE )
  603.       {
  604.       init = TRUE;
  605.       var_make( &nvar, SINGLE );
  606.       }
  607.  
  608.    #if INTENSIVE_DEBUG
  609.    sprintf( bwb_ebuf, "in fnc_int(): received f_arg <%f> ",
  610.       var_getdval( &( argv[ 0 ] ) ) );
  611.    bwb_debug( bwb_ebuf );
  612.    #endif
  613.  
  614.    #if PROG_ERRORS
  615.    if ( argc < 1 )
  616.       {
  617.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function INT().",
  618.          argc );
  619.       bwb_error( bwb_ebuf );
  620.       return NULL;
  621.       }
  622.    else if ( argc > 1 )
  623.       {
  624.       sprintf( bwb_ebuf, "Too many parameters (%d) to function INT().",
  625.          argc );
  626.       bwb_error( bwb_ebuf );
  627.       return NULL;
  628.       }
  629.    #else
  630.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  631.       {
  632.       return NULL;
  633.       }
  634.    #endif
  635.  
  636.    /* assign values */
  637.  
  638.    * var_findfval( &nvar, nvar.array_pos ) 
  639.       = (float) floor( var_getdval( &( argv[ 0 ] ) ) );
  640.  
  641.    return &nvar;
  642.    }
  643.  
  644. /***************************************************************
  645.  
  646.         FUNCTION:       fnc_mki()
  647.  
  648.         DESCRIPTION:    This C function implements the BASIC
  649.                         predefined MKI$() function.
  650.  
  651. ***************************************************************/
  652.  
  653. struct bwb_variable *
  654. fnc_mki( int argc, struct bwb_variable *argv  )
  655.    {
  656.    register int i;
  657.    static struct bwb_variable nvar;
  658.    bstring *b;
  659.    static char tbuf[ sizeof( int ) ];
  660.    static int init = FALSE;
  661.  
  662.    /* initialize the variable if necessary */
  663.  
  664.    if ( init == FALSE )
  665.       {
  666.       init = TRUE;
  667.       var_make( &nvar, STRING );
  668.       }
  669.  
  670.    #if PROG_ERRORS
  671.    if ( argc < 1 )
  672.       {
  673.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function MKI$().",
  674.          argc );
  675.       bwb_error( bwb_ebuf );
  676.       return NULL;
  677.       }
  678.    else if ( argc > 1 )
  679.       {
  680.       sprintf( bwb_ebuf, "Too many parameters (%d) to function MKI$().",
  681.          argc );
  682.       bwb_error( bwb_ebuf );
  683.       return NULL;
  684.       }
  685.    #else
  686.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  687.       {
  688.       return NULL;
  689.       }
  690.    #endif
  691.  
  692.    /* assign values */
  693.  
  694.    an_integer.the_integer = var_getival( &( argv[ 0 ] ) );
  695.  
  696.    for ( i = 0; i < sizeof( int ); ++i )
  697.       {
  698.       tbuf[ i ] = an_integer.the_chars[ i ];
  699.       }
  700.    b = var_getsval( &nvar );
  701.    b->length = sizeof( int );
  702.    b->buffer = tbuf;
  703.    b->rab = FALSE;   
  704.  
  705.    return &nvar;
  706.    }
  707.  
  708. /***************************************************************
  709.  
  710.         FUNCTION:       fnc_mkd()
  711.  
  712.         DESCRIPTION:    This C function implements the BASIC
  713.                         predefined MKD$() function.
  714.  
  715. ***************************************************************/
  716.  
  717. struct bwb_variable *
  718. fnc_mkd( int argc, struct bwb_variable *argv  )
  719.    {
  720.    register int i;
  721.    static struct bwb_variable nvar;
  722.    bstring *b;
  723.    char tbuf[ sizeof ( double ) ];
  724.    static int init = FALSE;
  725.  
  726.    /* initialize the variable if necessary */
  727.  
  728.    if ( init == FALSE )
  729.       {
  730.       init = TRUE;
  731.       var_make( &nvar, STRING );
  732.       }
  733.  
  734.    #if PROG_ERRORS
  735.    if ( argc < 1 )
  736.       {
  737.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function MKD$().",
  738.          argc );
  739.       bwb_error( bwb_ebuf );
  740.       return NULL;
  741.       }
  742.    else if ( argc > 1 )
  743.       {
  744.       sprintf( bwb_ebuf, "Too many parameters (%d) to function MKD$().",
  745.          argc );
  746.       bwb_error( bwb_ebuf );
  747.       return NULL;
  748.       }
  749.    #else
  750.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  751.       {
  752.       return NULL;
  753.       }
  754.    #endif
  755.  
  756.    /* assign values */
  757.  
  758.    a_double.the_double = var_getdval( &( argv[ 0 ] ) );
  759.  
  760.    for ( i = 0; i < sizeof ( double ); ++i )
  761.       {
  762.       tbuf[ i ] = a_double.the_chars[ i ];
  763.       tbuf[ i + 1 ] = '\0';
  764.       }
  765.    b = var_getsval( &nvar );
  766.    b->length = sizeof( double );
  767.    b->buffer = tbuf;
  768.    b->rab = FALSE;
  769.  
  770.    return &nvar;
  771.    }
  772.  
  773. /***************************************************************
  774.  
  775.         FUNCTION:       fnc_mks()
  776.  
  777.         DESCRIPTION:    This C function implements the BASIC
  778.                         predefined MKS$() function.
  779.  
  780. ***************************************************************/
  781.  
  782. struct bwb_variable *
  783. fnc_mks( int argc, struct bwb_variable *argv  )
  784.    {
  785.    register int i;
  786.    static struct bwb_variable nvar;
  787.    static unsigned char tbuf[ 5 ];
  788.    bstring *b;
  789.    static int init = FALSE;
  790.  
  791.    /* initialize the variable if necessary */
  792.  
  793.    if ( init == FALSE )
  794.       {
  795.       init = TRUE;
  796.       var_make( &nvar, STRING );
  797.       }
  798.  
  799.    #if PROG_ERRORS
  800.    if ( argc < 1 )
  801.       {
  802.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function MKS$().",
  803.          argc );
  804.       bwb_error( bwb_ebuf );
  805.       return NULL;
  806.       }
  807.    else if ( argc > 1 )
  808.       {
  809.       sprintf( bwb_ebuf, "Too many parameters (%d) to function MKS$().",
  810.          argc );
  811.       bwb_error( bwb_ebuf );
  812.       return NULL;
  813.       }
  814.    #else
  815.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  816.       {
  817.       return NULL;
  818.       }
  819.    #endif
  820.  
  821.    /* assign values */
  822.  
  823.    a_float.the_float = var_getfval( &( argv[ 0 ] ) );
  824.  
  825.    for ( i = 0; i < sizeof( float ); ++i )
  826.       {
  827.       tbuf[ i ] = a_float.the_chars[ i ];
  828.       }
  829.    b = var_getsval( &nvar );
  830.    b->length = sizeof( float );
  831.    b->buffer = tbuf;
  832.    b->rab = FALSE;
  833.  
  834.    #if INTENSIVE_DEBUG
  835.    sprintf( bwb_ebuf, "in fnc_mks(): string <%s> hex vals <%X><%X><%X><%X>",
  836.       tbuf, tbuf[ 0 ], tbuf[ 1 ], tbuf[ 2 ], tbuf[ 3 ] );
  837.    bwb_debug( bwb_ebuf );
  838.    #endif
  839.  
  840.    return &nvar;
  841.    }
  842.  
  843. /***************************************************************
  844.  
  845.         FUNCTION:       fnc_cvi()
  846.  
  847.         DESCRIPTION:    This C function implements the BASIC
  848.                         predefined CVI() function.
  849.  
  850. ***************************************************************/
  851.  
  852. struct bwb_variable *
  853. fnc_cvi( int argc, struct bwb_variable *argv  )
  854.    {
  855.    register int i;
  856.    struct bwb_variable *v;
  857.    bstring *b;
  858.    static struct bwb_variable nvar;
  859.    static int init = FALSE;
  860.  
  861.    /* initialize the variable if necessary */
  862.  
  863.    if ( init == FALSE )
  864.       {
  865.       init = TRUE;
  866.       var_make( &nvar, INTEGER );
  867.       }
  868.  
  869.    #if PROG_ERRORS
  870.    if ( argc < 1 )
  871.       {
  872.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function CVI().",
  873.          argc );
  874.       bwb_error( bwb_ebuf );
  875.       return NULL;
  876.       }
  877.    else if ( argc > 1 )
  878.       {
  879.       sprintf( bwb_ebuf, "Too many parameters (%d) to function CVI().",
  880.          argc );
  881.       bwb_error( bwb_ebuf );
  882.       return NULL;
  883.       }
  884.    #else
  885.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  886.       {
  887.       return NULL;
  888.       }
  889.    #endif
  890.  
  891.    /* assign values */
  892.  
  893.    v = &( argv[ 0 ] );
  894.    b = var_findsval( v, v->array_pos );
  895.  
  896.    for ( i = 0; i < sizeof( int ); ++i )
  897.       {
  898.       an_integer.the_chars[ i ] = b->buffer[ i ];
  899.       }
  900.  
  901.    * var_findival( &nvar, nvar.array_pos ) = an_integer.the_integer;
  902.  
  903.    return &nvar;
  904.    }
  905.  
  906. /***************************************************************
  907.  
  908.         FUNCTION:       fnc_cvd()
  909.  
  910.         DESCRIPTION:    This C function implements the BASIC
  911.                         predefined CVD() function.
  912.  
  913. ***************************************************************/
  914.  
  915. struct bwb_variable *
  916. fnc_cvd( int argc, struct bwb_variable *argv  )
  917.    {
  918.    register int i;
  919.    struct bwb_variable *v;
  920.    bstring *b;
  921.    static struct bwb_variable nvar;
  922.    static int init = FALSE;
  923.  
  924.    /* initialize the variable if necessary */
  925.  
  926.    if ( init == FALSE )
  927.       {
  928.       init = TRUE;
  929.       var_make( &nvar, DOUBLE );
  930.       }
  931.  
  932.    #if PROG_ERRORS
  933.    if ( argc < 1 )
  934.       {
  935.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function CVD().",
  936.          argc );
  937.       bwb_error( bwb_ebuf );
  938.       return NULL;
  939.       }
  940.    else if ( argc > 1 )
  941.       {
  942.       sprintf( bwb_ebuf, "Too many parameters (%d) to function CVD().",
  943.          argc );
  944.       bwb_error( bwb_ebuf );
  945.       return NULL;
  946.       }
  947.    #else
  948.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  949.       {
  950.       return NULL;
  951.       }
  952.    #endif
  953.  
  954.    /* assign values */
  955.  
  956.    v = &( argv[ 0 ] );
  957.    b = var_findsval( v, v->array_pos );
  958.  
  959.    for ( i = 0; i < sizeof( double ); ++i )
  960.       {
  961.       a_double.the_chars[ i ] = b->buffer[ i ];
  962.       }
  963.  
  964.    * var_finddval( &nvar, nvar.array_pos ) = a_double.the_double;
  965.  
  966.    return &nvar;
  967.  
  968.    }
  969.  
  970. /***************************************************************
  971.  
  972.         FUNCTION:       fnc_cvs()
  973.  
  974.         DESCRIPTION:    This C function implements the BASIC
  975.                         predefined CVS() function.
  976.  
  977. ***************************************************************/
  978.  
  979. struct bwb_variable *
  980. fnc_cvs( int argc, struct bwb_variable *argv  )
  981.    {
  982.    register int i;
  983.    struct bwb_variable *v;
  984.    bstring *b;
  985.    static struct bwb_variable nvar;
  986.    static int init = FALSE;
  987.  
  988.    /* initialize the variable if necessary */
  989.  
  990.    if ( init == FALSE )
  991.       {
  992.       init = TRUE;
  993.       var_make( &nvar, SINGLE );
  994.       }
  995.  
  996.    #if PROG_ERRORS
  997.    if ( argc < 1 )
  998.       {
  999.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function CVS().",
  1000.          argc );
  1001.       bwb_error( bwb_ebuf );
  1002.       return NULL;
  1003.       }
  1004.    else if ( argc > 1 )
  1005.       {
  1006.       sprintf( bwb_ebuf, "Too many parameters (%d) to function CVS().",
  1007.          argc );
  1008.       bwb_error( bwb_ebuf );
  1009.       return NULL;
  1010.       }
  1011.    #else
  1012.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  1013.       {
  1014.       return NULL;
  1015.       }
  1016.    #endif
  1017.  
  1018.    /* assign values */
  1019.  
  1020.    v = &( argv[ 0 ] );
  1021.    b = var_findsval( v, v->array_pos );
  1022.  
  1023.    for ( i = 0; i < sizeof( float ); ++i )
  1024.       {
  1025.       a_float.the_chars[ i ] = b->buffer[ i ];
  1026.       }
  1027.  
  1028.    #if INTENSIVE_DEBUG
  1029.    sprintf( bwb_ebuf, "in fnc_cvs(): string <%s> hex vals <%X><%X><%X><%X>",
  1030.       a_float.the_chars, a_float.the_chars[ 0 ], a_float.the_chars[ 1 ], 
  1031.       a_float.the_chars[ 2 ], a_float.the_chars[ 3 ] );
  1032.    bwb_debug( bwb_ebuf );
  1033.    #endif
  1034.  
  1035.    * var_findfval( &nvar, nvar.array_pos ) = a_float.the_float;
  1036.  
  1037.    return &nvar;
  1038.  
  1039.    }
  1040.  
  1041. /***************************************************************
  1042.  
  1043.         FUNCTION:       fnc_csng()
  1044.  
  1045.         DESCRIPTION:    
  1046.  
  1047. ***************************************************************/
  1048.  
  1049. struct bwb_variable *
  1050. fnc_csng( int argc, struct bwb_variable *argv )
  1051.    {
  1052.    static struct bwb_variable nvar;
  1053.    static int init = FALSE;
  1054.  
  1055.    /* initialize the variable if necessary */
  1056.  
  1057.    if ( init == FALSE )
  1058.       {
  1059.       init = TRUE;
  1060.       var_make( &nvar, SINGLE );
  1061.       }
  1062.  
  1063.    /* check parameters */
  1064.  
  1065.    #if PROG_ERRORS
  1066.    if ( argc < 1 )
  1067.       {
  1068.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function CINT().",
  1069.          argc );
  1070.       bwb_error( bwb_ebuf );
  1071.       return NULL;
  1072.       }
  1073.    else if ( argc > 1 )
  1074.       {
  1075.       sprintf( bwb_ebuf, "Too many parameters (%d) to function CINT().",
  1076.          argc );
  1077.       bwb_error( bwb_ebuf );
  1078.       return NULL;
  1079.       }
  1080.    #else
  1081.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  1082.       {
  1083.       return NULL;
  1084.       }
  1085.    #endif
  1086.  
  1087.    /* get truncated integer value */
  1088.  
  1089.    * var_findfval( &nvar, nvar.array_pos )
  1090.       = (float) var_getfval( &( argv[ 0 ] ) );
  1091.  
  1092.    return &nvar;
  1093.    }
  1094.  
  1095. /***************************************************************
  1096.  
  1097.         FUNCTION:       fnc_exp()
  1098.  
  1099.         DESCRIPTION:    
  1100.  
  1101. ***************************************************************/
  1102.  
  1103. struct bwb_variable *
  1104. fnc_exp( int argc, struct bwb_variable *argv )
  1105.    {
  1106.    static struct bwb_variable nvar;
  1107.    static int init = FALSE;
  1108.  
  1109.    /* initialize the variable if necessary */
  1110.  
  1111.    if ( init == FALSE )
  1112.       {
  1113.       init = TRUE;
  1114.       var_make( &nvar, DOUBLE );
  1115.       }
  1116.  
  1117.    #if PROG_ERRORS
  1118.    if ( argc < 1 )
  1119.       {
  1120.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function EXP().",
  1121.          argc );
  1122.       bwb_error( bwb_ebuf );
  1123.       return NULL;
  1124.       }
  1125.  
  1126.    else if ( argc > 1 )
  1127.       {
  1128.       sprintf( bwb_ebuf, "Too many parameters (%d) to function EXP().",
  1129.          argc );
  1130.       bwb_error( bwb_ebuf );
  1131.       return NULL;
  1132.       }
  1133.    #else
  1134.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  1135.       {
  1136.       return NULL;
  1137.       }
  1138.    #endif
  1139.  
  1140.    /* assign values */
  1141.  
  1142.    * var_finddval( &nvar, nvar.array_pos ) 
  1143.       = exp( var_getdval( &( argv[ 0 ] ) ) );
  1144.  
  1145.    return &nvar;
  1146.    }
  1147.  
  1148. /***************************************************************
  1149.  
  1150.         FUNCTION:       fnc_cint()
  1151.  
  1152.         DESCRIPTION:
  1153.  
  1154. ***************************************************************/
  1155.  
  1156. struct bwb_variable *
  1157. fnc_cint( int argc, struct bwb_variable *argv )
  1158.    {
  1159.    static struct bwb_variable nvar;
  1160.    static int init = FALSE;
  1161.  
  1162.    /* initialize the variable if necessary */
  1163.  
  1164.    if ( init == FALSE )
  1165.       {
  1166.       init = TRUE;
  1167.       var_make( &nvar, SINGLE );
  1168.       }
  1169.  
  1170.    /* check parameters */
  1171.  
  1172.    #if PROG_ERRORS
  1173.    if ( argc < 1 )
  1174.       {
  1175.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function CINT().",
  1176.          argc );
  1177.       bwb_error( bwb_ebuf );
  1178.       return NULL;
  1179.       }
  1180.    else if ( argc > 1 )
  1181.       {
  1182.       sprintf( bwb_ebuf, "Too many parameters (%d) to function CINT().",
  1183.          argc );
  1184.       bwb_error( bwb_ebuf );
  1185.       return NULL;
  1186.       }
  1187.    #else
  1188.    if ( fnc_checkargs( argc, argv, 1, 1 ) == FALSE )
  1189.       {
  1190.       return NULL;
  1191.       }
  1192.    #endif
  1193.  
  1194.    /* get truncated integer value */
  1195.  
  1196.    * var_findfval( &nvar, nvar.array_pos )
  1197.       = (float) trnc_int( (double) var_getfval( &( argv[ 0 ] )) );
  1198.  
  1199.    return &nvar;
  1200.    }
  1201.  
  1202. double
  1203. trnc_int( double x )
  1204.    {
  1205.    double sign;
  1206.  
  1207.    if ( x < 0.0 )
  1208.       {
  1209.       sign = -1.0;
  1210.       }
  1211.    else
  1212.       {
  1213.       sign = 1.0;
  1214.       }
  1215.  
  1216.    return ( floor( fabs( x )) * sign );
  1217.    }
  1218.  
  1219.  
  1220.