home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 11 Util / 11-Util.zip / MAWK113.ZIP / mawk113 / execute.c < prev    next >
C/C++ Source or Header  |  1993-01-14  |  34KB  |  1,264 lines
  1.  
  2. /********************************************
  3. execute.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: execute.c,v $
  14.  * Revision 5.7.1.1  1993/01/15  03:33:39  mike
  15.  * patch3: safer double to int conversion
  16.  *
  17.  * Revision 5.7  1992/12/17  02:48:01  mike
  18.  * 1.1.2d changes for DOS
  19.  *
  20.  * Revision 5.6  1992/11/29  18:57:50  mike
  21.  * field expressions convert to long so 16 bit and 32 bit
  22.  * systems behave the same
  23.  *
  24.  * Revision 5.5  1992/08/11  15:24:55  brennan
  25.  * patch2: F_PUSHA and FE_PUSHA
  26.  * If this is preparation for g?sub(r,s,$expr) or (++|--) on $expr,
  27.  * then if expr > NF, make sure $expr is set to ""
  28.  *
  29.  * Revision 5.4  1992/08/11  14:51:54  brennan
  30.  * patch2:  $expr++ is numeric even if $expr is string.
  31.  * I forgot to do this earlier when handling x++ case.
  32.  *
  33.  * Revision 5.3  1992/07/08  17:03:30  brennan
  34.  * patch 2
  35.  * revert to version 1.0 comparisons, i.e.
  36.  * page 44-45 of AWK book
  37.  *
  38.  * Revision 5.2  1992/04/20  21:40:40  brennan
  39.  * patch 2
  40.  * x++ is numeric, even if x is string
  41.  *
  42.  * Revision 5.1  1991/12/05  07:55:50  brennan
  43.  * 1.1 pre-release
  44.  *
  45. */
  46.  
  47.  
  48. #include "mawk.h"
  49. #include "code.h"
  50. #include "memory.h"
  51. #include "symtype.h"
  52. #include "field.h"
  53. #include "bi_funct.h"
  54. #include "bi_vars.h"
  55. #include "regexp.h"
  56. #include "repl.h"
  57. #include "fin.h"
  58. #include <math.h>
  59.  
  60. static int PROTO( compare, (CELL *) ) ;
  61. static int PROTO( d_to_index, (double)) ;
  62.  
  63. #if   NOINFO_SIGFPE
  64. static char dz_msg[] = "division by zero" ;
  65. #endif
  66.  
  67. #ifdef   DEBUG
  68. static void PROTO( eval_overflow, (void) ) ;
  69.  
  70. #define  inc_sp()   if( ++sp == eval_stack+EVAL_STACK_SIZE )\
  71.                          eval_overflow()
  72. #else
  73.  
  74. /* If things are working, the eval stack should not overflow */
  75.  
  76. #define inc_sp()    sp++
  77. #endif
  78.  
  79. #define  SAFETY    16
  80. #define  DANGER    (EVAL_STACK_SIZE-SAFETY)
  81.  
  82. /*  The stack machine that executes the code */
  83.  
  84. CELL  eval_stack[EVAL_STACK_SIZE] ;
  85. /* these can move for deep recursion */
  86. static CELL  *stack_base = eval_stack ;
  87. static CELL  *stack_danger = eval_stack + DANGER ;      
  88.  
  89. #ifdef  DEBUG
  90. static void eval_overflow()
  91. { overflow("eval stack" , EVAL_STACK_SIZE) ; mawk_exit(1) ; }
  92. #endif
  93.  
  94. static INST *restart_label ; /* control flow labels */
  95. INST *next_label ;
  96. static CELL tc ; /*useful temp */
  97.  
  98. void  execute(cdp, sp, fp)
  99.   register INST *cdp ;  /* code ptr, start execution here */
  100.   register CELL *sp ;   /* eval_stack pointer */
  101.   CELL *fp ;            /* frame ptr into eval_stack for
  102.                            user defined functions */
  103. { 
  104.   /* some useful temporaries */
  105.   CELL *cp ;
  106.   int t ;
  107.  
  108.   /* for moving the stack (deep recursion) */
  109.   CELL *old_stack_base ;
  110.   CELL *old_sp ;
  111.  
  112. #ifdef  DEBUG
  113.   CELL *entry_sp = sp ;
  114. #endif
  115.  
  116.  
  117.   if ( fp )  /* we are a function call, check for deep recursion */
  118.   {
  119.     if (sp > stack_danger)
  120.     { /* change stacks */
  121.       old_stack_base = stack_base ;
  122.       old_sp = sp ;
  123.       stack_base = (CELL *) zmalloc(sizeof(CELL)*EVAL_STACK_SIZE) ;
  124.       stack_danger = stack_base + DANGER ;
  125.       sp = stack_base ;
  126.       /* waste 1 slot for ANSI, actually LM_DOS breaks in
  127.          RET if we don't */
  128. #ifdef  DEBUG 
  129.       entry_sp = sp ;
  130. #endif
  131.     }
  132.     else old_stack_base = (CELL*) 0 ;
  133.   }
  134.  
  135.   while ( 1 )
  136.     switch( cdp++ -> op )
  137.     {   
  138.  
  139. /* HALT only used by the disassemble now ; this remains
  140.    so compilers don't offset the jump table */
  141.         case  _HALT :
  142.  
  143.         case  _STOP :  /* only for range patterns */
  144. #ifdef  DEBUG
  145.                 if ( sp != entry_sp+1 ) bozo("stop0") ;
  146. #endif
  147.                 return ;
  148.  
  149.         case  _PUSHC :  
  150.             inc_sp() ;
  151.             (void) cellcpy(sp, cdp++ -> ptr) ;
  152.             break ;
  153.  
  154.         case _PUSHD  :
  155.             inc_sp() ;
  156.             sp->type = C_DOUBLE ;
  157.             sp->dval = *(double*) cdp++->ptr ;
  158.             break ;
  159.  
  160.         case  _PUSHS :
  161.             inc_sp() ;
  162.             sp->type = C_STRING ;
  163.             sp->ptr = cdp++->ptr ;
  164.             string(sp)->ref_cnt++ ;
  165.             break ;
  166.  
  167.         case  F_PUSHA :
  168.         cp = (CELL*)cdp->ptr ;
  169.         if ( cp != field )
  170.         {
  171.         if ( nf < 0 )  split_field0() ;
  172.  
  173.         if ( ! ( 
  174. #if    LM_DOS
  175.              SAMESEG(cp,field)   &&
  176. #endif
  177.               cp >= NF && cp <= LAST_PFIELD ) )
  178.         {
  179.           /* its a real field $1, $2 ... 
  180.              If its greater than $NF, we have to
  181.              make sure its set to ""  so that
  182.              (++|--) and g?sub() work right
  183.           */
  184.           t = field_addr_to_index(cp) ;
  185.           if ( t > nf )
  186.           {
  187.             cell_destroy(cp) ;
  188.             cp->type = C_STRING ;
  189.             cp->ptr = (PTR) &null_str ;
  190.             null_str.ref_cnt++ ;
  191.           }
  192.         }
  193.         }
  194.             /* fall thru */
  195.  
  196.         case  _PUSHA :
  197.         case  A_PUSHA :
  198.             inc_sp() ;
  199.             sp -> ptr = cdp++ -> ptr ;
  200.             break ;
  201.  
  202.         case _PUSHI :  /* put contents of next address on stack*/
  203.             inc_sp() ;
  204.             (void) cellcpy(sp, cdp++ -> ptr) ;
  205.             break ;
  206.             
  207.         case L_PUSHI :  
  208.             /* put the contents of a local var on stack,
  209.                cdp->op holds the offset from the frame pointer */
  210.             inc_sp() ;
  211.             (void) cellcpy(sp, fp + cdp++->op) ;
  212.             break ;
  213.  
  214.         case L_PUSHA : /* put a local address on eval stack */
  215.             inc_sp() ;
  216.             sp->ptr = (PTR)(fp + cdp++->op) ;
  217.             break ;
  218.  
  219.  
  220.         case F_PUSHI :
  221.  
  222.         /* push contents of $i 
  223.            cdp[0] holds & $i , cdp[1] holds i */
  224.  
  225.             inc_sp() ;
  226.             if ( nf < 0 )  split_field0() ;
  227.             cp = (CELL *) cdp->ptr ;
  228.             t =  (cdp+1)->op ;
  229.             cdp += 2 ;
  230.  
  231.             if ( t <= nf ) (void) cellcpy(sp, cp) ;
  232.             else  /* an unset field */
  233.             { sp->type = C_STRING ;
  234.               sp->ptr = (PTR) & null_str ;
  235.               null_str.ref_cnt++ ;
  236.             }
  237.             break ;
  238.  
  239.         case NF_PUSHI :
  240.  
  241.             inc_sp() ;
  242.             if ( nf < 0 ) split_field0() ;
  243.             (void) cellcpy(sp, NF) ;
  244.             break ;
  245.  
  246.         case  FE_PUSHA :
  247.  
  248.             if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  249.  
  250.         t = d_to_index(sp->dval) ;
  251.             if ( t && nf < 0 )  split_field0() ;
  252.             sp->ptr = (PTR) field_ptr(t) ;
  253.         if ( t > nf )
  254.         {
  255.           /* make sure its set to "" */
  256.           cp = sp->ptr ;
  257.           cell_destroy(cp) ;
  258.           cp->type = C_STRING ;
  259.           cp->ptr = (PTR) &null_str ;
  260.           null_str.ref_cnt++ ;
  261.         }
  262.             break ;
  263.  
  264.         case  FE_PUSHI :
  265.  
  266.             if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  267.  
  268.         t = d_to_index(sp->dval) ;
  269.  
  270.             if ( nf < 0)  split_field0() ;
  271.             if ( t <= nf ) (void) cellcpy(sp, field_ptr(t)) ;
  272.             else
  273.             { sp->type = C_STRING ;
  274.               sp->ptr = (PTR) & null_str ;
  275.               null_str.ref_cnt++ ;
  276.             }
  277.             break ; 
  278.  
  279.  
  280.         case  AE_PUSHA :
  281.         /* top of stack has an expr, cdp->ptr points at an
  282.            array, replace the expr with the cell address inside
  283.            the array */
  284.  
  285.             cp = array_find((ARRAY)cdp++->ptr, sp, CREATE) ;
  286.             cell_destroy(sp) ;
  287.             sp->ptr = (PTR) cp ;
  288.             break ;
  289.  
  290.         case  AE_PUSHI :
  291.         /* top of stack has an expr, cdp->ptr points at an
  292.            array, replace the expr with the contents of the
  293.            cell inside the array */
  294.  
  295.             cp = array_find((ARRAY) cdp++->ptr, sp, CREATE) ;
  296.             cell_destroy(sp) ;
  297.             (void) cellcpy(sp, cp) ;
  298.             break ;
  299.  
  300.         case  LAE_PUSHI :
  301.         /*  sp[0] is an expression
  302.             cdp->op is offset from frame pointer of a CELL which
  303.                has an ARRAY in the ptr field, replace expr
  304.             with  array[expr]
  305.         */
  306.             cp = array_find( (ARRAY)fp[cdp++->op].ptr, sp, CREATE) ;
  307.             cell_destroy(sp) ;
  308.             (void) cellcpy(sp, cp) ;
  309.             break ;
  310.             
  311.         case  LAE_PUSHA :
  312.         /*  sp[0] is an expression
  313.             cdp->op is offset from frame pointer of a CELL which
  314.                has an ARRAY in the ptr field, replace expr
  315.             with  & array[expr]
  316.         */
  317.             cp = array_find( (ARRAY)fp[cdp++->op].ptr, sp, CREATE) ;
  318.             cell_destroy(sp) ;
  319.             sp->ptr = (PTR) cp ;
  320.             break ;
  321.             
  322.         case  LA_PUSHA  :
  323.         /*  cdp->op is offset from frame pointer of a CELL which
  324.                has an ARRAY in the ptr field. Push this ARRAY
  325.                on the eval stack
  326.         */
  327.             inc_sp() ;
  328.             sp->ptr = fp[cdp++->op].ptr ;
  329.             break ;
  330.  
  331.         case  SET_ALOOP :
  332.             { ALOOP_STATE *ap = (ALOOP_STATE *)
  333.                             (cdp + cdp->op + 2)->ptr ;
  334.  
  335.               ap->var = (CELL *) sp[-1].ptr ;
  336.               ap->A = (ARRAY) sp->ptr ;
  337.               sp -= 2 ;
  338.  
  339.           ap->index = -1 ;
  340.               if ( inc_aloop_state(ap) )  cdp++ ;
  341.           else  cdp += cdp->op + 3 ;
  342.         }
  343.         break ;
  344.  
  345.         case  ALOOP :
  346.  
  347.         if ( inc_aloop_state( (ALOOP_STATE*) cdp[1].ptr ) )
  348.             cdp += cdp->op ;
  349.         else    cdp += 2 ;
  350.         break ;
  351.  
  352.         case  _POP : 
  353.             cell_destroy(sp) ;
  354.             sp-- ;
  355.             break ;
  356.  
  357.         case _DUP  :
  358.             (void) cellcpy(sp+1, sp) ;
  359.             sp++ ; break ;
  360.  
  361.         case  _ASSIGN :
  362.             /* top of stack has an expr, next down is an
  363.                address, put the expression in *address and
  364.                replace the address with the expression */
  365.  
  366.             /* don't propagate type C_MBSTRN */
  367.             if ( sp->type == C_MBSTRN ) check_strnum(sp) ;
  368.             sp-- ;
  369.             cell_destroy( ((CELL *)sp->ptr) ) ;
  370.             (void) cellcpy( sp, cellcpy(sp->ptr, sp+1) ) ;
  371.             cell_destroy(sp+1) ;
  372.             break ;
  373.  
  374.         case  F_ASSIGN : /* assign to a field  */
  375.             if (sp->type == C_MBSTRN) check_strnum(sp) ;
  376.             sp-- ;
  377.             field_assign((CELL*)sp->ptr, sp+1) ;
  378.             cell_destroy(sp+1) ;
  379.             (void) cellcpy(sp, (CELL *) sp->ptr) ;
  380.             break ;
  381.  
  382.         case  _ADD_ASG:
  383.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  384.             cp = (CELL *) (sp-1)->ptr ;
  385.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  386.  
  387. #if SW_FP_CHECK   /* specific to V7 and XNX23A */
  388.             clrerr();
  389. #endif
  390.             cp->dval += sp-- -> dval ;
  391. #if SW_FP_CHECK
  392.             fpcheck();
  393. #endif
  394.             sp->type = C_DOUBLE ;
  395.             sp->dval = cp->dval ;
  396.             break ;
  397.  
  398.         case  _SUB_ASG:
  399.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  400.             cp = (CELL *) (sp-1)->ptr ;
  401.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  402. #if SW_FP_CHECK
  403.             clrerr();
  404. #endif
  405.             cp->dval -= sp-- -> dval ;
  406. #if SW_FP_CHECK
  407.             fpcheck();
  408. #endif
  409.             sp->type = C_DOUBLE ;
  410.             sp->dval = cp->dval ;
  411.             break ;
  412.  
  413.         case  _MUL_ASG:
  414.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  415.             cp = (CELL *) (sp-1)->ptr ;
  416.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  417. #if SW_FP_CHECK
  418.             clrerr();
  419. #endif
  420.             cp->dval *= sp-- -> dval ;
  421. #if SW_FP_CHECK
  422.             fpcheck();
  423. #endif
  424.             sp->type = C_DOUBLE ;
  425.             sp->dval = cp->dval ;
  426.             break ;
  427.  
  428.         case  _DIV_ASG:
  429.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  430.             cp = (CELL *) (sp-1)->ptr ;
  431.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  432.  
  433. #if  NOINFO_SIGFPE
  434.         CHECK_DIVZERO(sp->dval) ;
  435. #endif
  436.  
  437. #if SW_FP_CHECK
  438.             clrerr();
  439. #endif
  440.             cp->dval /= sp-- -> dval ;
  441. #if SW_FP_CHECK
  442.             fpcheck();
  443. #endif
  444.             sp->type = C_DOUBLE ;
  445.             sp->dval = cp->dval ;
  446.             break ;
  447.  
  448.         case  _MOD_ASG:
  449.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  450.             cp = (CELL *) (sp-1)->ptr ;
  451.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  452.  
  453. #if  NOINFO_SIGFPE
  454.         CHECK_DIVZERO(sp->dval) ;
  455. #endif
  456.  
  457.             cp->dval = fmod(cp->dval,sp-- -> dval) ;
  458.             sp->type = C_DOUBLE ;
  459.             sp->dval = cp->dval ;
  460.             break ;
  461.  
  462.         case  _POW_ASG:
  463.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  464.             cp = (CELL *) (sp-1)->ptr ;
  465.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  466.             cp->dval = pow(cp->dval,sp-- -> dval) ;
  467.             sp->type = C_DOUBLE ;
  468.             sp->dval = cp->dval ;
  469.             break ;
  470.  
  471.         /* will anyone ever use these ? */
  472.  
  473.         case F_ADD_ASG :
  474.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  475.             cp = (CELL *) (sp-1)->ptr ;
  476.             cast1_to_d( cellcpy(&tc, cp) ) ;
  477. #if SW_FP_CHECK
  478.             clrerr();
  479. #endif
  480.             tc.dval += sp-- -> dval ;
  481. #if SW_FP_CHECK
  482.             fpcheck();
  483. #endif
  484.             sp->type = C_DOUBLE ;
  485.             sp->dval = tc.dval ;
  486.             field_assign(cp, &tc) ;
  487.             break ;
  488.  
  489.         case F_SUB_ASG :
  490.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  491.             cp = (CELL *) (sp-1)->ptr ;
  492.             cast1_to_d( cellcpy(&tc, cp) ) ;
  493. #if SW_FP_CHECK
  494.             clrerr();
  495. #endif
  496.             tc.dval -= sp-- -> dval ;
  497. #if SW_FP_CHECK
  498.             fpcheck();
  499. #endif
  500.             sp->type = C_DOUBLE ;
  501.             sp->dval = tc.dval ;
  502.             field_assign(cp, &tc) ;
  503.             break ;
  504.  
  505.         case F_MUL_ASG :
  506.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  507.             cp = (CELL *) (sp-1)->ptr ;
  508.             cast1_to_d( cellcpy(&tc, cp) ) ;
  509. #if SW_FP_CHECK
  510.             clrerr();
  511. #endif
  512.             tc.dval *= sp-- -> dval ;
  513. #if SW_FP_CHECK
  514.             fpcheck();
  515. #endif
  516.             sp->type = C_DOUBLE ;
  517.             sp->dval = tc.dval ;
  518.             field_assign(cp, &tc) ;
  519.             break ;
  520.  
  521.         case F_DIV_ASG :
  522.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  523.             cp = (CELL *) (sp-1)->ptr ;
  524.             cast1_to_d( cellcpy(&tc, cp) ) ;
  525.  
  526. #if  NOINFO_SIGFPE
  527.         CHECK_DIVZERO(sp->dval) ;
  528. #endif
  529.  
  530. #if SW_FP_CHECK
  531.             clrerr();
  532. #endif
  533.             tc.dval /= sp-- -> dval ;
  534. #if SW_FP_CHECK
  535.             fpcheck();
  536. #endif
  537.             sp->type = C_DOUBLE ;
  538.             sp->dval = tc.dval ;
  539.             field_assign(cp, &tc) ;
  540.             break ;
  541.  
  542.         case F_MOD_ASG :
  543.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  544.             cp = (CELL *) (sp-1)->ptr ;
  545.             cast1_to_d( cellcpy(&tc, cp) ) ;
  546.  
  547. #if  NOINFO_SIGFPE
  548.         CHECK_DIVZERO(sp->dval) ;
  549. #endif
  550.  
  551.             tc.dval = fmod(tc.dval, sp-- -> dval) ;
  552.             sp->type = C_DOUBLE ;
  553.             sp->dval = tc.dval ;
  554.             field_assign(cp, &tc) ;
  555.             break ;
  556.  
  557.         case F_POW_ASG :
  558.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  559.             cp = (CELL *) (sp-1)->ptr ;
  560.             cast1_to_d( cellcpy(&tc, cp) ) ;
  561.             tc.dval = pow(tc.dval, sp-- -> dval) ;
  562.             sp->type = C_DOUBLE ;
  563.             sp->dval = tc.dval ;
  564.             field_assign(cp, &tc) ;
  565.             break ;
  566.  
  567.         case _ADD :
  568.             sp-- ;
  569.             if ( TEST2(sp) != TWO_DOUBLES )
  570.                     cast2_to_d(sp) ;
  571. #if SW_FP_CHECK
  572.             clrerr();
  573. #endif
  574.             sp[0].dval += sp[1].dval ;
  575. #if SW_FP_CHECK
  576.             fpcheck();
  577. #endif
  578.             break ;
  579.  
  580.         case _SUB :
  581.             sp-- ;
  582.             if ( TEST2(sp) != TWO_DOUBLES )
  583.                     cast2_to_d(sp) ;
  584. #if SW_FP_CHECK
  585.             clrerr();
  586. #endif
  587.             sp[0].dval -= sp[1].dval ;
  588. #if SW_FP_CHECK
  589.             fpcheck();
  590. #endif
  591.             break ;
  592.  
  593.         case _MUL :
  594.             sp-- ;
  595.             if ( TEST2(sp) != TWO_DOUBLES )
  596.                     cast2_to_d(sp) ;
  597. #if SW_FP_CHECK
  598.             clrerr();
  599. #endif
  600.             sp[0].dval *= sp[1].dval ;
  601. #if SW_FP_CHECK
  602.             fpcheck();
  603. #endif
  604.             break ;
  605.  
  606.         case _DIV :
  607.             sp-- ;
  608.             if ( TEST2(sp) != TWO_DOUBLES )
  609.                     cast2_to_d(sp) ;
  610.  
  611. #if  NOINFO_SIGFPE
  612.         CHECK_DIVZERO(sp[1].dval) ;
  613. #endif
  614.  
  615. #if SW_FP_CHECK
  616.             clrerr();
  617. #endif
  618.             sp[0].dval /= sp[1].dval ;
  619. #if SW_FP_CHECK
  620.             fpcheck();
  621. #endif
  622.             break ;
  623.  
  624.         case _MOD :
  625.             sp-- ;
  626.             if ( TEST2(sp) != TWO_DOUBLES )
  627.                     cast2_to_d(sp) ;
  628.  
  629. #if  NOINFO_SIGFPE
  630.         CHECK_DIVZERO(sp[1].dval) ;
  631. #endif
  632.  
  633.             sp[0].dval = fmod(sp[0].dval,sp[1].dval) ;
  634.             break ;
  635.  
  636.         case _POW :
  637.             sp-- ;
  638.             if ( TEST2(sp) != TWO_DOUBLES )
  639.                     cast2_to_d(sp) ;
  640.             sp[0].dval = pow(sp[0].dval,sp[1].dval) ;
  641.             break ;
  642.  
  643.         case _NOT :
  644.         reswitch_1:
  645.             switch( sp->type )
  646.             { case C_NOINIT :
  647.                     sp->dval = 1.0 ; break ;
  648.               case C_DOUBLE :
  649.                     sp->dval = D2BOOL(sp->dval) ? 0.0 : 1.0 ;
  650.                     break ;
  651.               case C_STRING :
  652.                     sp->dval = string(sp)->len ? 0.0 : 1.0 ;
  653.                     free_STRING(string(sp)) ;
  654.                     break ;
  655.               case C_STRNUM : /* test as a number */
  656.                     sp->dval = D2BOOL(sp->dval) ? 0.0 : 1.0 ;
  657.                     free_STRING(string(sp)) ;
  658.                     break ;
  659.               case C_MBSTRN :
  660.                     check_strnum(sp) ;
  661.                     goto reswitch_1 ;
  662.               default :
  663.                     bozo("bad type on eval stack") ;
  664.             }
  665.             sp->type = C_DOUBLE ;
  666.             break  ;
  667.  
  668.         case _TEST :
  669.         reswitch_2:
  670.             switch( sp->type )
  671.             { case C_NOINIT :
  672.                     sp->dval = 0.0 ; break ;
  673.               case C_DOUBLE :
  674.                     sp->dval = D2BOOL(sp->dval) ? 1.0 : 0.0 ;
  675.                     break ;
  676.               case C_STRING :
  677.                     sp->dval  = string(sp)->len ? 1.0 : 0.0 ;
  678.                     free_STRING(string(sp)) ;
  679.                     break ;
  680.               case C_STRNUM : /* test as a number */
  681.                     sp->dval = D2BOOL(sp->dval) ? 1.0 : 0.0 ;
  682.                     free_STRING(string(sp)) ;
  683.                     break ;
  684.               case C_MBSTRN :
  685.                     check_strnum(sp) ;
  686.                     goto reswitch_2 ;
  687.               default :
  688.                     bozo("bad type on eval stack") ;
  689.             }
  690.             sp->type = C_DOUBLE ;
  691.             break ;
  692.  
  693.         case _UMINUS :
  694.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  695.             sp->dval = - sp->dval ;
  696.             break ;
  697.  
  698.         case _UPLUS :  
  699.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  700.             break ;
  701.  
  702.         case _CAT :
  703.             { unsigned len1, len2 ;
  704.               char *str1, *str2 ;
  705.               STRING *b ;
  706.               
  707.               sp-- ;
  708.               if ( TEST2(sp) != TWO_STRINGS )
  709.                     cast2_to_s(sp) ;
  710.               str1 = string(sp)->str ;
  711.               len1 = string(sp)->len ;
  712.               str2 = string(sp+1)->str ;
  713.               len2 = string(sp+1)->len ;
  714.  
  715.               b = new_STRING((char *)0, len1+len2) ;
  716.               (void) memcpy(b->str, str1, SIZE_T(len1)) ;
  717.               (void) memcpy(b->str + len1, str2, SIZE_T(len2)) ;
  718.               free_STRING(string(sp)) ;
  719.               free_STRING( string(sp+1) ) ;
  720.  
  721.               sp->ptr = (PTR) b ;
  722.               break ;
  723.             }
  724.  
  725.         case _PUSHINT :
  726.             inc_sp() ;
  727.             sp->type = cdp++ -> op ;
  728.             break ;
  729.  
  730.         case _BUILTIN :
  731.         case _PRINT :
  732.             sp = (* (PF_CP) cdp++ -> ptr) (sp) ;
  733.             break ;
  734.  
  735.         case _POST_INC :
  736.         cp = (CELL *)sp->ptr ;
  737.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  738.         sp->type = C_DOUBLE ;
  739.         sp->dval = cp->dval ;
  740.             cp->dval += 1.0 ;
  741.             break ;
  742.  
  743.         case _POST_DEC :
  744.         cp = (CELL *)sp->ptr ;
  745.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  746.         sp->type = C_DOUBLE ;
  747.         sp->dval = cp->dval ;
  748.             cp->dval -= 1.0 ;
  749.             break ;
  750.  
  751.         case _PRE_INC :
  752.             cp = (CELL *) sp->ptr ;
  753.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  754.             sp->dval = cp->dval += 1.0 ;
  755.             sp->type = C_DOUBLE ;
  756.             break ;
  757.  
  758.         case _PRE_DEC :
  759.             cp = (CELL *) sp->ptr ;
  760.             if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
  761.             sp->dval = cp->dval -= 1.0 ;
  762.             sp->type = C_DOUBLE ;
  763.             break ;
  764.  
  765.  
  766.         case F_POST_INC  :
  767.             cp = (CELL *) sp->ptr ;
  768.         (void) cellcpy(&tc, cp) ;
  769.         cast1_to_d(&tc) ;
  770.         sp->type = C_DOUBLE ;
  771.         sp->dval = tc.dval ;
  772.         tc.dval += 1.0 ;
  773.             field_assign(cp, &tc) ;
  774.             break ;
  775.  
  776.         case F_POST_DEC  :
  777.             cp = (CELL *) sp->ptr ;
  778.         (void) cellcpy(&tc, cp) ;
  779.         cast1_to_d(&tc) ;
  780.         sp->type = C_DOUBLE ;
  781.         sp->dval = tc.dval ;
  782.         tc.dval -= 1.0 ;
  783.             field_assign(cp, &tc) ;
  784.             break ;
  785.  
  786.         case F_PRE_INC :
  787.             cp = (CELL *) sp->ptr ;
  788.             cast1_to_d(cellcpy(sp, cp)) ;
  789.             sp->dval += 1.0 ;
  790.             field_assign(cp, sp) ;
  791.             break ;
  792.  
  793.         case F_PRE_DEC :
  794.             cp = (CELL *) sp->ptr ;
  795.             cast1_to_d(cellcpy(sp, cp)) ;
  796.             sp->dval -= 1.0 ;
  797.             field_assign(cp, sp) ;
  798.             break ;
  799.  
  800.         case _JMP  :
  801.             cdp += cdp->op  ;
  802.             break ;
  803.  
  804.         case _JNZ  :
  805.             /* jmp if top of stack is non-zero and pop stack */
  806.             if ( test( sp ) )
  807.                 cdp += cdp->op  ;
  808.             else  cdp++ ;
  809.             cell_destroy(sp) ;
  810.             sp-- ;
  811.             break ;
  812.  
  813.         case _JZ  :
  814.             /* jmp if top of stack is zero and pop stack */
  815.             if ( ! test( sp ) )
  816.                 cdp += cdp->op  ;
  817.             else  cdp++ ;
  818.             cell_destroy(sp) ;
  819.             sp-- ;
  820.             break ;
  821.  
  822.     /*  the relation operations */
  823.     /*  compare() makes sure string ref counts are OK */
  824.         case  _EQ :
  825.             t = compare(--sp) ;
  826.             sp->type = C_DOUBLE ;
  827.             sp->dval = t == 0 ? 1.0 : 0.0 ;
  828.             break ;
  829.  
  830.         case  _NEQ :
  831.             t = compare(--sp) ;
  832.             sp->type = C_DOUBLE ;
  833.             sp->dval = t ? 1.0 : 0.0 ;
  834.             break ;
  835.  
  836.         case  _LT :
  837.             t = compare(--sp) ;
  838.             sp->type = C_DOUBLE ;
  839.             sp->dval = t < 0 ? 1.0 : 0.0 ;
  840.             break ;
  841.  
  842.         case  _LTE :
  843.             t = compare(--sp) ;
  844.             sp->type = C_DOUBLE ;
  845.             sp->dval = t <= 0 ? 1.0 : 0.0 ;
  846.             break ;
  847.  
  848.         case  _GT :
  849.             t = compare(--sp) ;
  850.             sp->type = C_DOUBLE ;
  851.             sp->dval = t > 0 ? 1.0 : 0.0 ;
  852.             break ;
  853.  
  854.         case  _GTE :
  855.             t = compare(--sp) ;
  856.             sp->type = C_DOUBLE ;
  857.             sp->dval = t >= 0 ? 1.0 : 0.0 ;
  858.             break ;
  859.  
  860.         case _MATCH0 : 
  861.             /* does $0 match, the RE at cdp */
  862.  
  863.             inc_sp() ;
  864.             if ( field->type >= C_STRING )
  865.             { sp->type = C_DOUBLE ;
  866.               sp->dval = REtest(string(field)->str, cdp++->ptr)
  867.                          ? 1.0 : 0.0 ;
  868.  
  869.               break /* the case */ ;
  870.             }
  871.             else
  872.             {
  873.               cellcpy(sp, field) ;
  874.               /* and FALL THRU */
  875.             }
  876.  
  877.         case _MATCH1 :
  878.             /* does expr at sp[0] match RE at cdp */
  879.             if ( sp->type < C_STRING ) cast1_to_s(sp) ;
  880.             t = REtest(string(sp)->str, cdp++->ptr) ;
  881.             free_STRING(string(sp)) ;
  882.             sp->type = C_DOUBLE ;
  883.             sp->dval = t ? 1.0 : 0.0 ;
  884.             break ;
  885.  
  886.  
  887.         case  _MATCH2 :
  888.             /* does sp[-1] match sp[0] as re */
  889.              cast_to_RE(sp) ;
  890.  
  891.             if ( (--sp)->type < C_STRING )  cast1_to_s(sp) ;
  892.             t = REtest(string(sp)->str, (sp+1)->ptr) ; 
  893.  
  894.             free_STRING(string(sp)) ;
  895.             sp->type = C_DOUBLE ;
  896.             sp->dval = t ? 1.0 : 0.0 ;
  897.             break ;
  898.  
  899.         case  A_TEST :
  900.         /* entry :  sp[0].ptr-> an array
  901.                     sp[-1]  is an expression
  902.  
  903.            we compute   expression in array  */
  904.             sp-- ;
  905.             cp = array_find( (sp+1)->ptr, sp, NO_CREATE) ;
  906.             cell_destroy(sp) ;
  907.             sp->type = C_DOUBLE ;
  908.             sp->dval = (cp!=(CELL*)0)  ? 1.0 : 0.0 ;
  909.             break ;
  910.  
  911.         case  A_DEL :
  912.         /* sp[0].ptr ->  array
  913.            sp[-1] is an expr
  914.            delete  array[expr]  */
  915.  
  916.             array_delete(sp->ptr, sp-1) ;
  917.             cell_destroy(sp-1) ;
  918.             sp -= 2 ;
  919.             break ;
  920.         
  921.         /* form a multiple array index */
  922.         case A_CAT :
  923.             sp = array_cat(sp, cdp++->op) ;
  924.             break ;
  925.  
  926.         case  _EXIT  :
  927.             if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
  928.             exit_code = d_to_i(sp->dval) ;
  929.         sp-- ;
  930.             /* fall thru */
  931.  
  932.         case  _EXIT0 :
  933.             if ( !(cdp = end_code.start) ) mawk_exit(exit_code) ;
  934.  
  935.             end_code.start = (INST *) 0 ; /* makes sure next exit exits */
  936.             if ( begin_code.start )
  937.          zfree(begin_code.start, begin_code.size) ;
  938.             if ( main_start )  zfree(main_start, main_size);
  939.             sp = eval_stack - 1 ; /* might be in user function */
  940.             break ;
  941.  
  942.         case  _JMAIN : /* go from BEGIN code to MAIN code */
  943.             zfree(begin_code.start, begin_code.size) ;
  944.             begin_code.start = (INST *) 0 ;
  945.             cdp = main_start ;
  946.             break ;
  947.  
  948.         case  _OMAIN :
  949.             if ( !main_fin )  open_main() ;
  950.             restart_label = cdp ;
  951.             cdp = next_label ;
  952.             break ;
  953.  
  954.         case  _NEXT :
  955.             cdp = next_label ;
  956.             break ;
  957.  
  958.         case  OL_GL :
  959.             {
  960.               char *p ;
  961.               unsigned len ;
  962.  
  963.               if ( !(p = FINgets(main_fin, &len)) )
  964.               {
  965.                 if ( !end_code.start )  mawk_exit(0) ;
  966.  
  967.                 cdp = end_code.start ;
  968.                 zfree(main_start, main_size) ;
  969.                 main_start = end_code.start = (INST*) 0 ;
  970.               }
  971.               else
  972.               { set_field0(p, len) ; cdp = restart_label ; }
  973.             }
  974.             break ;
  975.  
  976.         case  OL_GL_NR :
  977.             {
  978.               char *p ;
  979.               unsigned len ;
  980.  
  981.               if ( !(p = FINgets(main_fin, &len)) )
  982.               {
  983.                 if ( !end_code.start )  mawk_exit(0) ;
  984.  
  985.                 cdp = end_code.start ;
  986.                 zfree(main_start, main_size) ;
  987.                 main_start = end_code.start = (INST*) 0 ;
  988.               }
  989.               else
  990.               {
  991.                 set_field0(p, len) ; 
  992.                 cdp = restart_label ;
  993.  
  994.                 if ( TEST2(NR) != TWO_DOUBLES ) cast2_to_d(NR) ;
  995.  
  996.                 NR->dval += 1.0 ;
  997.                 FNR->dval += 1.0 ;
  998.               }
  999.             }
  1000.             break ;
  1001.  
  1002.  
  1003.         case  _RANGE :
  1004. /* test a range pattern:  pat1, pat2 { action }
  1005.    entry :
  1006.        cdp[0].op -- a flag, test pat1 if on else pat2
  1007.        cdp[1].op -- offset of pat2 code from cdp
  1008.        cdp[2].op -- offset of action code from cdp
  1009.        cdp[3].op -- offset of code after the action from cdp
  1010.        cdp[4] -- start of pat1 code
  1011. */
  1012.  
  1013. #define FLAG    cdp[0].op
  1014. #define PAT2    cdp[1].op
  1015. #define ACTION    cdp[2].op
  1016. #define FOLLOW    cdp[3].op
  1017. #define PAT1      4
  1018.  
  1019.             if ( FLAG )  /* test again pat1 */
  1020.             { 
  1021.               execute(cdp + PAT1,sp, fp) ;
  1022.               t = test(sp+1) ;
  1023.               cell_destroy(sp+1) ;
  1024.               if ( t )  FLAG = 0 ;
  1025.               else
  1026.               { cdp += FOLLOW ;
  1027.                 break ;  /* break the switch */
  1028.               }
  1029.             }
  1030.  
  1031.             /* test against pat2 and then perform the action */
  1032.             execute(cdp + PAT2, sp, fp) ;
  1033.             FLAG  = test(sp+1) ;
  1034.             cell_destroy(sp+1) ; 
  1035.             cdp += ACTION ;
  1036.             break ;
  1037.  
  1038. /* function calls  */
  1039.  
  1040.       case  _RET0  :
  1041.             inc_sp() ;
  1042.             sp->type = C_NOINIT ;
  1043.             /* fall thru */
  1044.  
  1045.       case  _RET   :
  1046.  
  1047. #ifdef  DEBUG 
  1048.             if ( sp != entry_sp+1 ) bozo("ret") ;
  1049. #endif
  1050.             if ( old_stack_base ) /* reset stack */
  1051.             {
  1052.               /* move the return value */
  1053.               (void) cellcpy(old_sp+1, sp) ;
  1054.               cell_destroy(sp) ;
  1055.               zfree(stack_base, sizeof(CELL)*EVAL_STACK_SIZE) ;
  1056.               stack_base = old_stack_base ;
  1057.               stack_danger = old_stack_base + DANGER ;
  1058.             }
  1059.               
  1060.             return  ;
  1061.  
  1062.       case  _CALL  :
  1063.  
  1064.             { FBLOCK *fbp = (FBLOCK*) cdp++->ptr ;
  1065.               int a_args = cdp++->op ; /* actual number of args */
  1066.               CELL *nfp = sp - a_args + 1 ; /* new fp for callee */
  1067.               CELL *local_p = sp+1; /* first local argument on stack */
  1068.               char *type_p ;  /* pts to type of an argument */
  1069.  
  1070.               if ( fbp->nargs ) type_p = fbp->typev + a_args ;
  1071.  
  1072.               /* create space for locals */
  1073.               if ( t = fbp->nargs - a_args ) /* have local args */
  1074.               {
  1075.                 while ( t-- )  
  1076.                 { (++sp)->type = C_NOINIT ;
  1077.                   if ( *type_p++ == ST_LOCAL_ARRAY )
  1078.                         sp->ptr = (PTR) new_ARRAY() ;
  1079.                 }
  1080.               }
  1081.               type_p-- ; /* *type_p is type of last arg */ 
  1082.  
  1083.               execute(fbp->code, sp, nfp) ;
  1084.  
  1085.               /* cleanup the callee's arguments */
  1086.               if ( sp >= nfp ) 
  1087.               {
  1088.                 cp = sp+1 ;  /* cp -> the function return */
  1089.  
  1090.                 do
  1091.                 {
  1092.                   if ( *type_p-- == ST_LOCAL_ARRAY )
  1093.                   {  if ( sp >= local_p ) array_free(sp->ptr) ; }
  1094.                   else  cell_destroy(sp) ;
  1095.  
  1096.                 } while ( --sp >= nfp ) ;
  1097.                     
  1098.                 (void) cellcpy(++sp, cp) ;
  1099.                 cell_destroy(cp) ;
  1100.               }
  1101.               else  sp++ ; /* no arguments passed */
  1102.             }
  1103.             break ;
  1104.  
  1105.         default :
  1106.             bozo("bad opcode") ;
  1107.     }
  1108. }
  1109.  
  1110. int test( cp )  /* test if a cell is null or not */
  1111.   register CELL *cp ;
  1112. { 
  1113. reswitch :
  1114.  
  1115.   switch ( cp->type )
  1116.   {
  1117.     case C_NOINIT :  return  0 ;
  1118.     case C_STRNUM :  /* test as a number */
  1119.     case C_DOUBLE :  return  cp->dval != 0.0 ;
  1120.     case C_STRING :  return  string(cp)->len ;
  1121.     case C_MBSTRN :  check_strnum(cp) ; goto reswitch ;
  1122.  
  1123.     default :
  1124.       bozo("bad cell type in call to test") ;
  1125.   }
  1126.   return 0 ; /*can't get here: shutup */
  1127. }
  1128.  
  1129. /* compare cells at cp and cp+1 and
  1130.    frees STRINGs at those cells
  1131. */
  1132. static int compare(cp)
  1133.   register CELL *cp ;
  1134. { int k ;
  1135.  
  1136. reswitch :
  1137.  
  1138.   switch( TEST2(cp) )
  1139.   { case TWO_NOINITS :  return 0 ; 
  1140.     
  1141.     case TWO_DOUBLES :
  1142.     two_d:
  1143.             return  cp->dval > (cp+1)->dval ? 1 :
  1144.                     cp->dval < (cp+1)->dval ? -1 : 0 ;
  1145.     
  1146.     case TWO_STRINGS :
  1147.     case STRING_AND_STRNUM :
  1148.     two_s:
  1149.             k = strcmp(string(cp)->str, string(cp+1)->str) ;
  1150.             free_STRING( string(cp) ) ;
  1151.             free_STRING( string(cp+1) ) ;
  1152.             return k ;
  1153.  
  1154.     case  NOINIT_AND_DOUBLE  :
  1155.     case  NOINIT_AND_STRNUM  :
  1156.     case  DOUBLE_AND_STRNUM  :
  1157.     case TWO_STRNUMS :
  1158.             cast2_to_d(cp) ; goto two_d ;
  1159.  
  1160.     case  NOINIT_AND_STRING  :
  1161.     case  DOUBLE_AND_STRING  :
  1162.             cast2_to_s(cp) ; goto two_s ;
  1163.  
  1164.     case  TWO_MBSTRNS :
  1165.             check_strnum(cp) ; check_strnum(cp+1) ;
  1166.             goto reswitch ;
  1167.  
  1168.     case  NOINIT_AND_MBSTRN :
  1169.     case  DOUBLE_AND_MBSTRN :
  1170.     case  STRING_AND_MBSTRN :
  1171.     case  STRNUM_AND_MBSTRN :
  1172.             check_strnum( cp->type == C_MBSTRN ? cp : cp+1 ) ;
  1173.             goto reswitch ;
  1174.  
  1175.     default :  /* there are no default cases */
  1176.             bozo("bad cell type passed to compare") ;
  1177.   }
  1178.   return 0 ; /* shut up */
  1179. }
  1180.  
  1181. /* does not assume target was a cell, if so
  1182.    then caller should have made a previous
  1183.    call to cell_destroy  */
  1184.  
  1185. CELL *cellcpy(target, source)
  1186.   register CELL *target, *source ;
  1187. { switch( target->type = source->type )
  1188.   { case C_NOINIT : 
  1189.     case C_SPACE  : 
  1190.     case C_SNULL  :
  1191.             break ;
  1192.  
  1193.     case C_DOUBLE :
  1194.             target->dval = source->dval ;
  1195.             break ;
  1196.  
  1197.     case C_STRNUM :
  1198.             target->dval = source->dval ;
  1199.             /* fall thru */
  1200.  
  1201.     case C_REPL    :
  1202.     case C_MBSTRN  :
  1203.     case C_STRING  :
  1204.             string(source)->ref_cnt++ ;
  1205.             /* fall thru */
  1206.  
  1207.     case C_RE  :
  1208.             target->ptr = source->ptr ;
  1209.             break ;
  1210.  
  1211.     case  C_REPLV :
  1212.             (void)  replv_cpy(target, source) ;
  1213.             break ;
  1214.  
  1215.     default :
  1216.             bozo("bad cell passed to cellcpy()") ;
  1217.             break ;
  1218.   }
  1219.   return  target ;
  1220. }
  1221.  
  1222. #ifdef   DEBUG
  1223.  
  1224. void  DB_cell_destroy(cp)    /* HANGOVER time */
  1225.   register CELL *cp ;
  1226. {
  1227.   switch( cp->type )
  1228.   { case C_NOINIT :
  1229.     case C_DOUBLE :  break ;
  1230.  
  1231.     case C_MBSTRN :
  1232.     case C_STRING :
  1233.     case C_STRNUM :
  1234.             if ( -- string(cp)->ref_cnt == 0 )
  1235.                 zfree(string(cp) , string(cp)->len+STRING_OH) ;
  1236.             break ;
  1237.  
  1238.     case  C_RE :
  1239.             bozo("cell destroy called on RE cell") ;
  1240.     default :
  1241.             bozo("cell destroy called on bad cell type") ;
  1242.   }
  1243. }
  1244.  
  1245. #endif
  1246.  
  1247.  
  1248.  
  1249. /* convert a double d to a field index  $d -> $i */
  1250. static int
  1251. d_to_index( d ) 
  1252.   double d ;
  1253. {
  1254.  
  1255.   if ( d > MAX_FIELD ) 
  1256.         rt_overflow("maximum number of fields", MAX_FIELD) ;
  1257.   
  1258.   if ( d >= 0.0 )  return (int) d ;
  1259.   
  1260.   /* might include nan */
  1261.   rt_error("negative field index $%.6g", d) ;
  1262.   return 0 ; /* shutup */
  1263. }
  1264.