static void print_cell(CELL *p, FILE *fp) { size_t len; switch (p->type) { case C_NOINIT: break; case C_MBSTRN: case C_STRING: case C_STRNUM: switch (len = string(p)->len) { case 0: break; case 1: putc(string(p)->str[0], fp); break; default: fwrite(string(p)->str, (size_t) 1, len, fp); } break; case C_DOUBLE: { Int ival = d_to_I(p->dval); /* integers print as "%[l]d" */ if ((double) ival == p->dval) fprintf(fp, INT_FMT, ival); else fprintf(fp, string(OFMT)->str, p->dval); } break; default: bozo("bad cell passed to print_cell"); } }
/* return 0 if a numeric is zero else return non-zero return 0 if a string is "" else return non-zero */ int test(CELL *cp) { reswitch: switch (cp->type) { case C_NOINIT: return 0; case C_STRNUM: /* test as a number */ case C_DOUBLE: return cp->dval != 0.0; case C_FIELDWIDTHS: case C_STRING: return (string(cp)->len != 0); case C_MBSTRN: check_strnum(cp); goto reswitch; default: bozo("bad cell type in call to test"); } return 0; /*can't get here: shutup */ }
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; }
CELL * cellcpy(CELL *target, CELL *source) { switch (target->type = source->type) { case C_NOINIT: case C_SPACE: case C_SNULL: break; case C_DOUBLE: target->dval = source->dval; break; case C_STRNUM: target->dval = source->dval; /* fall thru */ case C_FIELDWIDTHS: case C_REPL: case C_MBSTRN: case C_STRING: string(source)->ref_cnt++; /* fall thru */ case C_RE: target->ptr = source->ptr; break; case C_REPLV: replv_cpy(target, source); break; default: bozo("bad cell passed to cellcpy()"); break; } return target; }
void cast2_to_s(CELL * cp) { register Int lval; char xbuff[260]; switch (cp->type) { case C_NOINIT: null_str.ref_cnt++; cp->ptr = (PTR) & null_str; break; case C_DOUBLE: lval = d_to_I(cp->dval); if (lval == cp->dval) sprintf(xbuff, INT_FMT, lval); else sprintf(xbuff, string(CONVFMT)->str, cp->dval); cp->ptr = (PTR) new_STRING(xbuff); break; case C_STRING: goto two; case C_MBSTRN: case C_STRNUM: break; default: bozo("bad type on cast"); } cp->type = C_STRING; two: cp++; switch (cp->type) { case C_NOINIT: null_str.ref_cnt++; cp->ptr = (PTR) & null_str; break; case C_DOUBLE: lval = d_to_I(cp->dval); if (lval == cp->dval) sprintf(xbuff, INT_FMT, lval); else sprintf(xbuff, string(CONVFMT)->str, cp->dval); cp->ptr = (PTR) new_STRING(xbuff); break; case C_STRING: return; case C_MBSTRN: case C_STRNUM: break; default: bozo("bad type on cast"); } cp->type = C_STRING; }
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; }
static void build_field0(void) { #ifdef DEBUG if (nf < 0) bozo("nf <0 in build_field0"); #endif cell_destroy(field + 0); if (nf == 0) { field[0].type = C_STRING; field[0].ptr = (PTR) & null_str; null_str.ref_cnt++; } else if (nf == 1) { cellcpy(field, field + 1); } else { CELL c; STRING *ofs, *tail; size_t len; register CELL *cp; register char *p, *q; int cnt; CELL **fbp, *cp_limit; cast1_to_s(cellcpy(&c, OFS)); ofs = (STRING *) c.ptr; cast1_to_s(cellcpy(&c, field_ptr(nf))); tail = (STRING *) c.ptr; cnt = nf - 1; len = ((size_t) cnt) * ofs->len + tail->len; fbp = fbank; cp_limit = field + FBANK_SZ; cp = field + 1; while (cnt-- > 0) { if (cp->type < C_STRING) { /* use the string field temporarily */ if (cp->type == C_NOINIT) { cp->ptr = (PTR) & null_str; null_str.ref_cnt++; } else { /* its a double */ Int ival; char xbuff[260]; ival = d_to_I(cp->dval); if (ival == cp->dval) sprintf(xbuff, INT_FMT, ival); else sprintf(xbuff, string(CONVFMT)->str, cp->dval); cp->ptr = (PTR) new_STRING(xbuff); } } len += string(cp)->len; if (++cp == cp_limit) { cp = *++fbp; cp_limit = cp + FBANK_SZ; } } field[0].type = C_STRING; field[0].ptr = (PTR) new_STRING0(len); p = string(field)->str; /* walk it again , putting things together */ cnt = nf - 1; fbp = fbank; cp = field + 1; cp_limit = field + FBANK_SZ; while (cnt-- > 0) { memcpy(p, string(cp)->str, string(cp)->len); p += string(cp)->len; /* if not really string, free temp use of ptr */ if (cp->type < C_STRING) { free_STRING(string(cp)); } if (++cp == cp_limit) { cp = *++fbp; cp_limit = cp + FBANK_SZ; } /* add the separator */ q = ofs->str; while (*q) *p++ = *q++; } /* tack tail on the end */ memcpy(p, tail->str, tail->len); /* cleanup */ free_STRING(tail); free_STRING(ofs); } }
static void set_rs_shadow(void) { 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; case C_STRING: /* * Check for special case where we retained the cell as a string, * bypassing regular-expression compiling. */ if (string(&c)->len == 1) { rs_shadow.type = SEP_CHAR; rs_shadow.c = string(&c)->str[0]; break; } /* FALLTHRU */ default: bozo("bad cell in set_rs_shadow"); } }
int yylex(void) { register int c; token_lineno = lineno; #ifdef NO_LEAKS memset(&yylval, 0, sizeof(yylval)); #endif reswitch: switch (scan_code[NextUChar(c)]) { case 0: ct_ret(EOF); case SC_SPACE: goto reswitch; case SC_COMMENT: eat_comment(); goto reswitch; case SC_NL: lineno++; eat_nl(); ct_ret(NL); case SC_ESCAPE: while (scan_code[NextUChar(c)] == SC_SPACE) { ; /* empty */ }; if (c == '\n') { token_lineno = ++lineno; goto reswitch; } if (c == 0) ct_ret(EOF); un_next(); yylval.ival = '\\'; ct_ret(UNEXPECTED); case SC_SEMI_COLON: eat_nl(); ct_ret(SEMI_COLON); case SC_LBRACE: eat_nl(); brace_cnt++; ct_ret(LBRACE); case SC_PLUS: switch (next()) { case '+': yylval.ival = '+'; string_buff[0] = string_buff[1] = '+'; string_buff[2] = 0; ct_ret(INC_or_DEC); case '=': ct_ret(ADD_ASG); default: un_next(); ct_ret(PLUS); } case SC_MINUS: switch (next()) { case '-': yylval.ival = '-'; string_buff[0] = string_buff[1] = '-'; string_buff[2] = 0; ct_ret(INC_or_DEC); case '=': ct_ret(SUB_ASG); default: un_next(); ct_ret(MINUS); } case SC_COMMA: eat_nl(); ct_ret(COMMA); case SC_MUL: test1_ret('=', MUL_ASG, MUL); case SC_DIV: { static const int can_precede_div[] = {DOUBLE, STRING_, RPAREN, ID, D_ID, RE, RBOX, FIELD, GETLINE, INC_or_DEC, -1}; const int *p = can_precede_div; do { if (*p == current_token) { if (*p != INC_or_DEC) { test1_ret('=', DIV_ASG, DIV); } if (next() == '=') { un_next(); ct_ret(collect_RE()); } } } while (*++p != -1); ct_ret(collect_RE()); } case SC_MOD: test1_ret('=', MOD_ASG, MOD); case SC_POW: test1_ret('=', POW_ASG, POW); case SC_LPAREN: paren_cnt++; ct_ret(LPAREN); case SC_RPAREN: if (--paren_cnt < 0) { compile_error("extra ')'"); paren_cnt = 0; goto reswitch; } ct_ret(RPAREN); case SC_LBOX: ct_ret(LBOX); case SC_RBOX: ct_ret(RBOX); case SC_MATCH: string_buff[1] = '~'; string_buff[0] = 0; yylval.ival = 1; ct_ret(MATCH); case SC_EQUAL: test1_ret('=', EQ, ASSIGN); case SC_NOT: /* ! */ if ((c = next()) == '~') { string_buff[0] = '!'; string_buff[1] = '~'; string_buff[2] = 0; yylval.ival = 0; ct_ret(MATCH); } else if (c == '=') ct_ret(NEQ); un_next(); ct_ret(NOT); case SC_LT: /* '<' */ if (next() == '=') ct_ret(LTE); else un_next(); if (getline_flag) { getline_flag = 0; ct_ret(IO_IN); } else ct_ret(LT); case SC_GT: /* '>' */ if (print_flag && paren_cnt == 0) { print_flag = 0; /* there are 3 types of IO_OUT -- build the error string in string_buff */ string_buff[0] = '>'; if (next() == '>') { yylval.ival = F_APPEND; string_buff[1] = '>'; string_buff[2] = 0; } else { un_next(); yylval.ival = F_TRUNC; string_buff[1] = 0; } return current_token = IO_OUT; } test1_ret('=', GTE, GT); case SC_OR: if (next() == '|') { eat_nl(); ct_ret(OR); } else { un_next(); if (print_flag && paren_cnt == 0) { print_flag = 0; yylval.ival = PIPE_OUT; string_buff[0] = '|'; string_buff[1] = 0; ct_ret(IO_OUT); } else ct_ret(PIPE); } case SC_AND: if (next() == '&') { eat_nl(); ct_ret(AND); } else { un_next(); yylval.ival = '&'; ct_ret(UNEXPECTED); } case SC_QMARK: ct_ret(QMARK); case SC_COLON: ct_ret(COLON); case SC_RBRACE: if (--brace_cnt < 0) { compile_error("extra '}'"); eat_semi_colon(); brace_cnt = 0; goto reswitch; } if ((c = current_token) == NL || c == SEMI_COLON || c == SC_FAKE_SEMI_COLON || c == RBRACE) { /* if the brace_cnt is zero , we've completed a pattern action block. If the user insists on adding a semi-colon on the same line we will eat it. Note what we do below: physical law -- conservation of semi-colons */ if (brace_cnt == 0) eat_semi_colon(); eat_nl(); ct_ret(RBRACE); } /* supply missing semi-colon to statement that precedes a '}' */ brace_cnt++; un_next(); current_token = SC_FAKE_SEMI_COLON; return SEMI_COLON; case SC_DIGIT: case SC_DOT: { double d; int flag; if ((d = collect_decimal(c, &flag)) == 0.0) { if (flag) ct_ret(flag); else yylval.ptr = (PTR) & double_zero; } else if (d == 1.0) { yylval.ptr = (PTR) & double_one; } else { yylval.ptr = (PTR) ZMALLOC(double); *(double *) yylval.ptr = d; } ct_ret(DOUBLE); } case SC_DOLLAR: /* '$' */ { double d; int flag; while (scan_code[NextUChar(c)] == SC_SPACE) { ; /* empty */ }; if (scan_code[c] != SC_DIGIT && scan_code[c] != SC_DOT) { un_next(); ct_ret(DOLLAR); } /* compute field address at compile time */ if ((d = collect_decimal(c, &flag)) <= 0.0) { if (flag) ct_ret(flag); /* an error */ else yylval.cp = &field[0]; } else { int ival = d_to_I(d); double dval = (double) ival; if (dval != d) { compile_error("$%g is invalid field index", d); } yylval.cp = field_ptr(ival); } ct_ret(FIELD); } case SC_DQUOTE: return current_token = collect_string(); case SC_IDCHAR: /* collect an identifier */ { char *p = string_buff + 1; SYMTAB *stp; string_buff[0] = (char) c; while (1) { CheckStringSize(p); c = scan_code[NextUChar(*p++)]; if (c != SC_IDCHAR && c != SC_DIGIT) break; } un_next(); *--p = 0; switch ((stp = find(string_buff))->type) { case ST_NONE: /* check for function call before defined */ if (next() == '(') { stp->type = ST_FUNCT; stp->stval.fbp = (FBLOCK *) zmalloc(sizeof(FBLOCK)); stp->stval.fbp->name = stp->name; stp->stval.fbp->code = (INST *) 0; stp->stval.fbp->size = 0; yylval.fbp = stp->stval.fbp; current_token = FUNCT_ID; } else { yylval.stp = stp; current_token = current_token == DOLLAR ? D_ID : ID; } un_next(); break; case ST_NR: NR_flag = 1; stp->type = ST_VAR; /* FALLTHRU */ case ST_VAR: case ST_ARRAY: case ST_LOCAL_NONE: case ST_LOCAL_VAR: case ST_LOCAL_ARRAY: yylval.stp = stp; current_token = current_token == DOLLAR ? D_ID : ID; break; case ST_ENV: stp->type = ST_ARRAY; stp->stval.array = new_ARRAY(); load_environ(stp->stval.array); yylval.stp = stp; current_token = current_token == DOLLAR ? D_ID : ID; break; case ST_FUNCT: yylval.fbp = stp->stval.fbp; current_token = FUNCT_ID; break; case ST_KEYWORD: current_token = stp->stval.kw; break; case ST_BUILTIN: yylval.bip = stp->stval.bip; current_token = BUILTIN; break; case ST_LENGTH: yylval.bip = stp->stval.bip; /* check for length alone, this is an ugly hack */ while (scan_code[NextUChar(c)] == SC_SPACE) { ; /* empty */ }; un_next(); current_token = c == '(' ? BUILTIN : LENGTH; break; case ST_FIELD: yylval.cp = stp->stval.cp; current_token = FIELD; break; default: bozo("find returned bad st type"); } return current_token; } case SC_UNEXPECTED: yylval.ival = c & 0xff; ct_ret(UNEXPECTED); } return 0; /* never get here make lint happy */ }
char * FINgets(FIN * fin, size_t *len_p) { char *p; char *q = 0; size_t match_len; size_t r; restart: if ((p = fin->buffp) >= fin->limit) { /* need a refill */ if (fin->flags & EOF_FLAG) { if (fin->flags & MAIN_FLAG) { fin = next_main(0); goto restart; } else { *len_p = 0; return (char *) 0; } } if (fin->fp) { /* line buffering */ if (!fgets(fin->buff, BUFFSZ + 1, fin->fp)) { fin->flags |= EOF_FLAG; fin->buff[0] = 0; fin->buffp = fin->buff; fin->limit = fin->buffp; goto restart; /* might be main_fin */ } else { /* return this line */ /* find eol */ p = fin->buff; while (*p != '\n' && *p != 0) p++; *p = 0; *len_p = (unsigned) (p - fin->buff); fin->buffp = p; fin->limit = fin->buffp + strlen(fin->buffp); return fin->buff; } } else { /* block buffering */ r = fillbuff(fin->fd, fin->buff, (size_t) (fin->nbuffs * BUFFSZ)); if (r == 0) { fin->flags |= EOF_FLAG; fin->buffp = fin->buff; fin->limit = fin->buffp; goto restart; /* might be main */ } else if (r < fin->nbuffs * BUFFSZ) { fin->flags |= EOF_FLAG; } fin->limit = fin->buff + r; p = fin->buffp = fin->buff; if (fin->flags & START_FLAG) { fin->flags &= ~START_FLAG; if (rs_shadow.type == SEP_MLR) { /* trim blank lines from front of file */ while (*p == '\n') p++; fin->buffp = p; if (p >= fin->limit) goto restart; } } } } retry: switch (rs_shadow.type) { case SEP_CHAR: q = memchr(p, rs_shadow.c, (size_t) (fin->limit - p)); match_len = 1; break; case SEP_STR: q = str_str(p, (size_t) (fin->limit - p), ((STRING *) rs_shadow.ptr)->str, match_len = ((STRING *) rs_shadow.ptr)->len); break; case SEP_MLR: case SEP_RE: q = re_pos_match(p, (size_t) (fin->limit - p), rs_shadow.ptr, &match_len); /* if the match is at the end, there might still be more to match in the file */ if (q && q[match_len] == 0 && !(fin->flags & EOF_FLAG)) q = (char *) 0; break; default: bozo("type of rs_shadow"); } if (q) { /* the easy and normal case */ *q = 0; *len_p = (unsigned) (q - p); fin->buffp = q + match_len; return p; } if (fin->flags & EOF_FLAG) { /* last line without a record terminator */ *len_p = r = (unsigned) (fin->limit - p); fin->buffp = p + r; if (rs_shadow.type == SEP_MLR && fin->buffp[-1] == '\n' && r != 0) { (*len_p)--; *--fin->buffp = 0; fin->limit--; } return p; } if (p == fin->buff) { /* current record is too big for the input buffer, grow buffer */ p = enlarge_fin_buffer(fin); } else { /* move a partial line to front of buffer and try again */ size_t rr; size_t amount = (size_t) (fin->limit - p); size_t blocks = fin->nbuffs * BUFFSZ; r = amount; if (blocks < r) { fin->flags |= EOF_FLAG; return 0; } p = (char *) memmove(fin->buff, p, r); q = p + r; rr = blocks - r; if ((r = fillbuff(fin->fd, q, rr)) < rr) { fin->flags |= EOF_FLAG; fin->limit = fin->buff + amount + r; } } goto retry; }
void cast2_to_d(CELL *cp) { register STRING *s; switch (cp->type) { case C_NOINIT: cp->dval = 0.0; break; case C_DOUBLE: goto two; case C_STRNUM: free_STRING(string(cp)); break; case C_MBSTRN: case C_STRING: s = (STRING *) cp->ptr; errno = 0; #ifdef FPE_TRAPS_ON /* look for overflow error */ 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; default: bozo("cast on bad type"); } cp->type = C_DOUBLE; two: cp++; switch (cp->type) { case C_NOINIT: cp->dval = 0.0; break; case C_DOUBLE: return; case C_STRNUM: free_STRING(string(cp)); break; case C_MBSTRN: case C_STRING: s = (STRING *) cp->ptr; errno = 0; #ifdef FPE_TRAPS_ON /* look for overflow error */ 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; default: bozo("cast on bad type"); } cp->type = C_DOUBLE; }
/* * Find a file on file_list. Outputs return a FILE*, while inputs return FIN*. */ PTR file_find(STRING * sval, int type) { PTR result = 0; FILE_NODE *p; FILE_NODE *q; char *name = sval->str; TRACE(("file_find(%s, %d)\n", name, type)); for (q = 0, p = file_list; p != 0; q = p, p = p->link) { /* search is by name and type */ if (strcmp(name, p->name->str) == 0 && (p->type == type || /* no distinction between F_APPEND and F_TRUNC here */ (p->type >= F_APPEND && type >= F_APPEND))) { if (q != 0) { /* delete from list for move to front */ q->link = p->link; } break; /* while loop */ } } if (!p) { /* open a new one */ p = alloc_filenode(); switch (p->type = (short) type) { case F_TRUNC: if (!(p->ptr = (PTR) tfopen(name, BinMode2("wb", "w")))) output_failed(name); break; case F_APPEND: if (!(p->ptr = (PTR) tfopen(name, BinMode2("ab", "a")))) output_failed(name); break; case F_IN: p->ptr = (PTR) FINopen(name, 0); break; case PIPE_OUT: case PIPE_IN: #if defined(HAVE_REAL_PIPES) || defined(HAVE_FAKE_PIPES) if (!(p->ptr = get_pipe(name, type, &p->pid))) { if (type == PIPE_OUT) output_failed(name); } #else rt_error("pipes not supported"); #endif break; #ifdef DEBUG default: bozo("bad file type"); #endif } } else if (p->ptr == 0 && type == F_IN) { p->ptr = (PTR) FINopen(name, 0); } /* put p at the front of the list */ if (p->ptr == 0) { free_filenode(p); } else { if (p != file_list) { p->link = file_list; file_list = p; } /* successful open */ p->name = sval; sval->ref_cnt++; TRACE(("-> %p\n", p->ptr)); result = p->ptr; } return result; }
/* * Note: caller must do CELL cleanup. * The format parameter is modified, but restored. * * This routine does both printf and sprintf (if fp==0) */ static STRING * do_printf( FILE *fp, char *format, unsigned argcnt, /* number of args on eval stack */ CELL *cp) /* ptr to an array of arguments (on the eval stack) */ { char save; char *p; register char *q = format; register char *target; int l_flag, h_flag; /* seen %ld or %hd */ int ast_cnt; int ast[2]; UInt Uval = 0; Int Ival = 0; int sfmt_width, sfmt_prec, sfmt_flags, s_format; int num_conversion = 0; /* for error messages */ const char *who; /*ditto */ int pf_type = 0; /* conversion type */ PRINTER printer; /* pts at fprintf() or sprintf() */ STRING onechr; #ifdef SHORT_INTS char xbuff[256]; /* splice in l qualifier here */ #endif if (fp == (FILE *) 0) { /* doing sprintf */ target = sprintf_buff; printer = (PRINTER) sprintf; who = "sprintf"; } else { /* doing printf */ target = (char *) fp; /* will never change */ printer = (PRINTER) fprintf; who = "printf"; } while (1) { if (fp) { /* printf */ while (*q != '%') { if (*q == 0) { if (ferror(fp)) write_error(); /* return is ignored */ return (STRING *) 0; } else { putc(*q, fp); q++; } } } else { /* sprintf */ while (*q != '%') { if (*q == 0) { if (target > sprintf_limit) /* damaged */ { /* hope this works */ rt_overflow("sprintf buffer", (unsigned) (sprintf_limit - sprintf_buff)); } else { /* really done */ return new_STRING1(sprintf_buff, (size_t) (target - sprintf_buff)); } } else { *target++ = *q++; } } } /* *q == '%' */ num_conversion++; if (*++q == '%') { /* %% */ if (fp) putc(*q, fp); else *target++ = *q; q++; continue; } /* mark the '%' with p */ p = q - 1; /* eat the flags */ while (*q == '-' || *q == '+' || *q == ' ' || *q == '#' || *q == '0') q++; ast_cnt = 0; ast[0] = 0; if (*q == '*') { if (cp->type != C_DOUBLE) cast1_to_d(cp); ast[ast_cnt++] = d_to_i(cp++->dval); argcnt--; q++; } else while (scan_code[*(unsigned char *) q] == SC_DIGIT) q++; /* width is done */ if (*q == '.') { /* have precision */ q++; if (*q == '*') { if (cp->type != C_DOUBLE) cast1_to_d(cp); ast[ast_cnt++] = d_to_i(cp++->dval); argcnt--; q++; } else { while (scan_code[*(unsigned char *) q] == SC_DIGIT) q++; } } if (argcnt <= 0) rt_error("not enough arguments passed to %s(\"%s\")", who, format); l_flag = h_flag = 0; if (*q == 'l') { q++; l_flag = 1; } else if (*q == 'h') { q++; h_flag = 1; } switch (*q++) { case 's': if (l_flag + h_flag) bad_conversion(num_conversion, who, format); if (cp->type < C_STRING) cast1_to_s(cp); pf_type = PF_S; break; case 'c': if (l_flag + h_flag) bad_conversion(num_conversion, who, format); switch (cp->type) { case C_NOINIT: Ival = 0; break; case C_STRNUM: case C_DOUBLE: Ival = d_to_I(cp->dval); break; case C_STRING: /* fall thru to check for bad number formats */ //Ival = string(cp)->str[0]; //break; /* fall thru */ case C_FIELDWIDTHS: case C_MBSTRN: check_strnum(cp); Ival = ((cp->type == C_STRING) ? string(cp)->str[0] : d_to_I(cp->dval)); break; default: bozo("printf %c"); } onechr.len = 1; onechr.str[0] = (char) Ival; pf_type = PF_C; break; case 'd': case 'i': if (cp->type != C_DOUBLE) cast1_to_d(cp); Ival = d_to_I(cp->dval); pf_type = PF_D; break; case 'o': case 'x': case 'X': case 'u': if (cp->type != C_DOUBLE) cast1_to_d(cp); Uval = d_to_U(cp->dval); pf_type = PF_U; break; case 'e': case 'g': case 'f': case 'E': case 'G': if (h_flag + l_flag) bad_conversion(num_conversion, who, format); if (cp->type != C_DOUBLE) cast1_to_d(cp); pf_type = PF_F; break; default: bad_conversion(num_conversion, who, format); } save = *q; *q = 0; #ifdef SHORT_INTS if (pf_type == PF_D) { /* need to splice in long modifier */ strcpy(xbuff, p); if (l_flag) /* do nothing */ ; else { int k = q - p; if (h_flag) { Ival = (short) Ival; /* replace the 'h' with 'l' (really!) */ xbuff[k - 2] = 'l'; if (xbuff[k - 1] != 'd' && xbuff[k - 1] != 'i') Ival &= 0xffff; } else { /* the usual case */ xbuff[k] = xbuff[k - 1]; xbuff[k - 1] = 'l'; xbuff[k + 1] = 0; } } } #endif #define PUTS_C_ARGS target, fp, 0, &onechr, sfmt_width, sfmt_prec, sfmt_flags #define PUTS_S_ARGS target, fp, cp, 0, sfmt_width, sfmt_prec, sfmt_flags /* ready to call printf() */ s_format = 0; switch (AST(ast_cnt, pf_type)) { case AST(0, PF_C): /* FALLTHRU */ case AST(1, PF_C): /* FALLTHRU */ case AST(2, PF_C): s_format = 1; make_sfmt(p, ast, &sfmt_width, &sfmt_prec, &sfmt_flags); target = puts_sfmt(PUTS_C_ARGS); break; case AST(0, PF_S): /* FALLTHRU */ case AST(1, PF_S): /* FALLTHRU */ case AST(2, PF_S): s_format = 1; make_sfmt(p, ast, &sfmt_width, &sfmt_prec, &sfmt_flags); target = puts_sfmt(PUTS_S_ARGS); break; #ifdef SHORT_INTS #define FMT xbuff /* format in xbuff */ #else #define FMT p /* p -> format */ #endif case AST(0, PF_D): if (cp->dval > Max_Int && l_flag == 0 && h_flag == 0) { STRING *newp; char *np; newp = new_STRING0(strlen(p)+5); np = (char *) newp->str; while (*p != '\0') { if (*p == 'd' || *p == 'i') { *np++ = '.'; *np++ = '0'; *np++ = 'f'; ++p; } else *np++ = *p++; } np = '\0'; (*printer) ((PTR) target, newp->str, cp->dval); free_STRING(newp); } else (*printer) ((PTR) target, FMT, Ival); break; case AST(1, PF_D): (*printer) ((PTR) target, FMT, ast[0], Ival); break; case AST(2, PF_D): (*printer) ((PTR) target, FMT, ast[0], ast[1], Ival); break; case AST(0, PF_U): if (*(p+1) == 'u' && cp->dval > Max_Int ) { STRING *newp; char *np; newp = new_STRING0(strlen(p)+5); np = (char *) newp->str; while (*p != '\0') { if (*p == 'u') { *np++ = '.'; *np++ = '0'; *np++ = 'f'; ++p; } else *np++ = *p++; } np = '\0'; (*printer) ((PTR) target, newp->str, cp->dval); free_STRING(newp); } else (*printer) ((PTR) target, FMT, Uval); break; case AST(1, PF_U): (*printer) ((PTR) target, FMT, ast[0], Uval); break; case AST(2, PF_U): (*printer) ((PTR) target, FMT, ast[0], ast[1], Uval); break; #undef FMT case AST(0, PF_F): (*printer) ((PTR) target, p, cp->dval); break; case AST(1, PF_F): (*printer) ((PTR) target, p, ast[0], cp->dval); break; case AST(2, PF_F): (*printer) ((PTR) target, p, ast[0], ast[1], cp->dval); break; } if (fp == (FILE *) 0 && !s_format) { while (*target) target++; } *q = save; argcnt--; cp++; } }