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; }