Made code 64-bit clean. Enabled use of 64-bit arithmetic for integers.
git-svn-id: svn://localhost/root/svnrepo/trunk@13 bee25f81-8ba7-4b93-944d-dfac3d1a11cc
This commit is contained in:
colin.smith
parent
30a867f44b
commit
420e9ec1b3
|
|
@ -11,7 +11,7 @@ VM_COMP_OBJ = $(VM_OBJ) _compiler.o
|
|||
UNIX_OBJ = u-main.o
|
||||
PROGRAM = vx-scheme
|
||||
DEFVER = -DVERSION=$(VERSION)
|
||||
CFLAGS = -ansi -g -O2 -fno-exceptions -fno-rtti -Wall $(DEFVER)
|
||||
CFLAGS = -m64 -ansi -g -O2 -fno-exceptions -fno-rtti -Wall $(DEFVER)
|
||||
CC = gcc
|
||||
TC = ../testcases
|
||||
|
||||
|
|
@ -37,7 +37,7 @@ scheme-compiler: $(VM_COMP_OBJ) $(UNIX_OBJ) compile-file.scm vx-scheme
|
|||
./vx-scheme ./compile-file.scm < compile-file.scm \
|
||||
> _compile-file.cpp
|
||||
$(CC) $(CFLAGS) -c _compile-file.cpp
|
||||
$(CC) -o $@ $(VM_COMP_OBJ) $(UNIX_OBJ) \
|
||||
$(CC) $(CFLAGS) -o $@ $(VM_COMP_OBJ) $(UNIX_OBJ) \
|
||||
_compile-file.o -lstdc++ -lm
|
||||
|
||||
# Precompiled objects! Run the scheme-compiler to produce bytecode in
|
||||
|
|
|
|||
37
src/cell.cpp
37
src/cell.cpp
|
|
@ -18,7 +18,7 @@ Cell * Context::make ()
|
|||
return c;
|
||||
}
|
||||
|
||||
Cell * Context::make_int (int i)
|
||||
Cell * Context::make_int (intptr_t i)
|
||||
{
|
||||
// SHORT INTEGER support: if the integer fits in 24 bits,
|
||||
// then return a phony pointer with the short flag set and
|
||||
|
|
@ -199,9 +199,6 @@ void Cell::sanity_check ()
|
|||
{
|
||||
int bad = 0;
|
||||
|
||||
printf ("size = %Zu, typebits = %d, typemask = %x, numtypes = %d\n",
|
||||
sizeof (Cell), TYPEBITS, TYPEMASK, NUM_TYPES);
|
||||
|
||||
// Make sure that there are enough typebits to contain
|
||||
// all the types we know about.
|
||||
|
||||
|
|
@ -333,10 +330,10 @@ void Cell::stats ()
|
|||
//
|
||||
//======================================================================
|
||||
|
||||
int Cell::IntValue () const
|
||||
intptr_t Cell::IntValue () const
|
||||
{
|
||||
if (short_atom (this))
|
||||
return reinterpret_cast <int> (this) >> 8;
|
||||
return reinterpret_cast <intptr_t> (this) >> 8;
|
||||
|
||||
typecheck (Int); return cd.i;
|
||||
}
|
||||
|
|
@ -424,11 +421,10 @@ const char * Cell::name () const
|
|||
|
||||
void Cell::typefail (Type t1, Type t2) const
|
||||
{
|
||||
static char buf [128]; // XXX not reentrant, and fixed buffer dangerous
|
||||
sprintf (buf, "type check failure: wanted %s, got %s",
|
||||
sprintf (OS::errbuf, "type check failure: wanted %s, got %s",
|
||||
typeName [t2], typeName [t1]); /* XXX sprintf into fixed buf */
|
||||
|
||||
OS::exception (buf);
|
||||
OS::exception();
|
||||
}
|
||||
|
||||
void Cell::dump (FILE * out)
|
||||
|
|
@ -441,13 +437,13 @@ void Cell::dump (FILE * out)
|
|||
if (ca.i & MARK) fputs ("mark ", out);
|
||||
if (short_atom (ca.p))
|
||||
{
|
||||
printf ("short %d ", ca.p->IntValue ());
|
||||
printf ("short %" PRIdPTR " ", ca.p->IntValue ());
|
||||
}
|
||||
else
|
||||
{
|
||||
if (ca.i & ATOM)
|
||||
{
|
||||
printf ("atom %04x ", ca.i);
|
||||
printf ("atom %04" PRIxPTR " ", ca.i);
|
||||
if (ca.i & FORCED) fputs ("forced ", out);
|
||||
if (ca.i & QUICK) fputs ("quick ", out);
|
||||
if (ca.i & MACRO) fputs ("macro ", out);
|
||||
|
|
@ -471,7 +467,7 @@ void Cell::dump (FILE * out)
|
|||
fprintf (out, "%p", cd.p);
|
||||
break;
|
||||
|
||||
case Int: fprintf (out, " %d", cd.i); break;
|
||||
case Int: fprintf (out, " %" PRIdPTR, cd.i); break;
|
||||
case Real: fprintf (out, " %g", RealValue ()); break;
|
||||
case Unique: fprintf (out, " %s", cd.u); break;
|
||||
case Symbol: fprintf (out, " %s", SymbolValue ()->key);
|
||||
|
|
@ -676,13 +672,13 @@ class Slab
|
|||
// Supposedly the ANSI library guarantees that storage
|
||||
// is 4-aligned!
|
||||
|
||||
if (((int) storage) & 3)
|
||||
if ((reinterpret_cast<intptr_t>(storage)) & 3)
|
||||
abort ();
|
||||
|
||||
// But if it's not 8-aligned we can fix that using the
|
||||
// extra 4 bytes we allocated.
|
||||
|
||||
if (((int) storage) & 7)
|
||||
if ((reinterpret_cast<intptr_t>(storage)) & 7)
|
||||
start = reinterpret_cast <Cell *> (storage + 4);
|
||||
else
|
||||
start = reinterpret_cast <Cell *> (storage);
|
||||
|
|
@ -783,11 +779,12 @@ TOP:
|
|||
//
|
||||
|
||||
|
||||
inline Cell * Cell::untagged (Cell * c)
|
||||
{
|
||||
inline Cell * Cell::untagged (Cell * c) {
|
||||
static const uintptr_t not_tagmask = ~Cell::TAGMASK;
|
||||
|
||||
return reinterpret_cast <Cell *>
|
||||
(reinterpret_cast <int> (c) & ~Cell::TAGMASK);
|
||||
}
|
||||
(reinterpret_cast <uintptr_t> (c) & not_tagmask);
|
||||
}
|
||||
|
||||
inline void Cell::gc_set_car (Cell * src)
|
||||
{
|
||||
|
|
@ -967,7 +964,7 @@ E6: if (T == nil)
|
|||
// can contain integer VM codes as well as cell pointers.
|
||||
// These latter are marked with the ATOM flag.
|
||||
|
||||
if (reinterpret_cast <int> (P) & Cell::ATOM)
|
||||
if (reinterpret_cast <intptr_t> (P) & Cell::ATOM)
|
||||
goto next_element;
|
||||
|
||||
// Otherwise we mark, if not marked already.
|
||||
|
|
@ -1145,7 +1142,7 @@ void Context::gc ()
|
|||
// marked with the ATOM flag.
|
||||
|
||||
for (int ix = 0; ix < m_stack.size (); ++ix)
|
||||
if ((reinterpret_cast <int> ((p = m_stack [ix])) & Cell::ATOM) == 0)
|
||||
if ((reinterpret_cast <intptr_t> ((p = m_stack [ix])) & Cell::ATOM) == 0)
|
||||
mark (p);
|
||||
|
||||
// Mark the I/O ports referenced in this environment stack.
|
||||
|
|
|
|||
10
src/ctx.cpp
10
src/ctx.cpp
|
|
@ -91,6 +91,8 @@ void Context::init_machine ()
|
|||
clear (r_varl);
|
||||
}
|
||||
|
||||
char OS::errbuf [ebufsize];
|
||||
|
||||
// Context::using_vm - return true if we are using the bytecode vm.
|
||||
|
||||
bool Context::using_vm() const {
|
||||
|
|
@ -110,24 +112,22 @@ Cell* Context::eval(Cell* form) {
|
|||
|
||||
void error (const char * message, const char * m2 /* = 0 */)
|
||||
{
|
||||
static const int ebufsize = 256;
|
||||
static char errbuf [ebufsize];
|
||||
int ix = 0;
|
||||
const char *p;
|
||||
char *q;
|
||||
|
||||
// Concatenate the two strings into a static buffer.
|
||||
|
||||
for (p = message, ix = 0, q = errbuf; *p && ix < ebufsize-1; ++ix)
|
||||
for (p = message, ix = 0, q = OS::errbuf; *p && ix < OS::ebufsize-1; ++ix)
|
||||
*q++ = *p++;
|
||||
|
||||
if (m2)
|
||||
for (p = m2; *p && ix < ebufsize-1; ++ix)
|
||||
for (p = m2; *p && ix < OS::ebufsize-1; ++ix)
|
||||
*q++ = *p++;
|
||||
|
||||
*q = '\0';
|
||||
|
||||
OS::exception (errbuf);
|
||||
OS::exception();
|
||||
}
|
||||
|
||||
Cell * Context::extend (Cell * env)
|
||||
|
|
|
|||
|
|
@ -245,7 +245,7 @@ Cell* Context::interp_evaluator(Cell * form)
|
|||
psymbol s;
|
||||
Cell::Type t;
|
||||
Cell::Procedure lambda;
|
||||
int flag = 0;
|
||||
intptr_t flag = 0;
|
||||
double t1;
|
||||
bool trace;
|
||||
psymbol p;
|
||||
|
|
@ -280,7 +280,7 @@ Cell* Context::interp_evaluator(Cell * form)
|
|||
|
||||
#define RETURN_VALUE(v) do { \
|
||||
r_val = (v); \
|
||||
restore (r_cont); \
|
||||
restore_i (r_cont); \
|
||||
GOTO (r_cont); \
|
||||
} while (0)
|
||||
|
||||
|
|
@ -344,7 +344,7 @@ TOP:
|
|||
return r_val;
|
||||
|
||||
case ev_application:
|
||||
save (r_cont);
|
||||
save_i (r_cont);
|
||||
r_unev = cdr (r_exp);
|
||||
r_exp = car (r_exp);
|
||||
CALL_EVAL (ev_application2);
|
||||
|
|
@ -459,7 +459,7 @@ TOP:
|
|||
|
||||
r_env = extend (lambda.envt);
|
||||
bind_arguments (r_env, lambda.arglist, r_unev);
|
||||
save (macro_subst); // continuation
|
||||
save_i (macro_subst); // continuation
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -489,7 +489,7 @@ TOP:
|
|||
error ("can't dispatch one of those.");
|
||||
}
|
||||
|
||||
restore (r_cont);
|
||||
restore_i (r_cont);
|
||||
GOTO (r_cont);
|
||||
|
||||
case ev_eval:
|
||||
|
|
@ -512,7 +512,7 @@ TOP:
|
|||
|
||||
clear(r_argl);
|
||||
save(make_real(OS::get_time()));
|
||||
save(ev_time1); // cont
|
||||
save_i(ev_time1); // cont
|
||||
GOTO(apply_dispatch2);
|
||||
|
||||
case ev_time1:
|
||||
|
|
@ -530,7 +530,7 @@ TOP:
|
|||
|
||||
if (cdr (r_unev) == nil)
|
||||
{
|
||||
restore (r_cont);
|
||||
restore_i(r_cont);
|
||||
EVAL_DISPATCH ();
|
||||
}
|
||||
|
||||
|
|
@ -557,7 +557,7 @@ TOP:
|
|||
r_unev = cdr (r_unev);
|
||||
CALL_EVAL (ev_if_decide);
|
||||
|
||||
restore (r_cont);
|
||||
restore_i(r_cont);
|
||||
|
||||
if (r_val->istrue ())
|
||||
{
|
||||
|
|
@ -612,7 +612,7 @@ TOP:
|
|||
case ev_or:
|
||||
if (r_unev == nil || r_val->istrue ())
|
||||
{
|
||||
restore (r_cont);
|
||||
restore_i(r_cont);
|
||||
GOTO (r_cont);
|
||||
}
|
||||
|
||||
|
|
@ -624,7 +624,7 @@ TOP:
|
|||
case ev_and:
|
||||
if (r_unev == nil || !r_val->istrue ())
|
||||
{
|
||||
restore (r_cont);
|
||||
restore_i (r_cont);
|
||||
GOTO (r_cont);
|
||||
}
|
||||
|
||||
|
|
@ -639,7 +639,7 @@ TOP:
|
|||
// eval, please.
|
||||
|
||||
restore (r_env);
|
||||
restore (r_cont);
|
||||
restore_i (r_cont);
|
||||
r_exp = r_val;
|
||||
EVAL_DISPATCH ();
|
||||
|
||||
|
|
@ -844,7 +844,7 @@ TOP:
|
|||
save (r_unev);
|
||||
save (r_env);
|
||||
r_unev = cddr (r_unev);
|
||||
save (ev_do_step);
|
||||
save_i (ev_do_step);
|
||||
GOTO (ev_sequence);
|
||||
|
||||
case ev_do_step:
|
||||
|
|
@ -962,13 +962,13 @@ TOP:
|
|||
|
||||
if (t == Cell::Vec)
|
||||
{
|
||||
save (1);
|
||||
save_i (1);
|
||||
r_unev = vector_to_list (this, cons (r_unev, nil)); // yyy
|
||||
}
|
||||
else
|
||||
save (0);
|
||||
save_i (0);
|
||||
|
||||
save (ev_qq_finish);
|
||||
save_i (ev_qq_finish);
|
||||
r_val = nil;
|
||||
|
||||
case ev_qq0:
|
||||
|
|
@ -1001,7 +1001,7 @@ TOP:
|
|||
else if (p == s_quasiquote) // increase QQ level.
|
||||
{
|
||||
r_unev = cdr (r_unev);
|
||||
save (ev_qq1);
|
||||
save_i (ev_qq1);
|
||||
GOTO (ev_quasiquote);
|
||||
case ev_qq1:
|
||||
r_tmp = make_symbol (s_quasiquote);
|
||||
|
|
@ -1036,7 +1036,7 @@ TOP:
|
|||
|
||||
save (r_argl);
|
||||
r_exp = r_unev;
|
||||
save (ev_unq_spl2);
|
||||
save_i (ev_unq_spl2);
|
||||
GOTO (ev_qq0);
|
||||
}
|
||||
else
|
||||
|
|
@ -1057,13 +1057,13 @@ TOP:
|
|||
{
|
||||
QQCONS: // "move quasiquotation inward"
|
||||
save (cdr (r_unev)); // cons (qq (car), qq (cdr))
|
||||
save (ev_qq2); // new continuation
|
||||
save_i (ev_qq2); // new continuation
|
||||
r_unev = r_exp;
|
||||
GOTO (ev_qq0);
|
||||
case ev_qq2:
|
||||
restore (r_unev);
|
||||
save (r_val);
|
||||
save (ev_qq3);
|
||||
save_i (ev_qq3);
|
||||
GOTO (ev_qq0);
|
||||
case ev_qq3:
|
||||
restore (r_exp);
|
||||
|
|
@ -1073,15 +1073,15 @@ TOP:
|
|||
else
|
||||
r_val = r_unev; // atoms are self-evaluating
|
||||
|
||||
restore (r_cont);
|
||||
restore_i(r_cont);
|
||||
GOTO (r_cont);
|
||||
|
||||
case ev_qq_finish: // finished. reconvert to
|
||||
restore (flag); // vector form if necessary.
|
||||
restore_i(flag); // vector form if necessary.
|
||||
if (flag)
|
||||
r_val = vector_from_list (this, r_val);
|
||||
--r_qq;
|
||||
restore (r_cont);
|
||||
restore_i(r_cont);
|
||||
GOTO (r_cont);
|
||||
|
||||
case ev_qq_decrease:
|
||||
|
|
@ -1092,7 +1092,7 @@ TOP:
|
|||
|
||||
--r_qq;
|
||||
r_unev = cdr (r_unev);
|
||||
save (ev_qqd_1);
|
||||
save_i (ev_qqd_1);
|
||||
GOTO (ev_qq0);
|
||||
case ev_qqd_1:
|
||||
restore (r_exp); // recover head symbol
|
||||
|
|
@ -1146,7 +1146,7 @@ TOP:
|
|||
|
||||
save (r_unev);
|
||||
save (r_proc);
|
||||
save (ev_foreach2);
|
||||
save_i(ev_foreach2);
|
||||
GOTO (apply_dispatch2);
|
||||
case ev_foreach2:
|
||||
restore (r_proc);
|
||||
|
|
@ -1173,7 +1173,7 @@ TOP:
|
|||
save (r_varl);
|
||||
save (r_unev);
|
||||
save (r_proc);
|
||||
save (ev_map2);
|
||||
save_i(ev_map2);
|
||||
GOTO (apply_dispatch2);
|
||||
case ev_map2:
|
||||
restore (r_proc);
|
||||
|
|
@ -1199,7 +1199,7 @@ TOP:
|
|||
clear (r_argl);
|
||||
r_proc = r_exp->cd.cv->get (0);
|
||||
save (r_exp);
|
||||
save (ev_force2);
|
||||
save_i(ev_force2);
|
||||
GOTO (apply_dispatch2);
|
||||
case ev_force2:
|
||||
// Now, it can happen that the procedure we're
|
||||
|
|
@ -1220,7 +1220,7 @@ TOP:
|
|||
|
||||
}
|
||||
|
||||
restore (r_cont);
|
||||
restore_i(r_cont);
|
||||
GOTO (r_cont);
|
||||
|
||||
case ev_withinput:
|
||||
|
|
@ -1229,24 +1229,24 @@ TOP:
|
|||
with_input (Cell::caar (&r_argl)->StringValue ());
|
||||
r_proc = Cell::cadar (&r_argl);
|
||||
clear (r_argl);
|
||||
save (ev_withinput2); // continuation
|
||||
save_i(ev_withinput2); // continuation
|
||||
GOTO (apply_dispatch2);
|
||||
|
||||
case ev_withinput2:
|
||||
without_input ();
|
||||
restore (r_cont);
|
||||
restore_i(r_cont);
|
||||
GOTO (r_cont);
|
||||
|
||||
case ev_withoutput:
|
||||
with_output (Cell::caar (&r_argl)->StringValue ());
|
||||
r_proc = Cell::cadar (&r_argl);
|
||||
clear (r_argl);
|
||||
save (ev_withoutput2); // continuation
|
||||
save_i(ev_withoutput2); // continuation
|
||||
GOTO (apply_dispatch2);
|
||||
|
||||
case ev_withoutput2:
|
||||
without_output ();
|
||||
restore (r_cont);
|
||||
restore_i(r_cont);
|
||||
GOTO (r_cont);
|
||||
|
||||
case ev_load:
|
||||
|
|
@ -1274,7 +1274,7 @@ TOP:
|
|||
r_unev = make_oport (Cell::caar (&r_argl)->StringValue ());
|
||||
Cell::setcar (&r_argl, cons (r_unev, nil));
|
||||
save (r_unev);
|
||||
save (ev_callwof2); // cont
|
||||
save_i(ev_callwof2); // cont
|
||||
GOTO (apply_dispatch2);
|
||||
|
||||
case ev_callwof2:
|
||||
|
|
|
|||
|
|
@ -233,7 +233,7 @@ TOP:
|
|||
// hex constant. Drop the 'x' and convert with strtoul.
|
||||
|
||||
char * endptr;
|
||||
unsigned long ul = strtoul (lexeme.str () + 1, &endptr, 16);
|
||||
uintptr_t ul = strtoul (lexeme.str () + 1, &endptr, 16);
|
||||
|
||||
if (*endptr == '\0')
|
||||
READ_RETURN (make_int (ul));
|
||||
|
|
@ -425,7 +425,7 @@ void Cell::write (sstring& ss) const {
|
|||
switch(t) {
|
||||
case Int: {
|
||||
char buf[40];
|
||||
sprintf(buf, "%d", IntValue());
|
||||
sprintf(buf, "%" PRIdPTR, IntValue());
|
||||
ss.append(buf);
|
||||
break;
|
||||
}
|
||||
|
|
|
|||
28
src/subr.cpp
28
src/subr.cpp
|
|
@ -51,7 +51,7 @@ static bool exact_list (Cell * arglist)
|
|||
{
|
||||
case Cell::Int: continue;
|
||||
case Cell::Real: return false;
|
||||
default: error ("non-numeric type encountered");
|
||||
default: return false;
|
||||
}
|
||||
|
||||
return true;
|
||||
|
|
@ -78,7 +78,7 @@ Cell * skplus (Context * ctx, Cell * arglist)
|
|||
{
|
||||
if (exact_list (arglist))
|
||||
{
|
||||
int result = 0;
|
||||
intptr_t result = 0;
|
||||
|
||||
FOR_EACH (p, arglist)
|
||||
result += car (p)->IntValue ();
|
||||
|
|
@ -100,7 +100,7 @@ Cell * skminus (Context * ctx, Cell * arglist)
|
|||
{
|
||||
if (exact_list (arglist))
|
||||
{
|
||||
int result = car (arglist)->IntValue ();
|
||||
intptr_t result = car (arglist)->IntValue ();
|
||||
arglist = cdr (arglist);
|
||||
|
||||
if (arglist == nil)
|
||||
|
|
@ -154,7 +154,7 @@ Cell * times (Context * ctx, Cell * arglist)
|
|||
{
|
||||
if (exact_list (arglist))
|
||||
{
|
||||
int result = 1;
|
||||
intptr_t result = 1;
|
||||
|
||||
FOR_EACH (p, arglist)
|
||||
result *= Cell::car (p)->IntValue ();
|
||||
|
|
@ -176,8 +176,8 @@ Cell * skmax (Context * ctx, Cell * arglist)
|
|||
{
|
||||
if (exact_list (arglist))
|
||||
{
|
||||
int m = INT_MIN;
|
||||
int z;
|
||||
intptr_t m = numeric_limits<intptr_t>::min();
|
||||
intptr_t z;
|
||||
|
||||
FOR_EACH (a, arglist)
|
||||
if ((z = Cell::car (a)->IntValue ()) > m)
|
||||
|
|
@ -202,8 +202,8 @@ Cell * skmin (Context * ctx, Cell * arglist)
|
|||
{
|
||||
if (exact_list (arglist))
|
||||
{
|
||||
int m = INT_MAX;
|
||||
int z;
|
||||
intptr_t m = numeric_limits<intptr_t>::max();
|
||||
intptr_t z;
|
||||
|
||||
FOR_EACH (a, arglist)
|
||||
if ((z = car (a)->IntValue ()) < m)
|
||||
|
|
@ -323,8 +323,8 @@ BINOP (char_gt_ci, chrGTci, char, Char)
|
|||
if (cdr (a) != nil) \
|
||||
if (exact) \
|
||||
{ \
|
||||
int ia = car (a)->IntValue (); \
|
||||
int ib = cadr (a)->IntValue (); \
|
||||
intptr_t ia = car (a)->IntValue (); \
|
||||
intptr_t ib = cadr (a)->IntValue (); \
|
||||
if (! OP (ia, ib)) \
|
||||
return &Cell::Bool_F; \
|
||||
} \
|
||||
|
|
@ -435,7 +435,7 @@ Cell * write_char (Context * ctx, Cell * arglist)
|
|||
|
||||
Cell * skmake_vector (Context * ctx, Cell * arglist)
|
||||
{
|
||||
int n = car (arglist)->IntValue ();
|
||||
intptr_t n = car (arglist)->IntValue ();
|
||||
|
||||
if (cdr (arglist) != nil)
|
||||
return ctx->make_vector (n, cadr (arglist));
|
||||
|
|
@ -1183,7 +1183,7 @@ Cell * set_cdr (Context * ctx, Cell * arglist)
|
|||
return unspecified;
|
||||
}
|
||||
|
||||
Cell * set_car (Context * ctx, Cell * arglist)
|
||||
Cell* set_car(Context * ctx, Cell * arglist)
|
||||
{
|
||||
Cell::setcar (car (arglist), cadr (arglist));
|
||||
return unspecified;
|
||||
|
|
@ -1218,7 +1218,7 @@ Cell * integer_to_char (Context * ctx, Cell * arglist)
|
|||
|
||||
Cell * char_to_integer (Context * ctx, Cell * arglist)
|
||||
{
|
||||
return ctx->make_int ((int) car (arglist)->CharValue ());
|
||||
return ctx->make_int (static_cast<intptr_t>(car (arglist)->CharValue ()));
|
||||
}
|
||||
|
||||
Cell * open_input_file (Context * ctx, Cell * arglist)
|
||||
|
|
@ -1290,7 +1290,7 @@ Cell * inexact_to_exact (Context * ctx, Cell * arglist)
|
|||
if (a->type () == Cell::Int)
|
||||
return ctx->make_int (a->IntValue ());
|
||||
else
|
||||
return ctx->make_int ((int) a->RealValue ());
|
||||
return ctx->make_int (static_cast<intptr_t>(a->RealValue ()));
|
||||
}
|
||||
|
||||
// Round to nearest int... which would be easy except that the Scheme
|
||||
|
|
|
|||
|
|
@ -74,9 +74,9 @@ Cell * OS::undef (Context * ctx, const char * name)
|
|||
return 0;
|
||||
}
|
||||
|
||||
void OS::exception (const char * s) {
|
||||
if (jmpbuf_set) longjmp (jb, reinterpret_cast <int> (s));
|
||||
fputs(s, stderr);
|
||||
void OS::exception() {
|
||||
if (jmpbuf_set) longjmp (jb, 1);
|
||||
fputs(errbuf, stderr);
|
||||
fputs("\n", stderr);
|
||||
exit(1);
|
||||
}
|
||||
|
|
@ -98,7 +98,6 @@ void interact (Context * ctx)
|
|||
}
|
||||
|
||||
int main (int argc, char **argv) {
|
||||
const char *jv;
|
||||
Context ctx;
|
||||
Cell* scheme_argv = ctx.gc_protect(ctx.make_vector(0));
|
||||
cellvector* argvec = scheme_argv->VectorValue();
|
||||
|
|
@ -126,11 +125,11 @@ int main (int argc, char **argv) {
|
|||
// Interact
|
||||
|
||||
while (1) {
|
||||
if ((jv = reinterpret_cast <const char *> (setjmp (jb))) == 0) {
|
||||
if (setjmp (jb) == 0) {
|
||||
jmpbuf_set = true;
|
||||
interact (&ctx);
|
||||
} else {
|
||||
fprintf (stderr, "caught: %s\n", jv);
|
||||
fprintf (stderr, "caught: %s\n", OS::errbuf);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
60
src/vm.cpp
60
src/vm.cpp
|
|
@ -105,7 +105,7 @@ static bool exact_top_n (cellvector * cv, int n) {
|
|||
switch (cv->get_unchecked(ix)->type()) {
|
||||
case Cell::Int: continue;
|
||||
case Cell::Real: return false;
|
||||
default: error ("non-numeric type encountered");
|
||||
default: return false;
|
||||
}
|
||||
return true;
|
||||
}
|
||||
|
|
@ -176,19 +176,19 @@ void Context::print_insn(int addr, Cell* insn) {
|
|||
printf ("%4d:\t%s\t", addr, op->opcode->key);
|
||||
switch (op->opnd_type) {
|
||||
case OP_INT:
|
||||
printf ("%d", insn->cd.i);
|
||||
printf ("%" PRIdPTR, insn->cd.i);
|
||||
break;
|
||||
case OP_SYMBOL:
|
||||
printf ("%s", insn->cd.y->key);
|
||||
break;
|
||||
case OP_SUBR: printf ("%d,%s", INSN_COUNT (insn),
|
||||
case OP_SUBR: printf ("%" PRIdPTR ",%s", INSN_COUNT (insn),
|
||||
insn->flag(Cell::QUICK)
|
||||
? insn->cd.f->name
|
||||
: insn->cd.y->key);
|
||||
// XXX comment
|
||||
break;
|
||||
case OP_LEXADDR:
|
||||
printf ("%d,%d", LEXA_ESKIP(insn), LEXA_BSKIP(insn));
|
||||
printf ("%" PRIdPTR ",%" PRIdPTR, LEXA_ESKIP(insn), LEXA_BSKIP(insn));
|
||||
break;
|
||||
case OP_NONE:
|
||||
;
|
||||
|
|
@ -221,9 +221,9 @@ Cell* Context::vm_evaluator(Cell* form) {
|
|||
|
||||
Cell* Context::execute (Cell* proc, Cell* args) {
|
||||
cellvector *insns, *literals;
|
||||
int pc;
|
||||
intptr_t pc;
|
||||
int type;
|
||||
int start;
|
||||
intptr_t start;
|
||||
unsigned int count;
|
||||
unsigned int n_args = 0;
|
||||
unsigned int b_skip = 0;
|
||||
|
|
@ -232,7 +232,7 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
// Note the initial stack size.
|
||||
int initial_stackdepth = m_stack.size();
|
||||
|
||||
save (-1);
|
||||
save_i (-1);
|
||||
|
||||
// Push any arguments we received onto the stack.
|
||||
|
||||
|
|
@ -270,10 +270,10 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
printf ("\t");
|
||||
for (int ix = m_stack.size() - 1; ix >= 0; --ix) {
|
||||
Cell * c = m_stack.get_unchecked(ix);
|
||||
if (!(((int)c)&1)) {
|
||||
if (!((reinterpret_cast<intptr_t>(c))&1)) {
|
||||
if (c == root_envt) printf("#<root-envt> ");
|
||||
else c->write (stdout);
|
||||
} else printf ("%d", ((int)c)>>1);
|
||||
} else printf ("%" PRIdPTR, (reinterpret_cast<intptr_t>(c))>>1);
|
||||
fputc (' ', stdout);
|
||||
}
|
||||
printf("\n");
|
||||
|
|
@ -283,14 +283,14 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
switch (opcode)
|
||||
{
|
||||
case 0: // consti
|
||||
save (insn->cd.i);
|
||||
save_i (insn->cd.i);
|
||||
break;
|
||||
case 1: // nil
|
||||
m_stack.push (nil);
|
||||
break;
|
||||
case 2: // subr
|
||||
if (!insn->flag(Cell::QUICK)) {
|
||||
Cell* const subr = find_var(root_envt, insn->cd.y, 0);
|
||||
Cell* subr = find_var(root_envt, insn->cd.y, 0);
|
||||
if (!subr) error("missing primitive procedure");
|
||||
Cell* proc = cdr(subr);
|
||||
type = proc->type();
|
||||
|
|
@ -307,7 +307,7 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
cv.push(m_stack.pop());
|
||||
save(r_envt);
|
||||
save(r_cproc);
|
||||
save(pc+1);
|
||||
save_i(pc+1);
|
||||
for (unsigned int ix = 0; ix < n_args; ++ix)
|
||||
m_stack.push(cv.pop());
|
||||
r_cproc = proc;
|
||||
|
|
@ -396,7 +396,7 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
case 12: // proc
|
||||
// pop the starting instruction from the stack and compose it
|
||||
// with the current environment.
|
||||
restore (start);
|
||||
restore_i (start);
|
||||
m_stack.push (make_compiled_procedure (r_cproc->cd.cv->get_unchecked (0),
|
||||
r_cproc->cd.cv->get_unchecked (1),
|
||||
r_envt,
|
||||
|
|
@ -426,12 +426,12 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
// instruction slot in this segment.
|
||||
save (r_envt);
|
||||
save (r_cproc);
|
||||
save (insn->cd.i);
|
||||
save_i (insn->cd.i);
|
||||
break;
|
||||
case 17: // return
|
||||
r_val = m_stack.pop (); // value
|
||||
RETURN:
|
||||
restore (pc);
|
||||
restore_i (pc);
|
||||
if (pc < 0)
|
||||
goto FINISH;
|
||||
restore (r_cproc);
|
||||
|
|
@ -451,7 +451,7 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
// (We count from zero). 'take 0' would be a no-op; 'take 1'
|
||||
// would swap the top two elements. We use an unchecked get
|
||||
// because we "trust the compiler."
|
||||
int target = insn->cd.i;
|
||||
intptr_t target = insn->cd.i;
|
||||
int last = m_stack.size() - 1;
|
||||
r_tmp = m_stack.get_unchecked(last-target);
|
||||
for (int ix = last-target; ix < last; ++ix)
|
||||
|
|
@ -541,7 +541,7 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
n_args = insn->cd.i;
|
||||
if (n_args != 2)
|
||||
error ("bad arguments to vector-ref!");
|
||||
int ix = m_stack.pop()->IntValue();
|
||||
intptr_t ix = m_stack.pop()->IntValue();
|
||||
cellvector * cv = m_stack.pop()->VectorValue();
|
||||
m_stack.push(cv->get(ix));
|
||||
break;
|
||||
|
|
@ -570,7 +570,7 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
n_args = insn->cd.i;
|
||||
int sz = m_stack.size ();
|
||||
if (exact_top_n (&m_stack, n_args)) {
|
||||
int sum = 0;
|
||||
intptr_t sum = 0;
|
||||
for (int ix = sz - n_args; ix < sz; ++ix)
|
||||
sum += m_stack.get (ix)->IntValue(); // exact_top_n guarantees this is OK
|
||||
m_stack.discard (n_args);
|
||||
|
|
@ -589,7 +589,7 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
n_args = insn->cd.i;
|
||||
int sz = m_stack.size ();
|
||||
if (exact_top_n (&m_stack, n_args)) {
|
||||
int product = 1;
|
||||
intptr_t product = 1;
|
||||
for (int ix = sz - n_args; ix < sz; ++ix)
|
||||
product *= m_stack.get (ix)->IntValue(); // exact_top_n says this is OK
|
||||
m_stack.discard (n_args);
|
||||
|
|
@ -606,8 +606,8 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
case 35: { // quotient
|
||||
if (insn->cd.i != 2)
|
||||
error ("wrong # args");
|
||||
int d = m_stack.pop()->IntValue();
|
||||
int n = m_stack.pop()->IntValue();
|
||||
intptr_t d = m_stack.pop()->IntValue();
|
||||
intptr_t n = m_stack.pop()->IntValue();
|
||||
if (d == 0)
|
||||
error ("/0");
|
||||
m_stack.push (make_int (n/d));
|
||||
|
|
@ -616,8 +616,8 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
case 36: { // remainder
|
||||
if (insn->cd.i != 2)
|
||||
error ("wrong # args");
|
||||
int d = m_stack.pop()->IntValue();
|
||||
int n = m_stack.pop()->IntValue();
|
||||
intptr_t d = m_stack.pop()->IntValue();
|
||||
intptr_t n = m_stack.pop()->IntValue();
|
||||
if (d == 0)
|
||||
error ("/0");
|
||||
m_stack.push (make_int (n%d));
|
||||
|
|
@ -633,7 +633,7 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
if (n_args == 1) {
|
||||
m_stack.push(make_int(-m_stack.pop()->IntValue()));
|
||||
} else {
|
||||
int difference = m_stack.get(sz-n_args)->IntValue();
|
||||
intptr_t difference = m_stack.get(sz-n_args)->IntValue();
|
||||
for (int ix = sz - n_args + 1; ix < sz; ++ix)
|
||||
difference -= m_stack.get (ix)->IntValue();
|
||||
m_stack.discard (n_args);
|
||||
|
|
@ -687,7 +687,7 @@ Cell* Context::execute (Cell* proc, Cell* args) {
|
|||
m_stack.push(make_int(insn->cd.i));
|
||||
break;
|
||||
case 47: // promise
|
||||
restore(start);
|
||||
restore_i(start);
|
||||
r_tmp = make_compiled_procedure(r_cproc->cd.cv->get(0),
|
||||
r_cproc->cd.cv->get(1),
|
||||
r_envt,
|
||||
|
|
@ -895,7 +895,7 @@ Cell* Context::load_instructions(vm_cproc* cp) {
|
|||
Cell::setcar(a1, zero);
|
||||
switch(optab[opcode].opnd_type) {
|
||||
case OP_INT:
|
||||
Cell::setcar(a0, make_int(reinterpret_cast<int>(insn->operand)));
|
||||
Cell::setcar(a0, make_int(reinterpret_cast<intptr_t>(insn->operand)));
|
||||
break;
|
||||
case OP_SYMBOL:
|
||||
Cell::setcar(a0,
|
||||
|
|
@ -903,7 +903,7 @@ Cell* Context::load_instructions(vm_cproc* cp) {
|
|||
intern(static_cast<const char*>(insn->operand))));
|
||||
break;
|
||||
case OP_LEXADDR: {
|
||||
int la = reinterpret_cast<int>(insn->operand);
|
||||
int la = reinterpret_cast<intptr_t>(insn->operand);
|
||||
Cell::setcar(a0, make_int(la >> 16));
|
||||
Cell::setcar(a1, make_int(la & 0xffff));
|
||||
break;
|
||||
|
|
@ -974,18 +974,18 @@ Cell* Context::write_compiled_procedure(Cell* arglist) {
|
|||
fprintf(output, " { %2d,", opcode); // XXX magic number
|
||||
switch(op->opnd_type) {
|
||||
case OP_NONE: fprintf(output, "0,0"); break;
|
||||
case OP_INT: fprintf(output, "0,(void*)%d", insn->cd.i); break;
|
||||
case OP_INT: fprintf(output, "0,(void*)%" PRIdPTR, insn->cd.i); break;
|
||||
case OP_SYMBOL: fprintf(output, "0,");
|
||||
write_escaped_string(output, insn->cd.y->key); break;
|
||||
case OP_SUBR:
|
||||
// XXX write a comment
|
||||
fprintf(output, "%d,", INSN_COUNT(insn));
|
||||
fprintf(output, "%" PRIdPTR ",", INSN_COUNT(insn));
|
||||
if (insn->flag(Cell::QUICK))
|
||||
write_escaped_string(output, insn->cd.f->name);
|
||||
else
|
||||
write_escaped_string(output, insn->cd.y->key);
|
||||
break;
|
||||
case OP_LEXADDR: fprintf(output, "0,(void*)%#x", insn->cd.i); break;
|
||||
case OP_LEXADDR: fprintf(output, "0,(void*)%#" PRIxPTR, insn->cd.i); break;
|
||||
}
|
||||
}
|
||||
fprintf(output, " },\n");
|
||||
|
|
|
|||
|
|
@ -173,7 +173,7 @@ Cell * vx_invoke (Context * ctx, Cell * arglist)
|
|||
|
||||
void OS::exception (const char * s)
|
||||
{
|
||||
longjmp (jb, reinterpret_cast <int> (s));
|
||||
longjmp (jb, 1);
|
||||
}
|
||||
|
||||
void interact (Context * ctx)
|
||||
|
|
@ -191,7 +191,6 @@ void interact (Context * ctx)
|
|||
|
||||
extern "C" int scheme (char * a0)
|
||||
{
|
||||
const char * jv;
|
||||
Context ctx;
|
||||
|
||||
// Sanity check: we need to make sure that the "unique cells"
|
||||
|
|
@ -203,7 +202,7 @@ extern "C" int scheme (char * a0)
|
|||
// worked out ok. The garbage collector will be very unhappy if
|
||||
// any cells are not 8-aligned.
|
||||
|
||||
if (((int) nil) & 7)
|
||||
if ((reinterpret_cast<intptr_t>(nil)) & 7)
|
||||
{
|
||||
printf ("code module error: standard cells not 8-aligned\n");
|
||||
exit (1);
|
||||
|
|
@ -228,10 +227,10 @@ extern "C" int scheme (char * a0)
|
|||
}
|
||||
else while (1)
|
||||
{
|
||||
if ((jv = reinterpret_cast <const char *> (setjmp (jb))) == 0)
|
||||
if (setjmp (jb) == 0)
|
||||
interact (&ctx);
|
||||
else
|
||||
fprintf (stderr, "caught: %s\n", jv);
|
||||
fprintf (stderr, "caught: %s\n", OS::errbuf);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -12,6 +12,9 @@
|
|||
#include <stdio.h>
|
||||
#include <ctype.h>
|
||||
#include <limits.h>
|
||||
#define __STDC_FORMAT_MACROS
|
||||
#include <inttypes.h>
|
||||
|
||||
#ifndef WIN32
|
||||
#include <unistd.h>
|
||||
#else
|
||||
|
|
@ -56,11 +59,16 @@ class OS
|
|||
// supply value for undef symbol
|
||||
static Cell * undef (Context *, const char *);
|
||||
// report exception and restart
|
||||
static void exception (const char *);
|
||||
static void exception();
|
||||
// manage debug flags
|
||||
static unsigned int flags ();
|
||||
static bool flag (int bit)
|
||||
{ return (flags () & bit) != 0; }
|
||||
|
||||
// XXX global error buffer, set just before a longjmp to the
|
||||
// REPL. This should be made context local.
|
||||
static const int ebufsize = 256;
|
||||
static char errbuf [ebufsize];
|
||||
};
|
||||
|
||||
typedef Cell * (* subr_f) (Context * ctx, Cell * arglist);
|
||||
|
|
@ -300,8 +308,6 @@ class Cell
|
|||
|
||||
public:
|
||||
|
||||
typedef Cell * ptr;
|
||||
|
||||
void display (FILE *);
|
||||
void write(FILE *) const;
|
||||
void write(sstring&) const;
|
||||
|
|
@ -422,7 +428,7 @@ public:
|
|||
|
||||
// Value extractors
|
||||
|
||||
int IntValue() const;
|
||||
intptr_t IntValue() const;
|
||||
char CharValue() const;
|
||||
SubrBox* SubrValue() const;
|
||||
char* StringValue() const;
|
||||
|
|
@ -589,10 +595,10 @@ public:
|
|||
private:
|
||||
|
||||
static inline bool short_atom (const Cell * c)
|
||||
{ return (reinterpret_cast <unsigned int> (c) & (ATOM|SHORT))
|
||||
{ return (reinterpret_cast <uintptr_t> (c) & (ATOM|SHORT))
|
||||
== (ATOM|SHORT); }
|
||||
static inline bool long_atom (const Cell* c)
|
||||
{ return (reinterpret_cast <unsigned int> (c) & (ATOM|SHORT)) == ATOM; }
|
||||
{ return (reinterpret_cast <uintptr_t> (c) & (ATOM|SHORT)) == ATOM; }
|
||||
static inline bool atomic (const Cell * c)
|
||||
{ return short_atom (c) || ((c->ca.i & (ATOM|SHORT)) == ATOM); }
|
||||
|
||||
|
|
@ -619,23 +625,23 @@ public:
|
|||
// consists of two words, each at least 32 bits, with the
|
||||
// natural alignment (8 bytes for a 32-bit machine).
|
||||
|
||||
static const unsigned int TAGBITS = 3;
|
||||
static const unsigned int ATOM = 0x1;
|
||||
static const unsigned int MARK = 0x2;
|
||||
static const unsigned int SHORT = 0x4;
|
||||
static const uintptr_t TAGBITS = 3;
|
||||
static const uintptr_t ATOM = 0x1;
|
||||
static const uintptr_t MARK = 0x2;
|
||||
static const uintptr_t SHORT = 0x4;
|
||||
|
||||
static const unsigned int TYPEBITS = 5;
|
||||
static const unsigned int TYPEMASK = (1 << TYPEBITS) - 1;
|
||||
static const unsigned int TAGMASK = (1 << TAGBITS) - 1;
|
||||
static const uintptr_t TYPEBITS = 5;
|
||||
static const uintptr_t TYPEMASK = (1 << TYPEBITS) - 1;
|
||||
static const uintptr_t TAGMASK = (1 << TAGBITS) - 1;
|
||||
// Make sure flag bits are disjoint from TYPE and TAG bits.
|
||||
static const unsigned int FLAGBASE = 1 << (TYPEBITS + TAGBITS);
|
||||
static const unsigned int FORCED = FLAGBASE;
|
||||
static const unsigned int QUICK = FLAGBASE << 1;
|
||||
static const unsigned int GLOBAL = FLAGBASE << 2;
|
||||
static const unsigned int MACRO = FLAGBASE << 3;
|
||||
static const unsigned int VREF = FLAGBASE << 4;
|
||||
static const unsigned int FREE = FLAGBASE << 5;
|
||||
static const unsigned int FLAGBITS = 6;
|
||||
static const uintptr_t FLAGBASE = 1 << (TYPEBITS + TAGBITS);
|
||||
static const uintptr_t FORCED = FLAGBASE;
|
||||
static const uintptr_t QUICK = FLAGBASE << 1;
|
||||
static const uintptr_t GLOBAL = FLAGBASE << 2;
|
||||
static const uintptr_t MACRO = FLAGBASE << 3;
|
||||
static const uintptr_t VREF = FLAGBASE << 4;
|
||||
static const uintptr_t FREE = FLAGBASE << 5;
|
||||
static const uintptr_t FLAGBITS = 6;
|
||||
|
||||
static const int GLOBAL_ENV = -1;
|
||||
|
||||
|
|
@ -647,26 +653,26 @@ public:
|
|||
#error too many atom bits used
|
||||
#endif
|
||||
|
||||
inline int e_skip () {
|
||||
inline intptr_t e_skip () {
|
||||
// If global symbol, return -1. Else number of environments
|
||||
// to skip is in highest-order byte
|
||||
return (ca.i & GLOBAL) ? GLOBAL_ENV
|
||||
: (int)((ca.i >> (8*(sizeof(ca.i)-1))) & 0xff);
|
||||
}
|
||||
|
||||
inline int b_skip () {
|
||||
inline intptr_t b_skip () {
|
||||
// If global symbol, number of bindings to skip is in upper 16
|
||||
// bits; else, it's in 2nd-highest-order byte
|
||||
return (ca.i & GLOBAL) ? (ca.i >> (8*(sizeof(ca.i)-2)) & 0xffff)
|
||||
: ((ca.i >> (8*(sizeof(ca.i)-2))) & 0xff);
|
||||
}
|
||||
|
||||
void set_lexaddr (int e_skip, int b_skip) {
|
||||
void set_lexaddr (intptr_t e_skip, intptr_t b_skip) {
|
||||
// If global, set flag and store b_skip in upper 16 bits.
|
||||
// Else set e_skip in upper 8 bits, and set b_skip in
|
||||
// next 8 bits.
|
||||
const int start_bit = 8*(sizeof(ca.i)-2);
|
||||
const int two_bytes = (1 << 16) - 1;
|
||||
const intptr_t start_bit = 8*(sizeof(ca.i)-2);
|
||||
const intptr_t two_bytes = (1 << 16) - 1;
|
||||
ca.i &= ~(two_bytes << start_bit);
|
||||
if (e_skip == -1)
|
||||
ca.i |= (b_skip << start_bit) | GLOBAL | QUICK;
|
||||
|
|
@ -710,12 +716,12 @@ public:
|
|||
|
||||
union _car
|
||||
{
|
||||
unsigned int i;
|
||||
uintptr_t i;
|
||||
Cell * p;
|
||||
} ca;
|
||||
union _cdr
|
||||
{
|
||||
unsigned int i;
|
||||
uintptr_t i;
|
||||
double * d;
|
||||
Cell * p;
|
||||
const char * u;
|
||||
|
|
@ -871,7 +877,7 @@ class Context
|
|||
// Manufacture Cells and Atoms
|
||||
|
||||
Cell * make ();
|
||||
Cell * make_int (int i);
|
||||
Cell * make_int (intptr_t i);
|
||||
Cell * make_char (char ch);
|
||||
Cell * make_real (double d);
|
||||
Cell * make_string (size_t len);
|
||||
|
|
@ -952,7 +958,6 @@ class Context
|
|||
|
||||
Cell* RunMain();
|
||||
|
||||
|
||||
private:
|
||||
|
||||
Cell * alloc (Cell::Type t);
|
||||
|
|
@ -977,14 +982,14 @@ class Context
|
|||
void save (Cell * c) { m_stack.push (c); }
|
||||
void save (Cell & rc) { m_stack.push (rc.ca.p);
|
||||
m_stack.push (rc.cd.p); }
|
||||
void save (int i)
|
||||
void save_i (intptr_t i)
|
||||
{ m_stack.push (reinterpret_cast <Cell *> ((i << 1) | Cell::ATOM)); }
|
||||
void restore (Cell *& c) { c = m_stack.pop (); }
|
||||
void restore (Cell & rc) { rc.cd.p = m_stack.pop ();
|
||||
rc.ca.p = m_stack.pop (); }
|
||||
void restore (int & i)
|
||||
{ i = (reinterpret_cast <int> (m_stack.pop ()) &
|
||||
static_cast<int>(~Cell::ATOM)) >> 1; }
|
||||
void restore_i (intptr_t & i)
|
||||
{ i = (reinterpret_cast <intptr_t> (m_stack.pop ()) &
|
||||
static_cast<intptr_t>(~Cell::ATOM)) >> 1; }
|
||||
|
||||
// ===========================
|
||||
// REGISTER MACHINE
|
||||
|
|
@ -1002,7 +1007,7 @@ class Context
|
|||
Cell * r_nu; // reference to objects being created
|
||||
int r_qq; // quasiquotation depth
|
||||
cellvector r_gcp; // extra cells protected from GC
|
||||
int r_cont; // current continuation
|
||||
intptr_t r_cont; // current continuation
|
||||
cellvector m_stack; // recursion/evaluation stack
|
||||
int state; // current machine state
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue