initial import
[ICEs.git] / 157395 / ice.i.1
1 typedef struct scheme scheme;
2 typedef struct cell *pointer;
3 typedef void *(*func_alloc) (size_t);
4 typedef void (*func_dealloc) (void *);
5 typedef struct num {
6 char is_fixnum;
7 union {
8 long ivalue;
9 } value;
10 } num;
11 struct cell {
12 union {
13 struct {
14 struct cell *_car;
15 struct cell *_cdr;
16 } _cons;
17 } _object;
18 };
19 struct scheme {
20 pointer args;
21 pointer NIL;
22 };
23 enum scheme_opcodes {
24 OP_LOAD, OP_T0LVL, OP_T1LVL, OP_READ_INTERNAL, OP_GENSYM, OP_VALUEPRINT,
25 OP_EVAL, OP_REAL_EVAL, OP_E0ARGS, OP_E1ARGS, OP_APPLY,
26 OP_REAL_APPLY, OP_TRACING, OP_DOMACRO, OP_LAMBDA, OP_MKCLOSURE,
27 OP_QUOTE, OP_DEF0, OP_DEF1, OP_DEFP, OP_BEGIN, OP_IF0, OP_IF1,
28 OP_SET0, OP_SET1, OP_LET0, OP_LET1, OP_LET2, OP_LET0AST, OP_LET1AST,
29 OP_LET2AST, OP_LET0REC, OP_LET1REC, OP_LET2REC, OP_COND0, OP_COND1,
30 OP_DELAY, OP_AND0, OP_AND1, OP_OR0, OP_OR1, OP_C0STREAM,
31 OP_C1STREAM, OP_MACRO0, OP_MACRO1, OP_CASE0, OP_CASE1, OP_CASE2,
32 OP_PEVAL, OP_PAPPLY, OP_CONTINUATION, OP_INEX2EX, OP_EXP, OP_LOG,
33 OP_SIN, OP_COS, OP_TAN, OP_ASIN, OP_ACOS, OP_ATAN, OP_SQRT, OP_EXPT,
34 OP_FLOOR, OP_CEILING, OP_TRUNCATE, OP_ROUND, OP_ADD, OP_SUB, OP_MUL,
35 OP_DIV, OP_INTDIV, OP_REM, OP_MOD, OP_CAR, OP_CDR, OP_CONS,
36 OP_SETCAR, OP_SETCDR, OP_CHAR2INT, OP_INT2CHAR, OP_CHARUPCASE,
37 OP_CHARDNCASE, OP_SYM2STR, OP_ATOM2STR, OP_STR2SYM, OP_STR2ATOM,
38 OP_MKSTRING, OP_STRLEN, OP_STRREF, OP_STRSET, OP_STRAPPEND,
39 OP_SUBSTR, OP_VECTOR, OP_MKVECTOR, OP_VECLEN, OP_VECREF, OP_VECSET,
40 OP_NOT, OP_BOOLP, OP_EOFOBJP, OP_NULLP, OP_NUMEQ, OP_LESS, OP_GRE,
41 OP_LEQ, OP_GEQ, OP_SYMBOLP, OP_NUMBERP, OP_STRINGP, OP_INTEGERP,
42 OP_REALP, OP_CHARP, OP_CHARAP, OP_CHARNP, OP_CHARWP, OP_CHARUP,
43 OP_CHARLP, OP_PORTP, OP_INPORTP, OP_OUTPORTP, OP_PROCP, OP_PAIRP,
44 OP_LISTP, OP_ENVP, OP_VECTORP, OP_ARRAYP, OP_EQ, OP_EQV, OP_FORCE,
45 OP_SAVE_FORCED, OP_WRITE, OP_WRITE_CHAR, OP_DISPLAY, OP_NEWLINE,
46 OP_ERR0, OP_ERR1, OP_REVERSE, OP_LIST_STAR, OP_APPEND, OP_PUT,
47 OP_GET, OP_QUIT, OP_GC, OP_GCVERB, OP_NEWSEGMENT, OP_OBLIST,
48 OP_CURR_INPORT, OP_CURR_OUTPORT, OP_OPEN_INFILE, OP_OPEN_OUTFILE,
49 OP_OPEN_INOUTFILE, OP_OPEN_INSTRING, OP_OPEN_OUTSTRING,
50 OP_OPEN_INOUTSTRING, OP_CLOSE_INPORT, OP_CLOSE_OUTPORT, OP_INT_ENV,
51 OP_CURR_ENV, OP_READ, OP_READ_CHAR, OP_PEEK_CHAR, OP_CHAR_READY,
52 OP_SET_INPORT, OP_SET_OUTPORT, OP_RDSEXPR, OP_RDLIST, OP_RDDOT,
53 OP_RDQUOTE, OP_RDQQUOTE, OP_RDQQUOTEVEC, OP_RDUNQUOTE, OP_RDUQTSP,
54 OP_RDVEC, OP_P0LIST, OP_P1LIST, OP_PVECFROM, OP_LIST_LENGTH,
55 OP_ASSQ, OP_GET_CLOSURE, OP_CLOSUREP, OP_MACROP, OP_MAXDEFINED
56 };
57 num nvalue(pointer p)
58 {
59 }
60 static num num_intdiv(num a, num b)
61 {
62 num ret;
63 if (ret.is_fixnum) {
64 ret.value.ivalue = a.value.ivalue / b.value.ivalue;
65 }
66 return ret;
67 }
68 static pointer opexe_2(scheme * sc, enum scheme_opcodes op)
69 {
70 pointer x;
71 num v;
72 switch (op) {
73 case OP_INEX2EX:
74 x = ((sc->args)->_object._cons._car);
75 for (; x != sc->NIL; x = ((x)->_object._cons._cdr)) {
76 if (ivalue(((x)->_object._cons._car)) != 0)
77 v = num_intdiv(v,
78 nvalue(((x)->_object._cons.
79 _car)));
80 else {
81 }
82 }
83 return _s_return(sc, mk_number(sc, v));
84 }
85 }
86 typedef struct {
87 char *name;
88 } op_code_info;
89 static op_code_info dispatch_table[] = {
90 {
91 opexe_2, "inexact->exact", 1, 1, "\014"}
92 };
93 int scheme_init_custom_alloc(scheme * sc, func_alloc malloc, func_dealloc free)
94 {
95 int i, n = sizeof(dispatch_table) / sizeof(dispatch_table[0]);
96 for (i = 0; i < n; i++) {
97 if (dispatch_table[i].name != 0) {
98 }
99 }
100 }