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 }