CELL *
bi_printf(CELL *sp)
{
register int k;
register CELL *p;
FILE *fp;
TRACE_FUNC("bi_printf", sp);
k = sp->type;
if (k < 0) {
/* k has redirection */
if ((--sp)->type < C_STRING)
cast1_to_s(sp);
fp = (FILE *) file_find(string(sp), k);
free_STRING(string(sp));
k = (--sp)->type;
/* k is now number of args including format */
} else
fp = stdout;
sp -= k; /* sp points at the format string */
k--;
if (sp->type < C_STRING)
cast1_to_s(sp);
do_printf(fp, string(sp)->str, (unsigned) k, sp + 1);
free_STRING(string(sp));
/* cleanup arguments on eval stack */
for (p = sp + 1; k; k--, p++)
cell_destroy(p);
return --sp;
}
CELL *
bi_index(CELL * sp)
{
size_t idx;
size_t len;
const char *p;
sp--;
if (TEST2(sp) != TWO_STRINGS)
cast2_to_s(sp);
if ((len = string(sp + 1)->len)) {
idx = (size_t) ((p = str_str(string(sp)->str,
string(sp)->len,
string(sp + 1)->str,
len))
? p - string(sp)->str + 1
: 0);
} else { /* index of the empty string */
idx = 1;
}
free_STRING(string(sp));
free_STRING(string(sp + 1));
sp->type = C_DOUBLE;
sp->dval = (double) idx;
return sp;
}
static void
set_rs_shadow()
{
CELL c ;
STRING *sval ;
char *s ;
unsigned len ;
if (posix_space_flag && mawk_state == EXECUTION)
scan_code['\n'] = SC_UNEXPECTED ;
if (rs_shadow.type == SEP_STR)
free_STRING((STRING *) rs_shadow.ptr) ;
cast_for_split(cellcpy(&c, RS)) ;
switch (c.type)
{
case C_RE:
if ( (s = is_string_split(c.ptr, &len)) )
{
if (len == 1)
{
rs_shadow.type = SEP_CHAR ;
rs_shadow.c = s[0] ;
}
else
{
rs_shadow.type = SEP_STR ;
rs_shadow.ptr = (PTR) new_STRING(s) ;
}
}
else
{
rs_shadow.type = SEP_RE ;
rs_shadow.ptr = c.ptr ;
}
break ;
case C_SPACE:
rs_shadow.type = SEP_CHAR ;
rs_shadow.c = ' ' ;
break ;
case C_SNULL: /* RS becomes one or more blank lines */
if (mawk_state == EXECUTION) scan_code['\n'] = SC_SPACE ;
rs_shadow.type = SEP_MLR ;
sval = new_STRING("\n\n+") ;
rs_shadow.ptr = re_compile(sval) ;
free_STRING(sval) ;
break ;
default:
bozo("bad cell in set_rs_shadow") ;
}
}
/* compare cells at cp and cp+1 and
frees STRINGs at those cells
*/
static int
compare(CELL * cp)
{
int k;
reswitch:
switch (TEST2(cp)) {
case TWO_NOINITS:
return 0;
case TWO_DOUBLES:
two_d:
return cp->dval > (cp + 1)->dval ? 1 :
cp->dval < (cp + 1)->dval ? -1 : 0;
case TWO_STRINGS:
case STRING_AND_STRNUM:
two_s:
k = strcmp(string(cp)->str, string(cp + 1)->str);
free_STRING(string(cp));
free_STRING(string(cp + 1));
return k;
case NOINIT_AND_DOUBLE:
case NOINIT_AND_STRNUM:
case DOUBLE_AND_STRNUM:
case TWO_STRNUMS:
cast2_to_d(cp);
goto two_d;
case NOINIT_AND_STRING:
case DOUBLE_AND_STRING:
cast2_to_s(cp);
goto two_s;
case TWO_MBSTRNS:
check_strnum(cp);
check_strnum(cp + 1);
goto reswitch;
case NOINIT_AND_MBSTRN:
case DOUBLE_AND_MBSTRN:
case STRING_AND_MBSTRN:
case STRNUM_AND_MBSTRN:
check_strnum(cp->type == C_MBSTRN ? cp : cp + 1);
goto reswitch;
default: /* there are no default cases */
bozo("bad cell type passed to compare");
}
return 0; /* shut up */
}
CELL *array_cat(
CELL *sp,
int cnt)
{
CELL *p ; /* walks the eval stack */
CELL subsep ; /* local copy of SUBSEP */
size_t subsep_len ; /* string length of subsep_str */
char *subsep_str ;
size_t total_len ; /* length of cat'ed expression */
CELL *top ; /* value of sp at entry */
char *target ; /* build cat'ed char* here */
STRING *sval ; /* build cat'ed STRING here */
cellcpy(&subsep, SUBSEP) ;
if ( subsep.type < C_STRING ) cast1_to_s(&subsep) ;
subsep_len = string(&subsep)->len ;
subsep_str = string(&subsep)->str ;
assert(cnt > 0);
top = sp ;
sp -= (cnt-1) ;
total_len = ((size_t) (cnt-1)) * subsep_len ;
for(p = sp ; p <= top ; p++) {
if ( p->type < C_STRING ) cast1_to_s(p) ;
total_len += string(p)->len ;
}
sval = new_STRING0(total_len) ;
target = sval->str ;
for(p = sp ; p < top ; p++) {
memcpy(target, string(p)->str, string(p)->len) ;
target += string(p)->len ;
memcpy(target, subsep_str, subsep_len) ;
target += subsep_len ;
}
/* now p == top */
memcpy(target, string(p)->str, string(p)->len) ;
for(p = sp; p <= top ; p++) free_STRING(string(p)) ;
free_STRING(string(&subsep)) ;
/* set contents of sp , sp->type > C_STRING is possible so reset */
sp->type = C_STRING ;
sp->ptr = (PTR) sval ;
return sp ;
}
void
cast_for_split(CELL * cp)
{
static char meta[] = "^$.*+?|[]()";
static char xbuff[] = "\\X";
int c;
size_t len;
if (cp->type < C_STRING)
cast1_to_s(cp);
if ((len = string(cp)->len) == 1) {
if ((c = string(cp)->str[0]) == ' ') {
free_STRING(string(cp));
cp->type = C_SPACE;
return;
} else if (c == 0) {
#ifdef LOCAL_REGEXP
char temp[1];
temp[0] = (char) c;
free_STRING(string(cp));
cp->ptr = (PTR) new_STRING1(temp, (size_t) 1);
#else
/*
* A null is not a meta character, but strchr will match it anyway.
* For now, there's no reason to compile a null as a regular
* expression - just return a string containing the single
* character. That is used in a special case in set_rs_shadow().
*/
char temp[2];
temp[0] = (char) c;
free_STRING(string(cp));
cp->ptr = (PTR) new_STRING1(temp, (size_t) 1);
return;
#endif
} else if (strchr(meta, c)) {
xbuff[1] = (char) c;
free_STRING(string(cp));
cp->ptr = (PTR) new_STRING(xbuff);
}
} else if (len == 0) {
free_STRING(string(cp));
cp->type = C_SNULL;
return;
}
cast_to_RE(cp);
}
CELL *
bi_match(CELL * sp)
{
char *p;
size_t length;
if (sp->type != C_RE)
cast_to_RE(sp);
if ((--sp)->type < C_STRING)
cast1_to_s(sp);
cell_destroy(RSTART);
cell_destroy(RLENGTH);
RSTART->type = C_DOUBLE;
RLENGTH->type = C_DOUBLE;
p = REmatch(string(sp)->str, string(sp)->len, cast_to_re((sp + 1)->ptr), &length);
if (p) {
sp->dval = (double) (p - string(sp)->str + 1);
RLENGTH->dval = (double) length;
} else {
sp->dval = 0.0;
RLENGTH->dval = -1.0; /* posix */
}
free_STRING(string(sp));
sp->type = C_DOUBLE;
RSTART->dval = sp->dval;
return sp;
}
void
load_environ(ARRAY ENV)
{
CELL c;
register char **p = environ; /* walks environ */
char *s; /* looks for the '=' */
CELL *cp; /* pts at ENV[&c] */
c.type = C_STRING;
while (*p) {
if ((s = strchr(*p, '='))) { /* shouldn't fail */
size_t len = (size_t) (s - *p);
c.ptr = (PTR) new_STRING0(len);
memcpy(string(&c)->str, *p, len);
s++;
cp = array_find(ENV, &c, CREATE);
cp->type = C_MBSTRN;
cp->ptr = (PTR) new_STRING(s);
free_STRING(string(&c));
}
p++;
}
}
CELL *
bi_substr(CELL * sp)
{
int n_args, len;
register int i, n;
STRING *sval; /* substr(sval->str, i, n) */
n_args = sp->type;
sp -= n_args;
if (sp->type != C_STRING)
cast1_to_s(sp);
/* don't use < C_STRING shortcut */
sval = string(sp);
if ((len = (int) sval->len) == 0) /* substr on null string */
{
if (n_args == 3) {
cell_destroy(sp + 2);
}
cell_destroy(sp + 1);
return sp;
}
if (n_args == 2) {
n = MAX__INT;
if (sp[1].type != C_DOUBLE)
cast1_to_d(sp + 1);
} else {
if (TEST2(sp + 1) != TWO_DOUBLES)
cast2_to_d(sp + 1);
n = d_to_i(sp[2].dval);
}
i = d_to_i(sp[1].dval) - 1; /* i now indexes into string */
/*
* Workaround in case someone's written a script that does substr(0,last-1)
* by transforming it into substr(1,last).
*/
if (i < 0) {
n -= i + 1;
i = 0;
}
if (n > len - i) {
n = len - i;
}
if (n <= 0) /* the null string */
{
sp->ptr = (PTR) & null_str;
null_str.ref_cnt++;
} else { /* got something */
sp->ptr = (PTR) new_STRING0((size_t) n);
memcpy(string(sp)->str, sval->str + i, (size_t) n);
}
free_STRING(sval);
return sp;
}
static ANODE* find_by_ival(
ARRAY A ,
Int ival ,
int create_flag ,
int *redo )
{
DUAL_LINK *table = (DUAL_LINK*) A->ptr ;
unsigned indx = (unsigned) ival & A->hmask ;
ANODE *p = table[indx].ilink ; /* walks ilist */
ANODE *q = (ANODE*) 0 ; /* trails p */
while(1) {
if (!p) {
/* search failed */
if (A->type & AY_STR) {
/* need to search by string */
char buff[256] ;
STRING *sval ;
sprintf(buff, INT_FMT, ival) ;
sval = new_STRING(buff) ;
p = find_by_sval(A, sval, create_flag, redo) ;
if (*redo) {
table = (DUAL_LINK*) A->ptr ;
}
free_STRING(sval) ;
if (!p) return (ANODE*) 0 ;
}
else if (create_flag) {
p = ZMALLOC(ANODE) ;
p->sval = (STRING*) 0 ;
p->cell.type = C_NOINIT ;
if (++A->size > A->limit) {
double_the_hash_table(A) ; /* changes table, may change index */
table = (DUAL_LINK*) A->ptr ;
indx = A->hmask & (unsigned) ival ;
}
}
else return (ANODE*) 0 ;
p->ival = ival ;
A->type |= AY_INT ;
break ;
}
else if (p->ival == ival) {
/* found it, now move to the front */
if (!q) /* already at the front */
return p ;
/* delete for insertion at the front */
q->ilink = p->ilink ;
break ;
}
q = p ;
p = q->ilink ;
}
/* insert at the front */
p->ilink = table[indx].ilink ;
table[indx].ilink = p ;
return p ;
}
static void
free_filenode(FILE_NODE * p)
{
#ifdef NO_LEAKS
if (p->name != 0) {
free_STRING(p->name);
}
#endif
zfree(p, sizeof(FILE_NODE));
}
void
split_field0(void)
{
register CELL *cp;
register int cnt;
CELL c; /* copy field[0] here if not string */
if (field[0].type < C_STRING) {
cast1_to_s(cellcpy(&c, field + 0));
cp = &c;
} else
cp = &field[0];
if (string(cp)->len == 0)
nf = 0;
else {
switch (fs_shadow.type) {
case C_SNULL: /* FS == "" */
nf = (int) null_split(string(cp)->str, string(cp)->len);
break;
case C_SPACE:
nf = (int) space_split(string(cp)->str, string(cp)->len);
break;
default:
nf = (int) re_split(string(cp), fs_shadow.ptr);
break;
}
}
cell_destroy(NF);
NF->type = C_DOUBLE;
NF->dval = (double) nf;
if (nf > MAX_SPLIT) {
cnt = MAX_SPLIT;
load_field_ov();
} else
cnt = nf;
while (cnt > 0) {
cell_destroy(field + cnt);
field[cnt].ptr = (PTR) split_buff[cnt - 1];
USED_SPLIT_BUFF(cnt - 1);
field[cnt--].type = C_MBSTRN;
}
if (cp == &c) {
free_STRING(string(cp));
}
}
void
cast_to_REPL(CELL * cp)
{
register STRING *sval;
if (cp->type < C_STRING)
cast1_to_s(cp);
sval = (STRING *) cp->ptr;
cellcpy(cp, repl_compile(sval));
free_STRING(sval);
}
CELL *
bi_close(CELL * sp)
{
int x;
if (sp->type < C_STRING)
cast1_to_s(sp);
x = file_close((STRING *) sp->ptr);
free_STRING(string(sp));
sp->type = C_DOUBLE;
sp->dval = (double) x;
return sp;
}
void
cast1_to_d(CELL * cp)
{
switch (cp->type) {
case C_NOINIT:
cp->dval = 0.0;
break;
case C_DOUBLE:
return;
case C_MBSTRN:
case C_STRING:
{
register STRING *s = (STRING *) cp->ptr;
#ifdef FPE_TRAPS_ON /* look for overflow error */
errno = 0;
cp->dval = strtod(s->str, (char **) 0);
if (errno && cp->dval != 0.0) /* ignore underflow */
rt_error("overflow converting %s to double", s->str);
#else
cp->dval = strtod(s->str, (char **) 0);
#endif
free_STRING(s);
}
break;
case C_STRNUM:
/* don't need to convert, but do need to free the STRING part */
free_STRING(string(cp));
break;
default:
bozo("cast on bad type");
}
cp->type = C_DOUBLE;
}
void
cast_to_RE(CELL * cp)
{
register PTR p;
if (cp->type < C_STRING)
cast1_to_s(cp);
p = re_compile(string(cp));
free_STRING(string(cp));
cp->type = C_RE;
cp->ptr = p;
}
void
field_leaks(void)
{
int n;
free_STRING(string(CONVFMT));
free_STRING(string(FS));
free_STRING(string(OFMT));
free_STRING(string(RS));
cell_destroy(&field[0]);
for (n = 1; n <= nf; ++n) {
cell_destroy(&field[n]);
}
switch (fs_shadow.type) {
case C_RE:
re_destroy(fs_shadow.ptr);
break;
case C_STRING:
case C_STRNUM:
case C_MBSTRN:
cell_destroy(&fs_shadow);
break;
default:
break;
}
switch (rs_shadow.type) {
case SEP_STR:
free_STRING(((STRING *) (&rs_shadow.ptr)));
break;
case SEP_RE:
re_destroy(rs_shadow.ptr);
break;
}
}
CELL* array_find(
ARRAY A,
CELL *cp,
int create_flag)
{
ANODE *ap ;
int redid ;
if (A->size == 0 && !create_flag)
/* eliminating this trivial case early avoids unnecessary conversions later */
return (CELL*) 0 ;
switch (cp->type) {
case C_DOUBLE:
{
double d = cp->dval ;
Int ival = d_to_I(d) ;
if ((double)ival == d) {
if (A->type == AY_SPLIT) {
if (ival >= 1 && ival <= (int) A->size)
return (CELL*)A->ptr+(ival-1) ;
if (!create_flag) return (CELL*) 0 ;
convert_split_array_to_table(A) ;
}
else if (A->type == AY_NULL) make_empty_table(A, AY_INT) ;
ap = find_by_ival(A, ival, create_flag, &redid) ;
}
else {
/* convert to string */
char buff[260] ;
STRING *sval ;
sprintf(buff, string(CONVFMT)->str, d) ;
sval = new_STRING(buff) ;
ap = find_by_sval(A, sval, create_flag, &redid) ;
free_STRING(sval) ;
}
}
break ;
case C_NOINIT:
ap = find_by_sval(A, &null_str, create_flag, &redid) ;
break ;
default:
ap = find_by_sval(A, string(cp), create_flag, &redid) ;
break ;
}
return ap ? &ap->cell : (CELL *) 0 ;
}
CELL *
bi_print(
CELL *sp) /* stack ptr passed in */
{
register CELL *p;
register int k;
FILE *fp;
k = sp->type;
if (k < 0) {
/* k holds redirection */
if ((--sp)->type < C_STRING)
cast1_to_s(sp);
fp = (FILE *) file_find(string(sp), k);
free_STRING(string(sp));
k = (--sp)->type;
/* k now has number of arguments */
} else
fp = stdout;
if (k) {
p = sp - k; /* clear k variables off the stack */
sp = p - 1;
k--;
while (k > 0) {
print_cell(p, fp);
print_cell(OFS, fp);
cell_destroy(p);
p++;
k--;
}
print_cell(p, fp);
cell_destroy(p);
} else { /* print $0 */
sp--;
print_cell(&field[0], fp);
}
print_cell(ORS, fp);
if (ferror(fp))
write_error();
return sp;
}
static void
clear_aloop_stack(ALOOP_STATE * top)
{
ALOOP_STATE *q;
do {
while (top->ptr < top->limit) {
free_STRING(*top->ptr);
top->ptr++;
}
if (top->base < top->limit) {
zfree(top->base,
(unsigned) (top->limit - top->base) * sizeof(STRING *));
}
q = top;
top = q->link;
ZFREE(q);
} while (top);
}
CELL *
bi_fflush(CELL * sp)
{
int ret = 0;
if (sp->type == 0)
fflush(stdout);
else {
sp--;
if (sp->type < C_STRING)
cast1_to_s(sp);
ret = file_flush(string(sp));
free_STRING(string(sp));
}
sp->type = C_DOUBLE;
sp->dval = (double) ret;
return sp;
}
void
DB_cell_destroy(CELL *cp)
{
switch (cp->type) {
case C_NOINIT:
case C_DOUBLE:
break;
case C_MBSTRN:
case C_STRING:
case C_STRNUM:
free_STRING(string(cp));
break;
case C_RE:
bozo("cell destroy called on RE cell");
default:
bozo("cell destroy called on bad cell type");
}
}
void
scan_cleanup(void)
{
if (program_fd >= 0)
zfree(buffer, (size_t) (BUFFSZ + 1));
if (program_string)
free_STRING(program_string);
if (program_fd > 0)
close(program_fd);
/* redefine SPACE as [ \t\n] */
scan_code['\n'] = (char) ((posix_space_flag && rs_shadow.type != SEP_MLR)
? SC_UNEXPECTED
: SC_SPACE);
scan_code['\f'] = SC_UNEXPECTED; /*value doesn't matter */
scan_code['\013'] = SC_UNEXPECTED; /* \v not space */
scan_code['\r'] = SC_UNEXPECTED;
}
CELL *
bi_length(CELL * sp)
{
size_t len;
if (sp->type == 0)
cellcpy(sp, field);
else
sp--;
if (sp->type < C_STRING)
cast1_to_s(sp);
len = string(sp)->len;
free_STRING(string(sp));
sp->type = C_DOUBLE;
sp->dval = (double) len;
return sp;
}
CELL *
bi_tolower(CELL * sp)
{
STRING *old;
register char *p, *q;
if (sp->type != C_STRING)
cast1_to_s(sp);
old = string(sp);
sp->ptr = (PTR) new_STRING0(old->len);
q = string(sp)->str;
p = old->str;
while (*p) {
*q = *p++;
*q = (char) tolower((UChar) * q);
q++;
}
free_STRING(old);
return sp;
}
void
set_binmode(int x)
{
CELL c;
int change = ((x & 4) == 0);
/* set RS */
c.type = C_STRING;
c.ptr = (PTR) new_STRING((change && (x & 1)) ? "\r\n" : "\n");
field_assign(RS, &c);
free_STRING(string(&c));
/* set ORS */
cell_destroy(ORS);
ORS->type = C_STRING;
ORS->ptr = (PTR) new_STRING((change && (x & 2)) ? "\r\n" : "\n");
cell_destroy(BINMODE);
BINMODE->type = C_DOUBLE;
BINMODE->dval = (double) x;
}
void array_clear(ARRAY A)
{
unsigned i ;
ANODE *p, *q ;
if (A->type == AY_SPLIT) {
for(i = 0; i < A->size; i++)
cell_destroy((CELL*)A->ptr+i) ;
zfree(A->ptr, A->limit * sizeof(CELL)) ;
}
else if (A->type & AY_STR) {
DUAL_LINK *table = (DUAL_LINK*) A->ptr ;
for(i=0; (unsigned) i <= A->hmask; i++) {
p = table[i].slink ;
while(p) {
q = p ;
p = q->slink ;
free_STRING(q->sval) ;
cell_destroy(&q->cell) ;
ZFREE(q) ;
}
}
zfree(A->ptr, (A->hmask+1)*sizeof(DUAL_LINK)) ;
}
else if (A->type & AY_INT) {
DUAL_LINK *table = (DUAL_LINK*) A->ptr ;
for(i=0; (unsigned) i <= A->hmask; i++) {
p = table[i].ilink ;
while(p) {
q = p ;
p = q->ilink ;
cell_destroy(&q->cell) ;
ZFREE(q) ;
}
}
zfree(A->ptr, (A->hmask+1)*sizeof(DUAL_LINK)) ;
}
memset(A, 0, sizeof(*A)) ;
}
CELL *
bi_sprintf(CELL *sp)
{
CELL *p;
int argcnt = sp->type;
STRING *sval;
TRACE_FUNC("bi_sprintf", sp);
sp -= argcnt; /* sp points at the format string */
argcnt--;
if (sp->type != C_STRING)
cast1_to_s(sp);
sval = do_printf((FILE *) 0, string(sp)->str, (unsigned) argcnt, sp + 1);
free_STRING(string(sp));
sp->ptr = (PTR) sval;
/* cleanup */
for (p = sp + 1; argcnt; argcnt--, p++)
cell_destroy(p);
return sp;
}
void
execute(INST * cdp, /* code ptr, start execution here */
CELL *sp, /* eval_stack pointer */
CELL *fp) /* frame ptr into eval_stack for
user defined functions */
{
/* some useful temporaries */
CELL *cp;
int t;
unsigned tu;
/* save state for array loops via a stack */
ALOOP_STATE *aloop_state = (ALOOP_STATE *) 0;
/* for moving the eval stack on deep recursion */
CELL *old_stack_base = 0;
CELL *old_sp = 0;
#ifdef DEBUG
CELL *entry_sp = sp;
#endif
int force_exit = (end_start == 0);
if (fp) {
/* we are a function call, check for deep recursion */
if (sp > stack_danger) { /* change stacks */
old_stack_base = stack_base;
old_sp = sp;
stack_base = (CELL *) zmalloc(sizeof(CELL) * EVAL_STACK_SIZE);
stack_danger = stack_base + DANGER;
sp = stack_base;
/* waste 1 slot for ANSI, actually large model msdos breaks in
RET if we don't */
#ifdef DEBUG
entry_sp = sp;
#endif
} else
old_stack_base = (CELL *) 0;
}
while (1) {
TRACE(("execute %s sp(%ld:%s)\n",
da_op_name(cdp),
(long) (sp - stack_base),
da_type_name(sp)));
switch ((cdp++)->op) {
/* HALT only used by the disassemble now ; this remains
so compilers don't offset the jump table */
case _HALT:
case _STOP: /* only for range patterns */
#ifdef DEBUG
if (sp != entry_sp + 1)
bozo("stop0");
#endif
return;
case _PUSHC:
inc_sp();
cellcpy(sp, (cdp++)->ptr);
break;
case _PUSHD:
inc_sp();
sp->type = C_DOUBLE;
sp->dval = *(double *) (cdp++)->ptr;
break;
case _PUSHS:
inc_sp();
sp->type = C_STRING;
sp->ptr = (cdp++)->ptr;
string(sp)->ref_cnt++;
break;
case F_PUSHA:
cp = (CELL *) cdp->ptr;
if (cp != field) {
if (nf < 0)
split_field0();
if (!(cp >= NF && cp <= LAST_PFIELD)) {
/* it is a real field $1, $2 ...
If it is greater than $NF, we have to
make sure it is set to "" so that
(++|--) and g?sub() work right
*/
t = field_addr_to_index(cp);
if (t > nf) {
cp->type = C_STRING;
cp->ptr = (PTR) & null_str;
null_str.ref_cnt++;
}
}
}
/* fall thru */
case _PUSHA:
case A_PUSHA:
inc_sp();
sp->ptr = (cdp++)->ptr;
break;
case _PUSHI:
/* put contents of next address on stack */
inc_sp();
cellcpy(sp, (cdp++)->ptr);
break;
case L_PUSHI:
/* put the contents of a local var on stack,
cdp->op holds the offset from the frame pointer */
inc_sp();
cellcpy(sp, fp + (cdp++)->op);
break;
case L_PUSHA:
/* put a local address on eval stack */
inc_sp();
sp->ptr = (PTR) (fp + (cdp++)->op);
break;
case F_PUSHI:
/* push contents of $i
cdp[0] holds & $i , cdp[1] holds i */
inc_sp();
if (nf < 0)
split_field0();
cp = (CELL *) cdp->ptr;
t = (cdp + 1)->op;
cdp += 2;
if (t <= nf)
cellcpy(sp, cp);
else { /* an unset field */
sp->type = C_STRING;
sp->ptr = (PTR) & null_str;
null_str.ref_cnt++;
}
break;
case NF_PUSHI:
inc_sp();
if (nf < 0)
split_field0();
cellcpy(sp, NF);
break;
case FE_PUSHA:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
tu = d_to_index(sp->dval);
if (tu && nf < 0)
split_field0();
sp->ptr = (PTR) field_ptr((int) tu);
if ((int) tu > nf) {
/* make sure it is set to "" */
cp = (CELL *) sp->ptr;
cell_destroy(cp);
cp->type = C_STRING;
cp->ptr = (PTR) & null_str;
null_str.ref_cnt++;
}
break;
case FE_PUSHI:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
tu = d_to_index(sp->dval);
if (nf < 0)
split_field0();
if ((int) tu <= nf) {
cellcpy(sp, field_ptr((int) tu));
} else {
sp->type = C_STRING;
sp->ptr = (PTR) & null_str;
null_str.ref_cnt++;
}
break;
case AE_PUSHA:
/* top of stack has an expr, cdp->ptr points at an
array, replace the expr with the cell address inside
the array */
cp = array_find((ARRAY) (cdp++)->ptr, sp, CREATE);
cell_destroy(sp);
sp->ptr = (PTR) cp;
break;
case AE_PUSHI:
/* top of stack has an expr, cdp->ptr points at an
array, replace the expr with the contents of the
cell inside the array */
cp = array_find((ARRAY) (cdp++)->ptr, sp, CREATE);
cell_destroy(sp);
cellcpy(sp, cp);
break;
case LAE_PUSHI:
/* sp[0] is an expression
cdp->op is offset from frame pointer of a CELL which
has an ARRAY in the ptr field, replace expr
with array[expr]
*/
if (fp != 0) {
cp = array_find((ARRAY) fp[(cdp++)->op].ptr, sp, CREATE);
cell_destroy(sp);
cellcpy(sp, cp);
}
break;
case LAE_PUSHA:
/* sp[0] is an expression
cdp->op is offset from frame pointer of a CELL which
has an ARRAY in the ptr field, replace expr
with & array[expr]
*/
if (fp != 0) {
cp = array_find((ARRAY) fp[(cdp++)->op].ptr, sp, CREATE);
cell_destroy(sp);
sp->ptr = (PTR) cp;
}
break;
case LA_PUSHA:
/* cdp->op is offset from frame pointer of a CELL which
has an ARRAY in the ptr field. Push this ARRAY
on the eval stack
*/
if (fp != 0) {
inc_sp();
sp->ptr = fp[(cdp++)->op].ptr;
}
break;
case SET_ALOOP:
{
ALOOP_STATE *ap = ZMALLOC(ALOOP_STATE);
size_t vector_size;
ap->var = (CELL *) sp[-1].ptr;
ap->base = ap->ptr = array_loop_vector((ARRAY) 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 != 0 && (ap->ptr < ap->limit)) {
cell_destroy(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;
if (ap != 0) {
aloop_state = ap->link;
while (ap->ptr < ap->limit) {
free_STRING(*ap->ptr);
ap->ptr++;
}
if (ap->base < ap->limit) {
zfree(ap->base,
((unsigned) (ap->limit - ap->base)
* sizeof(STRING *)));
}
ZFREE(ap);
}
}
break;
case _POP:
cell_destroy(sp);
sp--;
break;
case _ASSIGN:
/* top of stack has an expr, next down is an
address, put the expression in *address and
replace the address with the expression */
/* don't propagate type C_MBSTRN */
if (sp->type == C_MBSTRN)
check_strnum(sp);
sp--;
cell_destroy(((CELL *) sp->ptr));
cellcpy(sp, cellcpy(sp->ptr, sp + 1));
cell_destroy(sp + 1);
break;
case F_ASSIGN:
/* assign to a field */
if (sp->type == C_MBSTRN)
check_strnum(sp);
sp--;
field_assign((CELL *) sp->ptr, sp + 1);
cell_destroy(sp + 1);
cellcpy(sp, (CELL *) sp->ptr);
break;
case _ADD_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
#ifdef SW_FP_CHECK /* specific to V7 and XNX23A */
clrerr();
#endif
cp->dval += (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = cp->dval;
break;
case _SUB_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
#ifdef SW_FP_CHECK
clrerr();
#endif
cp->dval -= (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = cp->dval;
break;
case _MUL_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
#ifdef SW_FP_CHECK
clrerr();
#endif
cp->dval *= (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = cp->dval;
break;
case _DIV_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
#ifdef NOINFO_SIGFPE
CHECK_DIVZERO(sp->dval);
#endif
#ifdef SW_FP_CHECK
clrerr();
#endif
cp->dval /= (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = cp->dval;
break;
case _MOD_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
#ifdef NOINFO_SIGFPE
CHECK_DIVZERO(sp->dval);
#endif
cp->dval = fmod(cp->dval, (sp--)->dval);
sp->type = C_DOUBLE;
sp->dval = cp->dval;
break;
case _POW_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
cp->dval = pow(cp->dval, (sp--)->dval);
sp->type = C_DOUBLE;
sp->dval = cp->dval;
break;
/* will anyone ever use these ? */
case F_ADD_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
cast1_to_d(cellcpy(&tc, cp));
#ifdef SW_FP_CHECK
clrerr();
#endif
tc.dval += (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = tc.dval;
field_assign(cp, &tc);
break;
case F_SUB_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
cast1_to_d(cellcpy(&tc, cp));
#ifdef SW_FP_CHECK
clrerr();
#endif
tc.dval -= (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = tc.dval;
field_assign(cp, &tc);
break;
case F_MUL_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
cast1_to_d(cellcpy(&tc, cp));
#ifdef SW_FP_CHECK
clrerr();
#endif
tc.dval *= (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = tc.dval;
field_assign(cp, &tc);
break;
case F_DIV_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
cast1_to_d(cellcpy(&tc, cp));
#ifdef NOINFO_SIGFPE
CHECK_DIVZERO(sp->dval);
#endif
#ifdef SW_FP_CHECK
clrerr();
#endif
tc.dval /= (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = tc.dval;
field_assign(cp, &tc);
break;
case F_MOD_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
cast1_to_d(cellcpy(&tc, cp));
#ifdef NOINFO_SIGFPE
CHECK_DIVZERO(sp->dval);
#endif
tc.dval = fmod(tc.dval, (sp--)->dval);
sp->type = C_DOUBLE;
sp->dval = tc.dval;
field_assign(cp, &tc);
break;
case F_POW_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
cast1_to_d(cellcpy(&tc, cp));
tc.dval = pow(tc.dval, (sp--)->dval);
sp->type = C_DOUBLE;
sp->dval = tc.dval;
field_assign(cp, &tc);
break;
case _ADD:
sp--;
if (TEST2(sp) != TWO_DOUBLES)
cast2_to_d(sp);
#ifdef SW_FP_CHECK
clrerr();
#endif
sp[0].dval += sp[1].dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
break;
case _SUB:
sp--;
if (TEST2(sp) != TWO_DOUBLES)
cast2_to_d(sp);
#ifdef SW_FP_CHECK
clrerr();
#endif
sp[0].dval -= sp[1].dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
break;
case _MUL:
sp--;
if (TEST2(sp) != TWO_DOUBLES)
cast2_to_d(sp);
#ifdef SW_FP_CHECK
clrerr();
#endif
sp[0].dval *= sp[1].dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
break;
case _DIV:
sp--;
if (TEST2(sp) != TWO_DOUBLES)
cast2_to_d(sp);
#ifdef NOINFO_SIGFPE
CHECK_DIVZERO(sp[1].dval);
#endif
#ifdef SW_FP_CHECK
clrerr();
#endif
sp[0].dval /= sp[1].dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
break;
case _MOD:
sp--;
if (TEST2(sp) != TWO_DOUBLES)
cast2_to_d(sp);
#ifdef NOINFO_SIGFPE
CHECK_DIVZERO(sp[1].dval);
#endif
sp[0].dval = fmod(sp[0].dval, sp[1].dval);
break;
case _POW:
sp--;
if (TEST2(sp) != TWO_DOUBLES)
cast2_to_d(sp);
sp[0].dval = pow(sp[0].dval, sp[1].dval);
break;
case _NOT:
/* evaluates to 0.0 or 1.0 */
reswitch_1:
switch (sp->type) {
case C_NOINIT:
sp->dval = 1.0;
break;
case C_DOUBLE:
sp->dval = sp->dval != 0.0 ? 0.0 : 1.0;
break;
case C_FIELDWIDTHS:
case C_STRING:
sp->dval = string(sp)->len ? 0.0 : 1.0;
free_STRING(string(sp));
break;
case C_STRNUM: /* test as a number */
sp->dval = sp->dval != 0.0 ? 0.0 : 1.0;
free_STRING(string(sp));
break;
case C_MBSTRN:
check_strnum(sp);
goto reswitch_1;
default:
bozo("bad type on eval stack");
}
sp->type = C_DOUBLE;
break;
case _TEST:
/* evaluates to 0.0 or 1.0 */
reswitch_2:
switch (sp->type) {
case C_NOINIT:
sp->dval = 0.0;
break;
case C_DOUBLE:
sp->dval = sp->dval != 0.0 ? 1.0 : 0.0;
break;
case C_FIELDWIDTHS:
case C_STRING:
sp->dval = string(sp)->len ? 1.0 : 0.0;
free_STRING(string(sp));
break;
case C_STRNUM: /* test as a number */
sp->dval = sp->dval != 0.0 ? 1.0 : 0.0;
free_STRING(string(sp));
break;
case C_MBSTRN:
check_strnum(sp);
goto reswitch_2;
default:
bozo("bad type on eval stack");
}
sp->type = C_DOUBLE;
break;
case _UMINUS:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
sp->dval = -sp->dval;
break;
case _UPLUS:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
break;
case _CAT:
{
size_t len1, len2;
char *str1, *str2;
STRING *b;
sp--;
if (TEST2(sp) != TWO_STRINGS)
cast2_to_s(sp);
str1 = string(sp)->str;
len1 = string(sp)->len;
str2 = string(sp + 1)->str;
len2 = string(sp + 1)->len;
b = new_STRING0(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 = (short) (cdp++)->op;
break;
case _BUILTIN:
case _PRINT:
sp = (*(PF_CP) (cdp++)->ptr) (sp);
break;
case _POST_INC:
cp = (CELL *) sp->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
sp->type = C_DOUBLE;
sp->dval = cp->dval;
cp->dval += 1.0;
break;
case _POST_DEC:
cp = (CELL *) sp->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
sp->type = C_DOUBLE;
sp->dval = cp->dval;
cp->dval -= 1.0;
break;
case _PRE_INC:
cp = (CELL *) sp->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
sp->dval = cp->dval += 1.0;
sp->type = C_DOUBLE;
break;
case _PRE_DEC:
cp = (CELL *) sp->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
sp->dval = cp->dval -= 1.0;
sp->type = C_DOUBLE;
break;
case F_POST_INC:
cp = (CELL *) sp->ptr;
cellcpy(&tc, cp);
cast1_to_d(&tc);
sp->type = C_DOUBLE;
sp->dval = tc.dval;
tc.dval += 1.0;
field_assign(cp, &tc);
break;
case F_POST_DEC:
cp = (CELL *) sp->ptr;
cellcpy(&tc, cp);
cast1_to_d(&tc);
sp->type = C_DOUBLE;
sp->dval = tc.dval;
tc.dval -= 1.0;
field_assign(cp, &tc);
break;
case F_PRE_INC:
cp = (CELL *) sp->ptr;
cast1_to_d(cellcpy(sp, cp));
sp->dval += 1.0;
field_assign(cp, sp);
break;
case F_PRE_DEC:
cp = (CELL *) sp->ptr;
cast1_to_d(cellcpy(sp, cp));
sp->dval -= 1.0;
field_assign(cp, sp);
break;
case _JMP:
cdp += cdp->op;
break;
case _JNZ:
/* jmp if top of stack is non-zero and pop stack */
if (test(sp))
cdp += cdp->op;
else
cdp++;
cell_destroy(sp);
sp--;
break;
case _JZ:
/* jmp if top of stack is zero and pop stack */
if (!test(sp))
cdp += cdp->op;
else
cdp++;
cell_destroy(sp);
sp--;
break;
case _LJZ:
/* special jump for logical and */
/* this is always preceded by _TEST */
if (sp->dval == 0.0) {
/* 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 (sp->dval != 0.0) {
/* 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:
t = compare(--sp);
sp->type = C_DOUBLE;
sp->dval = t == 0 ? 1.0 : 0.0;
break;
case _NEQ:
t = compare(--sp);
sp->type = C_DOUBLE;
sp->dval = t ? 1.0 : 0.0;
break;
case _LT:
t = compare(--sp);
sp->type = C_DOUBLE;
sp->dval = t < 0 ? 1.0 : 0.0;
break;
case _LTE:
t = compare(--sp);
sp->type = C_DOUBLE;
sp->dval = t <= 0 ? 1.0 : 0.0;
break;
case _GT:
t = compare(--sp);
sp->type = C_DOUBLE;
sp->dval = t > 0 ? 1.0 : 0.0;
break;
case _GTE:
t = compare(--sp);
sp->type = C_DOUBLE;
sp->dval = t >= 0 ? 1.0 : 0.0;
break;
case _MATCH0:
/* does $0 match, the RE at cdp? */
inc_sp();
if (field->type >= C_STRING) {
sp->type = C_DOUBLE;
sp->dval = (REtest(string(field)->str,
string(field)->len,
cast_to_re((cdp++)->ptr))
? 1.0
: 0.0);
break /* the case */ ;
} else {
cellcpy(sp, field);
/* and FALL THRU */
}
case _MATCH1:
/* does expr at sp[0] match RE at cdp */
if (sp->type < C_STRING)
cast1_to_s(sp);
t = REtest(string(sp)->str,
string(sp)->len,
cast_to_re((cdp++)->ptr));
free_STRING(string(sp));
sp->type = C_DOUBLE;
sp->dval = t ? 1.0 : 0.0;
break;
case _MATCH2:
/* does sp[-1] match sp[0] as re */
cast_to_RE(sp);
if ((--sp)->type < C_STRING)
cast1_to_s(sp);
t = REtest(string(sp)->str,
string(sp)->len,
cast_to_re((sp + 1)->ptr));
free_STRING(string(sp));
no_leaks_re_ptr((sp + 1)->ptr);
sp->type = C_DOUBLE;
sp->dval = t ? 1.0 : 0.0;
break;
case A_LENGTH:
sp--;
sp->type = C_DOUBLE;
sp->dval = (double) (((ARRAY) ((sp + 0)->ptr))->size);
break;
case A_TEST:
/* entry : sp[0].ptr-> an array
sp[-1] is an expression
we compute (expression in array) */
sp--;
cp = array_find((sp + 1)->ptr, sp, NO_CREATE);
cell_destroy(sp);
sp->type = C_DOUBLE;
sp->dval = (cp != (CELL *) 0) ? 1.0 : 0.0;
break;
case A_DEL:
/* sp[0].ptr -> array
sp[-1] is an expr
delete array[expr] */
array_delete(sp->ptr, sp - 1);
cell_destroy(sp - 1);
sp -= 2;
break;
case DEL_A:
/* free all the array at once */
array_clear(sp->ptr);
sp--;
break;
/* form a multiple array index */
case A_CAT:
sp = array_cat(sp, (cdp++)->op);
break;
case _EXIT:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
exit_code = d_to_i(sp->dval);
sp--;
/* fall thru */
case _EXIT0:
if (force_exit)
mawk_exit(exit_code);
cdp = end_start;
force_exit = 1; /* makes sure next exit exits */
if (begin_start) {
free_codes("BEGIN", begin_start, begin_size);
begin_start = 0;
begin_size = 0;
}
if (main_start) {
free_codes("MAIN", main_start, main_size);
main_start = 0;
main_size = 0;
}
sp = eval_stack - 1; /* might be in user function */
CLEAR_ALOOP_STACK(); /* ditto */
break;
case _JMAIN: /* go from BEGIN code to MAIN code */
free_codes("BEGIN", begin_start, begin_size);
begin_start = 0;
begin_size = 0;
cdp = main_start;
break;
case _OMAIN:
if (!main_fin)
open_main();
restart_label = cdp;
cdp = next_label;
break;
case _NEXT:
/* next might be inside an aloop -- clear stack */
CLEAR_ALOOP_STACK();
cdp = next_label;
break;
case _NEXTFILE:
/* nextfile might be inside an aloop -- clear stack */
CLEAR_ALOOP_STACK();
FINsemi_close(main_fin);
cdp = next_label;
break;
case OL_GL:
{
char *p;
size_t len;
if (!(p = FINgets(main_fin, &len))) {
if (force_exit)
mawk_exit(0);
cdp = end_start;
zfree(main_start, main_size);
main_start = (INST *) 0;
force_exit = 1;
} else {
set_field0(p, len);
cdp = restart_label;
rt_nr++;
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;
size_t len;
if (!(p = FINgets(main_fin, &len))) {
if (force_exit)
mawk_exit(0);
cdp = end_start;
zfree(main_start, main_size);
main_start = (INST *) 0;
force_exit = 1;
} else {
set_field0(p, len);
cdp = restart_label;
if (TEST2(NR) != TWO_DOUBLES)
cast2_to_d(NR);
NR->dval += 1.0;
rt_nr++;
FNR->dval += 1.0;
rt_fnr++;
}
}
break;
case _RANGE:
/* test a range pattern: pat1, pat2 { action }
entry :
cdp[0].op -- a flag, test pat1 if on else pat2
cdp[1].op -- offset of pat2 code from cdp
cdp[2].op -- offset of action code from cdp
cdp[3].op -- offset of code after the action from cdp
cdp[4] -- start of pat1 code
*/
#define FLAG cdp[0].op
#define PAT2 cdp[1].op
#define ACTION cdp[2].op
#define FOLLOW cdp[3].op
#define PAT1 4
if (FLAG) /* test against pat1 */
{
execute(cdp + PAT1, sp, fp);
t = test(sp + 1);
cell_destroy(sp + 1);
if (t)
FLAG = 0;
else {
cdp += FOLLOW;
break; /* break the switch */
}
}
/* test against pat2 and then perform the action */
execute(cdp + PAT2, sp, fp);
FLAG = test(sp + 1);
cell_destroy(sp + 1);
cdp += ACTION;
break;
/* function calls */
case _RET0:
inc_sp();
sp->type = C_NOINIT;
/* fall thru */
case _RET:
#ifdef DEBUG
if (sp != entry_sp + 1)
bozo("ret");
#endif
if (old_stack_base) /* reset stack */
{
/* move the return value */
cellcpy(old_sp + 1, sp);
cell_destroy(sp);
zfree(stack_base, sizeof(CELL) * EVAL_STACK_SIZE);
stack_base = old_stack_base;
stack_danger = old_stack_base + DANGER;
}
/* return might be inside an aloop -- clear stack */
CLEAR_ALOOP_STACK();
return;
case _CALL:
/* cdp[0] holds ptr to "function block"
cdp[1] holds number of input arguments
*/
{
FBLOCK *fbp = (FBLOCK *) (cdp++)->ptr;
int a_args = (cdp++)->op; /* actual number of args */
CELL *nfp = sp - a_args + 1; /* new fp for callee */
CELL *local_p = sp + 1; /* first local argument on stack */
char *type_p = 0; /* pts to type of an argument */
if (fbp->nargs)
type_p = fbp->typev + a_args - 1;
/* create space for locals */
t = fbp->nargs - a_args; /* t is number of locals */
while (t > 0) {
t--;
sp++;
type_p++;
sp->type = C_NOINIT;
if ((type_p) != 0 && (*type_p == ST_LOCAL_ARRAY))
sp->ptr = (PTR) new_ARRAY();
}
execute(fbp->code, sp, nfp);
/* cleanup the callee's arguments */
/* putting return value at top of eval stack */
if ((type_p != 0) && (sp >= nfp)) {
cp = sp + 1; /* cp -> the function return */
do {
if (*type_p == ST_LOCAL_ARRAY) {
if (sp >= local_p) {
array_clear(sp->ptr);
ZFREE((ARRAY) sp->ptr);
}
} else {
cell_destroy(sp);
}
type_p--;
sp--;
}
while (sp >= nfp);
cellcpy(++sp, cp);
cell_destroy(cp);
} else
sp++; /* no arguments passed */
}
break;
default:
bozo("bad opcode");
}
}
}
/* compare cells at cp and cp+1 and
frees STRINGs at those cells
*/
static int
compare(CELL *cp)
{
int result;
size_t len;
reswitch:
result = 0;
switch (TEST2(cp)) {
case TWO_NOINITS:
break;
case TWO_DOUBLES:
two_d:
result = ((cp->dval > (cp + 1)->dval)
? 1
: ((cp->dval < (cp + 1)->dval)
? -1
: 0));
break;
case TWO_STRINGS:
case STRING_AND_STRNUM:
two_s:
len = string(cp)->len;
if (len > string(cp + 1)->len)
len = string(cp + 1)->len;
result = memcmp(string(cp)->str, string(cp + 1)->str, len);
if (result == 0) {
if (len != string(cp)->len) {
result = 1;
} else if (len != string(cp + 1)->len) {
result = -1;
}
}
free_STRING(string(cp));
free_STRING(string(cp + 1));
break;
case NOINIT_AND_DOUBLE:
case NOINIT_AND_STRNUM:
case DOUBLE_AND_STRNUM:
case TWO_STRNUMS:
cast2_to_d(cp);
goto two_d;
case NOINIT_AND_STRING:
case DOUBLE_AND_STRING:
cast2_to_s(cp);
goto two_s;
case TWO_MBSTRNS:
check_strnum(cp);
check_strnum(cp + 1);
goto reswitch;
case NOINIT_AND_MBSTRN:
case DOUBLE_AND_MBSTRN:
case STRING_AND_MBSTRN:
case STRNUM_AND_MBSTRN:
check_strnum(cp->type == C_MBSTRN ? cp : cp + 1);
goto reswitch;
default: /* there are no default cases */
bozo("bad cell type passed to compare");
break;
}
return result;
}