1267 lines
33 KiB
C
1267 lines
33 KiB
C
|
|
/********************************************
|
|
execute.c
|
|
copyright 1991, Michael D. Brennan
|
|
|
|
This is a source file for mawk, an implementation of
|
|
the AWK programming language.
|
|
|
|
Mawk is distributed without warranty under the terms of
|
|
the GNU General Public License, version 2, 1991.
|
|
********************************************/
|
|
|
|
/* $Log: execute.c,v $
|
|
/* Revision 1.2 1993/07/02 23:57:14 jtc
|
|
/* Updated to mawk 1.1.4
|
|
/*
|
|
* Revision 5.7.1.1 1993/01/15 03:33:39 mike
|
|
* patch3: safer double to int conversion
|
|
*
|
|
* Revision 5.7 1992/12/17 02:48:01 mike
|
|
* 1.1.2d changes for DOS
|
|
*
|
|
* Revision 5.6 1992/11/29 18:57:50 mike
|
|
* field expressions convert to long so 16 bit and 32 bit
|
|
* systems behave the same
|
|
*
|
|
* Revision 5.5 1992/08/11 15:24:55 brennan
|
|
* patch2: F_PUSHA and FE_PUSHA
|
|
* If this is preparation for g?sub(r,s,$expr) or (++|--) on $expr,
|
|
* then if expr > NF, make sure $expr is set to ""
|
|
*
|
|
* Revision 5.4 1992/08/11 14:51:54 brennan
|
|
* patch2: $expr++ is numeric even if $expr is string.
|
|
* I forgot to do this earlier when handling x++ case.
|
|
*
|
|
* Revision 5.3 1992/07/08 17:03:30 brennan
|
|
* patch 2
|
|
* revert to version 1.0 comparisons, i.e.
|
|
* page 44-45 of AWK book
|
|
*
|
|
* Revision 5.2 1992/04/20 21:40:40 brennan
|
|
* patch 2
|
|
* x++ is numeric, even if x is string
|
|
*
|
|
* Revision 5.1 1991/12/05 07:55:50 brennan
|
|
* 1.1 pre-release
|
|
*
|
|
*/
|
|
|
|
|
|
#include "mawk.h"
|
|
#include "code.h"
|
|
#include "memory.h"
|
|
#include "symtype.h"
|
|
#include "field.h"
|
|
#include "bi_funct.h"
|
|
#include "bi_vars.h"
|
|
#include "regexp.h"
|
|
#include "repl.h"
|
|
#include "fin.h"
|
|
#include <math.h>
|
|
|
|
static int PROTO( compare, (CELL *) ) ;
|
|
static int PROTO( d_to_index, (double)) ;
|
|
|
|
#if NOINFO_SIGFPE
|
|
static char dz_msg[] = "division by zero" ;
|
|
#endif
|
|
|
|
#ifdef DEBUG
|
|
static void PROTO( eval_overflow, (void) ) ;
|
|
|
|
#define inc_sp() if( ++sp == eval_stack+EVAL_STACK_SIZE )\
|
|
eval_overflow()
|
|
#else
|
|
|
|
/* If things are working, the eval stack should not overflow */
|
|
|
|
#define inc_sp() sp++
|
|
#endif
|
|
|
|
#define SAFETY 16
|
|
#define DANGER (EVAL_STACK_SIZE-SAFETY)
|
|
|
|
/* The stack machine that executes the code */
|
|
|
|
CELL eval_stack[EVAL_STACK_SIZE] ;
|
|
/* these can move for deep recursion */
|
|
static CELL *stack_base = eval_stack ;
|
|
static CELL *stack_danger = eval_stack + DANGER ;
|
|
|
|
#ifdef DEBUG
|
|
static void eval_overflow()
|
|
{ overflow("eval stack" , EVAL_STACK_SIZE) ; mawk_exit(1) ; }
|
|
#endif
|
|
|
|
static INST *restart_label ; /* control flow labels */
|
|
INST *next_label ;
|
|
static CELL tc ; /*useful temp */
|
|
|
|
void execute(cdp, sp, fp)
|
|
register INST *cdp ; /* code ptr, start execution here */
|
|
register CELL *sp ; /* eval_stack pointer */
|
|
CELL *fp ; /* frame ptr into eval_stack for
|
|
user defined functions */
|
|
{
|
|
/* some useful temporaries */
|
|
CELL *cp ;
|
|
int t ;
|
|
|
|
/* for moving the stack (deep recursion) */
|
|
CELL *old_stack_base ;
|
|
CELL *old_sp ;
|
|
|
|
#ifdef DEBUG
|
|
CELL *entry_sp = sp ;
|
|
#endif
|
|
|
|
|
|
if ( fp ) /* we are a function call, check for deep recursion */
|
|
{
|
|
if (sp > stack_danger)
|
|
{ /* change stacks */
|
|
old_stack_base = stack_base ;
|
|
old_sp = sp ;
|
|
stack_base = (CELL *) zmalloc(sizeof(CELL)*EVAL_STACK_SIZE) ;
|
|
stack_danger = stack_base + DANGER ;
|
|
sp = stack_base ;
|
|
/* waste 1 slot for ANSI, actually LM_DOS breaks in
|
|
RET if we don't */
|
|
#ifdef DEBUG
|
|
entry_sp = sp ;
|
|
#endif
|
|
}
|
|
else old_stack_base = (CELL*) 0 ;
|
|
}
|
|
|
|
while ( 1 )
|
|
switch( cdp++ -> op )
|
|
{
|
|
|
|
/* HALT only used by the disassemble now ; this remains
|
|
so compilers don't offset the jump table */
|
|
case _HALT :
|
|
|
|
case _STOP : /* only for range patterns */
|
|
#ifdef DEBUG
|
|
if ( sp != entry_sp+1 ) bozo("stop0") ;
|
|
#endif
|
|
return ;
|
|
|
|
case _PUSHC :
|
|
inc_sp() ;
|
|
(void) cellcpy(sp, cdp++ -> ptr) ;
|
|
break ;
|
|
|
|
case _PUSHD :
|
|
inc_sp() ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = *(double*) cdp++->ptr ;
|
|
break ;
|
|
|
|
case _PUSHS :
|
|
inc_sp() ;
|
|
sp->type = C_STRING ;
|
|
sp->ptr = cdp++->ptr ;
|
|
string(sp)->ref_cnt++ ;
|
|
break ;
|
|
|
|
case F_PUSHA :
|
|
cp = (CELL*)cdp->ptr ;
|
|
if ( cp != field )
|
|
{
|
|
if ( nf < 0 ) split_field0() ;
|
|
|
|
if ( ! (
|
|
#if LM_DOS
|
|
SAMESEG(cp,field) &&
|
|
#endif
|
|
cp >= NF && cp <= LAST_PFIELD ) )
|
|
{
|
|
/* its a real field $1, $2 ...
|
|
If its greater than $NF, we have to
|
|
make sure its set to "" so that
|
|
(++|--) and g?sub() work right
|
|
*/
|
|
t = field_addr_to_index(cp) ;
|
|
if ( t > nf )
|
|
{
|
|
cell_destroy(cp) ;
|
|
cp->type = C_STRING ;
|
|
cp->ptr = (PTR) &null_str ;
|
|
null_str.ref_cnt++ ;
|
|
}
|
|
}
|
|
}
|
|
/* fall thru */
|
|
|
|
case _PUSHA :
|
|
case A_PUSHA :
|
|
inc_sp() ;
|
|
sp -> ptr = cdp++ -> ptr ;
|
|
break ;
|
|
|
|
case _PUSHI : /* put contents of next address on stack*/
|
|
inc_sp() ;
|
|
(void) cellcpy(sp, cdp++ -> ptr) ;
|
|
break ;
|
|
|
|
case L_PUSHI :
|
|
/* put the contents of a local var on stack,
|
|
cdp->op holds the offset from the frame pointer */
|
|
inc_sp() ;
|
|
(void) cellcpy(sp, fp + cdp++->op) ;
|
|
break ;
|
|
|
|
case L_PUSHA : /* put a local address on eval stack */
|
|
inc_sp() ;
|
|
sp->ptr = (PTR)(fp + cdp++->op) ;
|
|
break ;
|
|
|
|
|
|
case F_PUSHI :
|
|
|
|
/* push contents of $i
|
|
cdp[0] holds & $i , cdp[1] holds i */
|
|
|
|
inc_sp() ;
|
|
if ( nf < 0 ) split_field0() ;
|
|
cp = (CELL *) cdp->ptr ;
|
|
t = (cdp+1)->op ;
|
|
cdp += 2 ;
|
|
|
|
if ( t <= nf ) (void) cellcpy(sp, cp) ;
|
|
else /* an unset field */
|
|
{ sp->type = C_STRING ;
|
|
sp->ptr = (PTR) & null_str ;
|
|
null_str.ref_cnt++ ;
|
|
}
|
|
break ;
|
|
|
|
case NF_PUSHI :
|
|
|
|
inc_sp() ;
|
|
if ( nf < 0 ) split_field0() ;
|
|
(void) cellcpy(sp, NF) ;
|
|
break ;
|
|
|
|
case FE_PUSHA :
|
|
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
|
|
t = d_to_index(sp->dval) ;
|
|
if ( t && nf < 0 ) split_field0() ;
|
|
sp->ptr = (PTR) field_ptr(t) ;
|
|
if ( t > nf )
|
|
{
|
|
/* make sure its set to "" */
|
|
cp = sp->ptr ;
|
|
cell_destroy(cp) ;
|
|
cp->type = C_STRING ;
|
|
cp->ptr = (PTR) &null_str ;
|
|
null_str.ref_cnt++ ;
|
|
}
|
|
break ;
|
|
|
|
case FE_PUSHI :
|
|
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
|
|
t = d_to_index(sp->dval) ;
|
|
|
|
if ( nf < 0) split_field0() ;
|
|
if ( t <= nf ) (void) cellcpy(sp, field_ptr(t)) ;
|
|
else
|
|
{ sp->type = C_STRING ;
|
|
sp->ptr = (PTR) & null_str ;
|
|
null_str.ref_cnt++ ;
|
|
}
|
|
break ;
|
|
|
|
|
|
case AE_PUSHA :
|
|
/* top of stack has an expr, cdp->ptr points at an
|
|
array, replace the expr with the cell address inside
|
|
the array */
|
|
|
|
cp = array_find((ARRAY)cdp++->ptr, sp, CREATE) ;
|
|
cell_destroy(sp) ;
|
|
sp->ptr = (PTR) cp ;
|
|
break ;
|
|
|
|
case AE_PUSHI :
|
|
/* top of stack has an expr, cdp->ptr points at an
|
|
array, replace the expr with the contents of the
|
|
cell inside the array */
|
|
|
|
cp = array_find((ARRAY) cdp++->ptr, sp, CREATE) ;
|
|
cell_destroy(sp) ;
|
|
(void) cellcpy(sp, cp) ;
|
|
break ;
|
|
|
|
case LAE_PUSHI :
|
|
/* sp[0] is an expression
|
|
cdp->op is offset from frame pointer of a CELL which
|
|
has an ARRAY in the ptr field, replace expr
|
|
with array[expr]
|
|
*/
|
|
cp = array_find( (ARRAY)fp[cdp++->op].ptr, sp, CREATE) ;
|
|
cell_destroy(sp) ;
|
|
(void) cellcpy(sp, cp) ;
|
|
break ;
|
|
|
|
case LAE_PUSHA :
|
|
/* sp[0] is an expression
|
|
cdp->op is offset from frame pointer of a CELL which
|
|
has an ARRAY in the ptr field, replace expr
|
|
with & array[expr]
|
|
*/
|
|
cp = array_find( (ARRAY)fp[cdp++->op].ptr, sp, CREATE) ;
|
|
cell_destroy(sp) ;
|
|
sp->ptr = (PTR) cp ;
|
|
break ;
|
|
|
|
case LA_PUSHA :
|
|
/* cdp->op is offset from frame pointer of a CELL which
|
|
has an ARRAY in the ptr field. Push this ARRAY
|
|
on the eval stack
|
|
*/
|
|
inc_sp() ;
|
|
sp->ptr = fp[cdp++->op].ptr ;
|
|
break ;
|
|
|
|
case SET_ALOOP :
|
|
{ ALOOP_STATE *ap = (ALOOP_STATE *)
|
|
(cdp + cdp->op + 2)->ptr ;
|
|
|
|
ap->var = (CELL *) sp[-1].ptr ;
|
|
ap->A = (ARRAY) sp->ptr ;
|
|
sp -= 2 ;
|
|
|
|
ap->index = -1 ;
|
|
if ( inc_aloop_state(ap) ) cdp++ ;
|
|
else cdp += cdp->op + 3 ;
|
|
}
|
|
break ;
|
|
|
|
case ALOOP :
|
|
|
|
if ( inc_aloop_state( (ALOOP_STATE*) cdp[1].ptr ) )
|
|
cdp += cdp->op ;
|
|
else cdp += 2 ;
|
|
break ;
|
|
|
|
case _POP :
|
|
cell_destroy(sp) ;
|
|
sp-- ;
|
|
break ;
|
|
|
|
case _DUP :
|
|
(void) cellcpy(sp+1, sp) ;
|
|
sp++ ; break ;
|
|
|
|
case _ASSIGN :
|
|
/* top of stack has an expr, next down is an
|
|
address, put the expression in *address and
|
|
replace the address with the expression */
|
|
|
|
/* don't propagate type C_MBSTRN */
|
|
if ( sp->type == C_MBSTRN ) check_strnum(sp) ;
|
|
sp-- ;
|
|
cell_destroy( ((CELL *)sp->ptr) ) ;
|
|
(void) cellcpy( sp, cellcpy(sp->ptr, sp+1) ) ;
|
|
cell_destroy(sp+1) ;
|
|
break ;
|
|
|
|
case F_ASSIGN : /* assign to a field */
|
|
if (sp->type == C_MBSTRN) check_strnum(sp) ;
|
|
sp-- ;
|
|
field_assign((CELL*)sp->ptr, sp+1) ;
|
|
cell_destroy(sp+1) ;
|
|
(void) cellcpy(sp, (CELL *) sp->ptr) ;
|
|
break ;
|
|
|
|
case _ADD_ASG:
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
cp = (CELL *) (sp-1)->ptr ;
|
|
if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
|
|
|
|
#if SW_FP_CHECK /* specific to V7 and XNX23A */
|
|
clrerr();
|
|
#endif
|
|
cp->dval += sp-- -> dval ;
|
|
#if SW_FP_CHECK
|
|
fpcheck();
|
|
#endif
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = cp->dval ;
|
|
break ;
|
|
|
|
case _SUB_ASG:
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
cp = (CELL *) (sp-1)->ptr ;
|
|
if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
|
|
#if SW_FP_CHECK
|
|
clrerr();
|
|
#endif
|
|
cp->dval -= sp-- -> dval ;
|
|
#if SW_FP_CHECK
|
|
fpcheck();
|
|
#endif
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = cp->dval ;
|
|
break ;
|
|
|
|
case _MUL_ASG:
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
cp = (CELL *) (sp-1)->ptr ;
|
|
if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
|
|
#if SW_FP_CHECK
|
|
clrerr();
|
|
#endif
|
|
cp->dval *= sp-- -> dval ;
|
|
#if SW_FP_CHECK
|
|
fpcheck();
|
|
#endif
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = cp->dval ;
|
|
break ;
|
|
|
|
case _DIV_ASG:
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
cp = (CELL *) (sp-1)->ptr ;
|
|
if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
|
|
|
|
#if NOINFO_SIGFPE
|
|
CHECK_DIVZERO(sp->dval) ;
|
|
#endif
|
|
|
|
#if SW_FP_CHECK
|
|
clrerr();
|
|
#endif
|
|
cp->dval /= sp-- -> dval ;
|
|
#if SW_FP_CHECK
|
|
fpcheck();
|
|
#endif
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = cp->dval ;
|
|
break ;
|
|
|
|
case _MOD_ASG:
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
cp = (CELL *) (sp-1)->ptr ;
|
|
if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
|
|
|
|
#if NOINFO_SIGFPE
|
|
CHECK_DIVZERO(sp->dval) ;
|
|
#endif
|
|
|
|
cp->dval = fmod(cp->dval,sp-- -> dval) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = cp->dval ;
|
|
break ;
|
|
|
|
case _POW_ASG:
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
cp = (CELL *) (sp-1)->ptr ;
|
|
if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
|
|
cp->dval = pow(cp->dval,sp-- -> dval) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = cp->dval ;
|
|
break ;
|
|
|
|
/* will anyone ever use these ? */
|
|
|
|
case F_ADD_ASG :
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
cp = (CELL *) (sp-1)->ptr ;
|
|
cast1_to_d( cellcpy(&tc, cp) ) ;
|
|
#if SW_FP_CHECK
|
|
clrerr();
|
|
#endif
|
|
tc.dval += sp-- -> dval ;
|
|
#if SW_FP_CHECK
|
|
fpcheck();
|
|
#endif
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = tc.dval ;
|
|
field_assign(cp, &tc) ;
|
|
break ;
|
|
|
|
case F_SUB_ASG :
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
cp = (CELL *) (sp-1)->ptr ;
|
|
cast1_to_d( cellcpy(&tc, cp) ) ;
|
|
#if SW_FP_CHECK
|
|
clrerr();
|
|
#endif
|
|
tc.dval -= sp-- -> dval ;
|
|
#if SW_FP_CHECK
|
|
fpcheck();
|
|
#endif
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = tc.dval ;
|
|
field_assign(cp, &tc) ;
|
|
break ;
|
|
|
|
case F_MUL_ASG :
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
cp = (CELL *) (sp-1)->ptr ;
|
|
cast1_to_d( cellcpy(&tc, cp) ) ;
|
|
#if SW_FP_CHECK
|
|
clrerr();
|
|
#endif
|
|
tc.dval *= sp-- -> dval ;
|
|
#if SW_FP_CHECK
|
|
fpcheck();
|
|
#endif
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = tc.dval ;
|
|
field_assign(cp, &tc) ;
|
|
break ;
|
|
|
|
case F_DIV_ASG :
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
cp = (CELL *) (sp-1)->ptr ;
|
|
cast1_to_d( cellcpy(&tc, cp) ) ;
|
|
|
|
#if NOINFO_SIGFPE
|
|
CHECK_DIVZERO(sp->dval) ;
|
|
#endif
|
|
|
|
#if SW_FP_CHECK
|
|
clrerr();
|
|
#endif
|
|
tc.dval /= sp-- -> dval ;
|
|
#if SW_FP_CHECK
|
|
fpcheck();
|
|
#endif
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = tc.dval ;
|
|
field_assign(cp, &tc) ;
|
|
break ;
|
|
|
|
case F_MOD_ASG :
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
cp = (CELL *) (sp-1)->ptr ;
|
|
cast1_to_d( cellcpy(&tc, cp) ) ;
|
|
|
|
#if NOINFO_SIGFPE
|
|
CHECK_DIVZERO(sp->dval) ;
|
|
#endif
|
|
|
|
tc.dval = fmod(tc.dval, sp-- -> dval) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = tc.dval ;
|
|
field_assign(cp, &tc) ;
|
|
break ;
|
|
|
|
case F_POW_ASG :
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
cp = (CELL *) (sp-1)->ptr ;
|
|
cast1_to_d( cellcpy(&tc, cp) ) ;
|
|
tc.dval = pow(tc.dval, sp-- -> dval) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = tc.dval ;
|
|
field_assign(cp, &tc) ;
|
|
break ;
|
|
|
|
case _ADD :
|
|
sp-- ;
|
|
if ( TEST2(sp) != TWO_DOUBLES )
|
|
cast2_to_d(sp) ;
|
|
#if SW_FP_CHECK
|
|
clrerr();
|
|
#endif
|
|
sp[0].dval += sp[1].dval ;
|
|
#if SW_FP_CHECK
|
|
fpcheck();
|
|
#endif
|
|
break ;
|
|
|
|
case _SUB :
|
|
sp-- ;
|
|
if ( TEST2(sp) != TWO_DOUBLES )
|
|
cast2_to_d(sp) ;
|
|
#if SW_FP_CHECK
|
|
clrerr();
|
|
#endif
|
|
sp[0].dval -= sp[1].dval ;
|
|
#if SW_FP_CHECK
|
|
fpcheck();
|
|
#endif
|
|
break ;
|
|
|
|
case _MUL :
|
|
sp-- ;
|
|
if ( TEST2(sp) != TWO_DOUBLES )
|
|
cast2_to_d(sp) ;
|
|
#if SW_FP_CHECK
|
|
clrerr();
|
|
#endif
|
|
sp[0].dval *= sp[1].dval ;
|
|
#if SW_FP_CHECK
|
|
fpcheck();
|
|
#endif
|
|
break ;
|
|
|
|
case _DIV :
|
|
sp-- ;
|
|
if ( TEST2(sp) != TWO_DOUBLES )
|
|
cast2_to_d(sp) ;
|
|
|
|
#if NOINFO_SIGFPE
|
|
CHECK_DIVZERO(sp[1].dval) ;
|
|
#endif
|
|
|
|
#if SW_FP_CHECK
|
|
clrerr();
|
|
#endif
|
|
sp[0].dval /= sp[1].dval ;
|
|
#if SW_FP_CHECK
|
|
fpcheck();
|
|
#endif
|
|
break ;
|
|
|
|
case _MOD :
|
|
sp-- ;
|
|
if ( TEST2(sp) != TWO_DOUBLES )
|
|
cast2_to_d(sp) ;
|
|
|
|
#if NOINFO_SIGFPE
|
|
CHECK_DIVZERO(sp[1].dval) ;
|
|
#endif
|
|
|
|
sp[0].dval = fmod(sp[0].dval,sp[1].dval) ;
|
|
break ;
|
|
|
|
case _POW :
|
|
sp-- ;
|
|
if ( TEST2(sp) != TWO_DOUBLES )
|
|
cast2_to_d(sp) ;
|
|
sp[0].dval = pow(sp[0].dval,sp[1].dval) ;
|
|
break ;
|
|
|
|
case _NOT :
|
|
reswitch_1:
|
|
switch( sp->type )
|
|
{ case C_NOINIT :
|
|
sp->dval = 1.0 ; break ;
|
|
case C_DOUBLE :
|
|
sp->dval = D2BOOL(sp->dval) ? 0.0 : 1.0 ;
|
|
break ;
|
|
case C_STRING :
|
|
sp->dval = string(sp)->len ? 0.0 : 1.0 ;
|
|
free_STRING(string(sp)) ;
|
|
break ;
|
|
case C_STRNUM : /* test as a number */
|
|
sp->dval = D2BOOL(sp->dval) ? 0.0 : 1.0 ;
|
|
free_STRING(string(sp)) ;
|
|
break ;
|
|
case C_MBSTRN :
|
|
check_strnum(sp) ;
|
|
goto reswitch_1 ;
|
|
default :
|
|
bozo("bad type on eval stack") ;
|
|
}
|
|
sp->type = C_DOUBLE ;
|
|
break ;
|
|
|
|
case _TEST :
|
|
reswitch_2:
|
|
switch( sp->type )
|
|
{ case C_NOINIT :
|
|
sp->dval = 0.0 ; break ;
|
|
case C_DOUBLE :
|
|
sp->dval = D2BOOL(sp->dval) ? 1.0 : 0.0 ;
|
|
break ;
|
|
case C_STRING :
|
|
sp->dval = string(sp)->len ? 1.0 : 0.0 ;
|
|
free_STRING(string(sp)) ;
|
|
break ;
|
|
case C_STRNUM : /* test as a number */
|
|
sp->dval = D2BOOL(sp->dval) ? 1.0 : 0.0 ;
|
|
free_STRING(string(sp)) ;
|
|
break ;
|
|
case C_MBSTRN :
|
|
check_strnum(sp) ;
|
|
goto reswitch_2 ;
|
|
default :
|
|
bozo("bad type on eval stack") ;
|
|
}
|
|
sp->type = C_DOUBLE ;
|
|
break ;
|
|
|
|
case _UMINUS :
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
sp->dval = - sp->dval ;
|
|
break ;
|
|
|
|
case _UPLUS :
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
break ;
|
|
|
|
case _CAT :
|
|
{ unsigned len1, len2 ;
|
|
char *str1, *str2 ;
|
|
STRING *b ;
|
|
|
|
sp-- ;
|
|
if ( TEST2(sp) != TWO_STRINGS )
|
|
cast2_to_s(sp) ;
|
|
str1 = string(sp)->str ;
|
|
len1 = string(sp)->len ;
|
|
str2 = string(sp+1)->str ;
|
|
len2 = string(sp+1)->len ;
|
|
|
|
b = new_STRING((char *)0, len1+len2) ;
|
|
(void) memcpy(b->str, str1, SIZE_T(len1)) ;
|
|
(void) memcpy(b->str + len1, str2, SIZE_T(len2)) ;
|
|
free_STRING(string(sp)) ;
|
|
free_STRING( string(sp+1) ) ;
|
|
|
|
sp->ptr = (PTR) b ;
|
|
break ;
|
|
}
|
|
|
|
case _PUSHINT :
|
|
inc_sp() ;
|
|
sp->type = cdp++ -> op ;
|
|
break ;
|
|
|
|
case _BUILTIN :
|
|
case _PRINT :
|
|
sp = (* (PF_CP) cdp++ -> ptr) (sp) ;
|
|
break ;
|
|
|
|
case _POST_INC :
|
|
cp = (CELL *)sp->ptr ;
|
|
if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = cp->dval ;
|
|
cp->dval += 1.0 ;
|
|
break ;
|
|
|
|
case _POST_DEC :
|
|
cp = (CELL *)sp->ptr ;
|
|
if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = cp->dval ;
|
|
cp->dval -= 1.0 ;
|
|
break ;
|
|
|
|
case _PRE_INC :
|
|
cp = (CELL *) sp->ptr ;
|
|
if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
|
|
sp->dval = cp->dval += 1.0 ;
|
|
sp->type = C_DOUBLE ;
|
|
break ;
|
|
|
|
case _PRE_DEC :
|
|
cp = (CELL *) sp->ptr ;
|
|
if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
|
|
sp->dval = cp->dval -= 1.0 ;
|
|
sp->type = C_DOUBLE ;
|
|
break ;
|
|
|
|
|
|
case F_POST_INC :
|
|
cp = (CELL *) sp->ptr ;
|
|
(void) cellcpy(&tc, cp) ;
|
|
cast1_to_d(&tc) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = tc.dval ;
|
|
tc.dval += 1.0 ;
|
|
field_assign(cp, &tc) ;
|
|
break ;
|
|
|
|
case F_POST_DEC :
|
|
cp = (CELL *) sp->ptr ;
|
|
(void) cellcpy(&tc, cp) ;
|
|
cast1_to_d(&tc) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = tc.dval ;
|
|
tc.dval -= 1.0 ;
|
|
field_assign(cp, &tc) ;
|
|
break ;
|
|
|
|
case F_PRE_INC :
|
|
cp = (CELL *) sp->ptr ;
|
|
cast1_to_d(cellcpy(sp, cp)) ;
|
|
sp->dval += 1.0 ;
|
|
field_assign(cp, sp) ;
|
|
break ;
|
|
|
|
case F_PRE_DEC :
|
|
cp = (CELL *) sp->ptr ;
|
|
cast1_to_d(cellcpy(sp, cp)) ;
|
|
sp->dval -= 1.0 ;
|
|
field_assign(cp, sp) ;
|
|
break ;
|
|
|
|
case _JMP :
|
|
cdp += cdp->op ;
|
|
break ;
|
|
|
|
case _JNZ :
|
|
/* jmp if top of stack is non-zero and pop stack */
|
|
if ( test( sp ) )
|
|
cdp += cdp->op ;
|
|
else cdp++ ;
|
|
cell_destroy(sp) ;
|
|
sp-- ;
|
|
break ;
|
|
|
|
case _JZ :
|
|
/* jmp if top of stack is zero and pop stack */
|
|
if ( ! test( sp ) )
|
|
cdp += cdp->op ;
|
|
else cdp++ ;
|
|
cell_destroy(sp) ;
|
|
sp-- ;
|
|
break ;
|
|
|
|
/* the relation operations */
|
|
/* compare() makes sure string ref counts are OK */
|
|
case _EQ :
|
|
t = compare(--sp) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = t == 0 ? 1.0 : 0.0 ;
|
|
break ;
|
|
|
|
case _NEQ :
|
|
t = compare(--sp) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = t ? 1.0 : 0.0 ;
|
|
break ;
|
|
|
|
case _LT :
|
|
t = compare(--sp) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = t < 0 ? 1.0 : 0.0 ;
|
|
break ;
|
|
|
|
case _LTE :
|
|
t = compare(--sp) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = t <= 0 ? 1.0 : 0.0 ;
|
|
break ;
|
|
|
|
case _GT :
|
|
t = compare(--sp) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = t > 0 ? 1.0 : 0.0 ;
|
|
break ;
|
|
|
|
case _GTE :
|
|
t = compare(--sp) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = t >= 0 ? 1.0 : 0.0 ;
|
|
break ;
|
|
|
|
case _MATCH0 :
|
|
/* does $0 match, the RE at cdp */
|
|
|
|
inc_sp() ;
|
|
if ( field->type >= C_STRING )
|
|
{ sp->type = C_DOUBLE ;
|
|
sp->dval = REtest(string(field)->str, cdp++->ptr)
|
|
? 1.0 : 0.0 ;
|
|
|
|
break /* the case */ ;
|
|
}
|
|
else
|
|
{
|
|
cellcpy(sp, field) ;
|
|
/* and FALL THRU */
|
|
}
|
|
|
|
case _MATCH1 :
|
|
/* does expr at sp[0] match RE at cdp */
|
|
if ( sp->type < C_STRING ) cast1_to_s(sp) ;
|
|
t = REtest(string(sp)->str, cdp++->ptr) ;
|
|
free_STRING(string(sp)) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = t ? 1.0 : 0.0 ;
|
|
break ;
|
|
|
|
|
|
case _MATCH2 :
|
|
/* does sp[-1] match sp[0] as re */
|
|
cast_to_RE(sp) ;
|
|
|
|
if ( (--sp)->type < C_STRING ) cast1_to_s(sp) ;
|
|
t = REtest(string(sp)->str, (sp+1)->ptr) ;
|
|
|
|
free_STRING(string(sp)) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = t ? 1.0 : 0.0 ;
|
|
break ;
|
|
|
|
case A_TEST :
|
|
/* entry : sp[0].ptr-> an array
|
|
sp[-1] is an expression
|
|
|
|
we compute expression in array */
|
|
sp-- ;
|
|
cp = array_find( (sp+1)->ptr, sp, NO_CREATE) ;
|
|
cell_destroy(sp) ;
|
|
sp->type = C_DOUBLE ;
|
|
sp->dval = (cp!=(CELL*)0) ? 1.0 : 0.0 ;
|
|
break ;
|
|
|
|
case A_DEL :
|
|
/* sp[0].ptr -> array
|
|
sp[-1] is an expr
|
|
delete array[expr] */
|
|
|
|
array_delete(sp->ptr, sp-1) ;
|
|
cell_destroy(sp-1) ;
|
|
sp -= 2 ;
|
|
break ;
|
|
|
|
/* form a multiple array index */
|
|
case A_CAT :
|
|
sp = array_cat(sp, cdp++->op) ;
|
|
break ;
|
|
|
|
case _EXIT :
|
|
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
|
|
exit_code = d_to_i(sp->dval) ;
|
|
sp-- ;
|
|
/* fall thru */
|
|
|
|
case _EXIT0 :
|
|
if ( !(cdp = end_code.start) ) mawk_exit(exit_code) ;
|
|
|
|
end_code.start = (INST *) 0 ; /* makes sure next exit exits */
|
|
if ( begin_code.start )
|
|
zfree(begin_code.start, begin_code.size) ;
|
|
if ( main_start ) zfree(main_start, main_size);
|
|
sp = eval_stack - 1 ; /* might be in user function */
|
|
break ;
|
|
|
|
case _JMAIN : /* go from BEGIN code to MAIN code */
|
|
zfree(begin_code.start, begin_code.size) ;
|
|
begin_code.start = (INST *) 0 ;
|
|
cdp = main_start ;
|
|
break ;
|
|
|
|
case _OMAIN :
|
|
if ( !main_fin ) open_main() ;
|
|
restart_label = cdp ;
|
|
cdp = next_label ;
|
|
break ;
|
|
|
|
case _NEXT :
|
|
cdp = next_label ;
|
|
break ;
|
|
|
|
case OL_GL :
|
|
{
|
|
char *p ;
|
|
unsigned len ;
|
|
|
|
if ( !(p = FINgets(main_fin, &len)) )
|
|
{
|
|
if ( !end_code.start ) mawk_exit(0) ;
|
|
|
|
cdp = end_code.start ;
|
|
zfree(main_start, main_size) ;
|
|
main_start = end_code.start = (INST*) 0 ;
|
|
}
|
|
else
|
|
{ set_field0(p, len) ; cdp = restart_label ; }
|
|
}
|
|
break ;
|
|
|
|
case OL_GL_NR :
|
|
{
|
|
char *p ;
|
|
unsigned len ;
|
|
|
|
if ( !(p = FINgets(main_fin, &len)) )
|
|
{
|
|
if ( !end_code.start ) mawk_exit(0) ;
|
|
|
|
cdp = end_code.start ;
|
|
zfree(main_start, main_size) ;
|
|
main_start = end_code.start = (INST*) 0 ;
|
|
}
|
|
else
|
|
{
|
|
set_field0(p, len) ;
|
|
cdp = restart_label ;
|
|
|
|
if ( TEST2(NR) != TWO_DOUBLES ) cast2_to_d(NR) ;
|
|
|
|
NR->dval += 1.0 ;
|
|
FNR->dval += 1.0 ;
|
|
}
|
|
}
|
|
break ;
|
|
|
|
|
|
case _RANGE :
|
|
/* test a range pattern: pat1, pat2 { action }
|
|
entry :
|
|
cdp[0].op -- a flag, test pat1 if on else pat2
|
|
cdp[1].op -- offset of pat2 code from cdp
|
|
cdp[2].op -- offset of action code from cdp
|
|
cdp[3].op -- offset of code after the action from cdp
|
|
cdp[4] -- start of pat1 code
|
|
*/
|
|
|
|
#define FLAG cdp[0].op
|
|
#define PAT2 cdp[1].op
|
|
#define ACTION cdp[2].op
|
|
#define FOLLOW cdp[3].op
|
|
#define PAT1 4
|
|
|
|
if ( FLAG ) /* test again pat1 */
|
|
{
|
|
execute(cdp + PAT1,sp, fp) ;
|
|
t = test(sp+1) ;
|
|
cell_destroy(sp+1) ;
|
|
if ( t ) FLAG = 0 ;
|
|
else
|
|
{ cdp += FOLLOW ;
|
|
break ; /* break the switch */
|
|
}
|
|
}
|
|
|
|
/* test against pat2 and then perform the action */
|
|
execute(cdp + PAT2, sp, fp) ;
|
|
FLAG = test(sp+1) ;
|
|
cell_destroy(sp+1) ;
|
|
cdp += ACTION ;
|
|
break ;
|
|
|
|
/* function calls */
|
|
|
|
case _RET0 :
|
|
inc_sp() ;
|
|
sp->type = C_NOINIT ;
|
|
/* fall thru */
|
|
|
|
case _RET :
|
|
|
|
#ifdef DEBUG
|
|
if ( sp != entry_sp+1 ) bozo("ret") ;
|
|
#endif
|
|
if ( old_stack_base ) /* reset stack */
|
|
{
|
|
/* move the return value */
|
|
(void) cellcpy(old_sp+1, sp) ;
|
|
cell_destroy(sp) ;
|
|
zfree(stack_base, sizeof(CELL)*EVAL_STACK_SIZE) ;
|
|
stack_base = old_stack_base ;
|
|
stack_danger = old_stack_base + DANGER ;
|
|
}
|
|
|
|
return ;
|
|
|
|
case _CALL :
|
|
|
|
{ FBLOCK *fbp = (FBLOCK*) cdp++->ptr ;
|
|
int a_args = cdp++->op ; /* actual number of args */
|
|
CELL *nfp = sp - a_args + 1 ; /* new fp for callee */
|
|
CELL *local_p = sp+1; /* first local argument on stack */
|
|
char *type_p ; /* pts to type of an argument */
|
|
|
|
if ( fbp->nargs ) type_p = fbp->typev + a_args ;
|
|
|
|
/* create space for locals */
|
|
if ( t = fbp->nargs - a_args ) /* have local args */
|
|
{
|
|
while ( t-- )
|
|
{ (++sp)->type = C_NOINIT ;
|
|
if ( *type_p++ == ST_LOCAL_ARRAY )
|
|
sp->ptr = (PTR) new_ARRAY() ;
|
|
}
|
|
}
|
|
type_p-- ; /* *type_p is type of last arg */
|
|
|
|
execute(fbp->code, sp, nfp) ;
|
|
|
|
/* cleanup the callee's arguments */
|
|
if ( sp >= nfp )
|
|
{
|
|
cp = sp+1 ; /* cp -> the function return */
|
|
|
|
do
|
|
{
|
|
if ( *type_p-- == ST_LOCAL_ARRAY )
|
|
{ if ( sp >= local_p ) array_free(sp->ptr) ; }
|
|
else cell_destroy(sp) ;
|
|
|
|
} while ( --sp >= nfp ) ;
|
|
|
|
(void) cellcpy(++sp, cp) ;
|
|
cell_destroy(cp) ;
|
|
}
|
|
else sp++ ; /* no arguments passed */
|
|
}
|
|
break ;
|
|
|
|
default :
|
|
bozo("bad opcode") ;
|
|
}
|
|
}
|
|
|
|
int test( cp ) /* test if a cell is null or not */
|
|
register CELL *cp ;
|
|
{
|
|
reswitch :
|
|
|
|
switch ( cp->type )
|
|
{
|
|
case C_NOINIT : return 0 ;
|
|
case C_STRNUM : /* test as a number */
|
|
case C_DOUBLE : return cp->dval != 0.0 ;
|
|
case C_STRING : return string(cp)->len ;
|
|
case C_MBSTRN : check_strnum(cp) ; goto reswitch ;
|
|
|
|
default :
|
|
bozo("bad cell type in call to test") ;
|
|
}
|
|
return 0 ; /*can't get here: shutup */
|
|
}
|
|
|
|
/* compare cells at cp and cp+1 and
|
|
frees STRINGs at those cells
|
|
*/
|
|
static int compare(cp)
|
|
register CELL *cp ;
|
|
{ int k ;
|
|
|
|
reswitch :
|
|
|
|
switch( TEST2(cp) )
|
|
{ case TWO_NOINITS : return 0 ;
|
|
|
|
case TWO_DOUBLES :
|
|
two_d:
|
|
return cp->dval > (cp+1)->dval ? 1 :
|
|
cp->dval < (cp+1)->dval ? -1 : 0 ;
|
|
|
|
case TWO_STRINGS :
|
|
case STRING_AND_STRNUM :
|
|
two_s:
|
|
k = strcmp(string(cp)->str, string(cp+1)->str) ;
|
|
free_STRING( string(cp) ) ;
|
|
free_STRING( string(cp+1) ) ;
|
|
return k ;
|
|
|
|
case NOINIT_AND_DOUBLE :
|
|
case NOINIT_AND_STRNUM :
|
|
case DOUBLE_AND_STRNUM :
|
|
case TWO_STRNUMS :
|
|
cast2_to_d(cp) ; goto two_d ;
|
|
|
|
case NOINIT_AND_STRING :
|
|
case DOUBLE_AND_STRING :
|
|
cast2_to_s(cp) ; goto two_s ;
|
|
|
|
case TWO_MBSTRNS :
|
|
check_strnum(cp) ; check_strnum(cp+1) ;
|
|
goto reswitch ;
|
|
|
|
case NOINIT_AND_MBSTRN :
|
|
case DOUBLE_AND_MBSTRN :
|
|
case STRING_AND_MBSTRN :
|
|
case STRNUM_AND_MBSTRN :
|
|
check_strnum( cp->type == C_MBSTRN ? cp : cp+1 ) ;
|
|
goto reswitch ;
|
|
|
|
default : /* there are no default cases */
|
|
bozo("bad cell type passed to compare") ;
|
|
}
|
|
return 0 ; /* shut up */
|
|
}
|
|
|
|
/* does not assume target was a cell, if so
|
|
then caller should have made a previous
|
|
call to cell_destroy */
|
|
|
|
CELL *cellcpy(target, source)
|
|
register CELL *target, *source ;
|
|
{ switch( target->type = source->type )
|
|
{ case C_NOINIT :
|
|
case C_SPACE :
|
|
case C_SNULL :
|
|
break ;
|
|
|
|
case C_DOUBLE :
|
|
target->dval = source->dval ;
|
|
break ;
|
|
|
|
case C_STRNUM :
|
|
target->dval = source->dval ;
|
|
/* fall thru */
|
|
|
|
case C_REPL :
|
|
case C_MBSTRN :
|
|
case C_STRING :
|
|
string(source)->ref_cnt++ ;
|
|
/* fall thru */
|
|
|
|
case C_RE :
|
|
target->ptr = source->ptr ;
|
|
break ;
|
|
|
|
case C_REPLV :
|
|
(void) replv_cpy(target, source) ;
|
|
break ;
|
|
|
|
default :
|
|
bozo("bad cell passed to cellcpy()") ;
|
|
break ;
|
|
}
|
|
return target ;
|
|
}
|
|
|
|
#ifdef DEBUG
|
|
|
|
void DB_cell_destroy(cp) /* HANGOVER time */
|
|
register CELL *cp ;
|
|
{
|
|
switch( cp->type )
|
|
{ case C_NOINIT :
|
|
case C_DOUBLE : break ;
|
|
|
|
case C_MBSTRN :
|
|
case C_STRING :
|
|
case C_STRNUM :
|
|
if ( -- string(cp)->ref_cnt == 0 )
|
|
zfree(string(cp) , string(cp)->len+STRING_OH) ;
|
|
break ;
|
|
|
|
case C_RE :
|
|
bozo("cell destroy called on RE cell") ;
|
|
default :
|
|
bozo("cell destroy called on bad cell type") ;
|
|
}
|
|
}
|
|
|
|
#endif
|
|
|
|
|
|
|
|
/* convert a double d to a field index $d -> $i */
|
|
static int
|
|
d_to_index( d )
|
|
double d ;
|
|
{
|
|
|
|
if ( d > MAX_FIELD )
|
|
rt_overflow("maximum number of fields", MAX_FIELD) ;
|
|
|
|
if ( d >= 0.0 ) return (int) d ;
|
|
|
|
/* might include nan */
|
|
rt_error("negative field index $%.6g", d) ;
|
|
return 0 ; /* shutup */
|
|
}
|