home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CODE4-1.ZIP / SOURCE.ZIP / E4EXEC.C < prev    next >
Encoding:
C/C++ Source or Header  |  1989-10-13  |  16.0 KB  |  708 lines
  1.  
  2. /* e4exec.C   (c)Copyright Sequiter Software Inc., 1987, 1988, 1989.    All rights reserved.
  3.  
  4.    Expression Execution Routines
  5. */
  6.  
  7. #include "d4base.h"
  8. #include "u4error.h"
  9. #include "e4parse.h"
  10.  
  11. #include <string.h>
  12. #include <math.h>
  13. #include <time.h>
  14. #include <stdlib.h>
  15.  
  16. #define  RESULT_SIZE   258
  17.  
  18. static char  *expr_on, *expr_string ;
  19. static char   type ;
  20.  
  21. extern char  *v4eval_space ;
  22. extern char  *v4eval_end ;
  23.  
  24. extern BASE  *v4base ;
  25. extern int    v4cur_base ;
  26.  
  27. static void  strnrev( char *, int ) ;
  28. static void  str_blank_cat( char *, int, int ) ;
  29. static int   e4exec_funct( char *, int *) ;
  30.  
  31. static  void strnrev( s, s_len )  /* Reverse the character order */
  32. char *s ;
  33. int   s_len ;
  34. {
  35.    char *s2, c ;
  36.    s2 = s+ s_len -1 ;
  37.    while ( s2> s )
  38.    {
  39.       c     = *s ;
  40.       *s++  = *s2 ;
  41.       *s2-- = c ;
  42.    }
  43. }
  44.  
  45. static  void str_blank_cat( a, a_len, b_len )  /* move blanks to end */
  46. char *a ;
  47. int   a_len, b_len ;
  48. {
  49.    char *s ;
  50.    int     s_len ;
  51.  
  52.    s_len =  0 ;
  53.    s =    a+a_len-1 ;
  54.    while ( *s == ' '  &&  s>= a )
  55.    {
  56.       s-- ;
  57.       s_len++ ;
  58.    }
  59.    s++;
  60.  
  61.    strnrev( s, s_len+b_len ) ;
  62.    strnrev( s, b_len ) ;
  63.    strnrev( s+b_len, s_len) ;
  64. }
  65.  
  66.  
  67. /* expr_ptr  is only for error messages.
  68.  
  69.    256 bytes must be declared for 'result_ptr'
  70.  
  71.        Result Type    result_ptr format          Function Return
  72.  
  73.        Numeric        double                  sizeof(double) 
  74.        Character    string                  Length of String
  75.        Logical        int   ( -1 - TRUE;  0 - FALSE )   sizeof(int) 
  76.        Date        YYYYMMDD              8 (Length of date)
  77.  
  78.    Returns (character converted to an (int) )
  79.  
  80.        N - Numeric Result
  81.        C - Character Result
  82.        L - Logical Result
  83.        D - Date Result
  84.       -1 - Error
  85. */
  86.  
  87. static int e4exec_funct ( r_ptr, r_len )
  88. char    *r_ptr ;
  89. int    *r_len ;
  90. {
  91.    int      a_type, a_len, b_type, b_len, c_type, c_len, len, num_parms, i ;
  92.    union
  93.    {
  94.       char   *ch;
  95.       double *doub;
  96.       int    *i ;
  97.    }  a, b, c ;
  98.  
  99.    char  op_code ;
  100.    op_code =  *expr_on++ ;
  101.  
  102.    switch( op_code )
  103.    {
  104.       case A_ADD:
  105.       case A_SUBTRACT:
  106.       case A_MULTIPLY:
  107.       case A_DIVIDE:
  108.       #ifndef UNIX
  109.       case A_POWER:
  110.       #endif
  111.      a_type =  e4exec_funct( (a.ch= r_ptr), &a_len ) ;
  112.      if ( a_type == ERROR) return( ERROR) ;
  113.      b_type =  e4exec_funct( (b.ch= r_ptr+ a_len), &b_len ) ;
  114.      if ( b_type == ERROR) return( ERROR) ;
  115.      if (a_type != b_type  ||
  116.          a_type != NUM_CODE && a_type != CHAR_CODE )
  117.      {
  118.         /* operators in reverse order in epression */
  119.         e4type_error( op_code, b_type, a_type, 0) ;
  120.         return(ERROR) ;
  121.      }
  122.  
  123.      if ( a_type == NUM_CODE)
  124.      {
  125.         /* do not result error because type checking could be being done */
  126.  
  127.         *r_len =  sizeof(double) ;
  128.  
  129.         switch(op_code)
  130.         {
  131.            /* Multiply */
  132.            case A_MULTIPLY:
  133.           *a.doub = (*a.doub) * (*b.doub) ;
  134.           break ;
  135.            /* Divide */
  136.            case A_DIVIDE:
  137.           if (*a.doub != 0.0)
  138.              *a.doub = (*b.doub)/(*a.doub) ;
  139.           break ;
  140.            /* Add */
  141.            case A_ADD:
  142.           *a.doub =  (*a.doub)+ (*b.doub) ;
  143.           break ;
  144.            /* Subtract */
  145.            case A_SUBTRACT:
  146.           *a.doub =  (*b.doub) - (*a.doub) ;
  147.           break ;
  148.            #ifndef UNIX
  149.            /* Power */
  150.            case A_POWER:
  151.           *a.doub = pow(*b.doub,*a.doub) ;
  152.           break ;
  153.            #endif
  154.         }
  155.         return( NUM_CODE) ;
  156.      }
  157.      else    /*  CHAR_CODE */
  158.      {
  159.         if (op_code != A_ADD &&  op_code != A_SUBTRACT)
  160.         {
  161.            e4type_error( op_code, a_type, b_type, 0) ;
  162.            return(ERROR) ;
  163.         }
  164.         *r_len =  a_len +  b_len ;
  165.         strnrev( a.ch, *r_len ) ;
  166.         strnrev( a.ch, b_len ) ;
  167.         strnrev( a.ch+b_len, a_len ) ;
  168.  
  169.         if (op_code == A_SUBTRACT)    /* concatenation with blank shifting */
  170.            str_blank_cat( a.ch, b_len, a_len ) ;
  171.         return( CHAR_CODE) ;
  172.      }
  173.  
  174.       case I_FALSE:
  175.       case I_TRUE:
  176.      *r_len =  sizeof(int) ;
  177.      if ( v4eval_end - r_ptr    < sizeof(int) )
  178.      {
  179.         u4error( 540, expr_string, (char *) 0 ) ;
  180.         return( ERROR ) ;
  181.      }
  182.      if ( op_code == I_TRUE )
  183.         *((int *)r_ptr) =    1 ;
  184.      else
  185.         *((int *)r_ptr) =    0 ;
  186.      return( LOG_CODE ) ;
  187.  
  188.       case I_CHAR:
  189.      *r_len = (int) *expr_on++ ;
  190.      if ( v4eval_end - r_ptr    < *r_len )
  191.      {
  192.         u4error( 540, expr_string, (char *) 0 ) ;
  193.         return( ERROR ) ;
  194.      }
  195.      memcpy( r_ptr, expr_on, *r_len) ;
  196.      expr_on += *r_len ;
  197.      return( CHAR_CODE ) ;
  198.  
  199.  
  200.       case I_NUM:
  201.      *r_len =  sizeof(double) ;
  202.      if ( v4eval_end - r_ptr    < sizeof(double) )
  203.      {
  204.         u4error( 540, expr_string, (char *) 0 ) ;
  205.         return( ERROR ) ;
  206.      }
  207.      memcpy( r_ptr, expr_on, sizeof(double) ) ;
  208.      expr_on += sizeof(double) ;
  209.      return( NUM_CODE) ;
  210.  
  211.  
  212.       case L_OR:
  213.       case L_AND:
  214.      b_type =  e4exec_funct( (b.ch= r_ptr), &b_len ) ;
  215.      if (b_type == ERROR) return( ERROR) ;
  216.      a_type =  e4exec_funct( (a.ch= r_ptr+ b_len), &a_len ) ;
  217.      if (a_type == ERROR) return( ERROR) ;
  218.      if (a_type != LOG_CODE  ||  b_type != LOG_CODE)
  219.      {
  220.         e4type_error( op_code, b_type, a_type, 0) ;
  221.         return( ERROR) ;
  222.      }
  223.      *r_len =  sizeof(int) ;
  224.      if (op_code == L_AND)
  225.         *((int *) r_ptr) =    *a.i && *b.i ;
  226.      if (op_code == L_OR)
  227.         *((int *) r_ptr) =    *a.i || *b.i ;
  228.      return( LOG_CODE) ;
  229.  
  230.  
  231.       case L_NOT:
  232.      a_type =  e4exec_funct( (a.ch= r_ptr), &a_len ) ;
  233.      if ( a_type == ERROR)    return( ERROR) ;
  234.      if ( a_type != LOG_CODE)
  235.      {
  236.         e4type_error( L_NOT, a_type, 0, 0) ;
  237.         return( ERROR) ;
  238.      }
  239.      * ((int*) r_ptr) =  ! *a.i ;
  240.      *r_len =  sizeof(int) ;
  241.      return ( LOG_CODE) ;
  242.  
  243.  
  244.       case R_GE:
  245.       case R_LE:
  246.       case R_GT:
  247.       case R_LT:
  248.       case R_EQ:
  249.       case R_NE:
  250.       case R_SUB_COMPARE:
  251.      b_type =  e4exec_funct( (b.ch= r_ptr), &b_len ) ;
  252.      if ( b_type == ERROR)      return( ERROR );
  253.      a_type =  e4exec_funct( (a.ch= r_ptr+b_len), &a_len ) ;
  254.      if ( a_type == ERROR) return( ERROR) ;
  255.      if (a_type != b_type     ||
  256.          a_type != CHAR_CODE && op_code == R_SUB_COMPARE   ||
  257.          a_type == LOG_CODE)
  258.      {
  259.         e4type_error( op_code, b_type, a_type, 0) ;
  260.         return( ERROR) ;
  261.      }
  262.      *r_len =  sizeof(int) ;
  263.  
  264.      if ( a_type == NUM_CODE)
  265.      {
  266.         if (op_code == R_GE)
  267.           *((int *)r_ptr) =  *a.doub >= *b.doub ;
  268.         if (op_code == R_LE)
  269.           *((int *)r_ptr) =  *a.doub <= *b.doub ;
  270.         if (op_code == R_GT)
  271.           *((int *)r_ptr) =  *a.doub >    *b.doub ;
  272.         if (op_code == R_LT)
  273.           *((int *)r_ptr) =  *a.doub <    *b.doub ;
  274.         if (op_code == R_EQ)
  275.           *((int *)r_ptr) =  *a.doub == *b.doub ;
  276.         if (op_code == R_NE)
  277.           *((int *)r_ptr) =  *a.doub != *b.doub ;
  278.         return( LOG_CODE) ;
  279.      }
  280.  
  281.      if ( a_type == CHAR_CODE  ||  a_type == DATE_CODE)
  282.      {
  283.         int compare_result ;
  284.  
  285.         if ( b_len < a_len )
  286.            len =  b_len ;
  287.         else
  288.            len =  a_len ;
  289.  
  290.         compare_result =  memcmp( a.ch, b.ch, len ) ;
  291.  
  292.         if (op_code == R_GE)
  293.           *((int *)r_ptr) =  compare_result >= 0 ;
  294.         if (op_code == R_LE)
  295.           *((int *)r_ptr) =  compare_result <= 0 ;
  296.         if (op_code == R_GT)
  297.           *((int *)r_ptr) =  compare_result >  0 ;
  298.         if (op_code == R_LT)
  299.           *((int *)r_ptr) =  compare_result <  0 ;
  300.         if (op_code == R_EQ)
  301.           *((int *)r_ptr) =  compare_result == 0 ;
  302.         if (op_code == R_NE)
  303.           *((int *)r_ptr) =  compare_result != 0 ;
  304.         if (op_code == R_SUB_COMPARE)
  305.         {
  306.            if ( a_len <= 0 )
  307.            {
  308.           *((int *) r_ptr) =  1 ;
  309.           return ( LOG_CODE ) ;
  310.            }
  311.  
  312.            /* See if there is a match */
  313.            for ( i=0; i <= b_len-a_len; i++ )
  314.           if ( *a.ch == b.ch[i] )
  315.              if ( memcmp( a.ch, b.ch+i, a_len ) == 0 )
  316.              {
  317.             *((int *) r_ptr) =  1 ;
  318.             return ( LOG_CODE ) ;
  319.              }
  320.  
  321.            *((int *) r_ptr) =  0 ;
  322.            return ( LOG_CODE ) ;
  323.         }
  324.         return( LOG_CODE) ;
  325.      }
  326.  
  327.       case F_DATE:
  328.       case F_TIME:
  329.       case F_DTOC:
  330.       case F_DTOS:
  331.       case F_CTOD:
  332.       case F_RECNO:
  333.       case F_RECCOUNT:
  334.       case F_STR:
  335.       case F_SUBSTR:
  336.       case F_VAL:
  337.       case F_IIF:
  338.       case F_DELETED:
  339.       case F_DEL:
  340.       case F_UPPER:
  341.      if ( v4eval_end - r_ptr    < 10 )
  342.      {
  343.         u4error( 540, expr_string, (char *) 0 ) ;
  344.         return( ERROR ) ;
  345.      }
  346.      *r_len    =  sizeof(double) ;  /* default */
  347.      num_parms =  (int)  (*expr_on++) ;
  348.      a_type =  b_type =  c_type = -1 ;   /* -1 means missing */
  349.      a_len    =  b_len  =  c_len  =  0 ;
  350.      while( num_parms >= 3)
  351.      {
  352.         num_parms-- ;
  353.         c_type =  e4exec_funct( (c.ch= r_ptr), &c_len ) ;
  354.         if (c_type == ERROR)   return( ERROR) ;
  355.      }
  356.      if ( num_parms >= 2)
  357.      {
  358.         b_type =  e4exec_funct( (b.ch= r_ptr+ c_len), &b_len ) ;
  359.         if (b_type == ERROR)   return( ERROR) ;
  360.      }
  361.      if ( num_parms >= 1)
  362.      {
  363.         a_type =  e4exec_funct( (a.ch= r_ptr+ c_len+b_len), &a_len ) ;
  364.         if (a_type == ERROR)   return( ERROR) ;
  365.      }
  366.  
  367.      if (op_code == F_DATE || op_code == F_TIME)
  368.      {
  369.         long time_val ;
  370.         struct tm  *tm_ptr ;
  371.  
  372.             *r_len =  8 ;
  373.  
  374.         time ( (time_t *) &time_val) ;
  375.         tm_ptr =  localtime( (time_t *) &time_val) ;
  376.  
  377.         if (op_code == F_TIME)
  378.         {
  379.            c4ltoa( (long) tm_ptr->tm_hour, r_ptr, -2) ;
  380.            r_ptr+= 2;
  381.            *r_ptr++ = ':' ;
  382.            c4ltoa( (long) tm_ptr->tm_min, r_ptr, -2) ;
  383.            r_ptr+= 2;
  384.            *r_ptr++ = ':' ;
  385.            c4ltoa( (long) tm_ptr->tm_sec, r_ptr, -2) ;
  386.            r_ptr+= 2;
  387.            return( CHAR_CODE) ;
  388.         }
  389.  
  390.         if (op_code == F_DATE)
  391.         {
  392.            c4ltoa( (long) tm_ptr->tm_year+1900, r_ptr, -4) ;
  393.            r_ptr+= 4;
  394.            c4ltoa( (long) tm_ptr->tm_mon+1, r_ptr, -2) ;
  395.            r_ptr+= 2;
  396.            c4ltoa( (long) tm_ptr->tm_mday, r_ptr, -2) ;
  397.            r_ptr+= 2;
  398.            return( DATE_CODE) ;
  399.         }
  400.      }
  401.  
  402.      if (op_code == F_DTOC || op_code == F_DTOS )
  403.      {
  404.         if ( a_type != DATE_CODE )
  405.         {
  406.            e4type_error( op_code, a_type, 0, 0) ;
  407.            return( ERROR) ;
  408.         }
  409.             *r_len =  8 ;
  410.         memmove( r_ptr, a.ch, 8 ) ;
  411.         return( CHAR_CODE) ;
  412.      }
  413.  
  414.      if (op_code == F_CTOD)
  415.      {
  416.         if ( a_type != CHAR_CODE )
  417.         {
  418.            e4type_error( op_code, a_type, 0, 0) ;
  419.            return( ERROR) ;
  420.         }
  421.             *r_len =  8 ;
  422.         memmove( r_ptr, a.ch, 8 ) ;
  423.         return( DATE_CODE) ;
  424.      }
  425.  
  426.      if (op_code == F_RECNO)
  427.      {
  428.         *((double *)r_ptr) =  (double) v4base[ v4cur_base].rec_num ;
  429.         return( NUM_CODE) ;
  430.      }
  431.  
  432.      if (op_code == F_RECCOUNT)
  433.      {
  434.         *((double *)r_ptr) =  (double) d4reccount() ;
  435.         return( NUM_CODE) ;
  436.      }
  437.  
  438.      if (op_code == F_DELETED)
  439.      {
  440.         if (*v4base[ v4cur_base].buffer == '*')
  441.            *((int*)r_ptr) =  1 ;
  442.         else
  443.            *((int*)r_ptr) =  0 ;
  444.         *r_len =  sizeof(int) ;
  445.         return( LOG_CODE) ;
  446.      }
  447.  
  448.      if (op_code == F_DEL)
  449.      {
  450.         *r_ptr =  *v4base[ v4cur_base].buffer ;
  451.         *r_len =  1 ;
  452.         return( CHAR_CODE) ;
  453.      }
  454.  
  455.      if (op_code == F_STR)
  456.      {
  457.         int  dec ;
  458.  
  459.         /* defaults are length of 10 and dec of 0 */
  460.         if ( a_type != NUM_CODE    ||
  461.          b_type != -1 &&  b_type != NUM_CODE  ||
  462.          c_type != -1 &&  c_type != NUM_CODE)
  463.         {
  464.            e4type_error( op_code, a_type, b_type, c_type) ;
  465.            return ( ERROR) ;
  466.         }
  467.         if (b_type == -1)
  468.            len =  10 ;
  469.         else
  470.            len =  (int) *b.doub ;
  471.  
  472.         if (c_type == -1)
  473.            dec =   0 ;
  474.         else
  475.            dec =  (int) *c.doub ;
  476.  
  477.         if ( v4eval_end - r_ptr  < len )
  478.         {
  479.            u4error( 540, expr_string, (char *) 0 ) ;
  480.            return( ERROR ) ;
  481.         }
  482.         strcpy( r_ptr, c4dtoa( *a.doub, len, dec) ) ;
  483.         *r_len =  len ;
  484.         return( CHAR_CODE) ;
  485.      }
  486.  
  487.      if ( op_code == F_VAL)
  488.      {
  489.         if (a_type != CHAR_CODE)
  490.         {
  491.            e4type_error( op_code, a_type, 0,0 ) ;
  492.            return( ERROR) ;
  493.         }
  494.  
  495.         *((double *)r_ptr) =   strtod( a.ch, (char **) 0) ;
  496.         return (NUM_CODE) ;
  497.      }
  498.  
  499.      if ( op_code == F_SUBSTR)
  500.      {
  501.         int b_val, c_val ;
  502.  
  503.         if (a_type!= CHAR_CODE || b_type!= NUM_CODE || c_type!= NUM_CODE)
  504.         {
  505.            e4type_error( op_code, a_type, b_type, c_type) ;
  506.            return( ERROR );
  507.         }
  508.         b_val =  (int) *b.doub ;
  509.         c_val =  (int) *c.doub ;
  510.  
  511.         if ( b_val < 1)    b_val =  1 ;
  512.         if ( b_val > a_len) b_val =  a_len ;
  513.         if ( b_val+c_val-1 > a_len)  c_val =  a_len+1-b_val ;
  514.  
  515.         memmove( r_ptr, a.ch+ b_val-1, c_val) ;
  516.         *r_len =  c_val ;
  517.  
  518.         return (CHAR_CODE) ;
  519.      }
  520.  
  521.      if ( op_code == F_IIF)
  522.      {
  523.         if (a_type!= LOG_CODE || b_type == -1 ||  c_type == -1
  524.                   ||  b_type != c_type)
  525.         {
  526.            e4type_error( op_code, a_type, b_type, c_type) ;
  527.            return( ERROR) ;
  528.         }
  529.         if ( *a.i)
  530.         {
  531.            memcpy( r_ptr, b.ch, b_len ) ;
  532.            *r_len =  b_len ;
  533.         }
  534.         else
  535.         {
  536.            memcpy( r_ptr, c.ch, c_len ) ;
  537.            *r_len =  c_len ;
  538.         }
  539.         return( b_type) ;
  540.      }
  541.  
  542.      if ( op_code == F_UPPER )
  543.      {
  544.         if ( a_type != CHAR_CODE )
  545.         {
  546.            e4type_error( op_code, a_type, 0, 0) ;
  547.            return( ERROR) ;
  548.         }
  549.         memmove( r_ptr, a.ch, a_len ) ;
  550.         r_ptr[a_len] =  '\0' ;
  551.         strupr( r_ptr ) ;
  552.         *r_len =  a_len ;
  553.         return( CHAR_CODE) ;
  554.      }
  555.  
  556.       case F_BASE_FIELD:
  557.       {
  558.      long    field_num ;
  559.      char    f_type ;
  560.  
  561.      field_num= *((long *)expr_on)++ ;
  562.      f_type = f4type(  field_num) ;
  563.      if ( f_type == 'F' )  f_type = 'N' ;
  564.  
  565.      *r_len =  -1 ;
  566.      if ( f_type == 'N' ) *r_len = sizeof(double) ;
  567.          if ( f_type == 'D' ) *r_len =  8 ;
  568.      if ( f_type == 'L' ) *r_len =  sizeof(int) ;
  569.      if ( f_type == 'C' ) *r_len =  f4width(field_num) ;
  570.  
  571.      if ( *r_len < 0 )
  572.      {
  573.         u4error( 580, expr_string, (char *) 0 ) ;
  574.         return( ERROR ) ;
  575.      }
  576.      if ( v4eval_end - r_ptr  < *r_len )
  577.      {
  578.         u4error( 540, expr_string, (char *) 0 ) ;
  579.         return( ERROR ) ;
  580.      }
  581.  
  582.      if (f_type == 'N')
  583.         *((double *)r_ptr)  =  f4value( field_num ) ;
  584.      if (f_type == 'L')  *((int *)   r_ptr)  =  f4true(  field_num ) ;
  585.      if (f_type == 'D' ||  f_type == 'C' )
  586.           memcpy( r_ptr, f4ptr(field_num), *r_len) ;
  587.  
  588.      return( (int) f_type ) ;
  589.       }
  590.    }
  591.    return( ERROR ) ;
  592.    /* END Switch */
  593. }
  594.  
  595.  
  596. char e4type()
  597. {
  598.    return( type ) ;
  599. }
  600.  
  601.  
  602. char * e4type_str( type)
  603. int type ;
  604. {
  605.    switch( type)
  606.    {
  607.       case NUM_CODE:  return("Numeric") ;
  608.       case CHAR_CODE: return("Character") ;
  609.       case LOG_CODE:  return("Logical") ;
  610.       case DATE_CODE: return("Date") ;
  611.    }
  612.    return( (char *) 0) ;
  613. }
  614.  
  615.  
  616. /* e4type_error calls u4error with an appropriate error message. */
  617.  
  618. e4type_error( op_code, first_type, second_type, third_type)
  619. char op_code ;
  620. int  first_type, second_type, third_type ;
  621. {
  622.    char *first_ptr, *second_ptr, *third_ptr ;
  623.  
  624.    first_ptr = second_ptr = third_ptr  =  (char *) 0 ;
  625.  
  626.    if ( first_type != 0 )
  627.       first_ptr = "First Operand Type:" ;
  628.    if ( second_type != 0 )
  629.       second_ptr= "Second Operand Type:" ;
  630.    if ( third_type != 0)
  631.       third_ptr = "Third Operand Type:" ;
  632.  
  633.    u4error( E_TYPE,
  634.     "Expression:",
  635.      expr_string,
  636.  
  637.     "Operator or Function:",
  638.      e4name(op_code),
  639.  
  640.      first_ptr,
  641.      e4type_str( first_type),
  642.  
  643.      second_ptr,
  644.      e4type_str( second_type),
  645.  
  646.      third_ptr,
  647.      e4type_str( third_type),
  648.  
  649.      (char *) 0) ;
  650.  
  651.    return(0) ;
  652. }
  653.  
  654.  
  655.  
  656. void *e4exec( compile_ptr )
  657. char *compile_ptr  ;
  658. {
  659.    int     rc, save_base, eval_len ;
  660.  
  661.    save_base =    v4cur_base ;
  662.  
  663.    expr_on =  compile_ptr ;
  664.    if (expr_on == ((char *) 0)    )
  665.    {
  666.       u4error( E_COMPILE_NULL, (char *) 0) ;
  667.       return( (void *) 0) ;
  668.    }
  669.  
  670.    expr_on ++ ; /* Past Double Identifier */
  671.  
  672.    /* stored as a double */
  673.    v4cur_base    =  (int)  *(((double *)expr_on)++) ;
  674.  
  675.    expr_on ++ ; /* Past String Identifier */
  676.    rc =  *((unsigned char *) expr_on)++ ;  /* Length of Expression */
  677.    expr_string    =  expr_on ;
  678.    expr_on     +=  rc ;
  679.  
  680.    rc =  e4exec_funct( v4eval_space, &eval_len ) ;
  681.    if ( v4eval_end - v4eval_space > eval_len )
  682.       v4eval_space[eval_len] =    '\0' ;
  683.  
  684.    v4cur_base =  save_base ;
  685.  
  686.    type =  (char) rc ;
  687.  
  688.    if ( rc == ERROR )
  689.       return( (void *) 0) ;
  690.    else
  691.       return( (void *) v4eval_space ) ;
  692. }
  693.  
  694.  
  695. void * e4eval( expr_ptr )
  696. char * expr_ptr ;
  697. {
  698.    char *compile_ptr ;
  699.    void *result_ptr ;
  700.  
  701.    if ( e4parse( expr_ptr, &compile_ptr) < 0)  return( (char *) 0) ;
  702.    result_ptr =  e4exec( compile_ptr ) ;
  703.    h4free_memory( compile_ptr ) ;
  704.    return( (void *) result_ptr ) ;
  705. }
  706.  
  707.  
  708.