initial import

[ICEs.git] / 157395 / ice.i.1

typedef struct scheme scheme;
typedef struct cell *pointer;
typedef void *(*func_alloc) (size_t);
typedef void (*func_dealloc) (void *);
typedef struct num {
	char is_fixnum;
	union {
		long ivalue;
	} value;
} num;
struct cell {
	union {
		struct {
			struct cell *_car;
			struct cell *_cdr;
		} _cons;
	} _object;
};
struct scheme {
	pointer args;
	pointer NIL;
};
enum scheme_opcodes {
	OP_LOAD, OP_T0LVL, OP_T1LVL, OP_READ_INTERNAL, OP_GENSYM, OP_VALUEPRINT,
	    OP_EVAL, OP_REAL_EVAL, OP_E0ARGS, OP_E1ARGS, OP_APPLY,
	    OP_REAL_APPLY, OP_TRACING, OP_DOMACRO, OP_LAMBDA, OP_MKCLOSURE,
	    OP_QUOTE, OP_DEF0, OP_DEF1, OP_DEFP, OP_BEGIN, OP_IF0, OP_IF1,
	    OP_SET0, OP_SET1, OP_LET0, OP_LET1, OP_LET2, OP_LET0AST, OP_LET1AST,
	    OP_LET2AST, OP_LET0REC, OP_LET1REC, OP_LET2REC, OP_COND0, OP_COND1,
	    OP_DELAY, OP_AND0, OP_AND1, OP_OR0, OP_OR1, OP_C0STREAM,
	    OP_C1STREAM, OP_MACRO0, OP_MACRO1, OP_CASE0, OP_CASE1, OP_CASE2,
	    OP_PEVAL, OP_PAPPLY, OP_CONTINUATION, OP_INEX2EX, OP_EXP, OP_LOG,
	    OP_SIN, OP_COS, OP_TAN, OP_ASIN, OP_ACOS, OP_ATAN, OP_SQRT, OP_EXPT,
	    OP_FLOOR, OP_CEILING, OP_TRUNCATE, OP_ROUND, OP_ADD, OP_SUB, OP_MUL,
	    OP_DIV, OP_INTDIV, OP_REM, OP_MOD, OP_CAR, OP_CDR, OP_CONS,
	    OP_SETCAR, OP_SETCDR, OP_CHAR2INT, OP_INT2CHAR, OP_CHARUPCASE,
	    OP_CHARDNCASE, OP_SYM2STR, OP_ATOM2STR, OP_STR2SYM, OP_STR2ATOM,
	    OP_MKSTRING, OP_STRLEN, OP_STRREF, OP_STRSET, OP_STRAPPEND,
	    OP_SUBSTR, OP_VECTOR, OP_MKVECTOR, OP_VECLEN, OP_VECREF, OP_VECSET,
	    OP_NOT, OP_BOOLP, OP_EOFOBJP, OP_NULLP, OP_NUMEQ, OP_LESS, OP_GRE,
	    OP_LEQ, OP_GEQ, OP_SYMBOLP, OP_NUMBERP, OP_STRINGP, OP_INTEGERP,
	    OP_REALP, OP_CHARP, OP_CHARAP, OP_CHARNP, OP_CHARWP, OP_CHARUP,
	    OP_CHARLP, OP_PORTP, OP_INPORTP, OP_OUTPORTP, OP_PROCP, OP_PAIRP,
	    OP_LISTP, OP_ENVP, OP_VECTORP, OP_ARRAYP, OP_EQ, OP_EQV, OP_FORCE,
	    OP_SAVE_FORCED, OP_WRITE, OP_WRITE_CHAR, OP_DISPLAY, OP_NEWLINE,
	    OP_ERR0, OP_ERR1, OP_REVERSE, OP_LIST_STAR, OP_APPEND, OP_PUT,
	    OP_GET, OP_QUIT, OP_GC, OP_GCVERB, OP_NEWSEGMENT, OP_OBLIST,
	    OP_CURR_INPORT, OP_CURR_OUTPORT, OP_OPEN_INFILE, OP_OPEN_OUTFILE,
	    OP_OPEN_INOUTFILE, OP_OPEN_INSTRING, OP_OPEN_OUTSTRING,
	    OP_OPEN_INOUTSTRING, OP_CLOSE_INPORT, OP_CLOSE_OUTPORT, OP_INT_ENV,
	    OP_CURR_ENV, OP_READ, OP_READ_CHAR, OP_PEEK_CHAR, OP_CHAR_READY,
	    OP_SET_INPORT, OP_SET_OUTPORT, OP_RDSEXPR, OP_RDLIST, OP_RDDOT,
	    OP_RDQUOTE, OP_RDQQUOTE, OP_RDQQUOTEVEC, OP_RDUNQUOTE, OP_RDUQTSP,
	    OP_RDVEC, OP_P0LIST, OP_P1LIST, OP_PVECFROM, OP_LIST_LENGTH,
	    OP_ASSQ, OP_GET_CLOSURE, OP_CLOSUREP, OP_MACROP, OP_MAXDEFINED
};
num nvalue(pointer p)
{
}
static num num_intdiv(num a, num b)
{
	num ret;
	if (ret.is_fixnum) {
		ret.value.ivalue = a.value.ivalue / b.value.ivalue;
	}
	return ret;
}
static pointer opexe_2(scheme * sc, enum scheme_opcodes op)
{
	pointer x;
	num v;
	switch (op) {
	case OP_INEX2EX:
		x = ((sc->args)->_object._cons._car);
		for (; x != sc->NIL; x = ((x)->_object._cons._cdr)) {
			if (ivalue(((x)->_object._cons._car)) != 0)
				v = num_intdiv(v,
					       nvalue(((x)->_object._cons.
						       _car)));
			else {
			}
		}
		return _s_return(sc, mk_number(sc, v));
	}
}
typedef struct {
	char *name;
} op_code_info;
static op_code_info dispatch_table[] = {
	{
	 opexe_2, "inexact->exact", 1, 1, "\014"}
};
int scheme_init_custom_alloc(scheme * sc, func_alloc malloc, func_dealloc free)
{
	int i, n = sizeof(dispatch_table) / sizeof(dispatch_table[0]);
	for (i = 0; i < n; i++) {
		if (dispatch_table[i].name != 0) {
		}
	}
}