Aren
/
NetBSD
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
NetBSD/gnu/usr.bin/awk/execute.c

1267 lines
33 KiB
C
Raw Normal View History

initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
/********************************************
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 $
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
/* Revision 1.2 1993/07/02 23:57:14 jtc
/* Updated to mawk 1.1.4
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
/*
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
* 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
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
* 1.1 pre-release
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
*
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
*/
#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 *) ) ;
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
static int PROTO( d_to_index, (double)) ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
#if NOINFO_SIGFPE
static char dz_msg[] = "division by zero" ;
#endif
#ifdef DEBUG
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
static void PROTO( eval_overflow, (void) ) ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
#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 :
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
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++ ;
}
}
}
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
/* 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 :
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
t = d_to_index(sp->dval) ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
if ( t && nf < 0 ) split_field0() ;
sp->ptr = (PTR) field_ptr(t) ;
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
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++ ;
}
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
break ;
case FE_PUSHI :
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
if ( sp->type != C_DOUBLE ) cast1_to_d(sp) ;
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
t = d_to_index(sp->dval) ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
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 :
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
cp = (CELL *)sp->ptr ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
sp->type = C_DOUBLE ;
sp->dval = cp->dval ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
cp->dval += 1.0 ;
break ;
case _POST_DEC :
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
cp = (CELL *)sp->ptr ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
if ( cp->type != C_DOUBLE ) cast1_to_d(cp) ;
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
sp->type = C_DOUBLE ;
sp->dval = cp->dval ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
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 ;
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
(void) cellcpy(&tc, cp) ;
cast1_to_d(&tc) ;
sp->type = C_DOUBLE ;
sp->dval = tc.dval ;
tc.dval += 1.0 ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
field_assign(cp, &tc) ;
break ;
case F_POST_DEC :
cp = (CELL *) sp->ptr ;
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
(void) cellcpy(&tc, cp) ;
cast1_to_d(&tc) ;
sp->type = C_DOUBLE ;
sp->dval = tc.dval ;
tc.dval -= 1.0 ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
field_assign(cp, &tc) ;
break ;
case F_PRE_INC :
cp = (CELL *) sp->ptr ;
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
cast1_to_d(cellcpy(sp, cp)) ;
sp->dval += 1.0 ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
field_assign(cp, sp) ;
break ;
case F_PRE_DEC :
cp = (CELL *) sp->ptr ;
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
cast1_to_d(cellcpy(sp, cp)) ;
sp->dval -= 1.0 ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
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) ;
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
exit_code = d_to_i(sp->dval) ;
sp-- ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
/* 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") ;
}
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
return 0 ; /*can't get here: shutup */
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
}
/* 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 :
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
case STRING_AND_STRNUM :
two_s:
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
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 ;
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
case NOINIT_AND_STRING :
case DOUBLE_AND_STRING :
cast2_to_s(cp) ; goto two_s ;
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
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") ;
}
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
return 0 ; /* shut up */
initial import of 386bsd-0.1 sources
1993-03-21 12:45:37 +03:00
}
/* 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
Updated to mawk 1.1.4
1993-07-03 03:56:52 +04:00
/* 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 */
}