Esempio n. 1
0
static void asdl_defconst(int suffix, int size, Value v) {
	switch (suffix) {
	case I: put(rcc_Defconst(suffix, size, v.i)); return;
	case U: put(rcc_Defconst(suffix, size, v.u)); return;
	case P: put(rcc_Defconst(suffix, size, (unsigned long)v.p)); return;	/* FIXME */
	case F: put(rcc_Defconstf(size, mk_real(size, v))); return;
	assert(0);
	}
}
Esempio n. 2
0
File: plugin.c Progetto: aure/Sporth
static pointer plugin_function(scheme *sc, pointer args) {
    printf("this is a plugin!\n");
    /* first argument is an integer */
    long i = ivalue(car(args));
    printf("the first argument is %d\n", i);

    /* pop first argument using cdr */
    args = cdr(args);

    /* second argument is a string */
    char *str = string_value(car(args));
    printf("the second argument is %s\n", str);
   
    /* pop the argument */
    args = cdr(args);
    
    /* second argument is a float*/
    SPFLOAT flt  = rvalue(car(args));
    printf("the third argument is %g\n", flt);

    /* return a float */
    return mk_real(sc, 0.2468);
}
Esempio n. 3
0
/* (clock) */
static pointer s_clock(scheme* sc, pointer args) {
	return mk_real(sc, (double)clock());
}
Esempio n. 4
0
static rcc_node_ty visit(Node p) {
	Symbol q;
	rcc_node_ty left = NULL, right = NULL;
	int suffix = optype(p->op), size = opsize(p->op);

	assert(p);
	for (q = temps; q; q = q->u.t.next)
		if (q->u.t.cse == p) {
			q->u.t.cse = NULL;
			return rcc_CSE(0, 0, symboluid(q), visit(p));
		}
	if (p->kids[0] != NULL)
		left = visit(p->kids[0]);
	if (p->kids[1] != NULL)
		right = visit(p->kids[1]);
	switch (specific(p->op)) {
	case CNST+F:
		assert(p->syms[0]);
		return rcc_CNSTF(suffix, size, mk_real(size, p->syms[0]->u.c.v));
	case CALL+B:
		assert(p->syms[0]);
		assert(p->syms[0]->type);
		return rcc_CALLB(suffix, size, left, right, typeuid(p->syms[0]->type));
	case RET+V:
		return rcc_RET(suffix, size);
	case LABEL+V:
		assert(p->syms[0]);
		return rcc_LABEL(suffix, size, p->syms[0]->u.l.label);
	}
	switch (generic(p->op)) {
	case CNST:
		assert(p->syms[0]);
		return rcc_CNST(suffix, size, p->syms[0]->u.c.v.i);	/* FIXME */
	case ARG:
		assert(p->syms[0]);
		return rcc_ARG(suffix, size, left, p->syms[0]->u.c.v.i, p->syms[1]->u.c.v.i);
	case ASGN:
		assert(p->syms[0]);
		assert(p->syms[1]);
		return rcc_ASGN(suffix, size, left, right, p->syms[0]->u.c.v.i, p->syms[1]->u.c.v.i);
	case CVF: case CVI: case CVP: case CVU:
		assert(p->syms[0]);
		return rcc_CVT(suffix, size, generic(p->op), left, p->syms[0]->u.c.v.i);
	case CALL:
		assert(p->syms[0]);
		assert(p->syms[0]->type);
		return rcc_CALL(suffix, size, left, typeuid(p->syms[0]->type));
#define xx(op) case op: return rcc_##op(suffix, size, symboluid(p->syms[0]))
	xx(ADDRG);
	xx(ADDRF);
#undef xx
	case ADDRL:
		if (!p->syms[0]->defined)
			(*IR->local)(p->syms[0]);
		p->syms[0]->defined = 1;
		return rcc_ADDRL(suffix, size, symboluid(p->syms[0]));
	case JUMP:
		if (p->syms[0] != NULL)
			return rcc_BRANCH(suffix, size, p->syms[0]->u.l.label);
		return rcc_Unary(suffix, size, generic(p->op), left);
	case INDIR: case RET: case NEG: case BCOM: 
		return rcc_Unary(suffix, size, generic(p->op), left);
	case BOR: case BAND: case BXOR: case RSH: case LSH:
	case ADD: case SUB: case DIV: case MUL: case MOD:
		return rcc_Binary(suffix, size, generic(p->op), left, right);
	case EQ: case NE: case GT: case GE: case LE: case LT:
		assert(p->syms[0]);
		return rcc_Compare(suffix, size, generic(p->op), left, right, p->syms[0]->u.l.label);
	}
	assert(0);
	return NULL;
}