/********************************************
mawk_execute.c
libmawk changes (C) 2009-2014, Tibor 'Igor2' Palinkas;
based on mawk code coming with the below copyright:
copyright 1991-1996, 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.
********************************************/
#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 "debug.h"
#include <string.h>
#include "num.h"
#include "math_wrap.h"
#include "cell.h"
#include "execute.h"
#include "f2d.h"
static double compare(mawk_state_t *, mawk_cell_t *);
static int d_to_index(mawk_state_t *, mawk_num_t);
/* The stack machine that mawk_executes the code */
#ifdef DEBUG
void DB_mawk_eval_overflow(mawk_state_t * MAWK)
{
mawk_overflow(MAWK, "eval stack", EVAL_STACK_SIZE);
}
#endif
/* holds info for array loops (on a stack) */
typedef struct aloop_state {
struct aloop_state *link;
mawk_cell_t *var; /* for(var in A) */
mawk_string_t **base;
mawk_string_t **ptr;
mawk_string_t **limit;
} ALOOP_STATE;
/* clean up aloop stack on next, return, exit */
#define CLEAR_ALOOP_STACK() if(aloop_state){\
clear_aloop_stack(MAWK, aloop_state);\
aloop_state=(ALOOP_STATE*)0;}else
/* free the vector (aloop_state's ->base array and its members) */
static void aloop_free_vect(mawk_state_t *MAWK, ALOOP_STATE *top)
{
while (top->ptr < top->limit) {
free_STRING(*top->ptr);
top->ptr++;
}
if (top->base != NULL)
mawk_free(MAWK, top->base);
}
static void clear_aloop_stack(mawk_state_t *MAWK, ALOOP_STATE *top)
{
ALOOP_STATE *q;
do {
aloop_free_vect(MAWK, top);
q = top;
top = q->link;
MAWK_ZFREE(MAWK, q);
} while (top);
}
mawk_cell_t *mawk_call_c_func(mawk_state_t * MAWK, mawk_cell_t * sp, FBLOCK * fbp, int a_args)
{
/* unresolved functions must be C function calls */
if (fbp->code == NULL) {
SYMTAB *sym;
void *old_userdata;
sym = mawk_find(MAWK, fbp->name, 1);
if (sym->type == ST_C_FUNCTION) {
libmawk_c_function *old_func;
sp[1].type = ST_NONE;
old_userdata = MAWK->func_userdata;
old_func = MAWK->func_being_called;
MAWK->func_userdata = sym->stval.c_function.func_userdata;
MAWK->func_being_called = sym->stval.c_function.callback;
sp = sym->stval.c_function.callback(MAWK, sp, a_args) + 1;
MAWK->func_userdata = old_userdata;
MAWK->func_being_called = old_func;
}
else {
mawk_rt_error(MAWK, "unresolved function call %s\n", fbp->name);
}
return sp;
}
return NULL;
}
#define comment(s)
#define mawk_call_vars \
mawk_cell_t *nfp = sp - a_args + 1; comment("new fp for callee") \
mawk_cell_t *local_p = sp + 1 comment("first local argument on stack") \
#define mawk_call_pre() \
do { \
char *type_p; comment("pts to type of an argument") \
int t; \
if (fbp->nargs) \
type_p = fbp->typev + a_args - 1; \
comment("create space for locals");\
comment("t is number of locals"); \
t = fbp->nargs - a_args; \
while (t > 0) { \
t--; \
sp++; \
type_p++; \
sp->type = C_NOINIT; \
if (*type_p == ST_LOCAL_ARRAY) \
sp->ptr = (PTR) mawk_array_new(MAWK, NULL); \
} \
if (MAWK->debug_symbols) \
mawk_debug_callstack_push(MAWK, fbp); \
} while(0)
#define mawk_call_post(fbp, a_args_) \
do { \
int a_args = a_args_; \
mawk_call_vars; \
char *type_p; comment("pts to type of an argument"); \
if (fbp->nargs) \
type_p = fbp->typev + a_args - 1; \
if (MAWK->debug_symbols) \
mawk_debug_callstack_pop(MAWK); \
comment("cleanup the callee's arguments"); \
comment("putting return value at top of eval stack"); \
if (sp >= nfp) { \
mawk_cell_t *cp; \
comment("cp -> the function return"); \
cp = sp + 1; \
do { \
if (*type_p == ST_LOCAL_ARRAY) { \
if (sp >= local_p) { \
mawk_array_clear(MAWK, (mawk_array_t)(sp->ptr)); \
MAWK_ZFREE(MAWK, (mawk_array_t) sp->ptr); \
} \
} \
else \
mawk_cell_destroy(MAWK, sp); \
type_p--; \
sp--; \
} \
while (sp >= nfp); \
break; \
mawk_cellcpy(MAWK, ++sp, cp); \
mawk_cell_destroy(MAWK, cp); \
} \
else {\
comment("no arguments passed"); \
sp++; \
} \
} while(0)
/******************* mawk_execute: the VM ********************/
enum {
EXEST_NORMAL, /* don't do anything special when popping this frame */
EXEST_EXIT, /* exit when popping this frame */
EXEST_RANGE1, /* frame was the pat1 match code for a range */
EXEST_RANGE2 /* frame was the pat1 match code for a range */
};
#include "execute_debug.h"
/* cast cp to num and copy the value of the num to res_num (which is mawk_num_t) */
#define mawk_cast_get_num(res_num, cp) \
do { \
if (cp->type != C_NUM) \
mawk_cast1_to_num(MAWK, cp); \
res_num = cp->d.dval; \
} while(0)
#define RECURSION_OVERHEAD 8
#define mawk_push_exe_state(exest) \
do { \
inc_sp(); sp->type = C_EXE_STTYPE; sp->d.vcnt = exest; \
inc_sp(); sp->type = C_EXE_STATE; sp->ptr = cdp; \
inc_sp(); sp->type = C_EXE_STATE; sp->ptr = fp; \
inc_sp(); sp->type = C_EXE_STATE; sp->ptr = aloop_state; \
inc_sp(); sp->type = C_EXE_STATE; sp->ptr = old_stack_base; \
inc_sp(); sp->type = C_EXE_STATE; sp->ptr = old_sp; \
inc_sp(); sp->type = C_EXE_STATE; sp->ptr = call_fbp; \
inc_sp(); sp->type = C_EXE_STATE; sp->d.vcnt = call_a_args; \
db1printf("state push sp=%d..%d\n", stackptr(sp - RECURSION_OVERHEAD+1), stackptr(sp)); \
} while(0)
#define mawk_pop_exe_state()\
do { \
if ((sp[1-RECURSION_OVERHEAD].type != C_EXE_STTYPE) || (sp[0].type != C_EXE_STATE)) \
mawk_bozo(MAWK, "eval stack broken (in recursion)"); \
exest = sp[-7].d.vcnt; \
cdp = sp[-6].ptr; \
fp = sp[-5].ptr; \
aloop_state = sp[-4].ptr; \
old_stack_base = sp[-3].ptr; \
old_sp = sp[-2].ptr; \
call_fbp = sp[-1].ptr; \
call_a_args = sp[0].d.vcnt; \
db1printf("state pop sp=%d..%d exest=%d\n", stackptr(sp - RECURSION_OVERHEAD+1), stackptr(sp), exest); \
sp -= RECURSION_OVERHEAD; \
} while(0)
mawk_exec_result_t mawk_execute_(mawk_state_t *MAWK)
{
/* --- some useful temporaries (not saved on the eval stack during recursion) --- */
mawk_cell_t *cp;
int t;
double dt;
mawk_num_t tmp_num;
unsigned long runcount;
#ifdef DEBUG
mawk_cell_t *entry_sp = sp;
#endif
/* --- execution state (saved on evan stack during recursion) --- */
register INST *cdp; /* code ptr, continue execution here */
register mawk_cell_t *sp; /* eval_stack pointer */
mawk_cell_t *fp = 0; /* frame ptr into eval_stack for user defined functions */
FBLOCK *call_fbp = NULL; /* user function being executed */
int call_a_args = 0; /* number of caller args in user func being executed */
ALOOP_STATE *aloop_state = (ALOOP_STATE *) 0; /* save state for array loops via a stack */
mawk_cell_t *old_stack_base, *old_sp; /* for moving the eval stack on deep recursion */
int exest = 0;
sp = MAWK->sp;
db1printf("exe enter sp=%d\n", stackptr(sp));
exe_return:;
db1printf("exe_return sp=%d fp=%d\n", stackptr(sp), stackptr(fp));
db1printstack(MAWK, "exe_return:\n", sp, fp);
mawk_pop_exe_state();
if (exest == EXEST_EXIT) {
/* hit the bottom of current execution request; mawk_execute_ either
returns from here because normal end-of-execution or from a getline
that got "NO_MORE" */
goto out;
}
call_entry:;
if (fp) {
/* we are a function call, check for deep recursion */
if (sp > MAWK->stack_danger) { /* change stacks */
/* it's enough to save one set of stack_base and sp here; by the next time
we get in the danger zone the old values are already saved on the stack by
mawk_push_exe_state(exest) */
old_stack_base = MAWK->stack_base;
old_sp = sp;
MAWK->stack_base = (mawk_cell_t *) mawk_zmalloc(MAWK, sizeof(mawk_cell_t) * EVAL_STACK_SIZE);
MAWK->stack_danger = MAWK->stack_base + DANGER;
sp = MAWK->stack_base;
/* waste 1 slot for ANSI, actually large model msdos breaks in
RET if we don't */
#ifdef DEBUG
entry_sp = sp;
#endif
}
else
old_stack_base = (mawk_cell_t *) 0;
}
runcount = MAWK->runlimit;
while (MAWK->rt_exit_code == 0) {
runcount--;
if (runcount == 0)
goto out_runlimit;
switch (cdp++->op) {
/* HALT only used by the disassemble now ; this remains
so compilers don't offset the jump table */
case _HALT:
mawk_bozo(MAWK, "ran on halt");
goto out_exit;
case _PUSHC:
inc_sp();
mawk_cellcpy(MAWK, sp, cdp++->ptr);
break;
case _PUSHD:
inc_sp();
sp->type = C_NUM;
sp->d.dval = *(mawk_num_t *) cdp++->ptr;
break;
case _PUSHS:
inc_sp();
sp->type = C_STRING;
sp->ptr = cdp++->ptr;
string(sp)->ref_cnt++;
break;
case F_PUSHA:
cp = (mawk_cell_t *) cdp->ptr;
if (cp != MAWK->field) {
if (MAWK->nf < 0)
mawk_split_field0(MAWK);
if (!(cp >= MAWK_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 = mawk_field_addr_to_index(MAWK, cp);
if (t > MAWK->nf) {
mawk_cell_destroy(MAWK, cp);
cp->type = C_STRING;
cp->ptr = (PTR) & (MAWK->null_str);
MAWK->null_str.ref_cnt++;
}
}
}
/* fall thru */
case _PUSHA:
case A_PUSHA:
inc_sp();
sp->type = C_NOINIT; /* normal varref, not C_ARR_REF */
sp->ptr = cdp++->ptr;
break;
case _PUSHI:
/* put contents of next address on stack */
inc_sp();
mawk_cellcpy(MAWK, 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();
db1printf("pushi fp=%d + %d\n", stackptr(fp), cdp->op);
mawk_cellcpy(MAWK, sp, fp + cdp++->op);
break;
case L_PUSHA:
/* put a local address on eval stack */
inc_sp();
sp->type = C_NOINIT; /* normal varref, not C_ARR_REF */
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 (MAWK->nf < 0)
mawk_split_field0(MAWK);
cp = (mawk_cell_t *) cdp->ptr;
t = (cdp + 1)->op;
cdp += 2;
if (t <= MAWK->nf)
mawk_cellcpy(MAWK, sp, cp);
else { /* an unset field */
sp->type = C_STRING;
sp->ptr = (PTR) & (MAWK->null_str);
MAWK->null_str.ref_cnt++;
}
break;
case NF_PUSHI:
inc_sp();
if (MAWK->nf < 0)
mawk_split_field0(MAWK);
mawk_cellcpy(MAWK, sp, MAWK_NF);
break;
case FE_PUSHA:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
t = d_to_index(MAWK, sp->d.dval);
if (t && MAWK->nf < 0)
mawk_split_field0(MAWK);
sp->ptr = (PTR) field_ptr(t);
if (t > MAWK->nf) {
/* make sure its set to "" */
cp = (mawk_cell_t *) sp->ptr;
mawk_cell_destroy(MAWK, cp);
cp->type = C_STRING;
cp->ptr = (PTR) & (MAWK->null_str);
MAWK->null_str.ref_cnt++;
}
break;
case FE_PUSHI:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
t = d_to_index(MAWK, sp->d.dval);
if (MAWK->nf < 0)
mawk_split_field0(MAWK);
if (t <= MAWK->nf)
mawk_cellcpy(MAWK, sp, field_ptr(t));
else {
sp->type = C_STRING;
sp->ptr = (PTR) & MAWK->null_str;
MAWK->null_str.ref_cnt++;
}
break;
case AE_PUSHA: /* global lookup and push array mawk_cell_t */
/* top of stack has an expr, cdp->ptr points at an
array, replace the expr with the bifunct_target arr ref */
cp = MAWK_ZMALLOC(MAWK, mawk_cell_t);
mawk_cellcpy(MAWK, cp, sp);
mawk_cell_destroy(MAWK, sp);
sp->type = C_ARR_REF_BT;
sp->ptr = (PTR) (mawk_array_t)(cdp->ptr);
sp->d.idx_cell = cp;
cdp++;
break;
case AE_PUSHA_WRARR: /* global lookup and push array mawk_cell_t _ref_ for a later write */
{
/* idx in sp, push array ptr to sp+1 */
inc_sp();
sp->ptr = (mawk_array_t)(cdp->ptr);
cdp++;
sp->type = C_ARR_REF;
}
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 */
mawk_array_find(MAWK, (mawk_array_t)(cdp->ptr), sp, sp, MAWK_CREATE);
cdp++;
break;
case LAE_PUSHI:
/* sp[0] is an expression
cdp->op is offset from frame pointer of a mawk_cell_t which
has an mawk_array_t in the ptr field, replace expr
with array[expr]
*/
mawk_array_find(MAWK, (mawk_array_t)(fp[cdp->op].ptr), sp, sp, MAWK_CREATE);
cdp++;
break;
case LAE_PUSHA: /* local array lookup and push array mawk_cell_t */
/* sp[0] is an expression
cdp->op is offset from frame pointer of a mawk_cell_t which
has an mawk_array_t in the ptr field, replace expr
with bifunct_target arr ref
*/
cp = MAWK_ZMALLOC(MAWK, mawk_cell_t);
mawk_cellcpy(MAWK, cp, sp);
mawk_cell_destroy(MAWK, sp);
sp->type = C_ARR_REF_BT;
sp->ptr = (PTR) (mawk_array_t)(fp[cdp->op].ptr);
sp->d.idx_cell = cp;
cdp++;
break;
case LAE_PUSHA_WRARR: /* local array lookup and push array mawk_cell_t _ref_ for a later write */
{
/* idx in sp, push array ptr to sp+1 */
inc_sp();
sp->ptr = (mawk_array_t)(fp[cdp->op].ptr);
cdp++;
sp->type = C_ARR_REF;
}
break;
case LA_PUSHA:
/* cdp->op is offset from frame pointer of a mawk_cell_t which
has an mawk_array_t in the ptr field. Push this ARRAY
on the eval stack
*/
inc_sp();
sp->type = C_NOINIT; /* normal varref, not C_ARR_REF */
sp->ptr = fp[cdp++->op].ptr;
break;
case SET_ALOOP:
{
ALOOP_STATE *ap = MAWK_ZMALLOC(MAWK, ALOOP_STATE);
unsigned vector_size;
ap->var = (mawk_cell_t *) sp[-1].ptr;
ap->base = ap->ptr = mawk_array_loop_vector(MAWK, (mawk_array_t)(sp->ptr), &vector_size);
ap->limit = ap->base + vector_size;
sp -= 2;
/* push onto aloop stack */
ap->link = aloop_state;
aloop_state = ap;
cdp += cdp->op;
}
break;
case ALOOP:
{
ALOOP_STATE *ap = aloop_state;
if (ap->ptr < ap->limit) {
mawk_cell_destroy(MAWK, ap->var);
ap->var->type = C_STRING;
ap->var->ptr = (PTR) * ap->ptr++;
cdp += cdp->op;
}
else
cdp++;
}
break;
case POP_AL:
{
/* finish up an array loop */
ALOOP_STATE *ap = aloop_state;
aloop_state = ap->link;
aloop_free_vect(MAWK, ap);
MAWK_ZFREE(MAWK, ap);
}
break;
case _POP:
mawk_cell_destroy(MAWK, 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)
mawk_check_strnum(MAWK, sp);
sp--;
mawk_cell_destroy(MAWK, ((mawk_cell_t *) sp->ptr));
mawk_cellcpy(MAWK, sp->ptr, sp + 1);
mawk_cellcpy(MAWK, sp, sp->ptr);
mawk_cell_destroy(MAWK, sp + 1);
break;
case _ASSIGN_ARR:
/* don't propagate type C_MBSTRN */
if (sp->type == C_MBSTRN)
mawk_check_strnum(MAWK, sp);
sp-=2;
/* sp is the index, sp+1 is the array ref and sp+2 is rvalue expr result */
mawk_array_set_execute(MAWK, sp, sp+1, sp, sp+2);
break;
case F_ASSIGN:
/* assign to a field */
if (sp->type == C_MBSTRN)
mawk_check_strnum(MAWK, sp);
sp--;
mawk_field_assign(MAWK, (mawk_cell_t *) sp->ptr, sp + 1);
mawk_cell_destroy(MAWK, sp + 1);
mawk_cellcpy(MAWK, sp, (mawk_cell_t *) sp->ptr);
break;
case _ADD_ASG:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
cp = (mawk_cell_t *) (sp - 1)->ptr;
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
P_nansafe1(cp->d.dval, (cp->d.dval + sp->d.dval), sp->d.dval);
sp--;
sp->type = C_NUM;
sp->d.dval = cp->d.dval;
break;
case _ADD_ASG_ARR:
/* convert the expression result */
mawk_cast_get_num(tmp_num, sp);
sp-=2;
/* sp is the index, sp+1 is the array ref and sp+2 is rvalue expr result; after this sp+2 is the array val */
if (!mawk_array_pure(MAWK, sp+1, 1)) {
mawk_array_getnum_execute(MAWK, sp+2, sp+1, sp);
P_nansafe1(sp[2].d.dval, (sp[2].d.dval + tmp_num), tmp_num);
mawk_array_set_execute(MAWK, sp, sp+1, sp, sp+2);
}
else {
mawk_array_getptr_execute(MAWK, cp, sp+1, sp);
P_nansafe1(cp->d.dval, (cp->d.dval + tmp_num), tmp_num);
}
break;
case _SUB_ASG:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
cp = (mawk_cell_t *) (sp - 1)->ptr;
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
P_nansafe1(cp->d.dval, (cp->d.dval - sp->d.dval), sp->d.dval);
sp--;
sp->type = C_NUM;
sp->d.dval = cp->d.dval;
break;
case _SUB_ASG_ARR:
/* convert the expression result */
mawk_cast_get_num(tmp_num, sp);
sp-=2;
/* sp is the index, sp+1 is the array ref and sp+2 is rvalue expr result; after this sp+2 is the array val */
if (!mawk_array_pure(MAWK, sp+1, 1)) {
mawk_array_getnum_execute(MAWK, sp+2, sp+1, sp);
P_nansafe1(sp[2].d.dval, (sp[2].d.dval - tmp_num), tmp_num);
mawk_array_set_execute(MAWK, sp, sp+1, sp, sp+2);
}
else {
mawk_array_getptr_execute(MAWK, cp, sp+1, sp);
P_nansafe1(cp->d.dval, (cp->d.dval - tmp_num), tmp_num);
}
break;
case _MUL_ASG:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
cp = (mawk_cell_t *) (sp - 1)->ptr;
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
P_nansafe1(cp->d.dval, (cp->d.dval * sp->d.dval), sp->d.dval);
sp--;
sp->type = C_NUM;
sp->d.dval = cp->d.dval;
break;
case _MUL_ASG_ARR:
/* convert the expression result */
mawk_cast_get_num(tmp_num, sp);
sp-=2;
/* sp is the index, sp+1 is the array ref and sp+2 is rvalue expr result; after this sp+2 is the array val */
if (!mawk_array_pure(MAWK, sp+1, 1)) {
mawk_array_getnum_execute(MAWK, sp+2, sp+1, sp);
P_nansafe1(sp[2].d.dval, (sp[2].d.dval * tmp_num), tmp_num);
mawk_array_set_execute(MAWK, sp, sp+1, sp, sp+2);
}
else {
mawk_array_getptr_execute(MAWK, cp, sp+1, sp);
P_nansafe1(cp->d.dval, (cp->d.dval * tmp_num), tmp_num);
}
break;
case _DIV_ASG:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
cp = (mawk_cell_t *) (sp - 1)->ptr;
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
#ifdef MAWK_NO_FLOAT
{
mawk_num_t d;
d = sp--->d.dval;
if (d != MAWK_NUM_ZERO)
cp->d.dval /= d;
else
cp->d.dval = P_nan();
}
#else
{
P_nansafe1(cp->d.dval, (cp->d.dval / sp->d.dval), sp->d.dval);
sp--;
}
#endif
sp->type = C_NUM;
sp->d.dval = cp->d.dval;
break;
case _DIV_ASG_ARR:
/* convert the expression result */
mawk_cast_get_num(tmp_num, sp);
sp-=2;
/* sp is the index, sp+1 is the array ref and sp+2 is rvalue expr result; after this sp+2 is the array val */
if (!mawk_array_pure(MAWK, sp+1, 1)) {
mawk_array_getnum_execute(MAWK, sp+2, sp+1, sp);
#ifdef MAWK_NO_FLOAT
if (tmp_num != MAWK_NUM_ZERO)
sp[2].d.dval /= tmp_num;
else
sp[2].d.dval = P_nan();
#else
P_nansafe1(sp[2].d.dval, (sp[2].d.dval / tmp_num), tmp_num);
#endif
mawk_array_set_execute(MAWK, sp, sp+1, sp, sp+2);
}
else {
mawk_array_getptr_execute(MAWK, cp, sp+1, sp);
#ifdef MAWK_NO_FLOAT
if (tmp_num != MAWK_NUM_ZERO)
cp->d.dval /= tmp_num;
else
cp->d.dval = P_nan();
#else
P_nansafe1(cp->d.dval, (cp->d.dval / tmp_num), tmp_num);
#endif
}
break;
case _MOD_ASG:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
cp = (mawk_cell_t *) (sp - 1)->ptr;
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
if (P_isnan_manual(cp->d.dval) || P_isnan_manual(sp->d.dval))
cp->d.dval = P_nan();
else {
#ifdef MAWK_NO_FLOAT
cp->d.dval %= sp->d.dval;
#else
cp->d.dval = P_fmod(cp->d.dval, sp->d.dval);
#endif
}
sp--;
sp->type = C_NUM;
sp->d.dval = cp->d.dval;
break;
case _MOD_ASG_ARR:
/* convert the expression result */
mawk_cast_get_num(tmp_num, sp);
sp-=2;
/* sp is the index, sp+1 is the array ref and sp+2 is rvalue expr result; after this sp+2 is the array val */
if (!mawk_array_pure(MAWK, sp+1, 1)) {
mawk_array_getnum_execute(MAWK, sp+2, sp+1, sp);
#ifdef MAWK_NO_FLOAT
sp[2].d.dval %= tmp_num;
#else
sp[2].d.dval = P_fmod(sp[2].d.dval, tmp_num);
#endif
mawk_array_set_execute(MAWK, sp, sp+1, sp, sp+2);
}
else {
mawk_array_getptr_execute(MAWK, cp, sp+1, sp);
#ifdef MAWK_NO_FLOAT
cp->d.dval %= tmp_num;
#else
cp->d.dval = P_fmod(cp->d.dval, tmp_num);
#endif
}
break;
case _POW_ASG:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
cp = (mawk_cell_t *) (sp - 1)->ptr;
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
cp->d.dval = mawk_num_pow(cp->d.dval, sp--->d.dval);
sp->type = C_NUM;
sp->d.dval = cp->d.dval;
break;
case _POW_ASG_ARR:
/* convert the expression result */
mawk_cast_get_num(tmp_num, sp);
sp-=2;
/* sp is the index, sp+1 is the array ref and sp+2 is rvalue expr result; after this sp+2 is the array val */
if (!mawk_array_pure(MAWK, sp+1, 1)) {
mawk_array_getnum_execute(MAWK, sp+2, sp+1, sp);
sp[2].d.dval = mawk_num_pow(sp[2].d.dval, tmp_num);
mawk_array_set_execute(MAWK, sp, sp+1, sp, sp+2);
}
else {
mawk_array_getptr_execute(MAWK, cp, sp+1, sp);
cp->d.dval = mawk_num_pow(cp->d.dval, tmp_num);
}
break;
case F_ADD_ASG:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
cp = (mawk_cell_t *) (sp - 1)->ptr;
mawk_cellcpy(MAWK, &MAWK->tc, cp);
mawk_cast1_to_num(MAWK, &MAWK->tc);
P_nansafe1(MAWK->tc.d.dval, (MAWK->tc.d.dval + sp->d.dval), sp->d.dval);
sp--;
sp->type = C_NUM;
sp->d.dval = MAWK->tc.d.dval;
mawk_field_assign(MAWK, cp, &MAWK->tc);
break;
case F_SUB_ASG:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
cp = (mawk_cell_t *) (sp - 1)->ptr;
mawk_cellcpy(MAWK, &MAWK->tc, cp);
mawk_cast1_to_num(MAWK, &MAWK->tc);
P_nansafe1(MAWK->tc.d.dval, (MAWK->tc.d.dval - sp->d.dval), sp->d.dval);
sp--;
sp->type = C_NUM;
sp->d.dval = MAWK->tc.d.dval;
mawk_field_assign(MAWK, cp, &MAWK->tc);
break;
case F_MUL_ASG:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
cp = (mawk_cell_t *) (sp - 1)->ptr;
mawk_cellcpy(MAWK, &MAWK->tc, cp);
mawk_cast1_to_num(MAWK, &MAWK->tc);
P_nansafe1(MAWK->tc.d.dval, (MAWK->tc.d.dval * sp->d.dval), sp->d.dval);
sp--;
sp->type = C_NUM;
sp->d.dval = MAWK->tc.d.dval;
mawk_field_assign(MAWK, cp, &MAWK->tc);
break;
case F_DIV_ASG:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
cp = (mawk_cell_t *) (sp - 1)->ptr;
mawk_cellcpy(MAWK, &MAWK->tc, cp);
mawk_cast1_to_num(MAWK, &MAWK->tc);
#ifdef MAWK_NO_FLOAT
{
mawk_num_t d;
d = sp--->d.dval;
if (d != MAWK_NUM_ZERO)
MAWK->tc.d.dval /= d;
else
MAWK->tc.d.dval = P_nan();
}
#else
P_nansafe1(MAWK->tc.d.dval, (MAWK->tc.d.dval / sp->d.dval), sp->d.dval);
sp--;
#endif
sp->type = C_NUM;
sp->d.dval = MAWK->tc.d.dval;
mawk_field_assign(MAWK, cp, &MAWK->tc);
break;
case F_MOD_ASG:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
cp = (mawk_cell_t *) (sp - 1)->ptr;
mawk_cellcpy(MAWK, &MAWK->tc, cp);
mawk_cast1_to_num(MAWK, &MAWK->tc);
#ifdef MAWK_NO_FLOAT
{
int d;
d = sp--->d.dval;
if (d != MAWK_NUM_ZERO)
MAWK->tc.d.dval %= d;
else
MAWK->tc.d.dval = P_nan();
}
#else
MAWK->tc.d.dval = P_fmod(MAWK->tc.d.dval, sp--->d.dval);
#endif
sp->type = C_NUM;
sp->d.dval = MAWK->tc.d.dval;
mawk_field_assign(MAWK, cp, &MAWK->tc);
break;
case F_POW_ASG:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
cp = (mawk_cell_t *) (sp - 1)->ptr;
mawk_cellcpy(MAWK, &MAWK->tc, cp);
mawk_cast1_to_num(MAWK, &MAWK->tc);
MAWK->tc.d.dval = mawk_num_pow(MAWK->tc.d.dval, sp--->d.dval);
sp->type = C_NUM;
sp->d.dval = MAWK->tc.d.dval;
mawk_field_assign(MAWK, cp, &MAWK->tc);
break;
case _ADD:
sp--;
if (TEST2(sp) != TWO_NUMS)
mawk_cast2_to_num(MAWK, sp);
P_nansafe1(sp[0].d.dval, (sp[0].d.dval + sp[1].d.dval), sp[1].d.dval);
break;
case _SUB:
sp--;
if (TEST2(sp) != TWO_NUMS)
mawk_cast2_to_num(MAWK, sp);
P_nansafe1(sp[0].d.dval, (sp[0].d.dval - sp[1].d.dval), sp[1].d.dval);
break;
case _MUL:
sp--;
if (TEST2(sp) != TWO_NUMS)
mawk_cast2_to_num(MAWK, sp);
P_nansafe1(sp[0].d.dval, (sp[0].d.dval * sp[1].d.dval), sp[1].d.dval);
break;
case _DIV:
sp--;
if (TEST2(sp) != TWO_NUMS)
mawk_cast2_to_num(MAWK, sp);
#ifdef MAWK_NO_FLOAT
if (sp[1].d.dval != 0)
sp[0].d.dval /= sp[1].d.dval;
else
sp[0].d.dval = P_nan();
#else
P_nansafe1(sp[0].d.dval, (sp[0].d.dval / sp[1].d.dval), sp[1].d.dval);
#endif
break;
case _MOD:
sp--;
if (TEST2(sp) != TWO_NUMS)
mawk_cast2_to_num(MAWK, sp);
#ifdef MAWK_NO_FLOAT
{
int d;
d = sp[1].d.dval;
if (d != MAWK_NUM_ZERO)
sp[0].d.dval %= d;
else
sp[0].d.dval = P_nan();
}
#else
sp[0].d.dval = P_fmod(sp[0].d.dval, sp[1].d.dval);
#endif
break;
case _POW:
sp--;
if (TEST2(sp) != TWO_NUMS)
mawk_cast2_to_num(MAWK, sp);
sp[0].d.dval = mawk_num_pow(sp[0].d.dval, sp[1].d.dval);
break;
case _NOT:
/* evaluates to 0.0 or 1.0 */
reswitch_1:
switch (sp->type) {
case C_NOINIT:
sp->d.dval = MAWK_NUM_ONE;
break;
case C_NUM:
if (!P_isnan_manual(sp->d.dval))
sp->d.dval = sp->d.dval != MAWK_NUM_ZERO ? MAWK_NUM_ZERO : MAWK_NUM_ONE;
break;
case C_STRING:
sp->d.dval = string(sp)->len ? MAWK_NUM_ZERO : MAWK_NUM_ONE;
free_STRING(string(sp));
break;
case C_STRNUM: /* mawk_test as a number */
sp->d.dval = sp->d.dval != MAWK_NUM_ZERO ? MAWK_NUM_ZERO : MAWK_NUM_ONE;
free_STRING(string(sp));
break;
case C_MBSTRN:
mawk_check_strnum(MAWK, sp);
goto reswitch_1;
default:
mawk_bozo(MAWK, "bad type on eval stack");
}
sp->type = C_NUM;
break;
case _TEST:
/* evaluates to 0.0 or 1.0 */
reswitch_2:
switch (sp->type) {
case C_NOINIT:
sp->d.dval = MAWK_NUM_ZERO;
break;
case C_NUM:
if (!P_isnan_manual(sp->d.dval))
sp->d.dval = sp->d.dval != MAWK_NUM_ZERO ? MAWK_NUM_ONE : MAWK_NUM_ZERO;
break;
case C_STRING:
sp->d.dval = string(sp)->len ? MAWK_NUM_ONE : MAWK_NUM_ZERO;
free_STRING(string(sp));
break;
case C_STRNUM: /* mawk_test as a number */
sp->d.dval = sp->d.dval != MAWK_NUM_ZERO ? MAWK_NUM_ONE : MAWK_NUM_ZERO;
free_STRING(string(sp));
break;
case C_MBSTRN:
mawk_check_strnum(MAWK, sp);
goto reswitch_2;
default:
mawk_bozo(MAWK, "bad type on eval stack");
}
sp->type = C_NUM;
break;
case _UMINUS:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
if (!P_isnan_manual(sp->d.dval))
sp->d.dval = -sp->d.dval;
break;
case _UPLUS:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
break;
case _CAT:
{
unsigned len1, len2;
char *str1, *str2;
mawk_string_t *b;
sp--;
if (TEST2(sp) != TWO_STRINGS)
mawk_cast2_to_str(MAWK, sp);
str1 = string(sp)->str;
len1 = string(sp)->len;
str2 = string(sp + 1)->str;
len2 = string(sp + 1)->len;
b = mawk_new_STRING0(MAWK, len1 + len2);
memcpy(b->str, str1, len1);
memcpy(b->str + len1, str2, 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:
db1printstack(MAWK, "--start before bi", sp, fp);
cp = (*(PF_CP) mawk_d2f(cdp++->ptr)) (MAWK, sp);
db1printstack(MAWK, "--start after bi", sp, fp);
if (cp->type == C_REQ_NOMORE) {
db1printf("->nomore\n");
cdp-=2;
goto out_nomore;
}
sp = cp;
if (sp->type == C_REQ_CALL) { /* the bi function returned with a request to call an user function */
int a_args;
mawk_cell_t *pfp;
FBLOCK *fbp;
db1printf("->req call\n");
fbp = (FBLOCK *) sp->ptr;
sp--;
a_args = sp->d.dval; /* actual/caller's number of args on stack already */
sp--;
pfp = sp - a_args + 1;
{
mawk_call_pre();
db1printf("++ CALL2 sp=%d a_args(caller)=%d fbp->nargs(callee)=%d\n", stackptr(sp), a_args,fbp->nargs);
db1printstack(MAWK, "--start call2", sp, fp);
mawk_push_exe_state(EXEST_NORMAL);
aloop_state = NULL;
/*sp - RECURSION_OVERHEAD - fbp->nargs + a_args*/
fp = pfp;
db1printf("CALL2 fp=%d final-sp=%d\n", stackptr(fp), stackptr(sp));
cdp = fbp->code;
db1printf("CALL new=%d\n", stackptr(sp));
}
}
break;
case _PRINT:
sp = (*(PF_CP) mawk_d2f(cdp++->ptr)) (MAWK, sp);
break;
case _POST_INC:
cp = (mawk_cell_t *) sp->ptr;
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
sp->type = C_NUM;
sp->d.dval = cp->d.dval;
if (!P_isnan_manual(cp->d.dval))
cp->d.dval += MAWK_NUM_ONE;
break;
case _POST_INC_ARR:
inc_sp();
sp->type = C_NOINIT;
sp-=2;
/* sp is the index, sp+1 is the array ref and sp+2 is tmp; after this sp+2 is the array val */
if (!mawk_array_pure(MAWK, sp+1, 1)) {
mawk_array_getnum_execute(MAWK, sp+2, sp+1, sp);
tmp_num = sp[2].d.dval;
if (!P_isnan_manual(sp[2].d.dval))
sp[2].d.dval += MAWK_NUM_ONE;
mawk_array_set(MAWK, (mawk_array_t)sp[1].ptr, sp, sp+2);
}
else {
mawk_array_getptr_execute(MAWK, cp, sp+1, sp);
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
tmp_num = cp->d.dval;
if (!P_isnan_manual(cp->d.dval))
cp->d.dval += MAWK_NUM_ONE;
}
mawk_cell_destroy(MAWK, sp);
sp->type = C_NUM;
sp->d.dval = tmp_num;
break;
case _POST_DEC:
cp = (mawk_cell_t *) sp->ptr;
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
sp->type = C_NUM;
sp->d.dval = cp->d.dval;
if (!P_isnan_manual(sp->d.dval))
cp->d.dval -= MAWK_NUM_ONE;
break;
case _POST_DEC_ARR:
inc_sp();
sp->type = C_NOINIT;
sp-=2;
/* sp is the index, sp+1 is the array ref and sp+2 is tmp; after this sp+2 is the array val */
if (!mawk_array_pure(MAWK, sp+1, 1)) {
mawk_array_getnum_execute(MAWK, sp+2, sp+1, sp);
tmp_num = sp[2].d.dval;
if (!P_isnan_manual(sp[2].d.dval))
sp[2].d.dval -= MAWK_NUM_ONE;
mawk_array_set(MAWK, (mawk_array_t)sp[1].ptr, sp, sp+2);
}
else {
mawk_array_getptr_execute(MAWK, cp, sp+1, sp);
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
tmp_num = cp->d.dval;
if (!P_isnan_manual(cp->d.dval))
cp->d.dval -= MAWK_NUM_ONE;
}
mawk_cell_destroy(MAWK, sp);
sp->type = C_NUM;
sp->d.dval = tmp_num;
break;
case _PRE_INC:
cp = (mawk_cell_t *) sp->ptr;
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
if (!P_isnan_manual(sp->d.dval))
cp->d.dval += MAWK_NUM_ONE;
sp->d.dval = cp->d.dval;
sp->type = C_NUM;
break;
case _PRE_INC_ARR:
inc_sp();
sp->type = C_NOINIT;
sp-=2;
/* sp is the index, sp+1 is the array ref and sp+2 is tmp; after this sp+2 is the array val */
if (!mawk_array_pure(MAWK, sp+1, 1)) {
mawk_array_getnum_execute(MAWK, sp+2, sp+1, sp);
if (!P_isnan_manual(sp[2].d.dval))
sp[2].d.dval += MAWK_NUM_ONE;
mawk_array_set(MAWK, (mawk_array_t)sp[1].ptr, sp, sp+2);
mawk_cell_destroy(MAWK, sp);
sp->type = C_NUM;
sp->d.dval = sp[2].d.dval;
}
else {
mawk_array_getptr_execute(MAWK, cp, sp+1, sp);
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
if (!P_isnan_manual(cp->d.dval))
cp->d.dval += MAWK_NUM_ONE;
mawk_cell_destroy(MAWK, sp);
sp->type = C_NUM;
sp->d.dval = cp->d.dval;
}
break;
case _PRE_DEC:
cp = (mawk_cell_t *) sp->ptr;
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
if (!P_isnan_manual(sp->d.dval))
cp->d.dval -= MAWK_NUM_ONE;
sp->d.dval = cp->d.dval;
sp->type = C_NUM;
break;
case _PRE_DEC_ARR:
inc_sp();
sp->type = C_NOINIT;
sp-=2;
/* sp is the index, sp+1 is the array ref and sp+2 is tmp; after this sp+2 is the array val */
if (!mawk_array_pure(MAWK, sp+1, 1)) {
mawk_array_getnum_execute(MAWK, sp+2, sp+1, sp);
if (!P_isnan_manual(sp[2].d.dval))
sp[2].d.dval -= MAWK_NUM_ONE;
mawk_array_set(MAWK, (mawk_array_t)sp[1].ptr, sp, sp+2);
mawk_cell_destroy(MAWK, sp);
sp->type = C_NUM;
sp->d.dval = sp[2].d.dval;
}
else {
mawk_array_getptr_execute(MAWK, cp, sp+1, sp);
if (cp->type != C_NUM)
mawk_cast1_to_num(MAWK, cp);
if (!P_isnan_manual(cp->d.dval))
cp->d.dval -= MAWK_NUM_ONE;
mawk_cell_destroy(MAWK, sp);
sp->type = C_NUM;
sp->d.dval = cp->d.dval;
}
break;
case F_POST_INC:
cp = (mawk_cell_t *) sp->ptr;
mawk_cellcpy(MAWK, &MAWK->tc, cp);
mawk_cast1_to_num(MAWK, &MAWK->tc);
sp->type = C_NUM;
sp->d.dval = MAWK->tc.d.dval;
if (!P_isnan_manual(MAWK->tc.d.dval))
MAWK->tc.d.dval += MAWK_NUM_ONE;
mawk_field_assign(MAWK, cp, &MAWK->tc);
break;
case F_POST_DEC:
cp = (mawk_cell_t *) sp->ptr;
mawk_cellcpy(MAWK, &MAWK->tc, cp);
mawk_cast1_to_num(MAWK, &MAWK->tc);
sp->type = C_NUM;
sp->d.dval = MAWK->tc.d.dval;
if (!P_isnan_manual(MAWK->tc.d.dval))
MAWK->tc.d.dval -= MAWK_NUM_ONE;
mawk_field_assign(MAWK, cp, &MAWK->tc);
break;
case F_PRE_INC:
cp = (mawk_cell_t *) sp->ptr;
mawk_cellcpy(MAWK, sp, cp);
mawk_cast1_to_num(MAWK, sp);
if (!P_isnan_manual(sp->d.dval))
sp->d.dval += MAWK_NUM_ONE;
mawk_field_assign(MAWK, cp, sp);
break;
case F_PRE_DEC:
cp = (mawk_cell_t *) sp->ptr;
mawk_cellcpy(MAWK, sp, cp);
mawk_cast1_to_num(MAWK, sp);
if (!P_isnan_manual(sp->d.dval))
sp->d.dval -= MAWK_NUM_ONE;
mawk_field_assign(MAWK, cp, sp);
break;
case _JMP:
cdp += cdp->op;
break;
case _JNZ:
/* jmp if top of stack is non-zero and pop stack */
if (P_isnan(sp->d.dval))
mawk_rt_error(MAWK, "NaN in conditional jump");
if (mawk_test(MAWK, sp))
cdp += cdp->op;
else
cdp++;
mawk_cell_destroy(MAWK, sp);
sp--;
break;
case _JZ:
/* jmp if top of stack is zero and pop stack */
if (P_isnan(sp->d.dval))
mawk_rt_error(MAWK, "NaN in conditional jump");
if (!mawk_test(MAWK, sp))
cdp += cdp->op;
else
cdp++;
mawk_cell_destroy(MAWK, sp);
sp--;
break;
case _LJZ:
/* special jump for logical and */
/* this is always preceded by _TEST */
if (P_isnan(sp->d.dval))
mawk_rt_error(MAWK, "NaN in conditional jump");
if (sp->d.dval == MAWK_NUM_ZERO) {
/* take jump, but don't pop stack */
cdp += cdp->op;
}
else {
/* pop and don't jump */
sp--;
cdp++;
}
break;
case _LJNZ:
/* special jump for logical or */
/* this is always preceded by _TEST */
if (P_isnan(sp->d.dval))
mawk_rt_error(MAWK, "NaN in conditional jump");
if (sp->d.dval != MAWK_NUM_ZERO) {
/* take jump, but don't pop stack */
cdp += cdp->op;
}
else {
/* pop and don't jump */
sp--;
cdp++;
}
break;
/* the relation operations */
/* compare() makes sure string ref counts are OK */
case _EQ:
dt = compare(MAWK, --sp);
sp->type = C_NUM;
sp->d.dval = P_nansafe_exp1((dt == 0 ? MAWK_NUM_ONE : MAWK_NUM_ZERO), dt);
break;
case _NEQ:
dt = compare(MAWK, --sp);
sp->type = C_NUM;
sp->d.dval = P_nansafe_exp1((dt ? MAWK_NUM_ONE : MAWK_NUM_ZERO), dt);
break;
case _LT:
dt = compare(MAWK, --sp);
sp->type = C_NUM;
sp->d.dval = P_nansafe_exp1((dt < 0 ? MAWK_NUM_ONE : MAWK_NUM_ZERO), dt);
break;
case _LTE:
dt = compare(MAWK, --sp);
sp->type = C_NUM;
sp->d.dval = P_nansafe_exp1((dt <= 0 ? MAWK_NUM_ONE : MAWK_NUM_ZERO), dt);
break;
case _GT:
dt = compare(MAWK, --sp);
sp->type = C_NUM;
sp->d.dval = P_nansafe_exp1((dt > 0 ? MAWK_NUM_ONE : MAWK_NUM_ZERO), dt);
break;
case _GTE:
dt = compare(MAWK, --sp);
sp->type = C_NUM;
sp->d.dval = P_nansafe_exp1((dt >= 0 ? MAWK_NUM_ONE : MAWK_NUM_ZERO), dt);
break;
case _MATCH0:
/* does $0 match, the RE at cdp? */
inc_sp();
if (MAWK->field->type >= C_STRING) {
sp->type = C_NUM;
sp->d.dval = mawk_REtest(MAWK, string(MAWK->field)->str, cdp++->ptr)
? MAWK_NUM_ONE : MAWK_NUM_ZERO;
break /* the case */ ;
}
else {
mawk_cellcpy(MAWK, sp, MAWK->field);
/* and FALL THRU */
}
case _MATCH1:
/* does expr at sp[0] match RE at cdp */
if (sp->type < C_STRING)
mawk_cast1_to_str(MAWK, sp);
t = mawk_REtest(MAWK, string(sp)->str, cdp++->ptr);
free_STRING(string(sp));
sp->type = C_NUM;
sp->d.dval = t ? MAWK_NUM_ONE : MAWK_NUM_ZERO;
break;
case _MATCH2:
/* does sp[-1] match sp[0] as re */
mawk_cast_to_RE(MAWK, sp);
if ((--sp)->type < C_STRING)
mawk_cast1_to_str(MAWK, sp);
t = mawk_REtest(MAWK, string(sp)->str, (sp + 1)->ptr);
free_STRING(string(sp));
sp->type = C_NUM;
sp->d.dval = t ? MAWK_NUM_ONE : MAWK_NUM_ZERO;
break;
case A_TEST:
/* entry : sp[0].ptr-> an array
sp[-1] is an expression
we compute (expression in array) */
sp--;
t = mawk_array_find(MAWK, (mawk_array_t)((sp + 1)->ptr), sp, NULL, NO_MAWK_CREATE);
mawk_cell_destroy(MAWK, sp);
sp->type = C_NUM;
sp->d.dval = t ? MAWK_NUM_ONE : MAWK_NUM_ZERO;
break;
case A_DEL:
/* sp[0].ptr -> array
sp[-1] is an expr
delete array[expr] */
mawk_array_delete(MAWK, (mawk_array_t)(sp->ptr), sp - 1);
mawk_cell_destroy(MAWK, sp - 1);
sp -= 2;
break;
case DEL_A:
/* free all the array at once */
mawk_array_clear(MAWK, (mawk_array_t)(sp->ptr));
sp--;
break;
/* form a multiple array index */
case A_CAT:
sp = mawk_array_cat(MAWK, sp, cdp->op);
cdp++;
break;
case _EXIT:
if (sp->type != C_NUM)
mawk_cast1_to_num(MAWK, sp);
MAWK->exit_code = d_to_i(sp->d.dval);
sp--;
/* fall thru */
case _EXIT0:
if (!MAWK->end_start) {
mawk_exit_(MAWK, MAWK->exit_code);
goto out_exit;
}
cdp = MAWK->end_start;
MAWK->end_start = NULL; /* makes sure next exit exits */
if (MAWK->begin_start) {
mawk_zfree(MAWK, MAWK->begin_start, MAWK->begin_size);
MAWK->begin_start = NULL;
}
if (MAWK->main_start) {
mawk_zfree(MAWK, MAWK->main_start, MAWK->main_size);
MAWK->main_start = NULL;
}
sp = MAWK->eval_stack - 1; /* might be in user function */
CLEAR_ALOOP_STACK(); /* ditto */
/* cdp is set up to point to END, go on executing that */
break;
case _JMAIN: /* go from BEGIN code to MAIN code */
mawk_zfree(MAWK, MAWK->begin_start, MAWK->begin_size);
MAWK->begin_start = NULL;
cdp = MAWK->main_start;
if (MAWK->separate_begin)
goto out_sepmain;
break;
case _OMAIN:
if (!MAWK->main_input)
mawk_FINopen_main(MAWK);
if (!MAWK->main_input)
goto jump_end;
MAWK->restart_label = cdp;
cdp = MAWK->next_label;
break;
case _NEXT:
/* next might be inside an aloop -- clear stack */
CLEAR_ALOOP_STACK();
cdp = MAWK->next_label;
break;
case OL_GL:
{
char *p;
unsigned len;
p = mawk_FINgets(MAWK, MAWK->main_input, &len);
if (p == (void *) mawk_FIN_nomore) {
cdp--;
goto out_nomore;
}
if (!p) {
if (!MAWK->end_start)
mawk_exitval(MAWK, 0, MAWK_EXER_DONE);
jump_end:;
cdp = MAWK->end_start;
if (MAWK->main_start != NULL)
mawk_zfree(MAWK, MAWK->main_start, MAWK->main_size);
MAWK->main_start = MAWK->end_start = (INST *) 0;
}
else {
mawk_set_field0(MAWK, p, len);
cdp = MAWK->restart_label;
MAWK->rt_nr++;
MAWK->rt_fnr++;
}
}
break;
/* two kinds of OL_GL is a historical stupidity from working on
a machine with very slow floating point emulation */
case OL_GL_NR:
{
char *p;
unsigned len;
p = mawk_FINgets(MAWK, MAWK->main_input, &len);
if (p == (void *) mawk_FIN_nomore) {
cdp--;
goto out_nomore;
}
if (!p) {
if (!MAWK->end_start)
mawk_exitval(MAWK, 0, MAWK_EXER_DONE);
cdp = MAWK->end_start;
if (MAWK->main_start != NULL)
mawk_zfree(MAWK, MAWK->main_start, MAWK->main_size);
MAWK->main_start = MAWK->end_start = NULL;
}
else {
mawk_set_field0(MAWK, p, len);
cdp = MAWK->restart_label;
if (TEST2(NR) != TWO_NUMS) {
mawk_cast2_to_num(MAWK, NR);
}
NR->d.dval += MAWK_NUM_ONE;
MAWK->rt_nr++;
FNR->d.dval += MAWK_NUM_ONE;
MAWK->rt_fnr++;
}
}
break;
case _RANGE_CHK:
/* mawk_test a range pattern: pat1, pat2 { action }
entry :
cdp[0].op -- a flag, mawk_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
db1printstack(MAWK, "--start range", sp, fp);
/* FLAG: 0 means we are running the patten (we are between pat1 and pat2) */
if (FLAG) { /* mawk_test again pat1 */
/* prepare for executing pattern match for pat1 */
mawk_push_exe_state(EXEST_RANGE1);
cdp = cdp + PAT1;
db1printf("matching pat1\n");
break;
}
range_chk_pat2:;
/* mawk_test against pat2 */
mawk_push_exe_state(EXEST_RANGE2);
cdp = cdp + PAT2;
db1printf("matching pat2\n");
break;
case _RANGE_STOP: /* only for range patterns */
cp = sp; /* remember the result of the pattern match expr */
db1printstack(MAWK, "--stop cp", sp, fp);
sp--;
mawk_pop_exe_state();
if (exest == EXEST_RANGE1) {
t = mawk_test(MAWK, cp);
mawk_cell_destroy(MAWK, cp);
if (t) {
FLAG = 0;
goto range_chk_pat2;
}
else {
cdp += FOLLOW;
break; /* break the switch */
}
}
else if (exest == EXEST_RANGE2) {
/* pat2 and then perform the action */
FLAG = mawk_test(MAWK, cp);
mawk_cell_destroy(MAWK, cp);
cdp += ACTION;
}
else
mawk_bozo(MAWK, "wrong execution state when popping range stop frame");
exest = EXEST_NORMAL;
break;
/* function calls */
case _RET0:
db1printf("RET0 on sp=%d\n", stackptr(sp));
inc_sp();
sp->type = C_NOINIT;
/* fall thru */
case _RET:
#ifdef DEBUG
if (sp != entry_sp + 1)
mawk_bozo(MAWK, "ret");
#endif
db1printstack(MAWK, "-- ret entry", sp, fp);
{
mawk_cell_t retval;
mawk_cell_t *pfp = fp;
FBLOCK *cfbp;
int cargs;
/* have to save retval in case the stack got relocated */
mawk_cellcpy(MAWK, &retval, sp);
mawk_cell_destroy(MAWK, sp);
sp--;
db1printf("RET before removing overhead (retval already removed) sp=%d\n", stackptr(sp));
db1printstack(MAWK, "-- ret before overhead", sp, fp);
if (old_stack_base) { /* reset stack */
/* move the return value */
mawk_cellcpy(MAWK, old_sp + 1, &retval);
mawk_cell_destroy(MAWK, &retval);
/* restore */
mawk_zfree(MAWK, MAWK->stack_base, sizeof(mawk_cell_t) * EVAL_STACK_SIZE);
MAWK->stack_base = old_stack_base;
MAWK->stack_danger = old_stack_base + DANGER;
sp = old_sp;
}
/* return might be inside an aloop -- clear stack */
CLEAR_ALOOP_STACK();
cfbp = call_fbp;
cargs = call_a_args;
/* get back at the caller context */
mawk_pop_exe_state();
db1printf("RET after removing overhead sp=%d pfp=%d\n", stackptr(sp), stackptr(pfp));
if (cfbp != NULL) {
db1printf("removing %d locals\n", pfp-sp+1);
mawk_call_post(cfbp, cargs);
}
sp = pfp;
/* save retval to current sp (which might be in an older stack block) */
mawk_cellcpy(MAWK, sp, &retval);
mawk_cell_destroy(MAWK, &retval);
/* caller was not plain awk code, has to return immediately after the func */
if (exest == EXEST_EXIT)
goto out_funcret;
/* go on executing normally; we are back at the caller's context and
sp contains the return value */
}
break;
case _CALL:
{
/* cdp[0] holds ptr to "function block"
cdp[1] holds number of input arguments
*/
mawk_cell_t *pfp;
FBLOCK *fbp = (FBLOCK *) cdp++->ptr;
int a_args = cdp++->op; /* actual/caller's number of args already pushed on stack */
/* might be just a C function */
cp = mawk_call_c_func(MAWK, sp, fbp, a_args);
if (cp != NULL) {
/* C function call succeeded, new sp is returned by the user function */
sp = cp;
break;
}
/* native awk user function */
pfp = sp - a_args + 1;
{
mawk_call_pre();
db1printf("++ CALL sp=%d a_args(caller)=%d fbp->nargs(callee)=%d\n", stackptr(sp), a_args,fbp->nargs);
mawk_push_exe_state(EXEST_NORMAL);
aloop_state = NULL;
/*sp - RECURSION_OVERHEAD - fbp->nargs + a_args*/
fp = pfp;
db1printf("CALL fp=%d final-sp=%d\n", stackptr(fp), stackptr(sp));
call_fbp = fbp;
call_a_args = a_args;
cdp = fbp->code;
db1printf("CALL new=%d\n", stackptr(sp));
}
}
goto call_entry;
case LOCATION:
mawk_location_change(MAWK, cdp->op);
cdp++;
break;
default:
mawk_bozo(MAWK, "bad opcode");
}
} /* while */
/* got here because exit */
out:;
MAWK->sp = sp;
db1printf("exe out sp=%d\n", stackptr(sp));
return MAWK_EXER_DONE;
/* jump here to indicate return from a function; top of stack is the retval */
out_funcret:;
MAWK->sp = sp;
db1printf("exe out_funcret sp=%d\n", stackptr(sp));
return MAWK_EXER_FUNCRET;
/* jump here to indicate execution interrupted due to read block (no more input) */
out_nomore:;
mawk_push_exe_state(EXEST_NORMAL); /* for a later resume */
MAWK->sp = sp;
db1printf("exe out_nomore sp=%d\n", stackptr(sp));
return MAWK_EXER_INT_READ;
/* jump here to indicate execution interrupted due to read block (no more input) */
out_runlimit:;
mawk_push_exe_state(EXEST_NORMAL); /* for a later resume */
MAWK->sp = sp;
db1printf("exe out_runlimit sp=%d\n", stackptr(sp));
db1printstack(MAWK, "-- runlimit push", sp, fp);
return MAWK_EXER_INT_RUNLIMIT;
/* jump here to interrupt execution before running main */
out_sepmain:;
mawk_push_exe_state(EXEST_NORMAL); /* for a later resume */
MAWK->sp = sp;
db1printf("exe separate main sp=%d\n", stackptr(sp));
db1printstack(MAWK, "-- sepmain push", sp, fp);
return MAWK_EXER_INT_SEPMAIN;
/* jump here for hard exit; discards the whole stack! */
out_exit:;
/* if we hit exit, we sure won't need the eval stack anymore */
MAWK->sp = MAWK->eval_stack;
db1printf("exe out_exit sp=%d\n", stackptr(MAWK->sp));
return MAWK_EXER_EXIT;
}
/* entry point: start executing cdp (BEGIN, END or main) */
void mawk_execute(mawk_state_t *MAWK, register INST *cdp, register mawk_cell_t *sp, mawk_cell_t *fp)
{
mawk_cell_t *old_stack_base = 0, *old_sp = 0; /* for moving the eval stack on deep recursion */
ALOOP_STATE *aloop_state = (ALOOP_STATE *) 0;
FBLOCK *call_fbp = NULL; /* user function being executed */
int call_a_args = 0; /* number of caller args in user func being executed */
db1printf("=== mawk_execute()\n");
mawk_push_exe_state(EXEST_EXIT); /* this will get execute to exit at the end */
mawk_push_exe_state(EXEST_NORMAL);
MAWK->sp = sp;
mawk_execute_(MAWK);
}
mawk_exec_result_t mawk_resume(mawk_state_t *MAWK)
{
db1printf("=== mawk_resume()\n");
if (MAWK->eval_stack == MAWK->sp)
return MAWK_EXER_ERR_NOSTACK;
return mawk_execute_(MAWK);
}
/* entry point: Call awk function fbp with a_args already pushed on
the stack. sp is the stack pointer that is returned after the operation.
This function is called only from outside of execute.c, vm func calls
are embedded in execute_().
*/
mawk_exec_result_t mawk_call(mawk_state_t * MAWK, FBLOCK * fbp, int a_args, mawk_cell_t *res)
{
mawk_exec_result_t exer;
mawk_cell_t *old_stack_base = 0, *old_sp = 0;
ALOOP_STATE *aloop_state = (ALOOP_STATE *) 0;
mawk_cell_t *sp = MAWK->sp;
mawk_call_vars;
mawk_cell_t *cp, *fp = sp - a_args+1;
INST *cdp = fbp->code;
FBLOCK *call_fbp = NULL; /* user function being executed */
int call_a_args = 0; /* number of caller args in user func being executed */
db1printstack(MAWK, "=== mawk_call_do()\n", sp, fp);
/* might be just a C function */
cp = mawk_call_c_func(MAWK, sp, fbp, a_args);
if (cp != NULL) {
MAWK->sp = cp;
exer = MAWK_EXER_FUNCRET;
goto copy_retv;
}
{
mawk_call_pre();
MAWK->sp = sp;
db1printstack(MAWK, "mawk_call_do2()\n", sp, fp);
mawk_push_exe_state(EXEST_EXIT);
MAWK->sp = sp;
db1printstack(MAWK, "mawk_call_do3()\n", sp, fp);
mawk_push_exe_state(EXEST_NORMAL); /* to get mawk_execute_ to run our code */
MAWK->sp = sp;
db1printstack(MAWK, "mawk_call_do4()\n", sp, fp);
MAWK->sp = sp;
exer = mawk_execute_(MAWK);
db1printstack(MAWK, "mawk_call_AFTER()\n", MAWK->sp, fp);
}
copy_retv:;
if (exer == MAWK_EXER_FUNCRET) {
mawk_cellcpy(MAWK, res, MAWK->sp);
mawk_cell_destroy(MAWK, MAWK->sp);
MAWK->sp--;
}
return exer;
}
/*
return 0 if a numeric is zero else return non-zero
return 0 if a string is "" else return non-zero
*/
int mawk_test(mawk_state_t *MAWK, register mawk_cell_t *cp)
{
reswitch:
switch (cp->type) {
case C_NOINIT:
return 0;
case C_STRNUM: /* mawk_test as a number */
case C_NUM:
return cp->d.dval != MAWK_NUM_ZERO;
case C_STRING:
return string(cp)->len;
case C_MBSTRN:
mawk_check_strnum(MAWK, cp);
goto reswitch;
default:
mawk_bozo(MAWK, "bad cell type in call to mawk_test");
}
return 0; /*can't get here: shutup */
}
/* compare cells at cp and cp+1 and
frees STRINGs at those cells
*/
static double compare(mawk_state_t *MAWK, register mawk_cell_t *cp)
{
int k;
reswitch:
switch (TEST2(cp)) {
case TWO_NOINITS:
return 0;
case TWO_NUMS:
two_d:
if (P_isnan_manual((cp + 1)->d.dval))
return P_nan();
if (P_isnan_manual(cp->d.dval))
return P_nan();
return cp->d.dval > (cp + 1)->d.dval ? 1 : cp->d.dval < (cp + 1)->d.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 (double)k;
case NOINIT_AND_NUM:
case NOINIT_AND_STRNUM:
case NUM_AND_STRNUM:
case TWO_STRNUMS:
mawk_cast2_to_num(MAWK, cp);
goto two_d;
case NOINIT_AND_STRING:
case NUM_AND_STRING:
mawk_cast2_to_str(MAWK, cp);
goto two_s;
case TWO_MBSTRNS:
mawk_check_strnum(MAWK, cp);
mawk_check_strnum(MAWK, cp + 1);
goto reswitch;
case NOINIT_AND_MBSTRN:
case NUM_AND_MBSTRN:
case STRING_AND_MBSTRN:
case STRNUM_AND_MBSTRN:
mawk_check_strnum(MAWK, cp->type == C_MBSTRN ? cp : cp + 1);
goto reswitch;
default: /* there are no default cases */
mawk_bozo(MAWK, "bad cell type passed to compare");
}
return 0; /* shut up */
}
/* convert a number d to a field index $d -> $i */
static int d_to_index(mawk_state_t *MAWK, mawk_num_t d)
{
if (d > MAX_FIELD)
mawk_rt_overflow(MAWK, "maximum number of fields", MAX_FIELD);
if (d >= MAWK_NUM_ZERO)
return (int) d;
/* might include nan */
mawk_rt_error(MAWK, "negative field index $%.6g", d);
return 0; /* shutup */
}
void mawk_dummy_execute_func(void) { (void)mawk_f2d(NULL); } /* suppress compiler warning on unused func */