home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / SOFTWARE / SOURCES / MAWK11AS.ZIP / BI_FUNCT.C (.txt) < prev    next >
C/C++ Source or Header  |  1991-12-18  |  20KB  |  867 lines
  1.  
  2. /********************************************
  3. bi_funct.c
  4. copyright 1991, Michael D. Brennan
  5.  
  6. This is a source file for mawk, an implementation of
  7. the AWK programming language.
  8.  
  9. Mawk is distributed without warranty under the terms of
  10. the GNU General Public License, version 2, 1991.
  11. ********************************************/
  12.  
  13. /* $Log:    bi_funct.c,v $
  14.  * Revision 5.1  91/12/05  07:55:35  brennan
  15.  * 1.1 pre-release
  16.  * 
  17. */
  18.  
  19.  
  20. #include "mawk.h"
  21. #include "bi_funct.h"
  22. #include "bi_vars.h"
  23. #include "memory.h"
  24. #include "init.h"
  25. #include "files.h"
  26. #include "fin.h"
  27. #include "field.h"
  28. #include "regexp.h"
  29. #include "repl.h"
  30. #include <math.h>
  31.  
  32.  
  33. /* statics */
  34. static STRING *PROTO(gsub, (PTR, CELL *, char *, int) ) ;
  35. static void  PROTO( fplib_err, (char *, double, char *) ) ;
  36.  
  37.  
  38. /* global for the disassembler */
  39. BI_REC  bi_funct[] = { /* info to load builtins */
  40.  
  41. "index" , bi_index , 2, 2 ,
  42. "substr" , bi_substr, 2, 3,
  43. "length" , bi_length, 0, 1,
  44. "sprintf" , bi_sprintf, 1, 255,
  45. "sin", bi_sin , 1, 1 ,
  46. "cos", bi_cos , 1, 1 ,
  47. "atan2", bi_atan2, 2,2,
  48. "exp", bi_exp, 1, 1,
  49. "log", bi_log , 1, 1 ,
  50. "int", bi_int, 1, 1,
  51. "sqrt", bi_sqrt, 1, 1,
  52. "rand" , bi_rand, 0, 0,
  53. "srand", bi_srand, 0, 1,
  54. "close", bi_close, 1, 1,
  55. "system", bi_system, 1, 1,
  56. "toupper", bi_toupper, 1, 1,
  57. "tolower", bi_tolower, 1, 1,
  58.  
  59. (char *) 0, (PF_CP) 0, 0, 0 } ;
  60.  
  61.  
  62.  
  63. void bi_funct_init()
  64. { register BI_REC *p = bi_funct ;
  65.   register SYMTAB *stp ;
  66.  
  67.   while ( p->name )
  68.   { stp = insert( p->name ) ;
  69.     stp->type = ST_BUILTIN ;
  70.     stp->stval.bip = p++ ;
  71.   }
  72.   /* seed rand() off the clock */
  73.   { CELL c ;
  74.  
  75.     c.type = 0 ; (void) bi_srand(&c) ;
  76.   }
  77.  
  78. }
  79.  
  80. /**************************************************
  81.  string builtins (except split (in split.c) and [g]sub (at end))
  82.  **************************************************/
  83.  
  84. CELL *bi_length(sp)
  85.   register  CELL *sp ;
  86. { unsigned len ;
  87.  
  88.   if ( sp->type == 0 )  cellcpy(sp, field) ;
  89.   else sp-- ;
  90.  
  91.   if ( sp->type < C_STRING ) cast1_to_s(sp) ;
  92.   len = string(sp)->len ;
  93.  
  94.   free_STRING( string(sp) ) ;
  95.   sp->type = C_DOUBLE ;
  96.   sp->dval = (double) len ;
  97.  
  98.   return sp ;
  99. }
  100.  
  101. char *str_str(target, key , key_len)
  102.   register char *target, *key ;
  103.   unsigned key_len ;
  104. { 
  105.   switch( key_len )
  106.   { case 0 :  return (char *) 0 ;
  107.     case 1 :  return strchr( target, *key) ;
  108.     case 2 :
  109.         while ( target = strchr(target, *key) )
  110.           if ( target[1] == key[1] )  return  target ;
  111.           else target++ ;
  112.         /*failed*/
  113.         return (char *) 0 ;
  114.   }
  115.   key_len-- ;
  116.   while ( target = strchr(target, *key) )
  117.         if ( memcmp(target+1, key+1, SIZE_T(key_len)) == 0 ) return target ;
  118.         else target++ ;
  119.   /*failed*/
  120.   return (char *) 0 ;
  121. }
  122.  
  123.  
  124.  
  125. CELL *bi_index(sp)
  126.   register CELL *sp ;
  127. { register int idx ;
  128.   unsigned len ;
  129.   char *p ;
  130.  
  131.   sp-- ;
  132.   if ( TEST2(sp) != TWO_STRINGS )
  133.         cast2_to_s(sp) ;
  134.  
  135.   if ( len = string(sp+1)->len )
  136.     idx = (p = str_str(string(sp)->str,string(sp+1)->str,len))
  137.           ? p - string(sp)->str + 1 : 0 ;
  138.  
  139.   else  /* index of the empty string */
  140.     idx = 1 ;
  141.   
  142.   free_STRING( string(sp) ) ;
  143.   free_STRING( string(sp+1) ) ;
  144.   sp->type = C_DOUBLE ;
  145.   sp->dval = (double) idx ;
  146.   return sp ;
  147. }
  148.  
  149. /*  substr(s, i, n)
  150.     if l = length(s)
  151.     then get the characters
  152.     from  max(1,i) to min(l,n-i-1) inclusive */
  153.  
  154. CELL *bi_substr(sp)
  155.   CELL *sp ;
  156. { int n_args, len ;
  157.   register int i, n ;
  158.   STRING *sval ;  /* substr(sval->str, i, n) */
  159.  
  160.   n_args = sp->type ;
  161.   sp -= n_args ;
  162.   if ( sp->type != C_STRING )  cast1_to_s(sp) ;
  163.       /* don't use < C_STRING shortcut */
  164.   sval = string(sp) ;
  165.  
  166.   if ( (len = sval->len) == 0 )  /* substr on null string */
  167.   {  if ( n_args == 3 )  cell_destroy(sp+2) ;
  168.      cell_destroy(sp+1) ;
  169.      return sp ;
  170.   }
  171.  
  172.   if ( n_args == 2 )  
  173.   { n = MAX__INT  ;  
  174.     if ( sp[1].type != C_DOUBLE ) cast1_to_d(sp+1) ; 
  175.   }
  176.   else
  177.   { if ( TEST2(sp+1) != TWO_DOUBLES ) cast2_to_d(sp+1) ;
  178.     n = (int) sp[2].dval ;
  179.   }
  180.   i = (int) sp[1].dval - 1 ; /* i now indexes into string */
  181.  
  182.   if ( i < 0 ) { n += i ; i = 0 ; }
  183.   if ( n > len - i )  n = len - i ;
  184.  
  185.   if ( n <= 0 )  /* the null string */
  186.   { 
  187.     sp->ptr = (PTR) &null_str ;
  188.     null_str.ref_cnt++ ;
  189.   }
  190.   else  /* got something */
  191.   { 
  192.     sp->ptr = (PTR) new_STRING((char *)0, n) ;
  193.     (void) memcpy(string(sp)->str, sval->str + i, SIZE_T(n)) ;
  194.   }
  195.  
  196.   free_STRING(sval) ;
  197.   return sp ;
  198. } 
  199.  
  200. /*
  201.   match(s,r)
  202.   sp[0] holds r, sp[-1] holds s
  203. */
  204.  
  205. CELL *bi_match(sp)
  206.   register CELL *sp ;
  207. { 
  208.   char *p ;
  209.   unsigned length ;
  210.  
  211.   if ( sp->type != C_RE )  cast_to_RE(sp) ;
  212.   if ( (--sp)->type < C_STRING )  cast1_to_s(sp) ;
  213.  
  214.   cell_destroy(RSTART) ;
  215.   cell_destroy(RLENGTH) ;
  216.   RSTART->type = C_DOUBLE ;
  217.   RLENGTH->type = C_DOUBLE ;
  218.  
  219.   p = REmatch(string(sp)->str, (sp+1)->ptr, &length) ;
  220.  
  221.   if ( p )
  222.   { sp->dval = (double) ( p - string(sp)->str + 1 ) ;
  223.     RLENGTH->dval = (double) length ;
  224.   }
  225.   else
  226.   { sp->dval = 0.0 ;
  227.     RLENGTH->dval = -1.0 ; /* posix */
  228.   }
  229.  
  230.   free_STRING(string(sp)) ;
  231.   sp->type = C_DOUBLE ;
  232.  
  233.   RSTART->dval = sp->dval ;
  234.  
  235.   return sp ;
  236. }
  237.  
  238. CELL *bi_toupper(sp)
  239.   CELL *sp ;
  240. { STRING *old ;
  241.   register char *p, *q ;
  242.  
  243.   if ( sp->type != C_STRING )  cast1_to_s(sp) ;
  244.   old = string(sp) ;
  245.   sp->ptr = (PTR) new_STRING((char *) 0, old->len) ;
  246.  
  247.   q = string(sp)->str ; p = old->str ;
  248.  
  249.   while ( *p )
  250.   {
  251.     *q = *p++ ;
  252.     if ( *q >= 'a' && *q <= 'z' )  *q += 'A' - 'a' ;
  253.     q++ ;
  254.   }
  255.   free_STRING(old) ;
  256.   return sp ;
  257. }
  258.  
  259. CELL *bi_tolower(sp)
  260.   CELL *sp ;
  261. { STRING *old ;
  262.   register char *p, *q ;
  263.  
  264.   if ( sp->type != C_STRING )  cast1_to_s(sp) ;
  265.   old = string(sp) ;
  266.   sp->ptr = (PTR) new_STRING((char *) 0, old->len) ;
  267.  
  268.   q = string(sp)->str ; p = old->str ;
  269.  
  270.   while ( *p )
  271.   {
  272.     *q = *p++ ;
  273.     if ( *q >= 'A' && *q <= 'Z' )  *q += 'a' - 'A' ;
  274.     q++ ;
  275.   }
  276.   free_STRING(old) ;
  277.   return sp ;
  278. }
  279.  
  280.  
  281. /************************************************
  282.   arithemetic builtins
  283.  ************************************************/
  284.  
  285. static void fplib_err( fname, val, error)
  286.   char *fname ;
  287.   double val ;
  288.   char *error ;
  289. {
  290.   rt_error("%s(%g) : %s" , fname, val, error) ;
  291. }
  292.  
  293.  
  294. CELL *bi_sin(sp)
  295.   register CELL *sp ;
  296. { 
  297. #if ! STDC_MATHERR
  298.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  299.   sp->dval = sin( sp->dval ) ;
  300.   return sp ;
  301. #else
  302.   double x ;
  303.  
  304.   errno = 0 ;
  305.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  306.   x = sp->dval ;
  307.   sp->dval = sin( sp->dval ) ;
  308.   if ( errno )  fplib_err("sin", x, "loss of precision") ;
  309.   return sp ;
  310. #endif
  311. }
  312.  
  313. CELL *bi_cos(sp)
  314.   register CELL *sp ;
  315. { 
  316. #if ! STDC_MATHERR
  317.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  318.   sp->dval = cos( sp->dval ) ;
  319.   return sp ;
  320. #else
  321.   double x ;
  322.  
  323.   errno = 0 ;
  324.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  325.   x = sp->dval ;
  326.   sp->dval = cos( sp->dval ) ;
  327.   if ( errno )  fplib_err("cos", x, "loss of precision") ;
  328.   return sp ;
  329. #endif
  330. }
  331.  
  332. CELL *bi_atan2(sp)
  333.   register CELL *sp ;
  334. { 
  335. #if  !  STDC_MATHERR
  336.   sp-- ;
  337.   if ( TEST2(sp) != TWO_DOUBLES ) cast2_to_d(sp) ;
  338.   sp->dval = atan2(sp->dval, (sp+1)->dval) ;
  339.   return sp ;
  340. #else
  341.  
  342.   errno = 0 ;
  343.   sp-- ;
  344.   if ( TEST2(sp) != TWO_DOUBLES ) cast2_to_d(sp) ;
  345.   sp->dval = atan2(sp->dval, (sp+1)->dval) ;
  346.   if ( errno ) rt_error("atan2(0,0) : domain error") ;
  347.   return sp ;
  348. #endif
  349. }
  350.  
  351. CELL *bi_log(sp)
  352.   register CELL *sp ;
  353. { 
  354. #if ! STDC_MATHERR
  355.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  356.   sp->dval = log( sp->dval ) ;
  357.   return sp ;
  358. #else
  359.   double  x ;
  360.  
  361.   errno = 0 ;
  362.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  363.   x = sp->dval ;
  364.   sp->dval = log( sp->dval ) ;
  365.   if ( errno )  fplib_err("log", x, "domain error") ;
  366.   return sp ;
  367. #endif
  368. }
  369.  
  370. CELL *bi_exp(sp)
  371.   register CELL *sp ;
  372. { 
  373. #if  ! STDC_MATHERR
  374.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  375.   sp->dval = exp(sp->dval) ;
  376.   return sp ;
  377. #else
  378.   double  x ;
  379.  
  380.   errno = 0 ;
  381.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  382.   x = sp->dval ;
  383.   sp->dval = exp(sp->dval) ;
  384.   if ( errno && sp->dv