Exemple #1
0
/* Set up the next sample */
static int
screen_sample(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    gs_screen_enum *penum = senum;
    gs_point pt;
    int code = gs_screen_currentpoint(penum, &pt);
    ref proc;

    switch (code) {
        default:
            return code;
        case 1:
            /* All done */
            if (real_opproc(esp - 2) != 0)
                code = (*real_opproc(esp - 2)) (i_ctx_p);
            esp -= snumpush;
            screen_cleanup(i_ctx_p);
            return (code < 0 ? code : o_pop_estack);
        case 0:
            ;
    }
    push(2);
    make_real(op - 1, pt.x);
    make_real(op, pt.y);
    proc = sproc;
    push_op_estack(set_screen_continue);
    *++esp = proc;
    return o_push_estack;
}
Exemple #2
0
// (atan x)
// (atan x y)
Cell* op_atan(Scheme *sc) {
	Cell* x = first(sc->args);
	if (rest(sc->args) == &g_nil) {
		return s_return_helper(sc, make_real(sc, atan(double_value(x))));
	} else {
		Cell* y = second(sc->args);
		return s_return_helper(sc,
				make_real(sc, atan2(double_value(x), double_value(y))));
	}
}
Exemple #3
0
// (truncate x)
Cell* op_truncate(Scheme *sc) {
	Cell* num = first(sc->args);

	double doubleValue = double_value(num);
	if (doubleValue > 0) {
		return s_return_helper(sc, make_real(sc, floor(doubleValue)));
	} else {
		return s_return_helper(sc, make_real(sc, ceil(doubleValue)));
	}
}
Exemple #4
0
/* Common logic for [i][d]transform */
static int
common_transform(i_ctx_t *i_ctx_p,
        int (*ptproc)(gs_state *, double, double, gs_point *),
        int (*matproc)(double, double, const gs_matrix *, gs_point *))
{
    os_ptr op = osp;
    double opxy[2];
    gs_point pt;
    int code;

    /* Optimize for the non-matrix case */
    switch (r_type(op)) {
        case t_real:
            opxy[1] = op->value.realval;
            break;
        case t_integer:
            opxy[1] = (double)op->value.intval;
            break;
        case t_array:		/* might be a matrix */
        case t_shortarray:
        case t_mixedarray: {
            gs_matrix mat;
            gs_matrix *pmat = &mat;

            if ((code = read_matrix(imemory, op, pmat)) < 0 ||
                (code = num_params(op - 1, 2, opxy)) < 0 ||
                (code = (*matproc) (opxy[0], opxy[1], pmat, &pt)) < 0
                ) {		/* Might be a stack underflow. */
                check_op(3);
                return code;
            }
            op--;
            pop(1);
            goto out;
        }
        default:
            return_op_typecheck(op);
    }
    switch (r_type(op - 1)) {
        case t_real:
            opxy[0] = (op - 1)->value.realval;
            break;
        case t_integer:
            opxy[0] = (double)(op - 1)->value.intval;
            break;
        default:
            return_op_typecheck(op - 1);
    }
    if ((code = (*ptproc) (igs, opxy[0], opxy[1], &pt)) < 0)
        return code;
out:
    make_real(op - 1, pt.x);
    make_real(op, pt.y);
    return 0;
}
int
zfor(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    register es_ptr ep;
    int code;
    float params[3];

        /* Mostly undocumented, and somewhat bizarre Adobe behavior discovered	*/
        /* with the CET (28-05) and FTS (124-01) is that the proc is not run	*/
        /* if BOTH the initial value and increment are zero.			*/
    if ((code = float_params(op - 1, 3, params)) < 0)
        return code;
    if ( params[0] == 0.0 && params[1] == 0.0 ) {
        pop(4);		/* don't run the proc */
        return 0;
    }
    check_estack(7);
    ep = esp + 6;
    check_proc(*op);
    /* Push a mark, the control variable set to the initial value, */
    /* the increment, the limit, and the procedure, */
    /* and invoke the continuation operator. */
    if (r_has_type(op - 3, t_integer) &&
        r_has_type(op - 2, t_integer)
        ) {
        make_int(ep - 4, op[-3].value.intval);
        make_int(ep - 3, op[-2].value.intval);
        switch (r_type(op - 1)) {
            case t_integer:
                make_int(ep - 2, op[-1].value.intval);
                break;
            case t_real:
                make_int(ep - 2, (long)op[-1].value.realval);
                break;
            default:
                return_op_typecheck(op - 1);
        }
        if (ep[-3].value.intval >= 0)
            make_op_estack(ep, for_pos_int_continue);
        else
            make_op_estack(ep, for_neg_int_continue);
    } else {
        make_real(ep - 4, params[0]);
        make_real(ep - 3, params[1]);
        make_real(ep - 2, params[2]);
        make_op_estack(ep, for_real_continue);
    }
    make_mark_estack(ep - 5, es_for, no_cleanup);
    ref_assign(ep - 1, op);
    esp = ep;
    pop(4);
    return o_push_estack;
}
Exemple #6
0
/* - .currenthalftone <red_freq> ... <gray_proc> 2 */
static int
zcurrenthalftone(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    gs_halftone ht;

    gs_currenthalftone(igs, &ht);
    switch (ht.type) {
        case ht_type_screen:
            push(4);
            make_real(op - 3, ht.params.screen.frequency);
            make_real(op - 2, ht.params.screen.angle);
            op[-1] = istate->screen_procs.gray;
            make_int(op, 1);
            break;
        case ht_type_colorscreen:
            push(13);
            {
                os_ptr opc = op - 12;
                gs_screen_halftone *pht =
                    &ht.params.colorscreen.screens.colored.red;

                make_real(opc, pht->frequency);
                make_real(opc + 1, pht->angle);
                opc[2] = istate->screen_procs.red;

                opc = op - 9;
                pht = &ht.params.colorscreen.screens.colored.green;
                make_real(opc, pht->frequency);
                make_real(opc + 1, pht->angle);
                opc[2] = istate->screen_procs.green;

                opc = op - 6;
                pht = &ht.params.colorscreen.screens.colored.blue;
                make_real(opc, pht->frequency);
                make_real(opc + 1, pht->angle);
                opc[2] = istate->screen_procs.blue;

                opc = op - 3;
                pht = &ht.params.colorscreen.screens.colored.gray;
                make_real(opc, pht->frequency);
                make_real(opc + 1, pht->angle);
                opc[2] = istate->screen_procs.gray;
            }
            make_int(op, 2);
            break;
        default:		/* Screen was set by sethalftone. */
            push(2);
            op[-1] = istate->halftone;
            make_int(op, 0);
            break;
    }
    return 0;
}
Exemple #7
0
/* This is exported for .glyphwidth (in zcharx.c). */
int
finish_stringwidth(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    gs_point width;

    gs_text_total_width(senum, &width);
    push(2);
    make_real(op - 1, width.x);
    make_real(op, width.y);
    return 0;
}
Exemple #8
0
/* - .currentfilladjust2 <adjust.x> <adjust.y> */
static int
zcurrentfilladjust2(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    gs_point adjust;

    push(2);
    gs_currentfilladjust(igs, &adjust);
    make_real(op - 1, adjust.x);
    make_real(op, adjust.y);
    return 0;
}
Exemple #9
0
/* pathbbox */
int
zpathbbox(register os_ptr op)
{	gs_rect box;
	int code = gs_pathbbox(igs, &box);
	if ( code < 0 ) return code;
	push(4);
	make_real(op - 3, box.p.x);
	make_real(op - 2, box.p.y);
	make_real(op - 1, box.q.x);
	make_real(op, box.q.y);
	return 0;
}
Exemple #10
0
/* <num1> <num2> mul <product> */
int
zmul(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;

    switch (r_type(op)) {
    default:
	return_op_typecheck(op);
    case t_real:
	switch (r_type(op - 1)) {
	default:
	    return_op_typecheck(op - 1);
	case t_real:
	    op[-1].value.realval *= op->value.realval;
	    break;
	case t_integer:
	    make_real(op - 1, (double)op[-1].value.intval * op->value.realval);
	}
	break;
    case t_integer:
	switch (r_type(op - 1)) {
	default:
	    return_op_typecheck(op - 1);
	case t_real:
	    op[-1].value.realval *= (double)op->value.intval;
	    break;
	case t_integer: {
	    int int1 = op[-1].value.intval;
	    int int2 = op->value.intval;
	    uint abs1 = (uint)(int1 >= 0 ? int1 : -int1);
	    uint abs2 = (uint)(int2 >= 0 ? int2 : -int2);
	    float fprod;

	    if ((abs1 > MAX_HALF_INTVAL || abs2 > MAX_HALF_INTVAL) &&
		/* At least one of the operands is very large. */
		/* Check for integer overflow. */
		abs1 != 0 &&
		abs2 > MAX_INTVAL / abs1 &&
		/* Check for the boundary case */
		(fprod = (float)int1 * int2,
		 (int1 * int2 != MIN_INTVAL ||
		  fprod != (float)MIN_INTVAL))
		)
		make_real(op - 1, fprod);
	    else
		op[-1].value.intval = int1 * int2;
	}
	}
    }
    pop(1);
    return 0;
}
Exemple #11
0
/* Internal procedure to push one or more points */
static void
pf_push(i_ctx_t *i_ctx_p, gs_point * ppts, int n)
{
    os_ptr op = osp;

    while (n--) {
	op += 2;
	make_real(op - 1, ppts->x);
	make_real(op, ppts->y);
	ppts++;
    }
    osp = op;
}
Exemple #12
0
/* Calculate bonding box of a box transformed by a matrix. */
static int
zbbox_transform(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    gs_matrix m;
    float bbox[4];
    gs_point aa, az, za, zz;
    double temp;
    int code;

    if ((code = read_matrix(imemory, op, &m)) < 0)
        return code;

    if (!r_is_array(op - 1))
        return_op_typecheck(op - 1);
    check_read(op[-1]);
    if (r_size(op - 1) != 4)
        return_error(gs_error_rangecheck);
    if ((code = process_float_array(imemory, op - 1, 4, bbox) < 0))
        return code;

    gs_point_transform(bbox[0], bbox[1], &m, &aa);
    gs_point_transform(bbox[0], bbox[3], &m, &az);
    gs_point_transform(bbox[2], bbox[1], &m, &za);
    gs_point_transform(bbox[2], bbox[3], &m, &zz);

    if ( aa.x > az.x)
        temp = aa.x, aa.x = az.x, az.x = temp;
    if ( za.x > zz.x)
        temp = za.x, za.x = zz.x, zz.x = temp;
    if ( za.x < aa.x)
        aa.x = za.x;  /* min */
    if ( az.x > zz.x)
        zz.x = az.x;  /* max */

    if ( aa.y > az.y)
        temp = aa.y, aa.y = az.y, az.y = temp;
    if ( za.y > zz.y)
        temp = za.y, za.y = zz.y, zz.y = temp;
    if ( za.y < aa.y)
        aa.y = za.y;  /* min */
    if ( az.y > zz.y)
        zz.y = az.y;  /* max */

    push(2);
    make_real(op - 3, (float)aa.x);
    make_real(op - 2, (float)aa.y);
    make_real(op - 1, (float)zz.x);
    make_real(op    , (float)zz.y);
    return 0;
}
Exemple #13
0
/* - currentpoint <x> <y> */
static int
zcurrentpoint(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    gs_point pt;
    int code = gs_currentpoint(igs, &pt);

    if (code < 0)
        return code;
    push(2);
    make_real(op - 1, pt.x);
    make_real(op, pt.y);
    return 0;
}
Exemple #14
0
// (expt x y)
Cell* op_expt(Scheme *sc) {
	Cell* x = first(sc->args);
	Cell* y = second(sc->args);

	double result;
	int real_result = TRUE;

	if (x->_num.isFix && y->_num.isFix)
		real_result = FALSE;
	/* This 'if' is an R5RS compatibility fix. */
	/* NOTE: Remove this 'if' fix for R6RS.    */
	if (double_value(x) == 0 && double_value(y) < 0) {
		result = 0.0;
	} else {
		result = pow(double_value(x), double_value(y));
	}
	/* Before returning integer result make sure we can. */
	/* If the test fails, result is too big for integer. */
	if (!real_result) {
		long result_as_long = (long) result; //如果result有小数位,必然导致result_as_long和result不相等
		if (result != (double) result_as_long)
			real_result = TRUE;
	}
	if (real_result) {
		return s_return_helper(sc, make_real(sc, result));
	} else {
		return s_return_helper(sc, make_integer(sc, (long) result));
	}
}
Exemple #15
0
// (round x)
Cell* op_round(Scheme *sc) {
	Cell* num = first(sc->args);

	if (num->_num.isFix)
		return s_return_helper(sc, num);
	return s_return_helper(sc, make_real(sc, round_per_r5rs(double_value(num))));
}
Exemple #16
0
/*
 * Set up to collect the next sampled data value.
 */
static int
sampled_data_sample(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    gs_sampled_data_enum *penum = senum;
    ref proc;
    gs_function_Sd_params_t * params =
                        (gs_function_Sd_params_t *)&penum->pfn->params;
    int num_inputs = params->m;
    int i;

    /* Put set of input values onto the stack. */
    push(num_inputs);
    for (i = 0; i < num_inputs; i++) {
        double dmin = params->Domain[2 * i];
        double dmax = params->Domain[2 * i + 1];

        make_real(op - num_inputs + i + 1, (float) (
            penum->indexes[i] * (dmax - dmin)/(params->Size[i] - 1) + dmin));
    }

    proc = sample_proc;			    /* Get procedure from storage */
    push_op_estack(sampled_data_continue);  /* Put 'save' routine on estack, after sample proc */
    *++esp = proc;			    /* Put procedure to be executed */
    return o_push_estack;
}
Exemple #17
0
/* Ws Bs Wd Bd Ps .transformPQR_scale_wb[012] Pd

   The default TransformPQR procedure is implemented in C, rather than
   PostScript, as a speed optimization.

   This TransformPQR implements a relative colorimetric intent by scaling
   the XYZ values relative to the white and black points.
*/
static int
ztpqr_scale_wb_common(i_ctx_t *i_ctx_p, int idx)
{
    os_ptr op = osp;
    double a[4], Ps; /* a[0] = ws, a[1] = bs, a[2] = wd, a[3] = bd */
    double result;
    int code;
    int i;

    code = real_param(op, &Ps);
    if (code < 0) return code;

    for (i = 0; i < 4; i++) {
	ref tmp;

	code = array_get(imemory, op - 4 + i, idx, &tmp);
	if (code >= 0)
	    code = real_param(&tmp, &a[i]);
	if (code < 0) return code;
    }

    if (a[0] == a[1])
	return_error(e_undefinedresult);
    result = a[3] + (a[2] - a[3]) * (Ps - a[1]) / (a[0] - a[1]);
    make_real(op - 4, result);
    pop(4);
    return 0;
}
Exemple #18
0
/* <x1> <y1> <x2> <y2> <r> arcto <xt1> <yt1> <xt2> <yt2> */
static int
zarcto(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    float tanxy[4];		/* xt1, yt1, xt2, yt2 */
    int code = common_arct(i_ctx_p, tanxy);

    if (code < 0)
	return code;
    make_real(op - 4, tanxy[0]);
    make_real(op - 3, tanxy[1]);
    make_real(op - 2, tanxy[2]);
    make_real(op - 1, tanxy[3]);
    pop(1);
    return 0;
}
Exemple #19
0
int
make_floats(ref * op, const float *pval, int count)
{
    /* This should return e_undefinedresult for infinities. */
    for (; count--; op++, pval++)
	make_real(op, *pval);
    return 0;
}
Exemple #20
0
/* Make real values on the operand stack. */
int
make_reals(ref * op, const double *pval, int count)
{
    /* This should return e_limitcheck if any real is too large */
    /* to fit into a float on the stack. */
    for (; count--; op++, pval++)
	make_real(op, *pval);
    return 0;
}
Exemple #21
0
/* - currentflat <num> */
static int
zcurrentflat(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;

    push(1);
    make_real(op, gs_currentflat(igs));
    return 0;
}
Exemple #22
0
/* <bool> .pathbbox <llx> <lly> <urx> <ury> */
static int
z1pathbbox(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    gs_rect box;
    int code;

    check_type(*op, t_boolean);
    code = gs_upathbbox(igs, &box, op->value.boolval);
    if (code < 0)
	return code;
    push(3);
    make_real(op - 3, box.p.x);
    make_real(op - 2, box.p.y);
    make_real(op - 1, box.q.x);
    make_real(op, box.q.y);
    return 0;
}
/* [<req_x> <req_y>] [<med_x0> <med_y0> (<med_x1> <med_y1> | )]
 *     <policy> <orient|null> <roll> <matrix|null> .matchpagesize
 *   <matrix|null> <med_x> <med_y> true   -or-  false
 */
static int
zmatchpagesize(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    gs_matrix mat;
    float ignore_mismatch = (float)max_long;
    gs_point media_size;
    int orient;
    bool roll;
    int code;

    check_type(op[-3], t_integer);
    if (r_has_type(op - 2, t_null))
	orient = -1;
    else {
	check_int_leu(op[-2], 3);
	orient = (int)op[-2].value.intval;
    }
    check_type(op[-1], t_boolean);
    roll = op[-1].value.boolval;
    code = zmatch_page_size(imemory, 
			    op - 5, op - 4, (int)op[-3].value.intval,
			    orient, roll,
			    &ignore_mismatch, &mat, &media_size);
    switch (code) {
	default:
	    return code;
	case 0:
	    make_false(op - 5);
	    pop(5);
	    break;
	case 1:
	    code = write_matrix(op, &mat);
	    if (code < 0 && !r_has_type(op, t_null))
		return code;
	    op[-5] = *op;
	    make_real(op - 4, media_size.x);
	    make_real(op - 3, media_size.y);
	    make_true(op - 2);
	    pop(2);
	    break;
    }
    return 0;
}
Exemple #24
0
/* - currentdash <array> <offset> */
static int
zcurrentdash(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;

    push(2);
    ref_assign(op - 1, &istate->dash_pattern_array);
    make_real(op, gs_currentdash_offset(igs));
    return 0;
}
Exemple #25
0
/* - .currentdotlength <num> <bool> */
static int
zcurrentdotlength(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;

    push(2);
    make_real(op - 1, gs_currentdotlength(igs));
    make_bool(op, gs_currentdotlength_absolute(igs));
    return 0;
}
/* <num1> <num2> mul <product> */
int
zmul(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;

    switch (r_type(op)) {
    default:
        return_op_typecheck(op);
    case t_real:
        switch (r_type(op - 1)) {
        default:
            return_op_typecheck(op - 1);
        case t_real:
            op[-1].value.realval *= op->value.realval;
            break;
        case t_integer:
            make_real(op - 1, (double)op[-1].value.intval * op->value.realval);
        }
        break;
    case t_integer:
        switch (r_type(op - 1)) {
        default:
            return_op_typecheck(op - 1);
        case t_real:
            op[-1].value.realval *= (double)op->value.intval;
            break;
        case t_integer: {
            double ab = (double)op[-1].value.intval * op->value.intval;
            if (ab > 2147483647.)       /* (double)0x7fffffff */
                make_real(op - 1, ab);
            else if (ab < -2147483648.) /* (double)(int)0x80000000 */
                make_real(op - 1, ab);
            else
                op[-1].value.intval = (int)ab;
        }
        }
    }
    pop(1);
    return 0;
}
Exemple #27
0
/* <num1> <num2> div <real_quotient> */
int
zdiv(i_ctx_t *i_ctx_p)
{
    os_ptr op = osp;
    os_ptr op1 = op - 1;

    /* We can't use the non_int_cases macro, */
    /* because we have to check explicitly for op == 0. */
    switch (r_type(op)) {
	default:
	    return_op_typecheck(op);
	case t_real:
	    if (op->value.realval == 0)
		return_error(e_undefinedresult);
	    switch (r_type(op1)) {
		default:
		    return_op_typecheck(op1);
		case t_real:
		    op1->value.realval /= op->value.realval;
		    break;
		case t_integer:
		    make_real(op1, (double)op1->value.intval / op->value.realval);
	    }
	    break;
	case t_integer:
	    if (op->value.intval == 0)
		return_error(e_undefinedresult);
	    switch (r_type(op1)) {
		default:
		    return_op_typecheck(op1);
		case t_real:
		    op1->value.realval /= (double)op->value.intval;
		    break;
		case t_integer:
		    make_real(op1, (double)op1->value.intval / (double)op->value.intval);
	    }
    }
    pop(1);
    return 0;
}
Exemple #28
0
int
cie_cache_joint(i_ctx_t *i_ctx_p, const ref_cie_render_procs * pcrprocs,
		const gs_cie_common *pcie, gs_state * pgs)
{
    const gs_cie_render *pcrd = gs_currentcolorrendering(pgs);
    gx_cie_joint_caches *pjc = gx_unshare_cie_caches(pgs);
    gs_ref_memory_t *imem = (gs_ref_memory_t *) gs_state_memory(pgs);
    ref pqr_procs;
    uint space;
    int code;
    int i;

    if (pcrd == 0)		/* cache is not set up yet */
	return 0;
    if (pjc == 0)		/* must already be allocated */
	return_error(e_VMerror);
    if (r_has_type(&pcrprocs->TransformPQR, t_null)) {
	/*
	 * This CRD came from a driver, not from a PostScript dictionary.
	 * Resample TransformPQR in C code.
	 */
	return gs_cie_cs_complete(pgs, true);
    }
    gs_cie_compute_points_sd(pjc, pcie, pcrd);
    code = ialloc_ref_array(&pqr_procs, a_readonly, 3 * (1 + 4 + 4 * 6),
			    "cie_cache_common");
    if (code < 0)
	return code;
    /* When we're done, deallocate the procs and complete the caches. */
    check_estack(3);
    cie_cache_push_finish(i_ctx_p, cie_tpqr_finish, imem, pgs);
    *++esp = pqr_procs;
    space = r_space(&pqr_procs);
    for (i = 0; i < 3; i++) {
	ref *p = pqr_procs.value.refs + 3 + (4 + 4 * 6) * i;
	const float *ppt = (float *)&pjc->points_sd;
	int j;

	make_array(pqr_procs.value.refs + i, a_readonly | a_executable | space,
		   4, p);
	make_array(p, a_readonly | space, 4 * 6, p + 4);
	p[1] = pcrprocs->TransformPQR.value.refs[i];
	make_oper(p + 2, 0, cie_exec_tpqr);
	make_oper(p + 3, 0, cie_post_exec_tpqr);
	for (j = 0, p += 4; j < 4 * 6; j++, p++, ppt++)
	    make_real(p, *ppt);
    }
    return cie_prepare_cache3(i_ctx_p, &pcrd->RangePQR,
			      pqr_procs.value.const_refs,
			      pjc->TransformPQR.caches,
			      pjc, imem, "Transform.PQR");
}
Exemple #29
0
/* the interpreter will almost always call it directly. */
int
zop_sub(register os_ptr op)
{
    switch (r_type(op)) {
    default:
	return_op_typecheck(op);
    case t_real:
	switch (r_type(op - 1)) {
	default:
	    return_op_typecheck(op - 1);
	case t_real:
	    op[-1].value.realval -= op->value.realval;
	    break;
	case t_integer:
	    make_real(op - 1, (double)op[-1].value.intval - op->value.realval);
	}
	break;
    case t_integer:
	switch (r_type(op - 1)) {
	default:
	    return_op_typecheck(op - 1);
	case t_real:
	    op[-1].value.realval -= (double)op->value.intval;
	    break;
	case t_integer: {
	    int int1 = op[-1].value.intval;

	    if ((int1 ^ (op[-1].value.intval = int1 - op->value.intval)) < 0 &&
		(int1 ^ op->value.intval) < 0
		) {			/* Overflow, convert to real */
		make_real(op - 1, (float)int1 - op->value.intval);
	    }
	}
	}
    }
    return 0;
}
Exemple #30
0
/* the interpreter will almost always call it directly. */
int
zop_add(register os_ptr op)
{
    switch (r_type(op)) {
    default:
	return_op_typecheck(op);
    case t_real:
	switch (r_type(op - 1)) {
	default:
	    return_op_typecheck(op - 1);
	case t_real:
	    op[-1].value.realval += op->value.realval;
	    break;
	case t_integer:
	    make_real(op - 1, (double)op[-1].value.intval + op->value.realval);
	}
	break;
    case t_integer:
	switch (r_type(op - 1)) {
	default:
	    return_op_typecheck(op - 1);
	case t_real:
	    op[-1].value.realval += (double)op->value.intval;
	    break;
	case t_integer: {
	    int int2 = op->value.intval;

	    if (((op[-1].value.intval += int2) ^ int2) < 0 &&
		((op[-1].value.intval - int2) ^ int2) >= 0
		) {			/* Overflow, convert to real */
		make_real(op - 1, (double)(op[-1].value.intval - int2) + int2);
	    }
	}
	}
    }
    return 0;
}