예제 #1
0
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;
}
예제 #2
0
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;
}
예제 #3
0
파일: field.c 프로젝트: jbroll/starbase
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") ;
   }
}
예제 #4
0
/* 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 */
}
예제 #5
0
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 ;

}
예제 #6
0
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);
}
예제 #7
0
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;
}
예제 #8
0
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++;
    }
}
예제 #9
0
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;
}
예제 #10
0
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 ;
}
예제 #11
0
static void
free_filenode(FILE_NODE * p)
{
#ifdef NO_LEAKS
    if (p->name != 0) {
	free_STRING(p->name);
    }
#endif
    zfree(p, sizeof(FILE_NODE));
}
예제 #12
0
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));
    }
}
예제 #13
0
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);
}
예제 #14
0
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;
}
예제 #15
0
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;
}
예제 #16
0
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;

}
예제 #17
0
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;
    }
}
예제 #18
0
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 ;
}
예제 #19
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;
}
예제 #20
0
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);
}
예제 #21
0
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;
}
예제 #22
0
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");
    }
}
예제 #23
0
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;
}
예제 #24
0
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;
}
예제 #25
0
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;
}
예제 #26
0
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;
}
예제 #27
0
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)) ;
}
예제 #28
0
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;
}
예제 #29
0
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");
	}
    }
}
예제 #30
0
/* 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;
}