예제 #1
0
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");
    }
}
예제 #2
0
/*
  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 */
}
예제 #3
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;
}
예제 #4
0
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;
}
예제 #5
0
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;
}
예제 #6
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");
	}
    }
}
예제 #7
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;
}
예제 #8
0
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);
    }
}
예제 #9
0
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");
    }
}
예제 #10
0
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 */
}
예제 #11
0
파일: fin.c 프로젝트: jhoughten/Ted-s-Repo
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;
}
예제 #12
0
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;
}
예제 #13
0
/*
 * 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;
}
예제 #14
0
/*
 * 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++;
    }
}