aboutsummaryrefslogtreecommitdiffstats
path: root/eval.c
diff options
context:
space:
mode:
Diffstat (limited to 'eval.c')
-rw-r--r--eval.c1660
1 files changed, 323 insertions, 1337 deletions
diff --git a/eval.c b/eval.c
index 49395d3a..9ec1e4c3 100644
--- a/eval.c
+++ b/eval.c
@@ -29,49 +29,26 @@ extern void after_beginfile(IOBUF **curfile);
extern double pow(double x, double y);
extern double modf(double x, double *yp);
extern double fmod(double x, double y);
-NODE **fcall_list;
+NODE **fcall_list = NULL;
long fcall_count = 0;
int currule = 0;
IOBUF *curfile = NULL; /* current data file */
-int exiting = FALSE;
+bool exiting = false;
-#ifdef DEBUGGING
-extern int pre_execute(INSTRUCTION **);
-extern void post_execute(INSTRUCTION *);
-#else
-#define r_interpret interpret
-#endif
+int (*interpret)(INSTRUCTION *);
+#define MAX_EXEC_HOOKS 10
+static int num_exec_hook = 0;
+static Func_pre_exec pre_execute[MAX_EXEC_HOOKS];
+static Func_post_exec post_execute = NULL;
-/*
- * Flag which executable this is; done here because eval.c is compiled
- * differently for each of them.
- */
-enum exe_mode which_gawk =
-#ifdef PROFILING
- exe_profiling /* pgawk */
-#else
-# ifdef DEBUGGING
- exe_debugging /* dgawk */
-# else
- exe_normal /* normal gawk */
-# endif
-#endif
- ; /* which_gawk */
+extern void frame_popped();
-#if __GNUC__ < 2
-NODE *_t; /* used as a temporary in macros */
-#endif
int OFSlen;
int ORSlen;
int OFMTidx;
int CONVFMTidx;
-/* Profiling stuff */
-#ifdef PROFILING
-#define INCREMENT(n) n++
-#else
-#define INCREMENT(n) /* nothing */
-#endif
+static NODE *node_Boolean[2];
/* This rather ugly macro is for VMS C */
#ifdef C
@@ -226,12 +203,12 @@ load_casetable(void)
#if defined(LC_CTYPE)
int i;
char *cp;
- static int loaded = FALSE;
+ static bool loaded = false;
if (loaded || do_traditional)
return;
- loaded = TRUE;
+ loaded = true;
cp = setlocale(LC_CTYPE, NULL);
/* this is not per standard, but it's pretty safe */
@@ -262,9 +239,11 @@ static const char *const nodetypes[] = {
"Node_var_new",
"Node_param_list",
"Node_func",
- "Node_hashnode",
- "Node_ahash",
+ "Node_ext_func",
"Node_array_ref",
+ "Node_array_tree",
+ "Node_array_leaf",
+ "Node_dump_array",
"Node_arrayfor",
"Node_frame",
"Node_instruction",
@@ -349,6 +328,7 @@ static struct optypetab {
{ "Op_K_nextfile", "nextfile" },
{ "Op_builtin", NULL },
{ "Op_sub_builtin", NULL },
+ { "Op_ext_builtin", NULL },
{ "Op_in_array", " in " },
{ "Op_func_call", NULL },
{ "Op_indirect_func_call", NULL },
@@ -376,7 +356,6 @@ static struct optypetab {
{ "Op_field_assign", NULL },
{ "Op_after_beginfile", NULL },
{ "Op_after_endfile", NULL },
- { "Op_ext_func", NULL },
{ "Op_func", NULL },
{ "Op_exec_count", NULL },
{ "Op_breakpoint", NULL },
@@ -446,20 +425,21 @@ flags2str(int flagval)
{
static const struct flagtab values[] = {
{ MALLOC, "MALLOC" },
- { PERM, "PERM" },
{ STRING, "STRING" },
{ STRCUR, "STRCUR" },
{ NUMCUR, "NUMCUR" },
{ NUMBER, "NUMBER" },
{ MAYBE_NUM, "MAYBE_NUM" },
- { ARRAYMAXED, "ARRAYMAXED" },
- { FUNC, "FUNC" },
{ FIELD, "FIELD" },
{ INTLSTR, "INTLSTR" },
- { NUMIND, "NUMIND" },
-#ifdef WSTRCUR
+ { NUMINT, "NUMINT" },
+ { INTIND, "INTIND" },
{ WSTRCUR, "WSTRCUR" },
-#endif
+ { MPFN, "MPFN" },
+ { MPZN, "MPZN" },
+ { ARRAYMAXED, "ARRAYMAXED" },
+ { HALFHAT, "HALFHAT" },
+ { XARRAY, "XARRAY" },
{ 0, NULL },
};
@@ -484,7 +464,7 @@ genflags2str(int flagval, const struct flagtab *tab)
* the '|' character.
*/
space_needed = (strlen(tab[i].name) + (sp != buffer));
- if (space_left < space_needed)
+ if (space_left <= space_needed)
fatal(_("buffer overflow in genflags2str"));
if (sp != buffer) {
@@ -498,6 +478,7 @@ genflags2str(int flagval, const struct flagtab *tab)
}
}
+ *sp = '\0';
return buffer;
}
@@ -599,16 +580,13 @@ cmp_nodes(NODE *t1, NODE *t2)
(void) force_number(t1);
if (t2->flags & MAYBE_NUM)
(void) force_number(t2);
- if ((t1->flags & NUMBER) && (t2->flags & NUMBER)) {
- if (t1->numbr == t2->numbr)
- ret = 0;
- /* don't subtract, in case one or both are infinite */
- else if (t1->numbr < t2->numbr)
- ret = -1;
- else
- ret = 1;
- return ret;
- }
+ if (t1->flags & INTIND)
+ t1 = force_string(t1);
+ if (t2->flags & INTIND)
+ t2 = force_string(t2);
+
+ if ((t1->flags & NUMBER) && (t2->flags & NUMBER))
+ return cmp_numbers(t1, t2);
(void) force_string(t1);
(void) force_string(t2);
@@ -637,11 +615,13 @@ cmp_nodes(NODE *t1, NODE *t2)
ret = casetable[*cp1] - casetable[*cp2];
} else
ret = memcmp(t1->stptr, t2->stptr, l);
- return (ret == 0 ? ldiff : ret);
+
+ ret = ret == 0 ? ldiff : ret;
+ return ret;
}
+/* push_frame --- push a frame NODE onto stack */
-#if defined(PROFILING) || defined(DEBUGGING)
static void
push_frame(NODE *f)
{
@@ -663,35 +643,28 @@ push_frame(NODE *f)
fcall_list[1] = f;
}
+
+/* pop_frame --- pop off a frame NODE*/
+
static void
pop_frame()
{
-#ifdef DEBUGGING
- extern void frame_popped();
-#endif
if (fcall_count > 1)
memmove(fcall_list + 1, fcall_list + 2, (fcall_count - 1) * sizeof(NODE *));
fcall_count--;
assert(fcall_count >= 0);
-#ifdef DEBUGGING
- frame_popped();
-#endif
+ if (do_debug)
+ frame_popped();
}
-#else /* not PROFILING or DEBUGGING */
-#define push_frame(p) /* nothing */
-#define pop_frame() /* nothing */
-#endif
-#ifdef PROFILING
-
/* dump_fcall_stack --- print a backtrace of the awk function calls */
void
dump_fcall_stack(FILE *fp)
{
NODE *f, *func;
- long i = 0;
+ long i = 0, j, k = 0;
if (fcall_count == 0)
return;
@@ -699,44 +672,49 @@ dump_fcall_stack(FILE *fp)
/* current frame */
func = frame_ptr->func_node;
- fprintf(fp, "\t# %3ld. %s\n", i, func->lnode->param);
+ for (j = 0; j <= frame_ptr->num_tail_calls; j++)
+ fprintf(fp, "\t# %3ld. %s\n", k++, func->vname);
/* outer frames except main */
for (i = 1; i < fcall_count; i++) {
f = fcall_list[i];
func = f->func_node;
- fprintf(fp, "\t# %3ld. %s\n", i, func->lnode->param);
+ for (j = 0; j <= f->num_tail_calls; j++)
+ fprintf(fp, "\t# %3ld. %s\n", k++, func->vname);
}
- fprintf(fp, "\t# %3ld. -- main --\n", fcall_count);
+ fprintf(fp, "\t# %3ld. -- main --\n", k);
}
-#endif /* PROFILING */
/* set_IGNORECASE --- update IGNORECASE as appropriate */
void
set_IGNORECASE()
{
- static short warned = FALSE;
+ static bool warned = false;
+ NODE *n = IGNORECASE_node->var_value;
if ((do_lint || do_traditional) && ! warned) {
- warned = TRUE;
+ warned = true;
lintwarn(_("`IGNORECASE' is a gawk extension"));
}
load_casetable();
if (do_traditional)
- IGNORECASE = FALSE;
- else if ((IGNORECASE_node->var_value->flags & (STRING|STRCUR)) != 0) {
- if ((IGNORECASE_node->var_value->flags & MAYBE_NUM) == 0)
- IGNORECASE = (force_string(IGNORECASE_node->var_value)->stlen > 0);
- else
- IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
- } else if ((IGNORECASE_node->var_value->flags & (NUMCUR|NUMBER)) != 0)
- IGNORECASE = (force_number(IGNORECASE_node->var_value) != 0.0);
+ IGNORECASE = false;
+ else if ((n->flags & (STRING|STRCUR)) != 0) {
+ if ((n->flags & MAYBE_NUM) == 0) {
+ (void) force_string(n);
+ IGNORECASE = (n->stlen > 0);
+ } else {
+ (void) force_number(n);
+ IGNORECASE = ! iszero(n);
+ }
+ } else if ((n->flags & (NUMCUR|NUMBER)) != 0)
+ IGNORECASE = ! iszero(n);
else
- IGNORECASE = FALSE; /* shouldn't happen */
-
+ IGNORECASE = false; /* shouldn't happen */
+
set_RS(); /* set_RS() calls set_FS() if need be, for us */
}
@@ -745,26 +723,25 @@ set_IGNORECASE()
void
set_BINMODE()
{
- static short warned = FALSE;
+ static bool warned = false;
char *p;
- NODE *v;
+ NODE *v = BINMODE_node->var_value;
if ((do_lint || do_traditional) && ! warned) {
- warned = TRUE;
+ warned = true;
lintwarn(_("`BINMODE' is a gawk extension"));
}
if (do_traditional)
BINMODE = TEXT_TRANSLATE;
- else if ((BINMODE_node->var_value->flags & NUMBER) != 0) {
- BINMODE = (int) force_number(BINMODE_node->var_value);
+ else if ((v->flags & NUMBER) != 0) {
+ (void) force_number(v);
+ BINMODE = get_number_si(v);
/* Make sure the value is rational. */
if (BINMODE < TEXT_TRANSLATE)
BINMODE = TEXT_TRANSLATE;
else if (BINMODE > BINMODE_BOTH)
BINMODE = BINMODE_BOTH;
- }
- else if ((BINMODE_node->var_value->flags & STRING) != 0) {
- v = BINMODE_node->var_value;
+ } else if ((v->flags & STRING) != 0) {
p = v->stptr;
/*
@@ -813,8 +790,7 @@ set_BINMODE()
lintwarn(_("BINMODE value `%s' is invalid, treated as 3"), p);
break;
}
- }
- else
+ } else
BINMODE = 3; /* shouldn't happen */
}
@@ -823,7 +799,8 @@ set_BINMODE()
void
set_OFS()
{
- OFS = force_string(OFS_node->var_value)->stptr;
+ OFS_node->var_value = force_string(OFS_node->var_value);
+ OFS = OFS_node->var_value->stptr;
OFSlen = OFS_node->var_value->stlen;
OFS[OFSlen] = '\0';
}
@@ -833,7 +810,8 @@ set_OFS()
void
set_ORS()
{
- ORS = force_string(ORS_node->var_value)->stptr;
+ ORS_node->var_value = force_string(ORS_node->var_value);
+ ORS = ORS_node->var_value->stptr;
ORSlen = ORS_node->var_value->stlen;
ORS[ORSlen] = '\0';
}
@@ -849,6 +827,7 @@ fmt_ok(NODE *n)
{
NODE *tmp = force_string(n);
const char *p = tmp->stptr;
+
#if ! defined(PRINTF_HAS_F_FORMAT) || PRINTF_HAS_F_FORMAT != 1
static const char float_formats[] = "efgEG";
#else
@@ -890,7 +869,7 @@ fmt_index(NODE *n)
if (fmt_list == NULL)
emalloc(fmt_list, NODE **, fmt_num*sizeof(*fmt_list), "fmt_index");
- (void) force_string(n);
+ n = force_string(n);
while (ix < fmt_hiwater) {
if (cmp_nodes(fmt_list[ix], n) == 0)
return ix;
@@ -937,47 +916,56 @@ set_LINT()
{
#ifndef NO_LINT
int old_lint = do_lint;
+ NODE *n = LINT_node->var_value;
- if ((LINT_node->var_value->flags & (STRING|STRCUR)) != 0) {
- if ((LINT_node->var_value->flags & MAYBE_NUM) == 0) {
+ if ((n->flags & (STRING|STRCUR)) != 0) {
+ if ((n->flags & MAYBE_NUM) == 0) {
const char *lintval;
size_t lintlen;
- do_lint = (force_string(LINT_node->var_value)->stlen > 0);
- lintval = LINT_node->var_value->stptr;
- lintlen = LINT_node->var_value->stlen;
- if (do_lint) {
- do_lint = LINT_ALL;
+ n = force_string(LINT_node->var_value);
+ lintval = n->stptr;
+ lintlen = n->stlen;
+ if (lintlen > 0) {
+ do_flags |= DO_LINT_ALL;
if (lintlen == 5 && strncmp(lintval, "fatal", 5) == 0)
lintfunc = r_fatal;
- else if (lintlen == 7 && strncmp(lintval, "invalid", 7) == 0)
- do_lint = LINT_INVALID;
- else
+ else if (lintlen == 7 && strncmp(lintval, "invalid", 7) == 0) {
+ do_flags &= ~ DO_LINT_ALL;
+ do_flags |= DO_LINT_INVALID;
+ } else
lintfunc = warning;
- } else
+ } else {
+ do_flags &= ~(DO_LINT_ALL|DO_LINT_INVALID);
lintfunc = warning;
+ }
} else {
- if (force_number(LINT_node->var_value) != 0.0)
- do_lint = LINT_ALL;
+ (void) force_number(n);
+ if (! iszero(n))
+ do_flags |= DO_LINT_ALL;
else
- do_lint = FALSE;
+ do_flags &= ~(DO_LINT_ALL|DO_LINT_INVALID);
lintfunc = warning;
}
- } else if ((LINT_node->var_value->flags & (NUMCUR|NUMBER)) != 0) {
- if (force_number(LINT_node->var_value) != 0.0)
- do_lint = LINT_ALL;
+ } else if ((n->flags & (NUMCUR|NUMBER)) != 0) {
+ (void) force_number(n);
+ if (! iszero(n))
+ do_flags |= DO_LINT_ALL;
else
- do_lint = FALSE;
+ do_flags &= ~(DO_LINT_ALL|DO_LINT_INVALID);
lintfunc = warning;
} else
- do_lint = FALSE; /* shouldn't happen */
+ do_flags &= ~(DO_LINT_ALL|DO_LINT_INVALID); /* shouldn't happen */
if (! do_lint)
lintfunc = warning;
/* explicitly use warning() here, in case lintfunc == r_fatal */
- if (old_lint != do_lint && old_lint && do_lint == FALSE)
+ if (old_lint != do_lint && old_lint && ! do_lint)
warning(_("turning off `--lint' due to assignment to `LINT'"));
+
+ /* inform plug-in api of change */
+ update_ext_api();
#endif /* ! NO_LINT */
}
@@ -987,9 +975,11 @@ void
set_TEXTDOMAIN()
{
int len;
+ NODE *tmp;
- TEXTDOMAIN = force_string(TEXTDOMAIN_node->var_value)->stptr;
- len = TEXTDOMAIN_node->var_value->stlen;
+ tmp = TEXTDOMAIN_node->var_value = force_string(TEXTDOMAIN_node->var_value);
+ TEXTDOMAIN = tmp->stptr;
+ len = tmp->stlen;
TEXTDOMAIN[len] = '\0';
/*
* Note: don't call textdomain(); this value is for
@@ -997,10 +987,10 @@ set_TEXTDOMAIN()
*/
}
-/* update_ERRNO_saved --- update the value of ERRNO based on argument */
+/* update_ERRNO_int --- update the value of ERRNO based on argument */
void
-update_ERRNO_saved(int errcode)
+update_ERRNO_int(int errcode)
{
char *cp;
@@ -1013,12 +1003,22 @@ update_ERRNO_saved(int errcode)
ERRNO_node->var_value = make_string(cp, strlen(cp));
}
-/* update_ERRNO --- update the value of ERRNO based on errno */
+/* update_ERRNO_string --- update ERRNO */
+
+void
+update_ERRNO_string(const char *string)
+{
+ unref(ERRNO_node->var_value);
+ ERRNO_node->var_value = make_string(string, strlen(string));
+}
+
+/* unset_ERRNO --- eliminate the value of ERRNO */
void
-update_ERRNO()
+unset_ERRNO(void)
{
- update_ERRNO_saved(errno);
+ unref(ERRNO_node->var_value);
+ ERRNO_node->var_value = dupnode(Nnull_string);
}
/* update_NR --- update the value of NR */
@@ -1026,9 +1026,14 @@ update_ERRNO()
void
update_NR()
{
+#ifdef HAVE_MPFR
+ if (is_mpg_number(NR_node->var_value))
+ (void) mpg_update_var(NR_node);
+ else
+#endif
if (NR_node->var_value->numbr != NR) {
unref(NR_node->var_value);
- NR_node->var_value = make_number((AWKNUM) NR);
+ NR_node->var_value = make_number(NR);
}
}
@@ -1037,11 +1042,14 @@ update_NR()
void
update_NF()
{
- if (NF == -1 || NF_node->var_value->numbr != NF) {
+ long l;
+
+ l = get_number_si(NF_node->var_value);
+ if (NF == -1 || l != NF) {
if (NF == -1)
(void) get_field(UNLIMITED - 1, NULL); /* parse record */
unref(NF_node->var_value);
- NF_node->var_value = make_number((AWKNUM) NF);
+ NF_node->var_value = make_number(NF);
}
}
@@ -1050,14 +1058,18 @@ update_NF()
void
update_FNR()
{
+#ifdef HAVE_MPFR
+ if (is_mpg_number(FNR_node->var_value))
+ (void) mpg_update_var(FNR_node);
+ else
+#endif
if (FNR_node->var_value->numbr != FNR) {
unref(FNR_node->var_value);
- FNR_node->var_value = make_number((AWKNUM) FNR);
+ FNR_node->var_value = make_number(FNR);
}
}
-
NODE *frame_ptr; /* current frame */
STACK_ITEM *stack_ptr = NULL;
STACK_ITEM *stack_bottom;
@@ -1078,32 +1090,6 @@ NODE **args_array = NULL;
STACK_ITEM *
grow_stack()
{
- if (stack_ptr == NULL) {
- char *val;
-
- if ((val = getenv("GAWK_STACKSIZE")) != NULL) {
- if (isdigit((unsigned char) *val)) {
- unsigned long n = 0;
- for (; *val && isdigit((unsigned char) *val); val++)
- n = (n * 10) + *val - '0';
- if (n >= 1)
- STACK_SIZE = n;
- }
- }
-
- emalloc(stack_bottom, STACK_ITEM *, STACK_SIZE * sizeof(STACK_ITEM), "grow_stack");
- stack_ptr = stack_bottom - 1;
- stack_top = stack_bottom + STACK_SIZE - 1;
-
- /* initialize frame pointer */
- getnode(frame_ptr);
- frame_ptr->type = Node_frame;
- frame_ptr->stack = NULL;
- frame_ptr->func_node = NULL; /* in main */
- frame_ptr->vname = NULL;
- return stack_ptr;
- }
-
STACK_SIZE *= 2;
erealloc(stack_bottom, STACK_ITEM *, STACK_SIZE * sizeof(STACK_ITEM), "grow_stack");
stack_top = stack_bottom + STACK_SIZE - 1;
@@ -1118,15 +1104,12 @@ grow_stack()
*/
NODE **
-r_get_lhs(NODE *n, int reference)
+r_get_lhs(NODE *n, bool reference)
{
- int isparam = FALSE;
+ bool isparam = false;
if (n->type == Node_param_list) {
- if ((n->flags & FUNC) != 0)
- fatal(_("can't use function name `%s' as variable or array"),
- n->vname);
- isparam = TRUE;
+ isparam = true;
n = GET_PARAM(n->param_cnt);
}
@@ -1139,11 +1122,11 @@ r_get_lhs(NODE *n, int reference)
fatal(_("attempt to use array `%s' in a scalar context"),
array_vname(n));
n->orig_array->type = Node_var;
- n->orig_array->var_value = Nnull_string;
+ n->orig_array->var_value = dupnode(Nnull_string);
/* fall through */
case Node_var_new:
n->type = Node_var;
- n->var_value = Nnull_string;
+ n->var_value = dupnode(Nnull_string);
break;
case Node_var:
@@ -1158,14 +1141,14 @@ r_get_lhs(NODE *n, int reference)
_("reference to uninitialized argument `%s'") :
_("reference to uninitialized variable `%s'")),
n->vname);
- return &n->var_value;
+ return & n->var_value;
}
/* r_get_field --- get the address of a field node */
static inline NODE **
-r_get_field(NODE *n, Func_ptr *assign, int reference)
+r_get_field(NODE *n, Func_ptr *assign, bool reference)
{
long field_num;
NODE **lhs;
@@ -1180,7 +1163,9 @@ r_get_field(NODE *n, Func_ptr *assign, int reference)
}
}
- field_num = (long) force_number(n);
+ (void) force_number(n);
+ field_num = get_number_si(n);
+
if (field_num < 0)
fatal(_("attempt to access field %ld"), field_num);
@@ -1239,17 +1224,42 @@ static INSTRUCTION *
setup_frame(INSTRUCTION *pc)
{
NODE *r = NULL;
- NODE *m;
- NODE *f;
+ NODE *m, *f, *fp;
NODE **sp = NULL;
- char **varnames;
- int pcount, arg_count, i;
+ int pcount, arg_count, i, j;
+ bool tail_optimize = false;
f = pc->func_body;
- pcount = f->lnode->param_cnt;
- varnames = f->parmlist;
+ pcount = f->param_cnt;
+ fp = f->fparms;
arg_count = (pc + 1)->expr_count;
+ /* tail recursion optimization */
+ tail_optimize = ((pc + 1)->tail_call && do_optimize > 1
+ && ! do_debug && ! do_profile);
+
+ if (tail_optimize) {
+ /* free local vars of calling frame */
+
+ NODE *func;
+ int n;
+
+ func = frame_ptr->func_node;
+ for (n = func->param_cnt, sp = frame_ptr->stack; n > 0; n--) {
+ r = *sp++;
+ if (r->type == Node_var) /* local variable */
+ DEREF(r->var_value);
+ else if (r->type == Node_var_array) /* local array */
+ assoc_clear(r);
+ }
+ sp = frame_ptr->stack;
+
+ } else if (pcount > 0) {
+ emalloc(sp, NODE **, pcount * sizeof(NODE *), "setup_frame");
+ memset(sp, 0, pcount * sizeof(NODE *));
+ }
+
+
/* check for extra args */
if (arg_count > pcount) {
warning(
@@ -1262,23 +1272,23 @@ setup_frame(INSTRUCTION *pc)
} while (--arg_count > pcount);
}
- if (pcount > 0) {
- emalloc(sp, NODE **, pcount * sizeof(NODE *), "setup_frame");
- memset(sp, 0, pcount * sizeof(NODE *));
- }
+ for (i = 0, j = arg_count - 1; i < pcount; i++, j--) {
+ if (tail_optimize)
+ r = sp[i];
+ else {
+ getnode(r);
+ memset(r, 0, sizeof(NODE));
+ sp[i] = r;
+ }
- for (i = 0; i < pcount; i++) {
- getnode(r);
- memset(r, 0, sizeof(NODE));
- sp[i] = r;
if (i >= arg_count) {
/* local variable */
r->type = Node_var_new;
- r->vname = varnames[i];
+ r->vname = fp[i].param;
continue;
}
- m = PEEK(arg_count - i - 1); /* arguments in reverse order on runtime stack */
+ m = PEEK(j); /* arguments in reverse order on runtime stack */
if (m->type == Node_param_list)
m = GET_PARAM(m->param_cnt);
@@ -1302,7 +1312,7 @@ setup_frame(INSTRUCTION *pc)
* subsequent param.
*/
r->type = Node_var;
- r->var_value = Nnull_string;
+ r->var_value = dupnode(Nnull_string);
break;
case Node_val:
@@ -1313,10 +1323,16 @@ setup_frame(INSTRUCTION *pc)
default:
cant_happen();
}
- r->vname = varnames[i];
+ r->vname = fp[i].param;
}
+
stack_adj(-arg_count); /* adjust stack pointer */
+ if (tail_optimize) {
+ frame_ptr->num_tail_calls++;
+ return f->code_ptr;
+ }
+
if (pc->opcode == Op_indirect_func_call) {
r = POP(); /* indirect var */
DEREF(r);
@@ -1324,7 +1340,8 @@ setup_frame(INSTRUCTION *pc)
frame_ptr->vname = source; /* save current source */
- push_frame(frame_ptr);
+ if (do_profile || do_debug)
+ push_frame(frame_ptr);
/* save current frame in stack */
PUSH(frame_ptr);
@@ -1335,6 +1352,7 @@ setup_frame(INSTRUCTION *pc)
frame_ptr->stack = sp;
frame_ptr->prev_frame_size = (stack_ptr - stack_bottom); /* size of the previous stack frame */
frame_ptr->func_node = f;
+ frame_ptr->num_tail_calls = 0;
frame_ptr->vname = NULL;
frame_ptr->reti = pc; /* on return execute pc->nexti */
@@ -1354,7 +1372,7 @@ restore_frame(NODE *fp)
INSTRUCTION *ri;
func = frame_ptr->func_node;
- n = func->lnode->param_cnt;
+ n = func->param_cnt;
sp = frame_ptr->stack;
for (; n > 0; n--) {
@@ -1365,13 +1383,15 @@ restore_frame(NODE *fp)
assoc_clear(r);
freenode(r);
}
+
if (frame_ptr->stack != NULL)
efree(frame_ptr->stack);
ri = frame_ptr->reti; /* execution in calling frame
* resumes from ri->nexti.
*/
freenode(frame_ptr);
- pop_frame();
+ if (do_profile || do_debug)
+ pop_frame();
/* restore frame */
frame_ptr = fp;
@@ -1388,18 +1408,22 @@ restore_frame(NODE *fp)
static inline void
free_arrayfor(NODE *r)
{
- if (r->var_array != NULL) {
- size_t num_elems = r->table_size;
- NODE **list = r->var_array;
- while (num_elems > 0)
- unref(list[--num_elems]);
+ if (r->for_list != NULL) {
+ NODE *n;
+ size_t num_elems = r->for_list_size;
+ NODE **list = r->for_list;
+ while (num_elems > 0) {
+ n = list[--num_elems];
+ unref(n);
+ }
efree(list);
}
freenode(r);
}
-/* unwind_stack --- pop items off the run-time stack;
+/*
+ * unwind_stack --- pop items off the run-time stack;
* 'n' is the # of items left in the stack.
*/
@@ -1460,30 +1484,30 @@ unwind_stack(long n)
#define pop_stack() (void) unwind_stack(0)
-/*
- * This generated compiler warnings from GCC 4.4. Who knows why.
- *
-#define eval_condition(t) (((t)->flags & MAYBE_NUM) && force_number(t), \
- ((t)->flags & NUMBER) ? ((t)->numbr != 0.0) : ((t)->stlen != 0))
-*/
-
-
static inline int
eval_condition(NODE *t)
{
+ if (t == node_Boolean[false])
+ return false;
+
+ if (t == node_Boolean[true])
+ return true;
+
if ((t->flags & MAYBE_NUM) != 0)
force_number(t);
+ else if ((t->flags & INTIND) != 0)
+ force_string(t);
if ((t->flags & NUMBER) != 0)
- return (t->numbr != 0.0);
+ return ! iszero(t);
return (t->stlen != 0);
}
-/* cmp_scalar -- compare two nodes on the stack */
+/* cmp_scalars -- compare two nodes on the stack */
static inline int
-cmp_scalar()
+cmp_scalars()
{
NODE *t1, *t2;
int di;
@@ -1506,32 +1530,33 @@ static void
op_assign(OPCODE op)
{
NODE **lhs;
- NODE *r = NULL;
- AWKNUM x1, x2;
-#ifndef HAVE_FMOD
- AWKNUM x;
-#endif
+ NODE *t1, *t2;
+ AWKNUM x = 0.0, x1, x2;
lhs = POP_ADDRESS();
- x1 = force_number(*lhs);
- TOP_NUMBER(x2);
- unref(*lhs);
+ t1 = *lhs;
+ x1 = force_number(t1)->numbr;
+
+ t2 = TOP_SCALAR();
+ x2 = force_number(t2)->numbr;
+ DEREF(t2);
+
switch (op) {
case Op_assign_plus:
- r = *lhs = make_number(x1 + x2);
+ x = x1 + x2;
break;
case Op_assign_minus:
- r = *lhs = make_number(x1 - x2);
+ x = x1 - x2;
break;
case Op_assign_times:
- r = *lhs = make_number(x1 * x2);
+ x = x1 * x2;
break;
case Op_assign_quotient:
if (x2 == (AWKNUM) 0) {
decr_sp();
fatal(_("division by zero attempted in `/='"));
}
- r = *lhs = make_number(x1 / x2);
+ x = x1 / x2;
break;
case Op_assign_mod:
if (x2 == (AWKNUM) 0) {
@@ -1539,24 +1564,30 @@ op_assign(OPCODE op)
fatal(_("division by zero attempted in `%%='"));
}
#ifdef HAVE_FMOD
- r = *lhs = make_number(fmod(x1, x2));
+ x = fmod(x1, x2);
#else /* ! HAVE_FMOD */
(void) modf(x1 / x2, &x);
x = x1 - x2 * x;
- r = *lhs = make_number(x);
#endif /* ! HAVE_FMOD */
break;
case Op_assign_exp:
- r = *lhs = make_number((AWKNUM) calc_exp((double) x1, (double) x2));
+ x = calc_exp((double) x1, (double) x2);
break;
default:
break;
}
- UPREF(r);
- REPLACE(r);
-}
+ if (t1->valref == 1 && t1->flags == (MALLOC|NUMCUR|NUMBER)) {
+ /* optimization */
+ t1->numbr = x;
+ } else {
+ unref(t1);
+ t1 = *lhs = make_number(x);
+ }
+ UPREF(t1);
+ REPLACE(t1);
+}
/* PUSH_CODE --- push a code onto the runtime stack */
@@ -1584,7 +1615,8 @@ POP_CODE()
}
-/* Implementation of BEGINFILE and ENDFILE requires saving an execution
+/*
+ * Implementation of BEGINFILE and ENDFILE requires saving an execution
* state and the ability to return to that state. The state is
* defined by the instruction triggering the BEGINFILE/ENDFILE rule, the
* run-time stack, the rule and the source file. The source line is available in
@@ -1653,1138 +1685,92 @@ pop_exec_state(int *rule, char **src, long *sz)
}
-/*
- * r_interpret:
- * code is a list of instructions to run. returns the exit value
- * from the awk code.
- */
-
- /* N.B.:
- * 1) reference counting done for both number and string values.
- * 2) TEMP flag no longer needed (consequence of the above; valref = 0
- * is the replacement).
- * 3) Stack operations:
- * Use REPLACE[_XX] if last stack operation was TOP[_XX],
- * PUSH[_XX] if last operation was POP[_XX] instead.
- * 4) UPREF and DREF -- see awk.h
- */
-
+/* register_exec_hook --- add exec hooks in the interpreter. */
int
-r_interpret(INSTRUCTION *code)
+register_exec_hook(Func_pre_exec preh, Func_post_exec posth)
{
- INSTRUCTION *pc; /* current instruction */
- NODE *r = NULL;
- NODE *m;
- INSTRUCTION *ni;
- NODE *t1, *t2;
- NODE *f; /* function definition */
- NODE **lhs;
- AWKNUM x, x1, x2;
- int di, pre = FALSE;
- Regexp *rp;
-#if defined(GAWKDEBUG) || defined(ARRAYDEBUG)
- int last_was_stopme = FALSE; /* builtin stopme() called ? */
-#endif
- int stdio_problem = FALSE;
+ int pos = 0;
+ /*
+ * multiple post-exec hooks aren't supported. post-exec hook is mainly
+ * for use by the debugger.
+ */
- if (args_array == NULL)
- emalloc(args_array, NODE **, (max_args + 2)*sizeof(NODE *), "r_interpret");
- else
- erealloc(args_array, NODE **, (max_args + 2)*sizeof(NODE *), "r_interpret");
+ if (! preh || (post_execute && posth))
+ return false;
-/* array subscript */
-#define mk_sub(n) (n == 1 ? POP_STRING() : concat_exp(n, TRUE))
+ if (num_exec_hook == MAX_EXEC_HOOKS)
+ return false;
-#ifdef DEBUGGING
-#define JUMPTO(x) do { post_execute(pc); pc = (x); goto top; } while(FALSE)
-#else
-#define JUMPTO(x) do { pc = (x); goto top; } while(FALSE)
-#endif
-
- pc = code;
-
- /* N.B.: always use JUMPTO for next instruction, otherwise bad things
- * may happen. DO NOT add a real loop (for/while) below to
- * replace ' forever {'; this catches failure to use JUMPTO to execute
- * next instruction (e.g. continue statement).
+ /*
+ * Add to the beginning of the array but do not displace the
+ * debugger hook if it exists.
*/
+ if (num_exec_hook > 0) {
+ pos = !! do_debug;
+ if (num_exec_hook > pos)
+ memmove(pre_execute + pos + 1, pre_execute + pos,
+ (num_exec_hook - pos) * sizeof (preh));
+ }
+ pre_execute[pos] = preh;
+ num_exec_hook++;
- /* loop until hit Op_stop instruction */
-
- /* forever { */
-top:
- if (pc->source_line > 0)
- sourceline = pc->source_line;
-
-#ifdef DEBUGGING
- if (! pre_execute(&pc))
- goto top;
-#endif
-
- switch (pc->opcode) {
- case Op_rule:
- currule = pc->in_rule; /* for sole use in Op_K_next, Op_K_nextfile, Op_K_getline* */
- /* fall through */
- case Op_func:
- case Op_ext_func:
- source = pc->source_file;
- break;
-
- case Op_atexit:
- /* avoid false source indications */
- source = NULL;
- sourceline = 0;
- (void) nextfile(&curfile, TRUE); /* close input data file */
- /*
- * This used to be:
- *
- * if (close_io() != 0 && ! exiting && exit_val == 0)
- * exit_val = 1;
- *
- * Other awks don't care about problems closing open files
- * and pipes, in that it doesn't affect their exit status.
- * So we no longer do either.
- */
- (void) close_io(& stdio_problem);
- /*
- * However, we do want to exit non-zero if there was a problem
- * with stdout/stderr, so we reinstate a slightly different
- * version of the above:
- */
- if (stdio_problem && ! exiting && exit_val == 0)
- exit_val = 1;
- break;
-
- case Op_stop:
- return 0;
-
- case Op_push_i:
- m = pc->memory;
- PUSH((m->flags & INTLSTR) != 0 ? format_val(CONVFMT, CONVFMTidx, m): m);
- break;
-
- case Op_push:
- case Op_push_arg:
- {
- NODE *save_symbol;
- int isparam = FALSE;
-
- save_symbol = m = pc->memory;
- if (m->type == Node_param_list) {
- if ((m->flags & FUNC) != 0)
- fatal(_("can't use function name `%s' as variable or array"),
- m->vname);
- isparam = TRUE;
- save_symbol = m = GET_PARAM(m->param_cnt);
- if (m->type == Node_array_ref)
- m = m->orig_array;
- }
-
- switch (m->type) {
- case Node_var:
- if (do_lint && var_uninitialized(m))
- lintwarn(isparam ?
- _("reference to uninitialized argument `%s'") :
- _("reference to uninitialized variable `%s'"),
- save_symbol->vname);
- m = m->var_value;
- UPREF(m);
- PUSH(m);
- break;
-
- case Node_var_new:
- m->type = Node_var;
- m->var_value = Nnull_string;
- if (do_lint)
- lintwarn(isparam ?
- _("reference to uninitialized argument `%s'") :
- _("reference to uninitialized variable `%s'"),
- save_symbol->vname);
- PUSH(Nnull_string);
- break;
-
- case Node_var_array:
- if (pc->opcode == Op_push_arg)
- PUSH(m);
- else
- fatal(_("attempt to use array `%s' in a scalar context"),
- array_vname(save_symbol));
- break;
-
- default:
- cant_happen();
- }
- }
- break;
-
- case Op_push_param: /* function argument */
- m = pc->memory;
- if (m->type == Node_param_list)
- m = GET_PARAM(m->param_cnt);
- if (m->type == Node_var) {
- m = m->var_value;
- UPREF(m);
- PUSH(m);
- break;
- }
- /* else
- fall through */
- case Op_push_array:
- PUSH(pc->memory);
- break;
-
- case Op_push_lhs:
- lhs = get_lhs(pc->memory, pc->do_reference);
- PUSH_ADDRESS(lhs);
- break;
-
- case Op_subscript:
- t2 = mk_sub(pc->sub_count);
- t1 = POP_ARRAY();
- r = *assoc_lookup(t1, t2, TRUE);
- DEREF(t2);
- if (r->type == Node_val)
- UPREF(r);
- PUSH(r);
- break;
-
- case Op_sub_array:
- t2 = mk_sub(pc->sub_count);
- t1 = POP_ARRAY();
- r = in_array(t1, t2);
- if (r == NULL) {
- getnode(r);
- r->type = Node_var_array;
- r->var_array = NULL;
- r->vname = estrdup(t2->stptr, t2->stlen); /* the subscript in parent array */
- r->parent_array = t1;
- *assoc_lookup(t1, t2, FALSE) = r;
- } else if (r->type != Node_var_array)
- fatal(_("attempt to use scalar `%s[\"%.*s\"]' as an array"),
- array_vname(t1), (int) t2->stlen, t2->stptr);
- DEREF(t2);
- PUSH(r);
- break;
-
- case Op_subscript_lhs:
- t2 = mk_sub(pc->sub_count);
- t1 = POP_ARRAY();
- lhs = assoc_lookup(t1, t2, pc->do_reference);
- if ((*lhs)->type == Node_var_array)
- fatal(_("attempt to use array `%s[\"%.*s\"]' in a scalar context"),
- array_vname(t1), (int) t2->stlen, t2->stptr);
- DEREF(t2);
- PUSH_ADDRESS(lhs);
- break;
-
- case Op_field_spec:
- t1 = TOP_SCALAR();
- lhs = r_get_field(t1, (Func_ptr *) 0, TRUE);
- decr_sp();
- DEREF(t1);
- /* This used to look like this:
- PUSH(dupnode(*lhs));
- but was changed to bypass an apparent bug in the z/OS C compiler.
- Please do not remerge. */
- r = dupnode(*lhs); /* can't use UPREF here */
- PUSH(r);
- break;
-
- case Op_field_spec_lhs:
- t1 = TOP_SCALAR();
- lhs = r_get_field(t1, &pc->target_assign->field_assign, pc->do_reference);
- decr_sp();
- DEREF(t1);
- PUSH_ADDRESS(lhs);
- break;
-
- case Op_lint:
- if (do_lint) {
- switch (pc->lint_type) {
- case LINT_assign_in_cond:
- lintwarn(_("assignment used in conditional context"));
- break;
-
- case LINT_no_effect:
- lintwarn(_("statement has no effect"));
- break;
-
- default:
- cant_happen();
- }
- }
- break;
-
- case Op_K_break:
- case Op_K_continue:
- case Op_jmp:
- JUMPTO(pc->target_jmp);
-
- case Op_jmp_false:
- r = POP_SCALAR();
- di = eval_condition(r);
- DEREF(r);
- if (! di)
- JUMPTO(pc->target_jmp);
- break;
-
- case Op_jmp_true:
- r = POP_SCALAR();
- di = eval_condition(r);
- DEREF(r);
- if (di)
- JUMPTO(pc->target_jmp);
- break;
-
- case Op_and:
- case Op_or:
- t1 = POP_SCALAR();
- di = eval_condition(t1);
- DEREF(t1);
- if ((pc->opcode == Op_and && di)
- || (pc->opcode == Op_or && ! di))
- break;
- r = make_number((AWKNUM) di);
- PUSH(r);
- ni = pc->target_jmp;
- JUMPTO(ni->nexti);
-
- case Op_and_final:
- case Op_or_final:
- t1 = TOP_SCALAR();
- r = make_number((AWKNUM) eval_condition(t1));
- DEREF(t1);
- REPLACE(r);
- break;
-
- case Op_not:
- t1 = TOP_SCALAR();
- r = make_number((AWKNUM) ! eval_condition(t1));
- DEREF(t1);
- REPLACE(r);
- break;
-
- case Op_equal:
- r = make_number((AWKNUM) (cmp_scalar() == 0));
- REPLACE(r);
- break;
-
- case Op_notequal:
- r = make_number((AWKNUM) (cmp_scalar() != 0));
- REPLACE(r);
- break;
-
- case Op_less:
- r = make_number((AWKNUM) (cmp_scalar() < 0));
- REPLACE(r);
- break;
-
- case Op_greater:
- r = make_number((AWKNUM) (cmp_scalar() > 0));
- REPLACE(r);
- break;
-
- case Op_leq:
- r = make_number((AWKNUM) (cmp_scalar() <= 0));
- REPLACE(r);
- break;
-
- case Op_geq:
- r = make_number((AWKNUM) (cmp_scalar() >= 0));
- REPLACE(r);
- break;
-
- case Op_plus_i:
- x2 = force_number(pc->memory);
- goto plus;
-
- case Op_plus:
- POP_NUMBER(x2);
-plus:
- TOP_NUMBER(x1);
- r = make_number(x1 + x2);
- REPLACE(r);
- break;
-
- case Op_minus_i:
- x2 = force_number(pc->memory);
- goto minus;
-
- case Op_minus:
- POP_NUMBER(x2);
-minus:
- TOP_NUMBER(x1);
- r = make_number(x1 - x2);
- REPLACE(r);
- break;
-
- case Op_times_i:
- x2 = force_number(pc->memory);
- goto times;
-
- case Op_times:
- POP_NUMBER(x2);
-times:
- TOP_NUMBER(x1);
- r = make_number(x1 * x2);
- REPLACE(r);
- break;
-
- case Op_exp_i:
- x2 = force_number(pc->memory);
- goto exponent;
-
- case Op_exp:
- POP_NUMBER(x2);
-exponent:
- TOP_NUMBER(x1);
- x = calc_exp(x1, x2);
- r = make_number(x);
- REPLACE(r);
- break;
-
- case Op_quotient_i:
- x2 = force_number(pc->memory);
- goto quotient;
-
- case Op_quotient:
- POP_NUMBER(x2);
-quotient:
- if (x2 == 0)
- fatal(_("division by zero attempted"));
-
- TOP_NUMBER(x1);
- x = x1 / x2;
- r = make_number(x);
- REPLACE(r);
- break;
-
- case Op_mod_i:
- x2 = force_number(pc->memory);
- goto mod;
-
- case Op_mod:
- POP_NUMBER(x2);
-mod:
- if (x2 == 0)
- fatal(_("division by zero attempted in `%%'"));
-
- TOP_NUMBER(x1);
-#ifdef HAVE_FMOD
- x = fmod(x1, x2);
-#else /* ! HAVE_FMOD */
- (void) modf(x1 / x2, &x);
- x = x1 - x * x2;
-#endif /* ! HAVE_FMOD */
- r = make_number(x);
- REPLACE(r);
- break;
-
- case Op_preincrement:
- pre = TRUE;
- case Op_postincrement:
- x2 = 1.0;
-post:
- lhs = TOP_ADDRESS();
- x1 = force_number(*lhs);
- unref(*lhs);
- r = *lhs = make_number(x1 + x2);
- if (pre)
- UPREF(r);
- else
- r = make_number(x1);
- REPLACE(r);
- pre = FALSE;
- break;
-
- case Op_predecrement:
- pre = TRUE;
- case Op_postdecrement:
- x2 = -1.0;
- goto post;
-
- case Op_unary_minus:
- TOP_NUMBER(x1);
- r = make_number(-x1);
- REPLACE(r);
- break;
-
- case Op_store_sub:
- /* array[sub] assignment optimization,
- * see awkgram.y (optimize_assignment)
- */
- t1 = get_array(pc->memory, TRUE); /* array */
- t2 = mk_sub(pc->expr_count); /* subscript */
- lhs = assoc_lookup(t1, t2, FALSE);
- if ((*lhs)->type == Node_var_array)
- fatal(_("attempt to use array `%s[\"%.*s\"]' in a scalar context"),
- array_vname(t1), (int) t2->stlen, t2->stptr);
- DEREF(t2);
- unref(*lhs);
- *lhs = POP_SCALAR();
- break;
-
- case Op_store_var:
- /* simple variable assignment optimization,
- * see awkgram.y (optimize_assignment)
- */
-
- lhs = get_lhs(pc->memory, FALSE);
- unref(*lhs);
- *lhs = POP_SCALAR();
- break;
-
- case Op_store_field:
- {
- /* field assignment optimization,
- * see awkgram.y (optimize_assignment)
- */
-
- Func_ptr assign;
- t1 = TOP_SCALAR();
- lhs = r_get_field(t1, &assign, FALSE);
- decr_sp();
- DEREF(t1);
- unref(*lhs);
- *lhs = POP_SCALAR();
- assert(assign != NULL);
- assign();
- }
- break;
-
- case Op_assign_concat:
- /* x = x ... string concatenation optimization */
- lhs = get_lhs(pc->memory, FALSE);
- t1 = force_string(*lhs);
- t2 = POP_STRING();
-
- if (t1 != t2 && t1->valref == 1 && (t1->flags & PERM) == 0) {
- size_t nlen = t1->stlen + t2->stlen;
- erealloc(t1->stptr, char *, nlen + 2, "r_interpret");
- memcpy(t1->stptr + t1->stlen, t2->stptr, t2->stlen);
- t1->stlen = nlen;
- t1->stptr[nlen] = '\0';
-
-#if MBS_SUPPORT
- if ((t1->flags & WSTRCUR) != 0 && (t2->flags & WSTRCUR) != 0) {
- size_t wlen = t1->wstlen + t2->wstlen;
-
- erealloc(t1->wstptr, wchar_t *,
- sizeof(wchar_t) * (wlen + 2), "r_interpret");
- memcpy(t1->wstptr + t1->wstlen, t2->wstptr, t2->wstlen);
- t1->wstlen = wlen;
- t1->wstptr[wlen] = L'\0';
- t1->flags |= WSTRCUR;
- } else
- free_wstr(*lhs);
-#endif
- } else {
- size_t nlen = t1->stlen + t2->stlen;
- char *p;
-
- emalloc(p, char *, nlen + 2, "r_interpret");
- memcpy(p, t1->stptr, t1->stlen);
- memcpy(p + t1->stlen, t2->stptr, t2->stlen);
- unref(*lhs);
- t1 = *lhs = make_str_node(p, nlen, ALREADY_MALLOCED);
- }
- t1->flags &= ~(NUMCUR|NUMBER);
- DEREF(t2);
- break;
-
- case Op_assign:
- lhs = POP_ADDRESS();
- r = TOP_SCALAR();
- unref(*lhs);
- *lhs = r;
- UPREF(r);
- REPLACE(r);
- break;
-
- /* numeric assignments */
- case Op_assign_plus:
- case Op_assign_minus:
- case Op_assign_times:
- case Op_assign_quotient:
- case Op_assign_mod:
- case Op_assign_exp:
- op_assign(pc->opcode);
- break;
-
- case Op_var_update: /* update value of NR, FNR or NF */
- pc->update_var();
- break;
-
- case Op_var_assign:
- case Op_field_assign:
- if (pc->assign_ctxt == Op_sub_builtin
- && TOP()->numbr == 0.0 /* top of stack has a number == 0 */
- ) {
- /* There wasn't any substitutions. If the target is a FIELD,
- * this means no field re-splitting or $0 reconstruction.
- * Skip the set_FOO routine if the target is a special variable.
- */
-
- break;
- } else if ((pc->assign_ctxt == Op_K_getline
- || pc->assign_ctxt == Op_K_getline_redir)
- && TOP()->numbr <= 0.0 /* top of stack has a number <= 0 */
- ) {
- /* getline returned EOF or error */
-
- break;
- }
-
- if (pc->opcode == Op_var_assign)
- pc->assign_var();
- else
- pc->field_assign();
- break;
-
- case Op_concat:
- r = concat_exp(pc->expr_count, pc->concat_flag & CSUBSEP);
- PUSH(r);
- break;
-
- case Op_K_case:
- if ((pc + 1)->match_exp) {
- /* match a constant regex against switch expression instead of $0. */
- m = POP(); /* regex */
- t2 = TOP_SCALAR(); /* switch expression */
- (void) force_string(t2);
- rp = re_update(m);
- di = (research(rp, t2->stptr, 0, t2->stlen,
- avoid_dfa(m, t2->stptr, t2->stlen)) >= 0);
- } else {
- t1 = POP_SCALAR(); /* case value */
- t2 = TOP_SCALAR(); /* switch expression */
- di = (cmp_nodes(t2, t1) == 0);
- DEREF(t1);
- }
-
- if (di) { /* match found */
- decr_sp();
- DEREF(t2);
- JUMPTO(pc->target_jmp);
- }
- break;
-
- case Op_K_delete:
- t1 = POP_ARRAY();
- do_delete(t1, pc->expr_count);
- stack_adj(-pc->expr_count);
- break;
-
- case Op_K_delete_loop:
- t1 = POP_ARRAY();
- lhs = POP_ADDRESS(); /* item */
- do_delete_loop(t1, lhs);
- break;
-
- case Op_in_array:
- t1 = POP_ARRAY();
- t2 = mk_sub(pc->expr_count);
- di = (in_array(t1, t2) != NULL);
- DEREF(t2);
- PUSH(make_number((AWKNUM) di));
- break;
-
- case Op_arrayfor_init:
- {
- NODE **list = NULL;
- NODE *array, *sort_str;
- size_t num_elems = 0;
- static NODE *sorted_in = NULL;
- const char *how_to_sort = "@unsorted";
-
- /* get the array */
- array = POP_ARRAY();
-
- /* sanity: check if empty */
- if (array->var_array == NULL || array->table_size == 0)
- goto arrayfor;
-
- num_elems = array->table_size;
-
- if (sorted_in == NULL) /* do this once */
- sorted_in = make_string("sorted_in", 9);
-
- sort_str = NULL;
- /*
- * If posix, or if there's no PROCINFO[],
- * there's no ["sorted_in"], so no sorting
- */
- if (! do_posix && PROCINFO_node != NULL)
- sort_str = in_array(PROCINFO_node, sorted_in);
-
- if (sort_str != NULL) {
- sort_str = force_string(sort_str);
- if (sort_str->stlen > 0)
- how_to_sort = sort_str->stptr;
- }
-
- list = assoc_list(array, how_to_sort, SORTED_IN);
-
- /*
- * Actual array for use in lint warning
- * in Op_arrayfor_incr
- */
- list[num_elems] = array;
-
-arrayfor:
- getnode(r);
- r->type = Node_arrayfor;
- r->var_array = list;
- r->table_size = num_elems; /* # of elements in list */
- r->array_size = -1; /* current index */
- PUSH(r);
-
- if (num_elems == 0)
- JUMPTO(pc->target_jmp); /* Op_arrayfor_final */
- }
- break;
-
- case Op_arrayfor_incr:
- r = TOP(); /* Node_arrayfor */
- if (++r->array_size == r->table_size) {
- NODE *array;
- array = r->var_array[r->table_size]; /* actual array */
- if (do_lint && array->table_size != r->table_size)
- lintwarn(_("for loop: array `%s' changed size from %ld to %ld during loop execution"),
- array_vname(array), (long) r->table_size, (long) array->table_size);
- JUMPTO(pc->target_jmp); /* Op_arrayfor_final */
- }
-
- t1 = r->var_array[r->array_size];
- lhs = get_lhs(pc->array_var, FALSE);
- unref(*lhs);
- *lhs = make_string(t1->ahname_str, t1->ahname_len);
- break;
-
- case Op_arrayfor_final:
- r = POP();
- assert(r->type == Node_arrayfor);
- free_arrayfor(r);
- break;
-
- case Op_builtin:
- r = pc->builtin(pc->expr_count);
-#if defined(GAWKDEBUG) || defined(ARRAYDEBUG)
- if (! r)
- last_was_stopme = TRUE;
- else
-#endif
- PUSH(r);
- break;
-
- case Op_sub_builtin: /* sub, gsub and gensub */
- r = do_sub(pc->expr_count, pc->sub_flags);
- PUSH(r);
- break;
-
- case Op_K_print:
- do_print(pc->expr_count, pc->redir_type);
- break;
-
- case Op_K_printf:
- do_printf(pc->expr_count, pc->redir_type);
- break;
-
- case Op_K_print_rec:
- do_print_rec(pc->expr_count, pc->redir_type);
- break;
-
- case Op_push_re:
- m = pc->memory;
- if (m->type == Node_dynregex) {
- r = POP_STRING();
- unref(m->re_exp);
- m->re_exp = r;
- }
- PUSH(m);
- break;
-
- case Op_match_rec:
- m = pc->memory;
- t1 = *get_field(0, (Func_ptr *) 0);
-match_re:
- rp = re_update(m);
- /*
- * Any place where research() is called with a last parameter of
- * zero, we need to use the avoid_dfa test. This appears here and
- * in the code for Op_K_case.
- *
- * A new or improved dfa that distinguishes beginning/end of
- * string from beginning/end of line will allow us to get rid of
- * this hack.
- *
- * The avoid_dfa() function is in re.c; it is not very smart.
- */
-
- di = research(rp, t1->stptr, 0, t1->stlen,
- avoid_dfa(m, t1->stptr, t1->stlen));
- di = (di == -1) ^ (pc->opcode != Op_nomatch);
- if(pc->opcode != Op_match_rec) {
- decr_sp();
- DEREF(t1);
- }
- r = make_number((AWKNUM) di);
- PUSH(r);
- break;
-
- case Op_nomatch:
- /* fall through */
- case Op_match:
- m = pc->memory;
- t1 = TOP_STRING();
- if (m->type == Node_dynregex) {
- unref(m->re_exp);
- m->re_exp = t1;
- decr_sp();
- t1 = TOP_STRING();
- }
- goto match_re;
- break;
-
- case Op_indirect_func_call:
- {
- int arg_count;
-
- f = NULL;
- arg_count = (pc + 1)->expr_count;
- t1 = PEEK(arg_count); /* indirect var */
- assert(t1->type == Node_val); /* @a[1](p) not allowed in grammar */
- (void) force_string(t1);
- if (t1->stlen > 0) {
- /* retrieve function definition node */
- f = pc->func_body;
- if (f != NULL && strcmp(f->vname, t1->stptr) == 0)
- /* indirect var hasn't been reassigned */
- goto func_call;
- f = lookup(t1->stptr);
- }
-
- if (f == NULL || f->type != Node_func)
- fatal(_("function called indirectly through `%s' does not exist"), pc->func_name);
- pc->func_body = f; /* save for next call */
-
- goto func_call;
- }
-
- case Op_func_call:
- /* retrieve function definition node */
- f = pc->func_body;
- if (f == NULL) {
- f = lookup(pc->func_name);
- if (f == NULL || f->type != Node_func)
- fatal(_("function `%s' not defined"), pc->func_name);
- pc->func_body = f; /* save for next call */
- }
-
- /* save current frame along with source */
-
-func_call:
- ni = setup_frame(pc);
-
- if (ni->opcode == Op_ext_func) {
- /* dynamically set source and line numbers for an extension builtin. */
- ni->source_file = source;
- ni->source_line = sourceline;
- ni->nexti->source_line = sourceline; /* Op_builtin */
- ni->nexti->nexti->source_line = sourceline; /* Op_K_return */
- }
-
- /* run the function instructions */
- JUMPTO(ni); /* Op_func or Op_ext_func */
-
- case Op_K_return:
- m = POP_SCALAR(); /* return value */
-
- ni = pop_fcall();
-
- /* put the return value back on stack */
- PUSH(m);
-
- JUMPTO(ni);
-
- case Op_K_getline_redir:
- if ((currule == BEGINFILE || currule == ENDFILE)
- && pc->into_var == FALSE
- && pc->redir_type == redirect_input)
- fatal(_("`getline' invalid inside `%s' rule"), ruletab[currule]);
- r = do_getline_redir(pc->into_var, pc->redir_type);
- PUSH(r);
- break;
-
- case Op_K_getline: /* no redirection */
- if (! currule || currule == BEGINFILE || currule == ENDFILE)
- fatal(_("non-redirected `getline' invalid inside `%s' rule"),
- ruletab[currule]);
-
- do {
- int ret;
- ret = nextfile(& curfile, FALSE);
- if (ret <= 0)
- r = do_getline(pc->into_var, curfile);
- else {
-
- /* Save execution state so that we can return to it
- * from Op_after_beginfile or Op_after_endfile.
- */
-
- push_exec_state(pc, currule, source, stack_ptr);
-
- if (curfile == NULL)
- JUMPTO((pc + 1)->target_endfile);
- else
- JUMPTO((pc + 1)->target_beginfile);
- }
- } while (r == NULL); /* EOF */
-
- PUSH(r);
- break;
-
- case Op_after_endfile:
- /* Find the execution state to return to */
- ni = pop_exec_state(& currule, & source, NULL);
-
- assert(ni->opcode == Op_newfile || ni->opcode == Op_K_getline);
- JUMPTO(ni);
-
- case Op_after_beginfile:
- after_beginfile(& curfile);
-
- /* Find the execution state to return to */
- ni = pop_exec_state(& currule, & source, NULL);
-
- assert(ni->opcode == Op_newfile || ni->opcode == Op_K_getline);
- if (ni->opcode == Op_K_getline
- || curfile == NULL /* skipping directory argument */
- )
- JUMPTO(ni);
-
- break; /* read a record, Op_get_record */
-
- case Op_newfile:
- {
- int ret;
-
- ret = nextfile(& curfile, FALSE);
-
- if (ret < 0) /* end of input */
- JUMPTO(pc->target_jmp); /* end block or Op_atexit */
-
- if (ret == 0) /* read a record */
- JUMPTO((pc + 1)->target_get_record);
-
- /* ret > 0 */
- /* Save execution state for use in Op_after_beginfile or Op_after_endfile. */
-
- push_exec_state(pc, currule, source, stack_ptr);
-
- if (curfile == NULL) /* EOF */
- JUMPTO(pc->target_endfile);
- /* else
- execute beginfile block */
- }
- break;
-
- case Op_get_record:
- {
- int errcode = 0;
-
- ni = pc->target_newfile;
- if (curfile == NULL) {
- /* from non-redirected getline, e.g.:
- * {
- * while (getline > 0) ;
- * }
- */
-
- ni = ni->target_jmp; /* end_block or Op_atexit */
- JUMPTO(ni);
- }
-
- if (inrec(curfile, & errcode) != 0) {
- if (errcode > 0 && (do_traditional || ! pc->has_endfile))
- fatal(_("error reading input file `%s': %s"),
- curfile->name, strerror(errcode));
-
- JUMPTO(ni);
- } /* else
- prog (rule) block */
- }
- break;
-
- case Op_K_nextfile:
- {
- int ret;
-
- if (currule != Rule && currule != BEGINFILE)
- fatal(_("`nextfile' cannot be called from a `%s' rule"),
- ruletab[currule]);
-
- ret = nextfile(& curfile, TRUE); /* skip current file */
-
- if (currule == BEGINFILE) {
- long stack_size;
-
- ni = pop_exec_state(& currule, & source, & stack_size);
-
- assert(ni->opcode == Op_K_getline || ni->opcode == Op_newfile);
-
- /* pop stack returning to the state of Op_K_getline or Op_newfile. */
- unwind_stack(stack_size);
-
- if (ret == 0) {
- /* There was an error opening the file;
- * don't run ENDFILE block(s).
- */
-
- JUMPTO(ni);
- } else {
- /* do run ENDFILE block(s) first. */
-
- /* Execution state to return to in Op_after_endfile. */
- push_exec_state(ni, currule, source, stack_ptr);
-
- JUMPTO(pc->target_endfile);
- }
- } /* else
- Start over with the first rule. */
-
- /* empty the run-time stack to avoid memory leak */
- pop_stack();
-
- /* Push an execution state for Op_after_endfile to return to */
- push_exec_state(pc->target_newfile, currule, source, stack_ptr);
-
- JUMPTO(pc->target_endfile);
- }
- break;
-
- case Op_K_exit:
- /* exit not allowed in user-defined comparison functions for "sorted_in";
- * This is done so that END blocks aren't executed more than once.
- */
- if (! currule)
- fatal(_("`exit' cannot be called in the current context"));
-
- exiting = TRUE;
- POP_NUMBER(x1);
- exit_val = (int) x1;
-#ifdef VMS
- if (exit_val == 0)
- exit_val = EXIT_SUCCESS;
- else if (exit_val == 1)
- exit_val = EXIT_FAILURE;
- /* else
- just pass anything else on through */
-#endif
-
- if (currule == BEGINFILE || currule == ENDFILE) {
-
- /* Find the rule of the saved execution state (Op_K_getline/Op_newfile).
- * This is needed to prevent multiple execution of any END rules:
- * gawk 'BEGINFILE { exit(1) } \
- * END { while (getline > 0); }' in1 in2
- */
-
- (void) pop_exec_state(& currule, & source, NULL);
- }
-
- pop_stack(); /* empty stack, don't leak memory */
-
- /* Jump to either the first END block instruction
- * or to Op_atexit.
- */
-
- if (currule == END)
- ni = pc->target_atexit;
- else
- ni = pc->target_end;
- JUMPTO(ni);
-
- case Op_K_next:
- if (currule != Rule)
- fatal(_("`next' cannot be called from a `%s' rule"), ruletab[currule]);
-
- pop_stack();
- JUMPTO(pc->target_jmp); /* Op_get_record, read next record */
-
- case Op_pop:
-#if defined(GAWKDEBUG) || defined(ARRAYDEBUG)
- if (last_was_stopme)
- last_was_stopme = FALSE;
- else
-#endif
- {
- r = POP_SCALAR();
- DEREF(r);
- }
- break;
-
- case Op_line_range:
- if (pc->triggered) /* evaluate right expression */
- JUMPTO(pc->target_jmp);
- /* else
- evaluate left expression */
- break;
+ if (posth)
+ post_execute = posth;
- case Op_cond_pair:
- {
- int result;
- INSTRUCTION *ip;
+ return true;
+}
- t1 = TOP_SCALAR(); /* from right hand side expression */
- di = (eval_condition(t1) != 0);
- DEREF(t1);
- ip = pc->line_range; /* Op_line_range */
+/* interpreter routine when not debugging */
+#include "interpret.h"
- if (! ip->triggered && di) {
- /* not already triggered and left expression is TRUE */
- decr_sp();
- ip->triggered = TRUE;
- JUMPTO(ip->target_jmp); /* evaluate right expression */
- }
+/* interpreter routine with exec hook(s). Used when debugging and/or with MPFR. */
+#define r_interpret h_interpret
+#define EXEC_HOOK 1
+#include "interpret.h"
+#undef EXEC_HOOK
+#undef r_interpret
- result = ip->triggered || di;
- ip->triggered ^= di; /* update triggered flag */
- r = make_number((AWKNUM) result); /* final value of condition pair */
- REPLACE(r);
- JUMPTO(pc->target_jmp);
- }
- case Op_exec_count:
- INCREMENT(pc->exec_count);
- break;
+void
+init_interpret()
+{
+ long newval;
- case Op_no_op:
- case Op_K_do:
- case Op_K_while:
- case Op_K_for:
- case Op_K_arrayfor:
- case Op_K_switch:
- case Op_K_default:
- case Op_K_if:
- case Op_K_else:
- case Op_cond_exp:
- break;
+ if ((newval = getenv_long("GAWK_STACKSIZE")) > 0)
+ STACK_SIZE = newval;
- default:
- fatal(_("Sorry, don't know how to interpret `%s'"), opcode2str(pc->opcode));
- }
+ emalloc(stack_bottom, STACK_ITEM *, STACK_SIZE * sizeof(STACK_ITEM), "grow_stack");
+ stack_ptr = stack_bottom - 1;
+ stack_top = stack_bottom + STACK_SIZE - 1;
- JUMPTO(pc->nexti);
+ /* initialize frame pointer */
+ getnode(frame_ptr);
+ frame_ptr->type = Node_frame;
+ frame_ptr->stack = NULL;
+ frame_ptr->func_node = NULL; /* in main */
+ frame_ptr->num_tail_calls = 0;
+ frame_ptr->vname = NULL;
-/* } forever */
+ /* initialize true and false nodes */
+ node_Boolean[false] = make_number(0.0);
+ node_Boolean[true] = make_number(1.0);
+ if (! is_mpg_number(node_Boolean[false])) {
+ node_Boolean[false]->flags |= NUMINT;
+ node_Boolean[true]->flags |= NUMINT;
+ }
- /* not reached */
- return 0;
+ /*
+ * Select the interpreter routine. The version without
+ * any exec hook support (r_interpret) is faster by about
+ * 5%, or more depending on the opcodes.
+ */
-#undef mk_sub
-#undef JUMPTO
+ if (num_exec_hook > 0)
+ interpret = h_interpret;
+ else
+ interpret = r_interpret;
}
+