home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3350 < prev    next >
Encoding:
Internet Message Format  |  1991-05-17  |  60.7 KB
  1. From: brennan@ssc-vax.UUCP (Mike Brennan)
  2. Newsgroups: alt.sources
  3. Subject: mawk0.97.shar 2 of 6
  4. Message-ID: <3964@ssc-bee.ssc-vax.UUCP>
  5. Date: 11 May 91 14:51:06 GMT
  6.  
  7.  
  8. ------------------cut here----------------
  9.   { case C_NOINIT :  cp->dval = 0.0 ; break ;
  10.  
  11.     case C_DOUBLE :  goto two ;
  12.     case C_STRNUM :  
  13.             free_STRING( string(cp) ) ;
  14.             break ;
  15.  
  16.     case C_MBSTRN :
  17.     case C_STRING :  
  18.             s = (STRING *) cp->ptr ;
  19.  
  20. #if FPE_TRAPS  /* look for overflow error */
  21.             errno = 0 ;
  22.             cp->dval = strtod(s->str,(char **)0) ;
  23.             if ( errno && cp->dval != 0.0 ) /* ignore underflow */
  24.                 rt_error("overflow converting %s to double", s) ;
  25. #else
  26.             cp->dval = strtod(s->str,(char **)0) ;
  27. #endif
  28.             free_STRING(s) ;
  29.             break ;
  30.  
  31.     default :
  32.             bozo("cast on bad type") ;
  33.   }
  34.   cp->type = C_DOUBLE ;
  35.  
  36. two:   cp++ ;
  37.   switch( cp->type )
  38.   { case C_NOINIT :  cp->dval = 0.0 ; break ;
  39.  
  40.     case C_DOUBLE :  return ;
  41.     case C_STRNUM :  
  42.             free_STRING( string(cp) ) ;
  43.             break ;
  44.  
  45.     case C_MBSTRN :
  46.     case C_STRING :  
  47.             s = (STRING *) cp->ptr ;
  48.  
  49. #if FPE_TRAPS  /* look for overflow error */
  50.             errno = 0 ;
  51.             cp->dval = strtod(s->str,(char **)0) ;
  52.             if ( errno && cp->dval != 0.0 ) /* ignore underflow */
  53.                 rt_error("overflow converting %s to double", s) ;
  54. #else
  55.             cp->dval = strtod(s->str,(char **)0) ;
  56. #endif
  57.             free_STRING(s) ;
  58.             break ;
  59.  
  60.     default :
  61.             bozo("cast on bad type") ;
  62.   }
  63.   cp->type = C_DOUBLE ;
  64. }
  65.  
  66. void cast1_to_s( cp )
  67.   register CELL *cp ;
  68. { 
  69.   switch( cp->type )
  70.   { case C_NOINIT :  
  71.         null_str.ref_cnt++ ;
  72.         cp->ptr = (PTR) &null_str ;
  73.         break ;
  74.  
  75.     case C_DOUBLE  :
  76.         (void) sprintf(temp_buff.string_buff ,
  77.             string(field+OFMT)->str, cp->dval) ;
  78.  
  79.         cp->ptr = (PTR) new_STRING(temp_buff.string_buff) ;
  80.         break ;
  81.  
  82.     case C_STRING :  return ;
  83.  
  84.     case C_MBSTRN :
  85.     case C_STRNUM :  break ;
  86.  
  87.     default :  bozo("bad type on cast") ;
  88.   }
  89.   cp->type = C_STRING ;
  90. }
  91.  
  92. void cast2_to_s( cp )
  93.   register CELL *cp ;
  94. { 
  95.  
  96.   switch( cp->type )
  97.   { case C_NOINIT : 
  98.         null_str.ref_cnt++ ;
  99.         cp->ptr = (PTR) &null_str ;
  100.         break ;
  101.  
  102.     case C_DOUBLE  :
  103.         (void) sprintf(temp_buff.string_buff,
  104.             string(field+OFMT)->str, cp->dval ) ;
  105.  
  106.         cp->ptr = (PTR) new_STRING(temp_buff.string_buff) ;
  107.         break ;
  108.  
  109.     case C_STRING :  goto two ;
  110.  
  111.     case C_MBSTRN :
  112.     case C_STRNUM :  break ;
  113.  
  114.     default :  bozo("bad type on cast") ;
  115.   }
  116.   cp->type = C_STRING ;
  117.  
  118. two:
  119.   cp++ ;
  120.  
  121.   switch( cp->type )
  122.   { case C_NOINIT :  
  123.         null_str.ref_cnt++ ; 
  124.         cp->ptr = (PTR) &null_str ;
  125.         break ;
  126.  
  127.     case C_DOUBLE  :
  128.         (void) sprintf(temp_buff.string_buff,
  129.             string(field+OFMT)->str, cp->dval) ;
  130.  
  131.         cp->ptr = (PTR) new_STRING(temp_buff.string_buff) ;
  132.         break ;
  133.  
  134.     case C_STRING :  return ;
  135.  
  136.     case C_MBSTRN :
  137.     case C_STRNUM :  break ;
  138.  
  139.     default :  bozo("bad type on cast") ;
  140.   }
  141.   cp->type = C_STRING ;
  142. }
  143.  
  144. void  cast_to_RE( cp )
  145.   register CELL *cp ;
  146. { register PTR p ;
  147.  
  148.   if ( cp->type < C_STRING )  cast1_to_s(cp) ;
  149.  
  150.   p = re_compile( string(cp) ) ;
  151.   free_STRING( string(cp) ) ;
  152.   cp->type = C_RE ;
  153.   cp->ptr = p ;
  154.  
  155. }
  156.  
  157. void  cast_for_split(cp)
  158.   register CELL *cp ;
  159. {
  160.   static char meta[] = "^$.*+?|[]()" ;
  161.   static char xbuff[] = "\\X" ;
  162.   int c ;
  163.   unsigned len ;
  164.     
  165.   if ( cp->type < C_STRING )  cast1_to_s(cp) ;
  166.  
  167.   if ( (len = string(cp)->len) == 1 )
  168.   {
  169.         if ( (c = string(cp)->str[0]) == ' ' )
  170.         { free_STRING(string(cp)) ;
  171.           cp->type = C_SPACE ; 
  172.           return ; 
  173.         }
  174.         else
  175.         if ( strchr(meta, c) )
  176.         { xbuff[1] = c ;
  177.           free_STRING(string(cp)) ;
  178.           cp->ptr = (PTR) new_STRING(xbuff) ;
  179.         }
  180.   }
  181.   else
  182.   if ( len == 0 ) 
  183.   { free_STRING(string(cp)) ;
  184.     cp->type = C_SNULL ; 
  185.     return ; 
  186.   }
  187.  
  188.   cast_to_RE(cp) ;
  189. }
  190.  
  191. /* input: cp-> a CELL of type C_MBSTRN (maybe strnum)
  192.    test it -- casting it to the appropriate type
  193.    which is C_STRING or C_STRNUM
  194. */
  195.  
  196. void check_strnum( cp )
  197.   CELL *cp ;
  198. { char *test ;
  199.   register unsigned char *s , *q ;
  200.  
  201.   cp->type = C_STRING ; /* assume not C_STRNUM */
  202.   s = (unsigned char *) string(cp)->str ;
  203.   q = s + string(cp)->len ;
  204.   while ( scan_code[*s] == SC_SPACE )  s++ ;
  205.   if ( s == q )  return ;
  206.  
  207.   while ( scan_code[ q[-1] ] == SC_SPACE )  q-- ;
  208.   if ( scan_code[ q[-1] ] != SC_DIGIT &&
  209.        q[-1] != '.' )   return ;
  210.  
  211.   switch ( scan_code[*s] )
  212.   {
  213.     case SC_DIGIT :
  214.     case SC_PLUS  :
  215.     case SC_MINUS :
  216.     case SC_DOT   :
  217.  
  218. #if FPE_TRAPS
  219.              errno = 0 ;
  220.              cp->dval  = strtod((char *)s, &test) ;
  221.              if ( errno && cp->dval != 0.0 )
  222.                 rt_error(
  223.                 "overflow converting %s to double" , s) ;
  224. #else
  225.              cp->dval = strtod(s, &test) ;
  226. #endif
  227.  
  228.              if ((char *) q == test )  cp->type = C_STRNUM ;
  229.   }
  230. }
  231.  
  232. /* cast a CELL to a replacement cell */
  233.  
  234. void cast_to_REPL( cp )
  235.   register CELL *cp ;
  236. { register STRING *sval ;
  237.  
  238.   if ( cp->type < C_STRING )  cast1_to_s(cp) ;
  239.   sval = (STRING *) cp->ptr ;
  240.  
  241.   (void) cellcpy(cp, repl_compile(sval)) ;
  242.   free_STRING(sval) ;
  243. }
  244.  
  245.  
  246. #if   NO_STRTOD
  247.  
  248. static char d_str[] =
  249. "^[ \t]*[-+]?([0-9]+\\.?|\\.[0-9])[0-9]*([eE][-+]?[0-9]+)?" ;
  250.  
  251. static PTR d_ptr ;
  252.  
  253. void strtod_init()
  254. { STRING *sval = new_STRING(d_str) ;
  255.  
  256.   d_ptr = re_compile(sval) ;
  257.   free_STRING(sval) ;
  258. }
  259.  
  260. double strtod( s, endptr)
  261.   char *s , **endptr ;
  262. { double atof() ;
  263.  
  264.   if ( endptr )
  265.   { unsigned len ;
  266.  
  267.     (void) REmatch(s, d_ptr, &len) ;
  268.     *endptr = s + len ;
  269.   }
  270.   return  atof(s) ;
  271. }
  272. #endif  /* NO_STRTOD */
  273.  
  274. #if   NO_FMOD
  275.  
  276. double  fmod(x, y)
  277.   double x, y ;
  278. { double modf() ;
  279.   double ipart ;
  280.  
  281.   return modf(x/y, &ipart) * y ;
  282. }
  283.  
  284. #endif  /* NO_FMOD */
  285.  
  286.  
  287.  
  288. @//E*O*F mawk0.97/cast.c//
  289. chmod u=rw,g=r,o=r mawk0.97/cast.c
  290.  
  291. echo x - mawk0.97/code.c
  292. sed 's/^@//' > "mawk0.97/code.c" <<'@//E*O*F mawk0.97/code.c//'
  293.  
  294. /********************************************
  295. code.c
  296. copyright 1991, Michael D. Brennan
  297.  
  298. This is a source file for mawk, an implementation of
  299. the Awk programming language as defined in
  300. Aho, Kernighan and Weinberger, The AWK Programming Language,
  301. Addison-Wesley, 1988.
  302.  
  303. See the accompaning file, LIMITATIONS, for restrictions
  304. regarding modification and redistribution of this
  305. program in source or binary form.
  306. ********************************************/
  307.  
  308.  
  309. /* $Log:    code.c,v $
  310.  * Revision 2.1  91/04/08  08:22:46  brennan
  311.  * VERSION 0.97
  312.  * 
  313. */
  314.  
  315. /*  code.c  */
  316.  
  317. #include "mawk.h"
  318. #include "code.h"
  319. #include "init.h"
  320.  
  321.  
  322. #define   CODE_SZ      (PAGE_SZ*sizeof(INST))
  323.  
  324. INST *code_ptr  ;
  325. INST *main_start , *main_code_ptr ;
  326. INST *begin_start , *begin_code_ptr ;
  327. INST *end_start , *end_code_ptr ;
  328. unsigned  main_size, begin_size, end_size ;
  329.  
  330. void  PROTO(fdump, (void) ) ;
  331.  
  332. void  code_init()
  333. { 
  334.   main_code_ptr = main_start = (INST *) zmalloc(CODE_SZ) ;
  335.   begin_code_ptr = begin_start = (INST *) zmalloc(CODE_SZ) ;
  336.   end_code_ptr = end_start = (INST *) zmalloc(CODE_SZ) ;
  337.   code_ptr = main_code_ptr ;
  338. }
  339.  
  340. void code_cleanup()
  341. {
  342.   if ( dump_code )  fdump() ; /* dumps all functions */
  343.  
  344.   begin_code_ptr++->op = _HALT ;
  345.   if ( (begin_size = begin_code_ptr - begin_start) == 1 ) /* empty */
  346.   {
  347.       zfree( begin_start, CODE_SZ ) ;
  348.       begin_start = (INST *) 0 ;
  349.   }
  350.   else
  351.   if ( begin_size > PAGE_SZ ) overflow("BEGIN code" , PAGE_SZ) ;
  352.   else
  353.   {  begin_size *= sizeof(INST) ;
  354.      begin_start = (INST *) zrealloc(begin_start,CODE_SZ,begin_size) ;
  355.      if ( dump_code )
  356.      { fprintf(stderr, "BEGIN\n") ;
  357.        da(begin_start, stderr) ; 
  358.      }
  359.   }
  360.  
  361.   end_code_ptr++->op = _HALT ;
  362.   if ( (end_size = end_code_ptr - end_start) == 1 ) /* empty */
  363.   {
  364.       zfree( end_start, CODE_SZ ) ;
  365.       end_start = (INST *) 0 ;
  366.   }
  367.   else
  368.   if ( end_size > PAGE_SZ ) overflow("END code" , PAGE_SZ) ;
  369.   else
  370.   {  end_size *= sizeof(INST) ;
  371.      end_start = (INST *) zrealloc(end_start, CODE_SZ, end_size) ;
  372.      if ( dump_code )
  373.      { fprintf(stderr, "END\n") ;
  374.        da(end_start, stderr) ;
  375.      }
  376.   }
  377.  
  378.   code_ptr++->op = _HALT ;
  379.   if ( (main_size = code_ptr - main_start) == 1 ) /* empty */
  380.   {
  381.       zfree( main_start, CODE_SZ ) ;
  382.       main_start = (INST *) 0 ;
  383.   }
  384.   else
  385.   if ( main_size > PAGE_SZ ) overflow("MAIN code" , PAGE_SZ) ;
  386.   else
  387.   {  main_size *= sizeof(INST) ;
  388.      main_start = (INST *) zrealloc(main_start, CODE_SZ, main_size) ;
  389.      if ( dump_code )
  390.      { fprintf(stderr, "MAIN\n") ;
  391.        da(main_start, stderr) ;
  392.      }
  393.   }
  394. }
  395. @//E*O*F mawk0.97/code.c//
  396. chmod u=rw,g=r,o=r mawk0.97/code.c
  397.  
  398. echo x - mawk0.97/code.h
  399. sed 's/^@//' > "mawk0.97/code.h" <<'@//E*O*F mawk0.97/code.h//'
  400.  
  401. /********************************************
  402. code.h
  403. copyright 1991, Michael D. Brennan
  404.  
  405. This is a source file for mawk, an implementation of
  406. the Awk programming language as defined in
  407. Aho, Kernighan and Weinberger, The AWK Programming Language,
  408. Addison-Wesley, 1988.
  409.  
  410. See the accompaning file, LIMITATIONS, for restrictions
  411. regarding modification and redistribution of this
  412. program in source or binary form.
  413. ********************************************/
  414.  
  415.  
  416. /* $Log:    code.h,v $
  417.  * Revision 2.1  91/04/08  08:22:48  brennan
  418.  * VERSION 0.97
  419.  * 
  420. */
  421.  
  422.  
  423. /*  code.h  */
  424.  
  425. #ifndef  CODE_H
  426. #define  CODE_H
  427.  
  428. #include "memory.h"
  429. #include <setjmp.h>
  430.  
  431. /* coding scope */
  432. #define   SCOPE_MAIN    0
  433. #define   SCOPE_BEGIN   1  
  434. #define   SCOPE_END     2
  435. #define   SCOPE_FUNCT   3
  436.  
  437.  
  438. extern  INST  *code_ptr ;
  439. extern  INST  *begin_start , *begin_code_ptr ;
  440. extern  INST  *end_start , *end_code_ptr ;
  441. extern  INST  *main_start, *main_code_ptr ;
  442. extern  unsigned begin_size, end_size, main_size ;
  443.  
  444. extern  CELL  eval_stack[] ;
  445.  
  446.  
  447. #define  code1(x)  code_ptr++ -> op = (x)
  448.  
  449. #define  code2(x,y)    (void)( code_ptr++ -> op = (x) ,\
  450.                          code_ptr++ -> ptr = (PTR)(y) )
  451.  
  452.  
  453. /*  the machine opcodes  */
  454.  
  455. #define _HALT            0
  456. #define _STOP            1
  457. #define _STOP0           2  
  458. #define _PUSHC           3
  459. #define _PUSHINT         4
  460. #define _PUSHA           5
  461. #define _PUSHI           6
  462. #define L_PUSHA          7
  463. #define L_PUSHI          8
  464. #define AE_PUSHA         9
  465. #define AE_PUSHI        10
  466. #define A_PUSHA         11
  467. #define LAE_PUSHA       12
  468. #define LAE_PUSHI       13
  469. #define LA_PUSHA        14
  470. #define F_PUSHA         15
  471. #define FE_PUSHA        16
  472. #define F_PUSHI         17
  473. #define FE_PUSHI        18
  474. #define _POP            19
  475. #define _PULL           20
  476. #define _DUP            21
  477. #define _ADD            22
  478. #define _SUB            23
  479. #define _MUL            24
  480. #define _DIV            25
  481. #define _MOD            26
  482. #define _POW            27
  483. #define _NOT            28
  484. #define _TEST           29
  485. #define A_TEST          30
  486. #define A_DEL           31
  487. #define A_LOOP          32
  488. #define A_CAT           33
  489. #define _UMINUS         34
  490. #define _UPLUS          35
  491. #define _ASSIGN         36
  492. #define _ADD_ASG        37
  493. #define _SUB_ASG        38
  494. #define _MUL_ASG        39
  495. #define _DIV_ASG        40
  496. #define _MOD_ASG        41
  497. #define _POW_ASG        42
  498. #define F_ASSIGN        43
  499. #define F_ADD_ASG       44
  500. #define F_SUB_ASG       45
  501. #define F_MUL_ASG       46
  502. #define F_DIV_ASG       47
  503. #define F_MOD_ASG       48
  504. #define F_POW_ASG       49
  505. #define _CAT            50
  506. #define _BUILTIN        51
  507. #define _PRINT          52
  508. #define _POST_INC       53
  509. #define _POST_DEC       54
  510. #define _PRE_INC        55
  511. #define _PRE_DEC        56
  512. #define F_POST_INC      57
  513. #define F_POST_DEC      58
  514. #define F_PRE_INC       59
  515. #define F_PRE_DEC       60
  516. #define _JMP            61
  517. #define _JNZ            62
  518. #define _JZ             63
  519. #define _EQ             64
  520. #define _NEQ            65
  521. #define _LT             66
  522. #define _LTE            67
  523. #define _GT             68
  524. #define _GTE            69
  525. #define _MATCH          70
  526. #define _EXIT           71
  527. #define _EXIT0          72
  528. #define _NEXT           73
  529. #define _RANGE          74
  530. #define _CALL           75
  531. #define _RET            76
  532. #define _RET0           77
  533.  
  534.  
  535. /* next and exit statements */
  536.  
  537. extern jmp_buf  exit_jump, next_jump ;
  538. extern int exit_code ;
  539.  
  540. #endif  /* CODE_H */
  541. @//E*O*F mawk0.97/code.h//
  542. chmod u=rw,g=r,o=r mawk0.97/code.h
  543.  
  544. echo x - mawk0.97/da.c
  545. sed 's/^@//' > "mawk0.97/da.c" <<'@//E*O*F mawk0.97/da.c//'
  546.  
  547. /********************************************
  548. da.c
  549. copyright 1991, Michael D. Brennan
  550.  
  551. This is a source file for mawk, an implementation of
  552. the Awk programming language as defined in
  553. Aho, Kernighan and Weinberger, The AWK Programming Language,
  554. Addison-Wesley, 1988.
  555.  
  556. See the accompaning file, LIMITATIONS, for restrictions
  557. regarding modification and redistribution of this
  558. program in source or binary form.
  559. ********************************************/
  560.  
  561.  
  562. /* $Log:    da.c,v $
  563.  * Revision 2.1  91/04/08  08:22:50  brennan
  564.  * VERSION 0.97
  565.  * 
  566. */
  567.  
  568.  
  569. /*  da.c  */
  570. /*  disassemble code */ 
  571.  
  572.  
  573. #include  "mawk.h"
  574. #include  "code.h"
  575. #include  "bi_funct.h"
  576. #include  "repl.h"
  577. #include  "field.h"
  578.  
  579. char *PROTO(find_bi_name, (PF_CP) ) ;
  580.  
  581. void  da(start, fp)
  582.   INST *start ;
  583.   FILE *fp ;
  584. { CELL *cp ;
  585.   register INST *p = start ;
  586.  
  587.   while ( 1 )
  588.   { /* print the relative code address (label) */
  589.     fprintf(fp,"%03d ", p - start) ;
  590.  
  591.     switch( p++->op )
  592.     {
  593.       case _HALT :  fprintf(fp,"halt\n") ; return ;
  594.       case _STOP :  fprintf(fp,"stop\n") ; break  ;
  595.       case _STOP0 : fprintf(fp, "stop0\n") ; break ;
  596.  
  597.       case _PUSHC :
  598.             cp = (CELL *) p++->ptr ;
  599.             switch( cp->type )
  600.             { case C_DOUBLE :
  601.                   fprintf(fp,"pushc\t%.6g\n" ,  cp ->dval) ;
  602.                   break ;
  603.  
  604.               case C_STRING :
  605.                   fprintf(fp,"pushc\t\"%s\"\n" ,
  606.                           ((STRING *)cp->ptr)->str) ;
  607.                   break ;
  608.  
  609.               case C_RE :
  610.                   fprintf(fp,"pushc\t0x%x\t/%s/\n" , cp->ptr ,
  611.                     re_uncompile(cp->ptr) ) ;
  612.                   break ;
  613.  
  614.               case C_SPACE : 
  615.                   fprintf(fp, "pushc\tspace split\n") ;
  616.                   break ;
  617.  
  618.               case C_SNULL : 
  619.                   fprintf(fp, "pushc\tnull split\n") ;
  620.                   break ;
  621.               case C_REPL  :
  622.                   fprintf(fp, "pushc\trepl\t%s\n" ,
  623.                         repl_uncompile(cp) ) ;
  624.                   break ;
  625.               case C_REPLV :
  626.                   fprintf(fp, "pushc\treplv\t%s\n" ,
  627.                         repl_uncompile(cp) ) ;
  628.                   break ;
  629.                   
  630.               default :
  631.                   fprintf(fp,"pushc\tWEIRD\n") ;  ;
  632.                   break ;
  633.             }
  634.             break ;
  635.  
  636.       case _PUSHA :
  637.             fprintf(fp,"pusha\t0x%x\n", p++ -> ptr) ;
  638.             break ;
  639.  
  640.       case _PUSHI :
  641.             if ( (CELL *)p->ptr == field )
  642.                 fprintf(fp, "pushi\t$0\n") ;
  643.             else fprintf(fp,"pushi\t0x%x\n", p -> ptr) ;
  644.             p++ ;
  645.             break ;
  646.  
  647.       case  L_PUSHA :
  648.             fprintf( fp, "l_pusha\t%d\n", p++->op) ;
  649.             break ;
  650.  
  651.       case  L_PUSHI :
  652.             fprintf( fp, "l_pushi\t%d\n", p++->op) ;
  653.             break ;
  654.  
  655.       case  LAE_PUSHI :
  656.             fprintf( fp, "lae_pushi\t%d\n", p++->op) ;
  657.             break ;
  658.  
  659.       case  LAE_PUSHA :
  660.             fprintf( fp, "lae_pusha\t%d\n", p++->op) ;
  661.             break ;
  662.  
  663.       case  LA_PUSHA :
  664.             fprintf( fp, "la_pusha\t%d\n", p++->op) ;
  665.             break ;
  666.  
  667.       case F_PUSHA :
  668.             fprintf(fp,"f_pusha\t$%d\n" , (CELL *) p++->ptr - field ) ;
  669.             break ;
  670.  
  671.       case F_PUSHI :
  672.             fprintf(fp,"f_pushi\t$%d\n" , (CELL *) p++->ptr - field ) ;
  673.             break ;
  674.  
  675.       case FE_PUSHA :
  676.             fprintf(fp,"fe_pusha\n" ) ;
  677.             break ;
  678.  
  679.       case FE_PUSHI :
  680.             fprintf(fp,"fe_pushi\n" ) ;
  681.             break ;
  682.  
  683.       case AE_PUSHA :
  684.             fprintf(fp,"ae_pusha\t0x%x\n" , p++->ptr) ;
  685.             break ;
  686.  
  687.       case AE_PUSHI :
  688.             fprintf(fp,"ae_pushi\t0x%x\n" , p++->ptr) ;
  689.             break ;
  690.  
  691.       case A_PUSHA :
  692.             fprintf(fp,"a_pusha\t0x%x\n" , p++->ptr) ;
  693.             break ;
  694.  
  695.       case A_TEST :
  696.             fprintf(fp,"a_test\n" ) ;
  697.             break ;
  698.  
  699.       case A_DEL :
  700.             fprintf(fp,"a_del\n" ) ;
  701.             break ;
  702.  
  703.       case A_CAT :
  704.             fprintf(fp,"a_cat\t%d\n", p++->op ) ;
  705.             break ;
  706.  
  707.       case _POP :
  708.             fprintf(fp,"pop\n") ;
  709.             break ;
  710.  
  711.       case  _ADD :
  712.             fprintf(fp,"add\n") ; break ;
  713.  
  714.       case  _SUB :
  715.             fprintf(fp,"sub\n") ; break ;
  716.       case  _MUL :
  717.             fprintf(fp,"mul\n") ; break ;
  718.       case  _DIV :
  719.             fprintf(fp,"div\n") ; break ;
  720.       case  _MOD :
  721.             fprintf(fp,"mod\n") ; break ;
  722.       case  _POW :
  723.             fprintf(fp,"pow\n") ; break ;
  724.       case  _NOT :
  725.             fprintf(fp,"not\n") ; break ;
  726.       case  _UMINUS :
  727.             fprintf(fp,"uminus\n") ; break ;
  728.       case  _UPLUS :
  729.             fprintf(fp,"plus\n") ; break ;
  730.       case  _DUP :
  731.             fprintf(fp,"dup\n") ; break ;
  732.       case  _TEST :
  733.             fprintf(fp,"test\n") ; break ;
  734.  
  735.       case  _CAT  :
  736.             fprintf(fp,"cat\n") ; break ;
  737.  
  738.       case  _ASSIGN :
  739.             fprintf(fp,"assign\n") ; break ;
  740.       case  _ADD_ASG :
  741.             fprintf(fp,"add_asg\n") ; break ;
  742.       case  _SUB_ASG :
  743.             fprintf(fp,"sub_asg\n") ; break ;
  744.       case  _MUL_ASG :
  745.             fprintf(fp,"mul_asg\n") ; break ;
  746.       case  _DIV_ASG :
  747.             fprintf(fp,"div_asg\n") ; break ;
  748.       case  _MOD_ASG :
  749.             fprintf(fp,"mod_asg\n") ; break ;
  750.       case  _POW_ASG :
  751.             fprintf(fp,"pow_asg\n") ; break ;
  752.  
  753.       case  F_ASSIGN :
  754.             fprintf(fp,"f_assign\n") ; break ;
  755.       case  F_ADD_ASG :
  756.             fprintf(fp,"f_add_asg\n") ; break ;
  757.       case  F_SUB_ASG :
  758.             fprintf(fp,"f_sub_asg\n") ; break ;
  759.       case  F_MUL_ASG :
  760.             fprintf(fp,"f_mul_asg\n") ; break ;
  761.       case  F_DIV_ASG :
  762.             fprintf(fp,"f_div_asg\n") ; break ;
  763.       case  F_MOD_ASG :
  764.             fprintf(fp,"f_mod_asg\n") ; break ;
  765.       case  F_POW_ASG :
  766.             fprintf(fp,"f_pow_asg\n") ; break ;
  767.  
  768.       case  _PUSHINT :
  769.             fprintf(fp,"pushint\t%d\n" , p++ -> op ) ;
  770.             break ;
  771.  
  772.       case  _BUILTIN  :
  773.             fprintf(fp,"%s\n" , 
  774.                     find_bi_name( (PF_CP) p++ -> ptr ) ) ;
  775.             break ;
  776.  
  777.       case  _PRINT :
  778.             fprintf(fp,"%s\n", 
  779.             (PF_CP) p++ -> ptr == bi_printf
  780.                 ? "printf" : "print") ;
  781.             break ;
  782.       
  783.       case  _POST_INC :
  784.             fprintf(fp,"post_inc\n") ; break ;
  785.  
  786.       case  _POST_DEC :
  787.             fprintf(fp,"post_dec\n") ; break ;
  788.  
  789.       case  _PRE_INC :
  790.             fprintf(fp,"pre_inc\n") ; break ;
  791.  
  792.       case  _PRE_DEC :
  793.             fprintf(fp,"pre_dec\n") ; break ;
  794.  
  795.       case  F_POST_INC :
  796.             fprintf(fp,"f_post_inc\n") ; break ;
  797.  
  798.       case  F_POST_DEC :
  799.             fprintf(fp,"f_post_dec\n") ; break ;
  800.  
  801.       case  F_PRE_INC :
  802.             fprintf(fp,"f_pre_inc\n") ; break ;
  803.  
  804.       case  F_PRE_DEC :
  805.             fprintf(fp,"f_pre_dec\n") ; break ;
  806.  
  807.       case  _JMP :
  808.       case  _JNZ :
  809.       case  _JZ  :
  810.           { int j = (p-1)->op ;
  811.             char *s = j == _JMP ? "jmp" : 
  812.                       j == _JNZ ? "jnz" : "jz" ;
  813.  
  814.             fprintf(fp,"%s\t\t%03d\n" , s ,
  815.               (p - start) + p->op - 1 ) ;
  816.             p++ ;
  817.             break ;
  818.           }
  819.     
  820.       case  _EQ  :
  821.             fprintf(fp,"eq\n") ; break ;
  822.  
  823.       case  _NEQ  :
  824.             fprintf(fp,"neq\n") ; break ;
  825.  
  826.       case  _LT  :
  827.             fprintf(fp,"lt\n") ; break ;
  828.  
  829.       case  _LTE  :
  830.             fprintf(fp,"lte\n") ; break ;
  831.  
  832.       case  _GT  :
  833.             fprintf(fp,"gt\n") ; break ;
  834.  
  835.       case  _GTE  :
  836.             fprintf(fp,"gte\n") ; break ;
  837.  
  838.       case  _MATCH :
  839.             fprintf(fp,"match_op\n") ; break ;
  840.  
  841.       case  A_LOOP :
  842.             fprintf(fp,"a_loop\t%03d\n", p-start+p[1].op) ;
  843.             p += 2 ;
  844.             break ;
  845.  
  846.       case  _EXIT  :
  847.             fprintf(fp, "exit\n") ; break ;
  848.  
  849.       case  _EXIT0  :
  850.             fprintf(fp, "exit0\n") ; break ;
  851.  
  852.       case  _NEXT  :
  853.             fprintf(fp, "next\n") ; break ;
  854.  
  855.       case  _RET  :
  856.             fprintf(fp, "ret\n") ; break ;
  857.       case  _RET0 :
  858.             fprintf(fp, "ret0\n") ; break ;
  859.  
  860.       case  _CALL :
  861.             fprintf(fp, "call\t%s\t%d\n", 
  862.                 ((FBLOCK*)p->ptr)->name , p[1].op) ;
  863.             p += 2 ;
  864.             break ;
  865.  
  866.       case  _RANGE :
  867.             fprintf(fp, "range\t%03d %03d %03d\n",
  868.               /* label for pat2, action, follow */
  869.               p - start + p[1].op ,
  870.               p - start + p[2].op ,
  871.               p - start + p[3].op ) ;
  872.             p += 4 ; 
  873.             break ;
  874.       default :
  875.             fprintf(fp,"bad instruction\n") ;
  876.             return ;
  877.     }
  878.   }
  879. }
  880.  
  881. static struct {
  882. PF_CP action ;
  883. char *name ;
  884. } special_cases[] = {
  885. bi_length, "length",
  886. bi_split, "split",
  887. bi_match, "match",
  888. bi_getline,"getline",
  889. bi_sub, "sub",
  890. bi_gsub , "gsub",
  891. (PF_CP) 0, (char *) 0 } ;
  892.  
  893. static char *find_bi_name( p )
  894.   PF_CP p ;
  895. { BI_REC *q ;
  896.   int i ;
  897.  
  898.   for( q = bi_funct ; q->name ; q++ )
  899.     if ( q->fp == p )  /* found */
  900.         return q->name ;
  901.   /* next check some special cases */
  902.   for( i = 0 ; special_cases[i].action ; i++)
  903.     if ( special_cases[i].action == p )
  904.         return  special_cases[i].name ;
  905.  
  906.   return  "unknown builtin" ;
  907. }
  908.  
  909. static struct fdump {
  910. struct fdump *link ;
  911. FBLOCK  *fbp ;
  912. }  *fdump_list ;  /* linked list of all user functions */
  913.  
  914. void add_to_fdump_list( fbp )
  915.   FBLOCK *fbp ;
  916. { struct fdump *p = (struct fdump *)zmalloc(sizeof(struct fdump)) ;
  917.   p->fbp = fbp ;
  918.   p->link = fdump_list ;  fdump_list = p ;
  919. }
  920.  
  921. void  fdump()
  922. {
  923.   register struct fdump *p, *q = fdump_list ;
  924.  
  925.   while ( p = q )
  926.   { q = p->link ;
  927.     fprintf(stderr, "function %s\n" , p->fbp->name) ;
  928.     da(p->fbp->code, stderr) ;
  929.     zfree(p, sizeof(struct fdump)) ;
  930.   }
  931. }
  932. @//E*O*F mawk0.97/da.c//
  933. chmod u=rw,g=r,o=r mawk0.97/da.c
  934.  
  935. echo x - mawk0.97/error.c
  936. sed 's/^@//' > "mawk0.97/error.c" <<'@//E*O*F mawk0.97/error.c//'
  937.  
  938. /********************************************
  939. error.c
  940. copyright 1991, Michael D. Brennan
  941.  
  942. This is a source file for mawk, an implementation of
  943. the Awk programming language as defined in
  944. Aho, Kernighan and Weinberger, The AWK Programming Language,
  945. Addison-Wesley, 1988.
  946.  
  947. See the accompaning file, LIMITATIONS, for restrictions
  948. regarding modification and redistribution of this
  949. program in source or binary form.
  950. ********************************************/
  951.  
  952.  
  953. /* $Log:    error.c,v $
  954.  * Revision 2.2  91/04/09  12:38:52  brennan
  955.  * added static to funct decls to satisfy STARDENT compiler
  956.  * 
  957.  * Revision 2.1  91/04/08  08:22:52  brennan
  958.  * VERSION 0.97
  959.  * 
  960. */
  961.  
  962.  
  963. #include  "mawk.h"
  964. #include  "scan.h"
  965. #include  "bi_vars.h"
  966.  
  967. #ifndef  EOF
  968. #define  EOF  (-1)
  969. #endif
  970.  
  971. /* statics */
  972. static void  PROTO( check_FILENAME, (void) ) ;
  973. static void  PROTO( unexpected_char, (void) ) ;
  974. static void  PROTO( missing, (int, char *, int) ) ;
  975. static char *PROTO( type_to_str, (int) ) ;
  976.  
  977.  
  978. static struct token_str  {
  979. short token ;
  980. char *str ; }  token_str[] = {
  981. EOF , "end of file" ,
  982. NL , "end of line",
  983. SEMI_COLON , ";" ,
  984. LBRACE , "{" ,
  985. RBRACE , "}" ,
  986. SC_FAKE_SEMI_COLON, "}",
  987. LPAREN , "(" ,
  988. RPAREN , ")" ,
  989. LBOX , "[",
  990. RBOX , "]",
  991. QMARK , "?",
  992. COLON , ":",
  993. OR, "||",
  994. AND, "&&",
  995. P_OR, "||",
  996. P_AND, "&&",
  997. ASSIGN , "=" ,
  998. ADD_ASG, "+=",
  999. SUB_ASG, "-=",
  1000. MUL_ASG, "*=",
  1001. DIV_ASG, "/=",
  1002. MOD_ASG, "%=",
  1003. POW_ASG, "^=",
  1004. EQ  , "==" ,
  1005. NEQ , "!=",
  1006. LT, "<" ,
  1007. LTE, "<=" ,
  1008. GT, ">",
  1009. GTE, ">=" ,
  1010. MATCH, "~",
  1011. NOT_MATCH, "!~",
  1012. PLUS , "+" ,
  1013. MINUS, "-" ,
  1014. MUL , "*" ,
  1015. DIV, "/"  , 
  1016. MOD, "%" ,
  1017. POW, "^" ,
  1018. INC , "++" ,
  1019. DEC , "--" ,
  1020. NOT, "!" ,
  1021. COMMA, "," ,
  1022. CONSTANT , temp_buff.string_buff ,
  1023. ID , temp_buff.string_buff ,
  1024. FUNCT_ID , temp_buff.string_buff ,
  1025. BUILTIN , temp_buff.string_buff ,
  1026. IO_OUT, temp_buff.string_buff, 
  1027. IO_IN, "<" ,
  1028. PIPE, "|" ,
  1029. DOLLAR, "$" ,
  1030. FIELD, "$" ,
  1031. 0, (char *) 0 } ;
  1032.  
  1033. /* if paren_cnt >0 and we see one of these, we are missing a ')' */
  1034. static int missing_rparen[] =
  1035. { EOF, NL, SEMI_COLON, SC_FAKE_SEMI_COLON, RBRACE, 0 } ;
  1036.  
  1037. /* ditto for '}' */
  1038. static int missing_rbrace[] =
  1039. { EOF, BEGIN, END , 0 } ;
  1040.  
  1041. static void missing( c, n , ln)
  1042.   int c ;
  1043.   char *n ;
  1044.   int ln ;
  1045. { errmsg(0, "line %u: missing %c near %s" , ln, c, n) ; }
  1046.   
  1047. void  yyerror(s)
  1048.   char *s ; /* we won't use s as input 
  1049.   (yacc and bison force this).
  1050.   We will use s for storage to keep lint or the compiler
  1051.   off our back */
  1052. { struct token_str *p ;
  1053.   int *ip ;
  1054.  
  1055.   s = (char *) 0 ;
  1056.  
  1057.   for ( p = token_str ; p->token ; p++ )
  1058.       if ( current_token == p->token )
  1059.       { s = p->str ; break ; }
  1060.  
  1061.   if ( ! s )  /* search the keywords */
  1062.          s = find_kw_str(current_token) ;
  1063.  
  1064.   if ( s )
  1065.   {
  1066.     if ( paren_cnt )
  1067.         for( ip = missing_rparen ; *ip ; ip++)
  1068.           if ( *ip == current_token )
  1069.           { missing(')', s, token_lineno) ;
  1070.             paren_cnt = 0 ;
  1071.             goto done ;
  1072.           }
  1073.  
  1074.     if ( brace_cnt )
  1075.         for( ip = missing_rbrace ; *ip ; ip++)
  1076.           if ( *ip == current_token )
  1077.           { missing('}', s, token_lineno) ;
  1078.             brace_cnt = 0 ;
  1079.             goto done ;
  1080.           }
  1081.  
  1082.     compile_error("syntax error at or near %s", s) ;
  1083.  
  1084.   }
  1085.   else  /* special cases */
  1086.   switch ( current_token )
  1087.   {
  1088.     case UNEXPECTED :
  1089.             unexpected_char() ; 
  1090.             goto done ;
  1091.  
  1092.     case BAD_DECIMAL :
  1093.             compile_error(
  1094.               "syntax error in decimal constant %s",
  1095.               temp_buff.string_buff ) ;
  1096.             break ;
  1097.  
  1098.     case RE :
  1099.             compile_error(
  1100.             "syntax error at or near /%s/", 
  1101.             temp_buff.string_buff ) ;
  1102.             break ;
  1103.  
  1104.     default :
  1105.             compile_error("syntax error") ;
  1106.             break ;
  1107.   }
  1108.   return ;
  1109.  
  1110. done :
  1111.   if ( ++compile_error_count == MAX_COMPILE_ERRORS ) mawk_exit(1) ;
  1112. }
  1113.  
  1114. /* system provided errnos and messages */
  1115. extern int sys_nerr ;
  1116. extern char *sys_errlist[] ;
  1117.  
  1118. #ifdef  __STDC__
  1119. #include <stdarg.h>
  1120.  
  1121. /* generic error message with a hook into the system error 
  1122.    messages if errnum > 0 */
  1123.  
  1124. void  errmsg(int errnum, char *format, ...)
  1125. { va_list args ;
  1126.  
  1127.   fprintf(stderr, "%s: " , progname) ;
  1128.   va_start(args, format) ;
  1129.   (void) vfprintf(stderr, format, args) ;
  1130.   va_end(args) ;
  1131.   if ( errnum > 0 && errnum < sys_nerr )
  1132.     fprintf(stderr, " (%s)" , sys_errlist[errnum]) ;
  1133.   fprintf( stderr, "\n") ;
  1134. }
  1135.  
  1136. void  compile_error(char *format, ...)
  1137. { va_list args ;
  1138.  
  1139.   fprintf(stderr, "%s: line %u: " , progname, token_lineno) ;
  1140.   va_start(args, format) ;
  1141.   vfprintf(stderr, format, args) ;
  1142.   va_end(args) ;
  1143.   fprintf(stderr, "\n") ;
  1144.   if ( ++compile_error_count == MAX_COMPILE_ERRORS ) mawk_exit(1) ;
  1145. }
  1146.  
  1147. void  rt_error( char *format, ...)
  1148. { va_list args ;
  1149.  
  1150.   fprintf(stderr, "%s: run time error: " , progname ) ;
  1151.   va_start(args, format) ;
  1152.   vfprintf(stderr, format, args) ;
  1153.   va_end(args) ;
  1154.   check_FILENAME() ;
  1155.   fprintf(stderr, "\n\t(FILENAME=\"%s\" FNR=%g NR=%g)\n" ,
  1156.      string(bi_vars+FILENAME)->str, bi_vars[FNR].dval,
  1157.      bi_vars[NR].dval) ;
  1158.   mawk_exit(1) ;
  1159. }
  1160.  
  1161. #else
  1162.  
  1163. #include <varargs.h>
  1164.  
  1165. /*  void errmsg(errnum, format, ...) */
  1166.  
  1167. void  errmsg( va_alist)
  1168.   va_dcl
  1169. { va_list ap ;
  1170.   int errnum ;
  1171.   char *format ;
  1172.  
  1173.   fprintf(stderr, "%s: " , progname) ;
  1174.   va_start(ap) ;
  1175.   errnum = va_arg(ap, int) ;
  1176.   format = va_arg(ap, char *) ;
  1177.   (void) vfprintf(stderr, format, ap) ;
  1178.   if ( errnum > 0 && errnum < sys_nerr )
  1179.     fprintf(stderr, " (%s)" , sys_errlist[errnum]) ;
  1180.   fprintf( stderr, "\n") ;
  1181. }
  1182.  
  1183. void compile_error( va_alist )
  1184.   va_dcl
  1185. { va_list args ;
  1186.   char *format ;
  1187.  
  1188.   fprintf(stderr, "%s: line %u: " , progname, token_lineno) ;
  1189.   va_start(args) ;
  1190.   format = va_arg(args, char *) ;
  1191.   vfprintf(stderr, format, args) ;
  1192.   va_end(args) ;
  1193.   fprintf(stderr, "\n") ;
  1194.   if ( ++compile_error_count == MAX_COMPILE_ERRORS ) mawk_exit(1) ;
  1195. }
  1196.  
  1197. void  rt_error( va_alist )
  1198.   va_dcl
  1199. { va_list args ;
  1200.   char *format ;
  1201.  
  1202.   fprintf(stderr, "%s: run time error: " , progname ) ;
  1203.   va_start(args) ;
  1204.   format = va_arg(args, char *) ;
  1205.   vfprintf(stderr, format, args) ;
  1206.   va_end(args) ;
  1207.   check_FILENAME() ;
  1208.   fprintf(stderr, "\n\tFILENAME=\"%s\" FNR=%g NR=%g\n" ,
  1209.      string(bi_vars+FILENAME)->str, bi_vars[FNR].dval,
  1210.      bi_vars[NR].dval) ;
  1211.   mawk_exit(1) ;
  1212. }
  1213.  
  1214. #endif
  1215.  
  1216. void bozo(s)
  1217.   char *s ;
  1218. { errmsg(0, "bozo: %s" , s) ; mawk_exit(1) ; }
  1219.  
  1220. void overflow(s, size)
  1221.   char *s ; unsigned size ;
  1222. { errmsg(0 , "program limit exceeded: %s size=%u", s, size) ;
  1223.   mawk_exit(1) ; }
  1224.  
  1225. static void check_FILENAME()
  1226. {
  1227.   if ( bi_vars[FILENAME].type != C_STRING )
  1228.           cast1_to_s(bi_vars + FILENAME) ;
  1229.   if ( bi_vars[FNR].type != C_DOUBLE )
  1230.           cast1_to_d(bi_vars + FNR ) ;
  1231.   if ( bi_vars[NR].type != C_DOUBLE )
  1232.           cast1_to_d(bi_vars + NR ) ;
  1233. }
  1234.  
  1235. /* run time */
  1236. void rt_overflow(s, size)
  1237.   char *s ; unsigned size ;
  1238. { check_FILENAME() ;
  1239.   errmsg(0 , 
  1240.   "program limit exceeded: %s size=%u\n\
  1241. \t(FILENAME=\"%s\" FNR=%g NR=%g)", 
  1242.    s, size, string(bi_vars+FILENAME)->str, 
  1243.    bi_vars[FNR].dval,
  1244.    bi_vars[NR].dval) ;
  1245.    mawk_exit(1) ;
  1246. }
  1247.  
  1248. static void unexpected_char()
  1249. { int c = yylval.ival ;
  1250.  
  1251.   fprintf(stderr, "%s: %u: ", progname, token_lineno) ;
  1252.   if ( c > ' ')
  1253.       fprintf(stderr, "unexpected character '%c'\n" , c) ;
  1254.   else
  1255.       fprintf(stderr, "unexpected character 0x%02x\n" , c) ;
  1256. }
  1257.  
  1258. static char *type_to_str( type )
  1259.   int type ;
  1260. { char *retval ;
  1261.  
  1262.   switch( type )
  1263.   {
  1264.     case  ST_VAR :  retval = "variable" ; break ;
  1265.     case  ST_ARRAY :  retval = "array" ; break ;
  1266.     case  ST_FUNCT :  retval = "function" ; break ;
  1267.     case  ST_LOCAL_VAR : retval = "local variable" ; break ;
  1268.     case  ST_LOCAL_ARRAY : retval = "local array" ; break ;
  1269.     default : bozo("type_to_str") ;
  1270.   }
  1271.   return retval ;
  1272. }
  1273.  
  1274. /* emit an error message about a type clash */
  1275. void type_error(p)
  1276.   SYMTAB *p ;
  1277. { compile_error("illegal reference to %s %s", 
  1278.     type_to_str(p->type) , p->name) ;
  1279. }
  1280.  
  1281.  
  1282. @//E*O*F mawk0.97/error.c//
  1283. chmod u=rw,g=r,o=r mawk0.97/error.c
  1284.  
  1285. echo x - mawk0.97/execute.c
  1286. sed 's/^@//' > "mawk0.97/execute.c" <<'@//E*O*F mawk0.97/execute.c//'
  1287.  
  1288. /********************************************
  1289. execute.c
  1290. copyright 1991, Michael D. Brennan
  1291.  
  1292. This is a source file for mawk, an implementation of
  1293. the Awk programming language as defined in
  1294. Aho, Kernighan and Weinberger, The AWK Programming Language,
  1295. Addison-Wesley, 1988.
  1296.  
  1297. See the accompaning file, LIMITATIONS, for restrictions
  1298. regarding modification and redistribution of this
  1299. program in source or binary form.
  1300. ********************************************/
  1301.  
  1302. /* $Log:    execute.c,v $
  1303.  * Revision 2.2  91/04/09  12:38:54  brennan
  1304.  * added static to funct decls to satisfy STARDENT compiler
  1305.  * 
  1306.  * Revision 2.1  91/04/08  08:22:55  brennan
  1307.  * VERSION 0.97
  1308.  * 
  1309. */
  1310.  
  1311.  
  1312. #include "mawk.h"
  1313. #include "code.h"
  1314. #include "memory.h"
  1315. #include "symtype.h"
  1316. #include "field.h"
  1317. #include "bi_funct.h"
  1318. #include "regexp.h"
  1319. #include "repl.h"
  1320. #include <math.h>
  1321.  
  1322. /* static functions */
  1323. static int PROTO( compare, (CELL *) ) ;
  1324. static void PROTO( eval_overflow, (void) ) ;
  1325.  
  1326. #ifdef   DEBUG
  1327. #define  inc_sp()   if( ++sp == eval_stack+EVAL_STACK_SIZE )\
  1328.                          eval_overflow()
  1329. #else
  1330.  
  1331. /* If things are working, the only reason the eval stack should
  1332.    overflow is too much function recursion
  1333.    (checked for at _CALL below  */
  1334.  
  1335. #define inc_sp()    sp++
  1336. #endif
  1337.  
  1338. #define  SAFETY    3    /* if we get within 3 of stack top emit 
  1339.          overflow */
  1340.  
  1341. /*  The stack machine that executes the code */
  1342.  
  1343. CELL  eval_stack[EVAL_STACK_SIZE] ;
  1344.  
  1345. static void eval_overflow()
  1346. { overflow("eval stack" , EVAL_STACK_SIZE) ; mawk_exit(1) ; }
  1347.  
  1348. /* if this flag is on, recursive calls to execute need to
  1349.    return to the _CALL statement.  This only happens
  1350.    inside array loops */
  1351. int  returning ;  
  1352.  
  1353. INST  *execute(cdp, sp, fp)
  1354.   register INST *cdp ;  /* code ptr, start execution here */
  1355.   register CELL *sp ;   /* eval_stack pointer */
  1356.   CELL *fp ;            /* frame ptr into eval_stack for
  1357.                            user defined functions */
  1358. { 
  1359.   /* some useful temporaries */
  1360.   CELL *cp , tc ;
  1361.   int t ;
  1362.  
  1363. #ifdef  DEBUG
  1364.   CELL *entry_sp = sp ;
  1365. #endif
  1366.  
  1367.   while ( 1 )
  1368.     switch( cdp++ -> op )
  1369.     {   case  _HALT :
  1370.         case  _STOP :  
  1371.  
  1372. #ifdef   DEBUG
  1373. /* check the stack is sane */
  1374.                 if ( sp != entry_sp ) bozo("stop") ;
  1375.                 return cdp - 1 ;
  1376.  
  1377.         case  _STOP0  : /* if debugging stops range patterns */
  1378.                 if ( sp != entry_sp+1 ) bozo("stop0") ;
  1379. #else
  1380.         case  _STOP0  :
  1381. #endif
  1382.                 return cdp -  1 ;
  1383.  
  1384.         case  _PUSHC :  
  1385.             inc_sp() ;
  1386.             (void) cellcpy(sp, cdp++ -> ptr) ;
  1387.             break ;
  1388.  
  1389.         case  F_PUSHA :
  1390.             if ( (CELL*)cdp->ptr != field && nf < 0 ) split_field0() ;
  1391.             /* fall thru */
  1392.  
  1393.         case  _PUSHA :
  1394.         case  A_PUSHA :
  1395.             inc_sp() ;
  1396.             sp -> ptr = cdp++ -> ptr ;
  1397.             break ;
  1398.  
  1399.         case _PUSHI :  /* put contents of next address on stack*/
  1400.             inc_sp() ;
  1401.             (void) cellcpy(sp, cdp++ -> ptr) ;
  1402.             break ;
  1403.             
  1404.         case L_PUSHI :  
  1405.             /* put the contents of a local var on stack,
  1406.                cdp->op holds the offset from the frame pointer */
  1407.             inc_sp() ;
  1408.             (void) cellcpy(sp, fp + cdp++->op) ;
  1409.             break ;
  1410.  
  1411.         case L_PUSHA : /* put a local address on eval stack */
  1412.             inc_sp() ;
  1413.             sp->ptr = (PTR)(fp + cdp++->op) ;
  1414.             break ;
  1415.  
  1416.  
  1417.         case F_PUSHI :
  1418.  
  1419.         /* note $0 , RS , FS and OFMT are loaded by _PUSHI */
  1420.  
  1421.             inc_sp() ;
  1422.             if ( nf < 0 )  split_field0() ;
  1423.             if ( (t = (CELL *) cdp->ptr - field) <= nf ||
  1424.                   t == NF  )
  1425.             { (void) cellcpy(sp, cdp++ -> ptr) ; }
  1426.             else  /* an unset field */
  1427.             { sp->type = C_STRING ;
  1428.               sp->ptr = (PTR) & null_str ;
  1429.               null_str.ref_cnt++ ;
  1430.               cdp++ ;
  1431.             }
  1432.             break ;
  1433.  
  1434.         case  FE_PUSHA :
  1435.             if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  1436.             if ( (t = (int) sp->dval) < 0 )
  1437.                 rt_error( "negative field index(%d)", t) ;
  1438.             if ( t > MAX_FIELD )
  1439.                 rt_overflow("MAX_FIELD", MAX_FIELD) ;
  1440.             if ( t && nf < 0 )  split_field0() ;
  1441.             sp->ptr = (PTR) &field[t] ;
  1442.             break ;
  1443.  
  1444.         case  FE_PUSHI :
  1445.             if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  1446.  
  1447.             if ( (t = (int) sp->dval) == 0 )
  1448.             { (void) cellcpy(sp, &field[0]) ; break ; }
  1449.  
  1450.             if ( t < 0 )
  1451.                   rt_error( "negative field index(%d)", t) ;
  1452.             if ( t > MAX_FIELD )
  1453.                   rt_overflow("MAX_FIELD", MAX_FIELD) ;
  1454.  
  1455.             if ( nf < 0)  split_field0() ;
  1456.             if ( t <= nf ) (void) cellcpy(sp, &field[t]) ;
  1457.             else
  1458.             { sp->type = C_STRING ;
  1459.               sp->ptr = (PTR) & null_str ;
  1460.               null_str.ref_cnt++ ;
  1461.             }
  1462.             break ; 
  1463.  
  1464.  
  1465.         case  AE_PUSHA :
  1466.         /* top of stack has an expr, cdp->ptr points at an
  1467.            array, replace the expr with the cell address inside
  1468.            the array */
  1469.             cast1_to_s(sp) ;
  1470.             cp = array_find((ARRAY)cdp++->ptr, sp->ptr, 0) ;
  1471.             free_STRING( string(sp) );
  1472.             sp->ptr = (PTR) cp ;
  1473.             break ;
  1474.  
  1475.         case  AE_PUSHI :
  1476.         /* top of stack has an expr, cdp->ptr points at an
  1477.            array, replace the expr with the contents of the
  1478.            cell inside the array */
  1479.             cast1_to_s(sp) ;
  1480.             cp = array_find((ARRAY) cdp++->ptr, sp->ptr, 0) ;
  1481.             free_STRING(string(sp)) ;
  1482.             (void) cellcpy(sp, cp) ;
  1483.             break ;
  1484.  
  1485.         case  LAE_PUSHI :
  1486.         /*  sp[0] is an expression
  1487.             cdp->op is offset from frame pointer of a CELL which
  1488.                has an ARRAY in the ptr field, replace expr
  1489.             with  array[expr]
  1490.         */
  1491.             cast1_to_s(sp) ;
  1492.             cp = array_find( (ARRAY)fp[cdp++->op].ptr, sp->ptr, 0) ;
  1493.             free_STRING(string(sp)) ;
  1494.             (void) cellcpy(sp, cp) ;
  1495.             break ;
  1496.             
  1497.         case  LAE_PUSHA :
  1498.         /*  sp[0] is an expression
  1499.             cdp->op is offset from frame pointer of a CELL which
  1500.                has an ARRAY in the ptr field, replace expr
  1501.             with  & array[expr]
  1502.         */
  1503.             cast1_to_s(sp) ;
  1504.             cp = array_find( (ARRAY)fp[cdp++->op].ptr, sp->ptr, 0) ;
  1505.             free_STRING(string(sp)) ;
  1506.             sp->ptr = (PTR) cp ;
  1507.             break ;
  1508.             
  1509.         case  LA_PUSHA  :
  1510.         /*  cdp->op is offset from frame pointer of a CELL which
  1511.                has an ARRAY in the ptr field. Push this ARRAY
  1512.                on the eval stack
  1513.         */
  1514.             inc_sp() ;
  1515.             sp->ptr = fp[cdp++->op].ptr ;
  1516.             break ;
  1517.  
  1518.         case  A_LOOP :
  1519.             cdp = array_loop(cdp,sp,fp) ;
  1520.             if ( returning ) return cdp ; /*value doesn't matter*/
  1521.             sp -= 2 ;
  1522.             break ;
  1523.  
  1524.         case  _POP : 
  1525.             cell_destroy(sp) ;
  1526.             sp-- ;
  1527.             break ;
  1528.  
  1529.         case _DUP  :
  1530.             (void) cellcpy(sp+1, sp) ;
  1531.             sp++ ; break ;
  1532.  
  1533.         case  _ASSIGN :
  1534.             /* top of stack has an expr, next down is an
  1535.                address, put the expression in *address and
  1536.                replace the address with the expression */
  1537.  
  1538.             /* don't propagate type C_MBSTRN */
  1539.             if ( sp->type == C_MBSTRN ) check_strnum(sp) ;
  1540.             sp-- ;
  1541.             cell_destroy( ((CELL *)sp->ptr) ) ;
  1542.             (void) cellcpy( sp, cellcpy(sp->ptr, sp+1) ) ;
  1543.             cell_destroy(sp+1) ;
  1544.             break ;
  1545.  
  1546.         case  F_ASSIGN : /* assign to a field  */
  1547.             if (sp->type == C_MBSTRN) check_strnum(sp) ;
  1548.             sp-- ;
  1549.             field_assign((CELL*)sp->ptr - field, sp+1) ;
  1550.             cell_destroy(sp+1) ;
  1551.             (void) cellcpy(sp, (CELL *) sp->ptr) ;
  1552.             break ;
  1553.  
  1554.         case  _ADD_ASG:
  1555.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1556.             cp = (CELL *) (sp-1)->ptr ;
  1557.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1558.             cp->dval += sp-- -> dval ;
  1559.             sp->type = C_DOUBLE ;
  1560.             sp->dval = cp->dval ;
  1561.             break ;
  1562.  
  1563.         case  _SUB_ASG:
  1564.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1565.             cp = (CELL *) (sp-1)->ptr ;
  1566.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1567.             cp->dval -= sp-- -> dval ;
  1568.             sp->type = C_DOUBLE ;
  1569.             sp->dval = cp->dval ;
  1570.             break ;
  1571.  
  1572.         case  _MUL_ASG:
  1573.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1574.             cp = (CELL *) (sp-1)->ptr ;
  1575.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1576.             cp->dval *= sp-- -> dval ;
  1577.             sp->type = C_DOUBLE ;
  1578.             sp->dval = cp->dval ;
  1579.             break ;
  1580.  
  1581.         case  _DIV_ASG:
  1582.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1583.             cp = (CELL *) (sp-1)->ptr ;
  1584.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1585.             cp->dval /= sp-- -> dval ;
  1586.             sp->type = C_DOUBLE ;
  1587.             sp->dval = cp->dval ;
  1588.             break ;
  1589.  
  1590.         case  _MOD_ASG:
  1591.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1592.             cp = (CELL *) (sp-1)->ptr ;
  1593.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1594.             cp->dval = fmod(cp->dval,sp-- -> dval) ;
  1595.             sp->type = C_DOUBLE ;
  1596.             sp->dval = cp->dval ;
  1597.             break ;
  1598.  
  1599.         case  _POW_ASG:
  1600.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1601.             cp = (CELL *) (sp-1)->ptr ;
  1602.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1603.             cp->dval = pow(cp->dval,sp-- -> dval) ;
  1604.             sp->type = C_DOUBLE ;
  1605.             sp->dval = cp->dval ;
  1606.             break ;
  1607.  
  1608.         /* will anyone ever use these ? */
  1609.  
  1610.         case F_ADD_ASG :
  1611.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1612.             cp = (CELL *) (sp-1)->ptr ;
  1613.             cast1_to_d( cellcpy(&tc, cp) ) ;
  1614.             tc.dval += sp-- -> dval ;
  1615.             sp->type = C_DOUBLE ;
  1616.             sp->dval = tc.dval ;
  1617.             field_assign(cp-field, &tc) ;
  1618.             break ;
  1619.  
  1620.         case F_SUB_ASG :
  1621.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1622.             cp = (CELL *) (sp-1)->ptr ;
  1623.             cast1_to_d( cellcpy(&tc, cp) ) ;
  1624.             tc.dval -= sp-- -> dval ;
  1625.             sp->type = C_DOUBLE ;
  1626.             sp->dval = tc.dval ;
  1627.             field_assign(cp-field, &tc) ;
  1628.             break ;
  1629.  
  1630.         case F_MUL_ASG :
  1631.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1632.             cp = (CELL *) (sp-1)->ptr ;
  1633.             cast1_to_d( cellcpy(&tc, cp) ) ;
  1634.             tc.dval *= sp-- -> dval ;
  1635.             sp->type = C_DOUBLE ;
  1636.             sp->dval = tc.dval ;
  1637.             field_assign(cp-field, &tc) ;
  1638.             break ;
  1639.  
  1640.         case F_DIV_ASG :
  1641.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1642.             cp = (CELL *) (sp-1)->ptr ;
  1643.             cast1_to_d( cellcpy(&tc, cp) ) ;
  1644.             tc.dval /= sp-- -> dval ;
  1645.             sp->type = C_DOUBLE ;
  1646.             sp->dval = tc.dval ;
  1647.             field_assign(cp-field, &tc) ;
  1648.             break ;
  1649.  
  1650.         case F_MOD_ASG :
  1651.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1652.             cp = (CELL *) (sp-1)->ptr ;
  1653.             cast1_to_d( cellcpy(&tc, cp) ) ;
  1654.             tc.dval = fmod(tc.dval, sp-- -> dval) ;
  1655.             sp->type = C_DOUBLE ;
  1656.             sp->dval = tc.dval ;
  1657.             field_assign(cp-field, &tc) ;
  1658.             break ;
  1659.  
  1660.         case F_POW_ASG :
  1661.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1662.             cp = (CELL *) (sp-1)->ptr ;
  1663.             cast1_to_d( cellcpy(&tc, cp) ) ;
  1664.             tc.dval = pow(tc.dval, sp-- -> dval) ;
  1665.             sp->type = C_DOUBLE ;
  1666.             sp->dval = tc.dval ;
  1667.             field_assign(cp-field, &tc) ;
  1668.             break ;
  1669.  
  1670.         case _ADD :
  1671.             sp-- ;
  1672.             if ( TEST2(sp) != TWO_DOUBLES )
  1673.                     cast2_to_d(sp) ;
  1674.             sp[0].dval += sp[1].dval ;
  1675.             break ;
  1676.  
  1677.         case _SUB :
  1678.             sp-- ;
  1679.             if ( TEST2(sp) != TWO_DOUBLES )
  1680.                     cast2_to_d(sp) ;
  1681.             sp[0].dval -= sp[1].dval ;
  1682.             break ;
  1683.  
  1684.         case _MUL :
  1685.             sp-- ;
  1686.             if ( TEST2(sp) != TWO_DOUBLES )
  1687.                     cast2_to_d(sp) ;
  1688.             sp[0].dval *= sp[1].dval ;
  1689.             break ;
  1690.  
  1691.         case _DIV :
  1692.             sp-- ;
  1693.             if ( TEST2(sp) != TWO_DOUBLES )
  1694.                     cast2_to_d(sp) ;
  1695.             sp[0].dval /= sp[1].dval ;
  1696.             break ;
  1697.  
  1698.         case _MOD :
  1699.             sp-- ;
  1700.             if ( TEST2(sp) != TWO_DOUBLES )
  1701.                     cast2_to_d(sp) ;
  1702.             sp[0].dval = fmod(sp[0].dval,sp[1].dval) ;
  1703.             break ;
  1704.  
  1705.         case _POW :
  1706.             sp-- ;
  1707.             if ( TEST2(sp) != TWO_DOUBLES )
  1708.                     cast2_to_d(sp) ;
  1709.             sp[0].dval = pow(sp[0].dval,sp[1].dval) ;
  1710.             break ;
  1711.  
  1712.         case _NOT :
  1713.         reswitch_1:
  1714.             switch( sp->type )
  1715.             { case C_NOINIT :
  1716.                     sp->dval = 1.0 ; break ;
  1717.               case C_DOUBLE :
  1718.                     sp->dval =  sp->dval ? 0.0 : 1.0 ;
  1719.                     break ;
  1720.               case C_STRING :
  1721.                     sp->dval = string(sp)->len ? 0.0 : 1.0 ;
  1722.                     free_STRING(string(sp)) ;
  1723.                     break ;
  1724.               case C_STRNUM : /* test as a number */
  1725.                     sp->dval = sp->dval ? 0.0 : 1.0 ;
  1726.                     free_STRING(string(sp)) ;
  1727.                     break ;
  1728.               case C_MBSTRN :
  1729.                     check_strnum(sp) ;
  1730.                     goto reswitch_1 ;
  1731.               default :
  1732.                     bozo("bad type on eval stack") ;
  1733.             }
  1734.             sp->type = C_DOUBLE ;
  1735.             break  ;
  1736.  
  1737.         case _TEST :
  1738.         reswitch_2:
  1739.             switch( sp->type )
  1740.             { case C_NOINIT :
  1741.                     sp->dval = 0.0 ; break ;
  1742.               case C_DOUBLE :
  1743.                     sp->dval = sp->dval ? 1.0 : 0.0 ;
  1744.                     break ;
  1745.               case C_STRING :
  1746.                     sp->dval  = string(sp)->len ? 1.0 : 0.0 ;
  1747.                     free_STRING(string(sp)) ;
  1748.                     break ;
  1749.               case C_STRNUM : /* test as a number */
  1750.                     sp->dval  = sp->dval ? 0.0 : 1.0 ;
  1751.                     free_STRING(string(sp)) ;
  1752.                     break ;
  1753.               case C_MBSTRN :
  1754.                     check_strnum(sp) ;
  1755.                     goto reswitch_2 ;
  1756.               default :
  1757.                     bozo("bad type on eval stack") ;
  1758.             }
  1759.             sp->type = C_DOUBLE ;
  1760.             break ;
  1761.  
  1762.         case _UMINUS :
  1763.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1764.             sp->dval = - sp->dval ;
  1765.             break ;
  1766.  
  1767.         case _UPLUS :  
  1768.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1769.             break ;
  1770.  
  1771.         case _CAT :
  1772.             { unsigned len1, len2 ;
  1773.               char *str1, *str2 ;
  1774.               STRING *b ;
  1775.               
  1776.               sp-- ;
  1777.               if ( TEST2(sp) != TWO_STRINGS )
  1778.                     cast2_to_s(sp) ;
  1779.               str1 = string(sp)->str ;
  1780.               len1 = string(sp)->len ;
  1781.               str2 = string(sp+1)->str ;
  1782.               len2 = string(sp+1)->len ;
  1783.  
  1784.               b = new_STRING((char *)0, len1+len2) ;
  1785.               (void) memcpy(b->str, str1, len1) ;
  1786.               (void) memcpy(b->str + len1, str2, len2) ;
  1787.               free_STRING(string(sp)) ;
  1788.               free_STRING( string(sp+1) ) ;
  1789.  
  1790.               sp->ptr = (PTR) b ;
  1791.               break ;
  1792.             }
  1793.  
  1794.         case _PUSHINT :
  1795.             inc_sp() ;
  1796.             sp->type = cdp++ -> op ;
  1797.             break ;
  1798.  
  1799.         case _BUILTIN :
  1800.         case _PRINT :
  1801.             sp = (* (PF_CP) cdp++ -> ptr) (sp) ;
  1802.             break ;
  1803.  
  1804.         case _POST_INC :
  1805.             (void) cellcpy(sp, cp = (CELL *)sp->ptr) ;
  1806.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1807.             cp->dval += 1.0 ;
  1808.             break ;
  1809.  
  1810.         case _POST_DEC :
  1811.             (void) cellcpy(sp, cp = (CELL *)sp->ptr) ;
  1812.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1813.             cp->dval -= 1.0 ;
  1814.             break ;
  1815.  
  1816.         case _PRE_INC :
  1817.             cp = (CELL *) sp->ptr ;
  1818.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1819.             sp->dval = cp->dval += 1.0 ;
  1820.             sp->type = C_DOUBLE ;
  1821.             break ;
  1822.  
  1823.         case _PRE_DEC :
  1824.             cp = (CELL *) sp->ptr ;
  1825.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  1826.             sp->dval = cp->dval -= 1.0 ;
  1827.             sp->type = C_DOUBLE ;
  1828.             break ;
  1829.  
  1830.  
  1831.         case F_POST_INC  :
  1832.             cp = (CELL *) sp->ptr ;
  1833.             (void) cellcpy(sp, cellcpy(&tc, cp) ) ;
  1834.             cast1_to_d(&tc) ;
  1835.             tc.dval += 1.0 ;
  1836.             field_assign(cp-field, &tc) ;
  1837.             break ;
  1838.  
  1839.         case F_POST_DEC  :
  1840.             cp = (CELL *) sp->ptr ;
  1841.             (void) cellcpy(sp, cellcpy(&tc, cp) ) ;
  1842.             cast1_to_d(&tc) ;
  1843.             tc.dval -= 1.0 ;
  1844.             field_assign(cp-field, &tc) ;
  1845.             break ;
  1846.  
  1847.         case F_PRE_INC :
  1848.             cp = (CELL *) sp->ptr ;
  1849.             cast1_to_d(cellcpy(&tc, cp)) ;
  1850.             sp->dval = tc.dval += 1.0 ;
  1851.             sp->type = C_DOUBLE ;
  1852.             field_assign(cp-field, sp) ;
  1853.             break ;
  1854.  
  1855.         case F_PRE_DEC :
  1856.             cp = (CELL *) sp->ptr ;
  1857.             cast1_to_d(cellcpy(&tc, cp)) ;
  1858.             sp->dval = tc.dval -= 1.0 ;
  1859.             sp->type = C_DOUBLE ;
  1860.             field_assign(cp-field, sp) ;
  1861.             break ;
  1862.  
  1863.         case _JMP  :
  1864.             cdp += cdp->op - 1 ;
  1865.             break ;
  1866.  
  1867.         case _JNZ  :
  1868.             /* jmp if top of stack is non-zero and pop stack */
  1869.             if ( test( sp ) )
  1870.                 cdp += cdp->op - 1 ;
  1871.             else  cdp++ ;
  1872.             cell_destroy(sp) ;
  1873.             sp-- ;
  1874.             break ;
  1875.  
  1876.         case _JZ  :
  1877.             /* jmp if top of stack is zero and pop stack */
  1878.             if ( ! test( sp ) )
  1879.                 cdp += cdp->op - 1 ;
  1880.             else  cdp++ ;
  1881.             cell_destroy(sp) ;
  1882.             sp-- ;
  1883.             break ;
  1884.  
  1885.     /*  the relation operations */
  1886.     /*  compare() makes sure string ref counts are OK */
  1887.         case  _EQ :
  1888.             t = compare(--sp) ;
  1889.             sp->type = C_DOUBLE ;
  1890.             sp->dval = t == 0 ? 1.0 : 0.0 ;
  1891.             break ;
  1892.  
  1893.         case  _NEQ :
  1894.             t = compare(--sp) ;
  1895.             sp->type = C_DOUBLE ;
  1896.             sp->dval = t ? 1.0 : 0.0 ;
  1897.             break ;
  1898.  
  1899.         case  _LT :
  1900.             t = compare(--sp) ;
  1901.             sp->type = C_DOUBLE ;
  1902.             sp->dval = t < 0 ? 1.0 : 0.0 ;
  1903.             break ;
  1904.  
  1905.         case  _LTE :
  1906.             t = compare(--sp) ;
  1907.             sp->type = C_DOUBLE ;
  1908.             sp->dval = t <= 0 ? 1.0 : 0.0 ;
  1909.             break ;
  1910.  
  1911.         case  _GT :
  1912.             t = compare(--sp) ;
  1913.             sp->type = C_DOUBLE ;
  1914.             sp->dval = t > 0 ? 1.0 : 0.0 ;
  1915.             break ;
  1916.  
  1917.         case  _GTE :
  1918.             t = compare(--sp) ;
  1919.             sp->type = C_DOUBLE ;
  1920.             sp->dval = t >= 0 ? 1.0 : 0.0 ;
  1921.             break ;
  1922.  
  1923.         case  _MATCH :
  1924.             /* does sp[-1] match sp[0] as re */
  1925.             if ( sp->type != C_RE )  cast_to_RE(sp) ;
  1926.  
  1927.             if ( (--sp)->type < C_STRING )  cast1_to_s(sp) ;
  1928.             t = REtest(string(sp)->str, (sp+1)->ptr) ; 
  1929.  
  1930.             free_STRING(string(sp)) ;
  1931.             sp->type = C_DOUBLE ;
  1932.             sp->dval = t ? 1.0 : 0.0 ;
  1933.             break ;
  1934.  
  1935.         case  A_TEST :
  1936.         /* entry :  sp[0].ptr-> an array
  1937.                     sp[-1]  is an expression
  1938.  
  1939.            we compute   expression in array  */
  1940.             if ( (--sp)->type < C_STRING ) cast1_to_s(sp) ;
  1941.             t = array_test( (sp+1)->ptr, string(sp)) ;
  1942.             free_STRING(string(sp)) ;
  1943.             sp->type = C_DOUBLE ;
  1944.             sp->dval = t ? 1.0 : 0.0 ;
  1945.             break ;
  1946.  
  1947.         case  A_DEL :
  1948.         /* sp[0].ptr ->  array)
  1949.            sp[-1] is an expr
  1950.            delete  array[expr]  */
  1951.  
  1952.             cast1_to_s(--sp) ;
  1953.             array_delete( sp[1].ptr , sp->ptr) ;
  1954.             free_STRING( string(sp) ) ;
  1955.             sp-- ;
  1956.             break ;
  1957.         
  1958.         /* form a multiple array index */
  1959.         case A_CAT :
  1960.             sp = array_cat(sp, cdp++->op) ;
  1961.             break ;
  1962.  
  1963.         case  _EXIT0 :
  1964.             longjmp( exit_jump, 1) ;
  1965.  
  1966.         case  _EXIT  :
  1967.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  1968.             exit_code = (int) sp->dval ;
  1969.             longjmp( exit_jump, 1) ;
  1970.  
  1971.         case  _NEXT :
  1972.             longjmp(next_jump, 1) ;
  1973.  
  1974.         case  _RANGE :
  1975. /* test a range pattern:  pat1, pat2 { action }
  1976.    entry :
  1977.        cdp[0].op -- a flag, test pat1 if on else pat2
  1978.        cdp[1].op -- offset of pat2 code from cdp
  1979.        cdp[2].op -- offset of action code from cdp
  1980.        cdp[3].op -- offset of code after the action from cdp
  1981.        cdp[4] -- start of pat1 code
  1982. */
  1983.  
  1984. #define FLAG    cdp[0].op
  1985. #define PAT2    cdp[1].op
  1986. #define ACTION    cdp[2].op
  1987. #define FOLLOW    cdp[3].op
  1988. #define PAT1      4
  1989.  
  1990.             if ( FLAG )  /* test again pat1 */
  1991.             { 
  1992.               (void) execute(cdp + PAT1,sp, fp) ;
  1993.               t = test(sp+1) ;
  1994.               cell_destroy(sp+1) ;
  1995.               if ( t )  FLAG = 0 ;
  1996.               else
  1997.               { cdp += FOLLOW ;
  1998.                 break ;  /* break the switch */
  1999.               }
  2000.             }
  2001.  
  2002.             /* test against pat2 and then perform the action */
  2003.             (void) execute(cdp + PAT2, sp, fp) ;
  2004.             FLAG  = test(sp+1) ;
  2005.             cell_destroy(sp+1) ; 
  2006.             cdp += ACTION ;
  2007.             break ;
  2008.  
  2009. /* function calls  */
  2010.  
  2011.       case  _RET0  :
  2012.             inc_sp() ;
  2013.             sp->type = C_NOINIT ;
  2014.             /* fall thru */
  2015.  
  2016.       case  _RET   :
  2017.  
  2018. #ifdef  DEBUG
  2019.             if ( sp != entry_sp+1 ) bozo("ret") ;
  2020. #endif
  2021.             returning = 1 ;
  2022.             return  cdp-1 ;
  2023.  
  2024.       case  _CALL  :
  2025.  
  2026.             { FBLOCK *fbp = (FBLOCK*) cdp++->ptr ;
  2027.               int a_args = cdp++->op ; /* actual number of args */
  2028.               CELL *nfp = sp - a_args + 1 ; /* new fp for callee */
  2029.               CELL *local_p = sp+1; /* first local argument on stack */
  2030.               char *type_p ;  /* pts to type of an argument */
  2031.  
  2032.               if ( fbp->nargs ) type_p = fbp->typev + a_args ;
  2033.  
  2034.               /* create space for locals */
  2035.               if ( t = fbp->nargs - a_args ) /* have local args */
  2036.               {
  2037.                 if ( sp + t >= eval_stack + EVAL_STACK_SIZE - SAFETY )
  2038.                    eval_overflow() ;
  2039.  
  2040.                 while ( t-- )  
  2041.                 { (++sp)->type = C_NOINIT ;
  2042.                   if ( *type_p++ == ST_LOCAL_ARRAY )
  2043.                         sp->ptr = (PTR) new_ARRAY() ;
  2044.                 }
  2045.               }
  2046.               type_p-- ; /* *type_p is type of last arg */ 
  2047.  
  2048.               (void) execute(fbp->code, sp, nfp) ;
  2049. #ifdef  DEBUG
  2050. if ( !returning )  bozo("call") ;
  2051. #endif
  2052.               returning = 0 ;
  2053.  
  2054.               /* cleanup the callee's arguments */
  2055.               if ( sp >= nfp ) 
  2056.               {
  2057.                 cp = sp+1 ;  /* cp -> the function return */
  2058.  
  2059.                 do
  2060.                 {
  2061.                   if ( *type_p-- == ST_LOCAL_ARRAY )
  2062.                   {  if ( sp >= local_p ) array_free(sp->ptr) ; }
  2063.                   else  cell_destroy(sp) ;
  2064.  
  2065.                 } while ( --sp >= nfp ) ;
  2066.                     
  2067.                 (void) cellcpy(++sp, cp) ;
  2068.                 cell_destroy(cp) ;
  2069.               }
  2070.               else  sp++ ; /* no arguments passed */
  2071.             }
  2072.             break ;
  2073.  
  2074.         default :
  2075.             bozo("bad opcode") ;
  2076.     }
  2077. }
  2078.  
  2079. int test( cp )  /* test if a cell is null or not */
  2080.   register CELL *cp ;
  2081. { 
  2082. reswitch :
  2083.  
  2084.   switch ( cp->type )
  2085.   {
  2086.     case C_NOINIT :  return  0 ;
  2087.     case C_STRNUM :  /* test as a number */
  2088.     case C_DOUBLE :  return  cp->dval != 0.0 ;
  2089.     case C_STRING :  return  string(cp)->len ;
  2090.     case C_MBSTRN :  check_strnum(cp) ; goto reswitch ;
  2091.  
  2092.     default :
  2093.       bozo("bad cell type in call to test") ;
  2094.   }
  2095. }
  2096.  
  2097. /* compare cells at cp and cp+1 and
  2098.    frees STRINGs at those cells
  2099. */
  2100.  
  2101. static int compare(cp)
  2102.   register CELL *cp ;
  2103. { int k ;
  2104.  
  2105. reswitch :
  2106.  
  2107.   switch( TEST2(cp) )
  2108.   { case TWO_NOINITS :  return 0 ; 
  2109.     
  2110.     case TWO_DOUBLES :
  2111.     two_d:
  2112.             return  cp->dval > (cp+1)->dval ? 1 :
  2113.                     cp->dval < (cp+1)->dval ? -1 : 0 ;
  2114.     
  2115.     case TWO_STRINGS :
  2116.     case STRING_AND_STRNUM :
  2117.     two_s:
  2118.             k = strcmp(string(cp)->str, string(cp+1)->str) ;
  2119.             free_STRING( string(cp) ) ;
  2120.             free_STRING( string(cp+1) ) ;
  2121.             return k ;
  2122.  
  2123.     case  NOINIT_AND_DOUBLE  :
  2124.     case  NOINIT_AND_STRNUM  :
  2125.     case  DOUBLE_AND_STRNUM  :
  2126.     case TWO_STRNUMS :
  2127.             cast2_to_d(cp) ; goto two_d ;
  2128.  
  2129.     case  NOINIT_AND_STRING  :
  2130.     case  DOUBLE_AND_STRING  :
  2131.             cast2_to_s(cp) ; goto two_s ;
  2132.  
  2133.     case  TWO_MBSTRNS :
  2134.             check_strnum(cp) ; check_strnum(cp+1) ;
  2135.             goto reswitch ;
  2136.  
  2137.     case  NOINIT_AND_MBSTRN :
  2138.     case  DOUBLE_AND_MBSTRN :
  2139.     case  STRING_AND_MBSTRN :
  2140.     case  STRNUM_AND_MBSTRN :
  2141.             check_strnum( cp->type == C_MBSTRN ? cp : cp+1 ) ;
  2142.             goto reswitch ;
  2143.  
  2144.     default :  /* there are no default cases */
  2145.             bozo("bad cell type passed to compare") ;
  2146.   }
  2147. }
  2148.  
  2149. /* does not assume target was a cell, if so
  2150.    then caller should have made a previous
  2151.    call to cell_destroy  */
  2152.  
  2153. CELL *cellcpy(target, source)
  2154.   register CELL *target, *source ;
  2155. { switch( target->type = source->type )
  2156.   { case C_NOINIT : 
  2157.     case C_SPACE  : 
  2158.     case C_SNULL  :
  2159.             break ;
  2160.  
  2161.     case C_DOUBLE :
  2162.             target->dval = source->dval ;
  2163.             break ;
  2164.  
  2165.     case C_STRNUM :
  2166.             target->dval = source->dval ;
  2167.             /* fall thru */
  2168.  
  2169.     case C_REPL    :
  2170.     case C_MBSTRN  :
  2171.     case C_STRING  :
  2172.             string(source)->ref_cnt++ ;
  2173.             /* fall thru */
  2174.  
  2175.     case C_RE  :
  2176.             target->ptr = source->ptr ;
  2177.             break ;
  2178.  
  2179.     case  C_REPLV :
  2180.             (void)  replv_cpy(target, source) ;
  2181.             break ;
  2182.  
  2183.     default :
  2184.             bozo("bad cell passed to cellcpy()") ;
  2185.             break ;
  2186.   }
  2187.   return  target ;
  2188. }
  2189.  
  2190. #ifdef   DEBUG
  2191.  
  2192. void  DB_cell_destroy(cp)    /* HANGOVER time */
  2193.   register CELL *cp ;
  2194. {
  2195.   switch( cp->type )
  2196.   { case C_NOINIT :
  2197.     case C_DOUBLE :  break ;
  2198.  
  2199.     case C_MBSTRN :
  2200.     case C_STRING :
  2201.     case C_STRNUM :
  2202.             if ( -- string(cp)->ref_cnt == 0 )
  2203.                 zfree(string(cp) , string(cp)->len+5) ;
  2204.             break ;
  2205.  
  2206.     case  C_RE :
  2207.             bozo("cell destroy called on RE cell") ;
  2208.     default :
  2209.             bozo("cell destroy called on bad cell type") ;
  2210.   }
  2211. }
  2212.  
  2213. #endif
  2214. @//E*O*F mawk0.97/execute.c//
  2215. chmod u=rw,g=r,o=r mawk0.97/execute.c
  2216.  
  2217. echo x - mawk0.97/fcall.c
  2218. sed 's/^@//' > "mawk0.97/fcall.c" <<'@//E*O*F mawk0.97/fcall.c//'
  2219.  
  2220. /********************************************
  2221. fcall.c
  2222. copyright 1991, Michael D. Brennan
  2223.  
  2224. This is a source file for mawk, an implementation of
  2225. the Awk programming language as defined in
  2226. Aho, Kernighan and Weinberger, The AWK Programming Language,
  2227. Addison-Wesley, 1988.
  2228.  
  2229. See the accompaning file, LIMITATIONS, for restrictions
  2230. regarding modification and redistribution of this
  2231. program in source or binary form.
  2232. ********************************************/
  2233.  
  2234.  
  2235. /*$Log:    fcall.c,v $
  2236.  * Revision 2.1  91/04/08  08:22:59  brennan
  2237.  * VERSION 0.97
  2238.  * 
  2239. */
  2240.  
  2241. #include "mawk.h"
  2242. #include "symtype.h"
  2243. #include "code.h"
  2244.  
  2245. /* This file has functions involved with type checking of
  2246.    function calls
  2247. */
  2248.  
  2249. static  FCALL_REC *PROTO(first_pass, (FCALL_REC *) ) ;
  2250. static  CA_REC    *PROTO(call_arg_check, (FBLOCK *, CA_REC *,
  2251.         INST *, unsigned) ) ;
  2252. static  int PROTO(arg_cnt_ok, (FBLOCK *,CA_REC *, unsigned) ) ;
  2253.  
  2254.  
  2255. static int check_progress ;
  2256.     /* flag that indicates call_arg_check() was able to type
  2257.        check some call arguments */
  2258.  
  2259. /* type checks a list of call arguments,
  2260.    returns a list of arguments whose type is still unknown
  2261. */
  2262. static CA_REC *call_arg_check( callee, entry_list , start,  line_no)
  2263.   FBLOCK *callee ;
  2264.   CA_REC *entry_list  ;  
  2265.   INST  *start ; /* to locate patch */
  2266.   unsigned line_no ; /* for error messages */
  2267. { register CA_REC *q ;
  2268.   CA_REC *exit_list  = (CA_REC *) 0 ;
  2269.  
  2270.   check_progress = 0 ;
  2271.  
  2272.   /* loop :
  2273.        take q off entry_list
  2274.        test it
  2275.            if OK  zfree(q)  else put on exit_list
  2276.   */
  2277.      
  2278.   while ( q = entry_list )
  2279.   {
  2280.     entry_list = q->link ;
  2281.  
  2282.     if ( q->type == ST_NONE )
  2283.     { /* try to infer the type */
  2284.       /* it might now be in symbol table */
  2285.       if ( q->sym_p->type == ST_VAR )
  2286.       { /* set type and patch */
  2287.         q->type = CA_EXPR ;
  2288.         start[q->call_offset+1].ptr  = (PTR) q->sym_p->stval.cp ;
  2289.       }
  2290.       else
  2291.       if ( q->sym_p->type == ST_ARRAY )
  2292.       { q->type = CA_ARRAY ;
  2293.         start[q->call_offset].op = A_PUSHA ;
  2294.         start[q->call_offset+1].ptr = (PTR) q->sym_p->stval.array ;
  2295.       } 
  2296.       else /* try to infer from callee */
  2297.       {
  2298.         switch( callee->typev[q->arg_num] )
  2299.         {
  2300.           case  ST_LOCAL_VAR :
  2301.                 q->type = CA_EXPR ;
  2302.                 q->sym_p->type = ST_VAR ;
  2303.                 q->sym_p->stval.cp = new_CELL() ;
  2304.                 q->sym_p->stval.cp->type = C_NOINIT ;
  2305.                 start[q->call_offset+1].ptr  = 
  2306.                          (PTR) q->sym_p->stval.cp ;
  2307.                 break ;
  2308.  
  2309.           case  ST_LOCAL_ARRAY :
  2310.                 q->type = CA_ARRAY ;
  2311.                 q->sym_p->type = ST_ARRAY ;
  2312.                 q->sym_p->stval.array = new_ARRAY() ;
  2313.                 start[q->call_offset].op = A_PUSHA ;
  2314.                 start[q->call_offset+1].ptr = 
  2315.                       (PTR) q->sym_p->stval.array ;
  2316.                 break ;
  2317.         }
  2318.       }
  2319.     }
  2320.     else
  2321.     if ( q->type == ST_LOCAL_NONE )
  2322.     { /* try to infer the type */
  2323.       if ( * q->type_p == ST_LOCAL_VAR )
  2324.       { /* set type , don't need to patch */
  2325.         q->type = CA_EXPR ;
  2326.       }
  2327.       else
  2328.       if ( * q->type_p == ST_LOCAL_ARRAY )
  2329.       { q->type = CA_ARRAY ;
  2330.         start[q->call_offset].op = LA_PUSHA ;
  2331.         /* offset+1 op is OK */
  2332.       } 
  2333.       else /* try to infer from callee */
  2334.       {
  2335.         switch( callee->typev[q->arg_num] )
  2336.         {
  2337.           case  ST_LOCAL_VAR :
  2338.                 q->type = CA_EXPR ;
  2339.                 * q->type_p = ST_LOCAL_VAR ;
  2340.                 /* do not need to patch */
  2341.                 break ;
  2342.  
  2343.           case  ST_LOCAL_ARRAY :
  2344.                 q->type = CA_ARRAY ;
  2345.                 * q->type_p = ST_LOCAL_ARRAY ;
  2346.                 start[q->call_offset].op = LA_PUSHA ;
  2347.                 break ;
  2348.         }
  2349.       }
  2350.     }
  2351.  
  2352.     /* if we still do not know the type put on the new list
  2353.        else type check */
  2354.  
  2355.     if ( q->type == ST_NONE || q->type == ST_LOCAL_NONE )
  2356.     {
  2357.       q->link = exit_list ;
  2358.       exit_list = q ;
  2359.     }
  2360.     else  /* type known */
  2361.     {
  2362.       if ( callee->typev[q->arg_num] == ST_LOCAL_NONE )
  2363.            callee->typev[q->arg_num] = q->type ;
  2364.  
  2365.       else
  2366.       if ( q->type != callee->typev[q->arg_num] )
  2367.       {
  2368.         errmsg(0, "line %u: type error in arg(%d) in call to %s",
  2369.           line_no, q->arg_num+1, callee->name) ;
  2370.         if ( ++compile_error_count == MAX_COMPILE_ERRORS )
  2371.                     mawk_exit(1) ;
  2372.       }
  2373.  
  2374.       zfree(q, sizeof(CA_REC)) ;
  2375.       check_progress = 1 ;
  2376.     }
  2377.   } /* while */
  2378.  
  2379.   return  exit_list ;
  2380. }
  2381.  
  2382.  
  2383. static  int  arg_cnt_ok( fbp, q, line_no )
  2384.   FBLOCK  *fbp ;
  2385.   CA_REC  *q ;
  2386.   unsigned line_no ;
  2387. {
  2388.   if ( q->arg_num  >= fbp->nargs )
  2389.   {
  2390.     errmsg(0, "line %u: too many arguments in call to %s" ,
  2391.        line_no, fbp->name ) ;
  2392.     if ( ++compile_error_count == MAX_COMPILE_ERRORS ) 
  2393.               mawk_exit(1) ;
  2394.  
  2395.     return  0 ;
  2396.   }
  2397.   else  return 1 ;
  2398. }
  2399.  
  2400.  
  2401. FCALL_REC  *resolve_list ;
  2402.         /* function calls whose arg types need checking 
  2403.            are stored on this list */
  2404.  
  2405.  
  2406. /* on first pass thru the resolve list
  2407.    we check :
  2408.       if forward referenced functions were really defined
  2409.       if right number of arguments
  2410.    and compute call_start which is now known
  2411. */
  2412.  
  2413. static  FCALL_REC *first_pass( p )
  2414.   register FCALL_REC *p ;
  2415. { FCALL_REC dummy ;
  2416.