/* $Header$ */
/*
* Copyright © 1988-2004 Keith Packard and Bart Massey.
* All Rights Reserved. See the file COPYING in this directory
* for licensing information.
*/
#include "nickle.h"
#include <assert.h>
#undef DEBUG_FRAME
#define Stack(i) ((Value) STACK_ELT(thread->thread.continuation.stack, i))
#define CStack(i) ((Value) STACK_ELT(cstack, i))
/*
* Instruction must be completed because changes have been
* committed to storage.
*/
Bool complete;
Bool signalFinished; /* current thread is finished */
Bool signalSuspend; /* current thread is suspending */
#define Arg(n) ((n) <= base ? CStack(base - (n)) : value)
static FramePtr
BuildFrame (Value thread, Value func, Value value, Bool staticInit, Bool tail,
Bool varargs, int nformal,
int base, int argc, InstPtr savePc, ObjPtr saveObj)
{
ENTER ();
CodePtr code = func->func.code;
FuncBodyPtr body = staticInit ? &code->func.staticInit : &code->func.body;
StackObject *cstack = thread->thread.continuation.stack;
int fe;
FramePtr frame;
#ifdef DEBUG_FRAME
FilePrintf (FileStdout, "BuildFrame func %v value %v\n", func, value);
ThreadStackDump (thread);
FileFlush (FileStdout, True);
#endif
frame = thread->thread.continuation.frame;
if (tail)
frame = frame->previous;
frame = NewFrame (func, frame,
func->func.staticLink,
body->dynamics,
func->func.statics);
for (fe = 0; fe < nformal; fe++)
BoxValueSet (frame->frame, fe, Copy (Arg(fe)));
if (varargs)
{
int extra = argc - nformal;
Value array;
array = NewArray (True, False, typePoly, 1, &extra);
BoxValueSet (frame->frame, fe, array);
for (; fe < argc; fe++)
ArrayValueSet (&array->array, fe-nformal, Copy (Arg(fe)));
}
if (tail)
{
frame->savePc = thread->thread.continuation.frame->savePc;
frame->saveObj = thread->thread.continuation.frame->saveObj;
}
else
{
frame->savePc = savePc;
frame->saveObj = saveObj;
}
RETURN (frame);
}
static Value
ThreadCall (Value thread, Bool tail, InstPtr *next, int *stack)
{
ENTER ();
int argc = *stack;
Value value = thread->thread.continuation.value;
StackObject *cstack = thread->thread.continuation.stack;
Value func;
CodePtr code;
FramePtr frame;
ArgType *argt;
int fe;
int base;
/*
* Typecheck actuals
*/
fe = 0;
base = argc - 2;
if (argc < 0)
{
Value numvar = Arg(0);
if (!ValueIsInt (numvar))
{
RaiseStandardException (exception_invalid_argument,
"Incompatible argument",
2, NewInt(-1), Arg(0));
RETURN (Void);
}
argc = -argc - 1 + ValueInt(numvar);
base = argc - 1;
*stack = 1 + argc; /* count + args */
func = CStack(argc);
}
else
func = argc ? CStack(argc-1) : value;
if (!ValueIsFunc(func))
{
ThreadStackDump (thread);
RaiseStandardException (exception_invalid_unop_value,
"Not a function",
1, func);
RETURN (Void);
}
code = func->func.code;
argt = code->base.args;
while (fe < argc || (argt && !argt->varargs))
{
if (!argt)
{
RaiseStandardException (exception_invalid_argument,
"Too many parameters",
2, NewInt (argc), NewInt(code->base.argc));
RETURN (Void);
}
if (fe == argc)
{
RaiseStandardException (exception_invalid_argument,
"Too few arguments",
2, NewInt (argc), NewInt(code->base.argc));
RETURN (Void);
}
if (!TypeCompatibleAssign (argt->type, Arg(fe)))
{
RaiseStandardException (exception_invalid_argument,
"Incompatible argument",
2, NewInt (fe), Arg(fe));
RETURN (Void);
}
fe++;
if (!argt->varargs)
argt = argt->next;
}
if (code->base.builtin)
{
Value *values = 0;
int formal;
formal = code->base.argc;
if (code->base.varargs)
{
formal = -1;
values = AllocateTemp (argc * sizeof (Value));
for (fe = 0; fe < argc; fe++)
values[fe] = Arg(fe);
}
if (code->builtin.needsNext)
{
/*
* Let the non-local function handle the stack adjust
*/
*stack = 0;
switch (formal) {
case -1:
value = (*code->builtin.b.builtinNJ)(next, argc, values);
break;
case 0:
value = (*code->builtin.b.builtin0J)(next);
break;
case 1:
value = (*code->builtin.b.builtin1J)(next, Arg(0));
break;
case 2:
value = (*code->builtin.b.builtin2J)(next, Arg(0), Arg(1));
break;
}
}
else
{
switch (formal) {
case -1:
value = (*code->builtin.b.builtinN)(argc, values);
break;
case 0:
value = (*code->builtin.b.builtin0)();
break;
case 1:
value = (*code->builtin.b.builtin1)(Arg(0));
break;
case 2:
value = (*code->builtin.b.builtin2)(Arg(0), Arg(1));
break;
case 3:
value = (*code->builtin.b.builtin3)(Arg(0), Arg(1), Arg(2));
break;
case 4:
value = (*code->builtin.b.builtin4)(Arg(0), Arg(1), Arg(2),
Arg(3));
break;
case 5:
value = (*code->builtin.b.builtin5)(Arg(0), Arg(1), Arg(2),
Arg(3), Arg(4));
break;
case 6:
value = (*code->builtin.b.builtin6)(Arg(0), Arg(1), Arg(2),
Arg(3), Arg(4), Arg(5));
break;
case 7:
value = (*code->builtin.b.builtin7)(Arg(0), Arg(1), Arg(2),
Arg(3), Arg(4), Arg(5),
Arg(6));
break;
default:
value = Void;
break;
}
/*
* For a tail call, drop the topmost frame
*/
if (tail && !aborting)
{
complete = True;
thread->thread.continuation.obj = thread->thread.continuation.frame->saveObj;
*next = thread->thread.continuation.frame->savePc;
thread->thread.continuation.frame = thread->thread.continuation.frame->previous;
}
}
}
else
{
frame = BuildFrame (thread, func, value, False, tail, code->base.varargs,
code->base.argc, base, argc, *next, thread->thread.continuation.obj);
if (aborting)
RETURN (value);
complete = True;
thread->thread.continuation.frame = frame;
thread->thread.continuation.obj = code->func.body.obj;
*next = ObjCode (code->func.body.obj, 0);
}
RETURN (value);
}
/*
* Call the pseudo function to initialize static values
*/
static void
ThreadStaticInit (Value thread, InstPtr *next)
{
ENTER ();
Value value = thread->thread.continuation.value;
CodePtr code = value->func.code;
FramePtr frame;
frame = BuildFrame (thread, value, Void, True, False, False, 0, 0, 0,
*next, thread->thread.continuation.obj);
if (aborting)
return;
complete = True;
thread->thread.continuation.frame = frame;
thread->thread.continuation.obj = code->func.staticInit.obj;
*next = ObjCode (code->func.staticInit.obj, 0);
EXIT ();
}
static INLINE void
ThreadAssign (Value ref, Value v, Bool initialize)
{
ENTER ();
if (!ValueIsRef (ref))
{
RaiseStandardException (exception_invalid_binop_values,
"Attempted store through non reference",
2, ref, v);
}
else if (RefConstant(ref) && !initialize)
{
RaiseStandardException (exception_readonly_box,
"Attempted assignment to constant box",
1, v);
}
else if (ref->ref.element >= ref->ref.box->nvalues)
{
RaiseStandardException (exception_invalid_array_bounds,
"Attempted assignment beyond box bounds",
2, NewInt(ref->ref.element), v);
}
else if (!TypeCompatibleAssign (RefType (ref), v))
{
RaiseStandardException (exception_invalid_argument,
"Incompatible types in assignment",
2, NewInt(ref->ref.element), v);
}
else
{
if (!v)
abort ();
v = Copy (v);
if (!aborting)
{
complete = True;
RefValueSet (ref, v);
}
}
EXIT ();
}
static Value
ThreadArray (Value thread, Bool resizable, int ndim, Type *type)
{
ENTER ();
int i;
int *dims;
dims = AllocateTemp (ndim * sizeof (int));
for (i = 0; i < ndim; i++)
{
Value d = Stack(i);
dims[i] = IntPart (d, "Invalid array dimension");
if (dims[i] < 0)
RaiseStandardException (exception_invalid_argument,
"Negative array dimension",
2, NewInt (0), d);
if (aborting)
RETURN (0);
}
RETURN (NewArray (False, resizable, type, ndim, dims));
}
static Value
ThreadArrayInd (Value thread, Bool resizable, Value dim, Type *type)
{
ENTER ();
Array *a = &dim->array;
int i;
int ndim = ArrayLimits(a)[0];
int *dims;
dims = AllocateTemp (ndim * sizeof (int));
for (i = 0; i < ndim; i++)
{
Value d = ArrayValue (a, i);
dims[i] = IntPart (d, "Invalid array dimension");
if (dims[i] < 0)
RaiseStandardException (exception_invalid_argument,
"Negative array dimension",
2, NewInt (0), d);
if (aborting)
RETURN (0);
}
RETURN (NewArray (False, resizable, type, ndim, dims));
}
static int
ThreadArrayIndex (Value array, Value thread, int ndim,
Value last, int off, Bool except, Bool resize)
{
int i;
int dim;
int part;
Value d;
int *dims = ArrayDims (&array->array);
int *limits = ArrayLimits (&array->array);
i = 0;
for (dim = ndim - 1; dim >= 0; dim--)
{
if (dim == 0)
d = last;
else
d = Stack(dim + off - 1);
if (!ValueIsInt(d) || (part = ValueInt(d)) < 0)
{
RaiseStandardException (exception_invalid_argument,
"Array index not non-negative integer",
2, array, d);
return 0;
}
if (limits[dim] <= part)
{
if (resize && array->array.resizable)
{
if (dims[dim] > part)
limits[dim] = part + 1;
else
ArrayResize (array, dim, part + 1);
}
else if (except)
{
RaiseStandardException (exception_invalid_array_bounds,
"Array index out of bounds",
2, array, d);
return 0;
}
}
i = i * dims[dim] + part;
}
return i;
}
/*
* Array initialization
*
* Array initialization uses the stack to hold temporary index values while
* the array is walked. The stack looks like:
*
* array
* major-index
* ...
* minor-index
* num-dimensions
*
* Each Element Repeat instruction indicates which dimension
* is being stepped over. When the entire array has been walked,
* a final Element inst with ndim set to the dimensionality of the
* array is executed which pops the whole mess off the stack and
* returns the completed array
*
* Repeat elements indicate along which dimension the repeat occurs.
* The initial value for the repeat has already been stored in the
* array, so the task is just to copy that first element to the end
* of the dimension.
*/
static void
ThreadArrayReplicate (Value thread, Value array, int dim, int start)
{
int dimsize = 1;
int i;
int total;
Value *elements;
assert (!array->array.resizable);
for (i = 0; i < dim; i++)
dimsize *= ArrayDims(&array->array)[i];
start = start - dimsize;
total = ArrayDims(&array->array)[dim] * dimsize;
elements = BoxElements (array->array.u.fix);
for (i = start + dimsize; i % total; i += dimsize)
memmove (elements + i, elements + start,
dimsize * sizeof (elements[0]));
}
void
ThreadStackDump (Value thread);
static Value
ThreadArrayInit (Value thread, Value value, AInitMode mode,
int dim, int *stack, InstPtr *next)
{
ENTER ();
Value array;
int i;
int ndim;
if (aborting)
RETURN(value);
switch (mode) {
case AInitModeStart:
complete = True;
STACK_PUSH (thread->thread.continuation.stack, value);
for (i = 0; i < dim; i++)
STACK_PUSH (thread->thread.continuation.stack, Zero);
STACK_PUSH (thread->thread.continuation.stack, NewInt(dim));
break;
case AInitModeRepeat:
ndim = ValueInt(Stack(0));
array = Stack(ndim+1);
if (ValueInt(Stack(dim+1)) == ArrayDims(&array->array)[dim])
break;
/* fall through ... */
case AInitModeElement:
ndim = ValueInt(Stack(0));
array = Stack(ndim+1);
/*
* Check and see if we're done
*/
if (dim == ndim)
{
*stack = ndim + 2;
value = array;
break;
}
/*
* Initialize a single value?
*/
if (dim == 0)
{
if (!TypeCompatibleAssign (ArrayType(&array->array), value))
{
RaiseStandardException (exception_invalid_argument,
"Incompatible types in array initialization",
2, array, value);
break;
}
i = ThreadArrayIndex (array, thread, ndim, Stack(1), 2, True, False);
if (aborting)
break;
complete=True;
ArrayValueSet (&array->array, i, Copy (value));
}
complete = True;
/*
* Step to the next element
*/
STACK_DROP(thread->thread.continuation.stack, dim+1);
STACK_PUSH(thread->thread.continuation.stack,
Plus (STACK_POP(thread->thread.continuation.stack),
One));
/*
* Reset remaining indices to zero
*/
for (i = 0; i < dim; i++)
STACK_PUSH (thread->thread.continuation.stack, Zero);
STACK_PUSH (thread->thread.continuation.stack, NewInt (ndim));
if (mode == AInitModeRepeat)
{
i = ThreadArrayIndex (array, thread, ndim, Stack(1), 2, False, False);
ThreadArrayReplicate (thread, array, dim, i);
}
break;
case AInitModeFunc:
if (aborting)
break;
complete = True;
/*
* Fetch the function
*/
value = Stack(dim+2);
/*
* Push args. Tricky because the stack keeps growing
*/
i = dim + 1;
while (--dim >= 0)
{
STACK_PUSH(thread->thread.continuation.stack, value);
value = Stack(i);
}
break;
case AInitModeFuncDone:
ndim = ValueInt(Stack(0));
value = Stack(ndim+1);
*stack = ndim + 3;
break;
case AInitModeTest:
if (aborting)
break;
complete = True;
ndim = ValueInt(Stack(0));
array = Stack(ndim+1);
value = FalseVal;
/* Done with this row? */
if (ValueInt(Stack(1)) == ArrayDims(&array->array)[0])
{
/* Find dim with space */
for (dim = 1; dim < ndim; dim++)
if (ValueInt(Stack(1+dim)) < ArrayDims(&array->array)[dim] - 1)
break;
/* All done? */
if (dim == ndim)
{
value = TrueVal;
break;
}
/*
* Step to the next element
*/
STACK_DROP(thread->thread.continuation.stack, dim+1);
STACK_PUSH(thread->thread.continuation.stack,
Plus (STACK_POP(thread->thread.continuation.stack),
One));
/*
* Reset remaining indices to zero
*/
while (--dim >= 0)
STACK_PUSH (thread->thread.continuation.stack, Zero);
STACK_PUSH (thread->thread.continuation.stack, NewInt (ndim));
}
break;
}
RETURN (value);
}
#ifdef DEBUG_JUMP
void
ThreadCatches (Value thread)
{
CatchPtr catch;
FilePrintf (FileStdout, "(");
for (catch = thread->thread.continuation.catches;
catch;
catch = catch->continuation.catches)
{
FilePrintf (FileStdout, "%A ", catch->exception->symbol.name);
}
FilePrintf (FileStdout, ")\n");
}
#endif
static Value
ThreadRaise (Value thread, Value value, int argc, SymbolPtr exception, InstPtr *next)
{
ENTER ();
StackObject *cstack = thread->thread.continuation.stack;
Value args;
int i;
int base = argc - 2;
#ifdef DEBUG_JUMP
FilePrintf (FileStdout, " Raise: %A ", exception->symbol.name);
ThreadCatches (thread);
#endif
/*
* Build and array to hold the arguments, this will end up
* in the thread's value on entry to the catch block
*/
args = NewArray (False, False, typePoly, 1, &argc);
for (i = 0; i < argc; i++)
ArrayValueSet (&args->array, i, Arg(i));
if (!aborting)
{
RaiseException (thread, exception, args, next);
if (!aborting)
complete = True;
}
RETURN (args);
}
static void
ThreadEndCatch (Value thread, int catches)
{
#ifdef DEBUG_JUMP
FilePrintf (FileStdout, " EndCatch: %d ", catches);
#endif
while (catches--)
thread->thread.continuation.catches = thread->thread.continuation.catches->continuation.catches;
#ifdef DEBUG_JUMP
ThreadCatches (thread);
#endif
}
static Value
ThreadExceptionCall (Value thread, InstPtr *next, int *stack)
{
ENTER ();
Value args;
Value ret;
int argc;
int i;
/*
* The compiler places a Noop with the push flag set
* before the function is stuffed in the thread value,
* this pushes the array of arguments carefully crafted
* in ThreadRaise above. Fetch the argument array and
* push all of them onto the stack.
*/
args = Stack(0);
if (!ValueIsArray (args))
{
RaiseStandardException (exception_invalid_argument,
"exception call argument must be array",
1, args);
*stack = 1;
RETURN (Void);
}
if (aborting)
{
*stack = 1;
RETURN (Void);
}
complete = True;
argc = ArrayLimits(&args->array)[0];
for (i = 0; i < argc; i++)
{
STACK_PUSH (thread->thread.continuation.stack,
thread->thread.continuation.value);
thread->thread.continuation.value = ArrayValue(&args->array, i);
}
/*
* Call the function
*/
ret = ThreadCall (thread, False, next, &argc);
/*
* Account for the argument array
*/
*stack = 1 + argc;
RETURN (ret);
}
static void
ThreadFarJump (Value thread, Value ret, FarJumpPtr farJump, InstPtr *next)
{
ENTER ();
Value continuation;
/*
* Build the continuation
*/
continuation = FarJumpContinuation (&thread->thread.continuation, farJump);
/*
* And jump
*/
if (!aborting)
{
complete = True;
ContinuationJump (thread, &continuation->continuation, ret, next);
}
EXIT ();
}
static void
ThreadUnwind (Value thread, int twixt, int catch)
{
while (twixt--)
thread->thread.continuation.twixts = thread->thread.continuation.twixts->continuation.twixts;
#ifdef DEBUG_JUMP
FilePrintf (FileStdout, " Before unwind: ");
ThreadCatches (thread);
#endif
while (catch--)
{
#ifdef DEBUG_JUMP
FilePrintf (FileStdout, " Unwind: %A\n",
thread->thread.continuation.catches->exception->symbol.name);
#endif
thread->thread.continuation.catches = thread->thread.continuation.catches->continuation.catches;
}
#ifdef DEBUG_JUMP
FilePrintf (FileStdout, " After unwind: ");
ThreadCatches (thread);
#endif
}
#define ThreadBoxCheck(box,i) (BoxValueGet(box,i) == 0 ? ThreadBoxSetDefault(box,i,0) : 0)
typedef struct _TypeChain {
struct _TypeChain *prev;
Type *type;
} TypeChain;
static void
ThreadBoxSetDefault (BoxPtr box, int i, TypeChain *chain)
{
if (BoxValueGet (box, i) == 0)
{
Type *ctype = TypeCanon (BoxType (box, i));
StructType *st = ctype->structs.structs;
TypeChain link, *c;
/*
* Check for recursion
*/
for (c = chain; c; c = c->prev)
if (c->type == ctype)
return;
link.prev = chain;
link.type = ctype;
switch (ctype->base.tag) {
case type_union:
BoxValueSet (box, i, NewUnion (st, False));
break;
case type_struct:
BoxValueSet (box, i, NewStruct (st, False));
box = BoxValueGet (box, i)->structs.values;
for (i = 0; i < st->nelements; i++)
{
if (BoxValueGet (box, i) == 0)
ThreadBoxSetDefault (box, i, &link);
}
break;
default:
break;
}
}
}
static Value
ThreadOpArray (Value thread, Value value, int stack, Bool fetch, Bool typeCheck)
{
Value v;
char *s;
int i;
v = Stack(stack-1);
switch (ValueTag(v)) {
case rep_string:
if (!fetch)
{
RaiseStandardException (exception_invalid_unop_value,
"Strings aren't addressable",
1, value);
break;
}
if (stack != 1)
{
RaiseStandardException (exception_invalid_binop_values,
"Strings have only 1 dimension",
2, NewInt (stack), v);
break;
}
i = IntPart (value, "Invalid string index");
if (aborting)
break;
s = StringChars (&v->string);
if (i < 0 || StringLength (s, v->string.length) <= i)
{
RaiseStandardException (exception_invalid_binop_values,
"String index out of bounds",
2, value, v);
break;
}
value = NewInt (StringGet (s, v->string.length, i));
break;
case rep_array:
if (stack != v->array.ndim)
{
RaiseStandardException (exception_invalid_binop_values,
"Mismatching dimensionality",
2, NewInt (stack), v);
break;
}
i = ThreadArrayIndex (v, thread, stack, value, 0, True, !fetch);
if (!aborting)
{
BoxPtr box = ArrayValueBox (&v->array, i);
int elt = ArrayValueElt (&v->array, i);
if (typeCheck)
ThreadBoxCheck (box, elt);
if (fetch)
value = BoxValue (box, elt);
else
value = NewRef (box, elt);
}
break;
case rep_hash:
if (stack != 1)
{
RaiseStandardException (exception_invalid_binop_values,
"Hashes have only one dimension",
2, NewInt (stack), v);
break;
}
if (fetch)
value = HashGet (v, value);
else
value = HashRef (v, value);
break;
default:
RaiseStandardException (exception_invalid_unop_value,
"Not an array",
1, value);
break;
}
return value;
}
static Value
ThreadOpDot (Value thread, Value value, Atom atom, Bool fetch)
{
Value v;
switch (ValueTag(value)) {
default:
RaiseStandardException (exception_invalid_unop_value,
"Not a struct/union",
1, value);
break;
case rep_struct:
if (fetch)
v = StructMemValue (value, atom);
else
v = StructMemRef (value, atom);
if (!v)
{
RaiseStandardException (exception_invalid_struct_member,
"no such struct member",
2, value,
NewStrString (AtomName (atom)));
break;
}
value = v;
break;
case rep_union:
if (fetch)
v = UnionValue (value, atom);
else
v = UnionRef (value, atom);
if (!v)
{
if (StructMemType (value->unions.type, atom))
RaiseStandardException (exception_invalid_struct_member,
"requested union tag not current",
2, value,
NewStrString (AtomName (atom)));
else
RaiseStandardException (exception_invalid_struct_member,
"no such union tag",
2, value,
NewStrString (AtomName (atom)));
break;
}
value = v;
break;
}
return value;
}
#include <signal.h>
void
ThreadStackDump (Value thread)
{
StackObject *cstack = thread->thread.continuation.stack;
StackChunk *chunk;
StackPointer stackPointer;
int i = 0;
chunk = cstack->current;
stackPointer = STACK_TOP(cstack);
while (chunk)
{
while (stackPointer < CHUNK_MAX(chunk))
{
FilePrintf (FileStdout, "%d: %v\n", i++, (Value) *stackPointer++);
}
chunk = chunk->previous;
stackPointer = CHUNK_MIN(chunk);
}
}
#ifdef DEBUG_INST
int dump_inst = 0;
#endif
void
ThreadsRun (Value thread, Value lex)
{
signalInterrupt = False;
for (;;)
{
if (signaling)
{
signaling = False;
aborting = False;
/*
* Check for pending external signals
*/
if (signalInterrupt)
{
signalInterrupt = False;
if (thread)
ThreadSetState (thread, ThreadInterrupted);
(void) write (2, "<abort>\n", 8);
}
if (signalTimer)
{
signalTimer = False;
TimerInterrupt ();
}
if (signalIo)
{
signalIo = False;
IoInterrupt ();
}
if (signalChild)
{
signalChild = False;
ProcessInterrupt ();
}
if (lex && !(lex->file.flags & (FileInputBlocked|FileOutputBlocked)))
break;
}
else if (thread && !Runnable (thread))
break;
else if (!running)
ThreadsBlock ();
else
{
ENTER ();
Value thread = running;
StackObject *cstack;
InstPtr inst, next;
FramePtr fp;
int i, j;
int stack;
Value value, v, w;
BoxPtr box;
inst = thread->thread.continuation.pc;
value = thread->thread.continuation.value;
cstack = thread->thread.continuation.stack;
for (j = 0; j < 10; j++)
{
stack = 0;
next = inst + 1;
complete = False;
#ifdef DEBUG_INST
if (dump_inst)
{
InstDump (inst, 1, 0, 0, 0);
FileFlush (FileStdout, True);
}
#endif
switch (inst->base.opCode) {
case OpNoop:
break;
case OpBranch:
next = inst + inst->branch.offset;
break;
case OpBranchFalse:
if (!ValueIsBool(value))
{
RaiseStandardException (exception_invalid_argument,
"conditional expression not bool",
2, value, Void);
break;
}
if (!True (value))
next = inst + inst->branch.offset;
break;
case OpBranchTrue:
if (!ValueIsBool(value))
{
RaiseStandardException (exception_invalid_argument,
"conditional expression not bool",
2, value, Void);
break;
}
if (True (value))
next = inst + inst->branch.offset;
break;
case OpCase:
value = Equal (CStack(stack), value);
if (True (value))
{
next = inst + inst->branch.offset;
stack++;
}
break;
case OpDefault:
next = inst + inst->branch.offset;
stack++;
break;
case OpTagCase:
if (!ValueIsUnion(value))
{
RaiseStandardException (exception_invalid_argument,
"union switch expression not union",
2, value, Void);
break;
}
if (value->unions.tag == inst->tagcase.tag)
{
next = inst + inst->tagcase.offset;
v = UnionValue (value, inst->tagcase.tag);
if (!v)
{
if (StructMemType (value->unions.type, inst->atom.atom))
RaiseStandardException (exception_invalid_struct_member,
"requested union tag not current",
2, value,
NewStrString (AtomName (inst->atom.atom)));
else
RaiseStandardException (exception_invalid_struct_member,
"no such union tag",
2, value,
NewStrString (AtomName (inst->atom.atom)));
break;
}
value = v;
}
break;
case OpTagGlobal:
box = inst->box.box;
ThreadAssign (NewRef (inst->box.box, 0), value, True);
break;
case OpTagLocal:
box = thread->thread.continuation.frame->frame;
i = inst->frame.element;
ThreadAssign (NewRef (box, i), value, True);
break;
case OpReturnVoid:
value = Void;
/* fall through */
case OpReturn:
if (!thread->thread.continuation.frame)
{
RaiseStandardException (exception_invalid_argument,
"return outside of function",
2, Void, Void);
break;
}
if (!TypeCompatibleAssign (thread->thread.continuation.frame->function->func.code->base.type,
value))
{
RaiseStandardException (exception_invalid_argument,
"Incompatible type in return",
2, value, Void);
break;
}
if (aborting)
break;
complete = True;
next = thread->thread.continuation.frame->savePc;
thread->thread.continuation.obj = thread->thread.continuation.frame->saveObj;
thread->thread.continuation.frame = thread->thread.continuation.frame->previous;
break;
case OpGlobal:
ThreadBoxCheck (inst->box.box, 0);
value = BoxValue (inst->box.box, 0);
break;
case OpGlobalRef:
ThreadBoxCheck (inst->box.box, 0);
/* fall through... */
case OpGlobalRefStore:
value = NewRef (inst->box.box, 0);
break;
case OpStatic:
case OpStaticRef:
case OpStaticRefStore:
for (i = 0, fp = thread->thread.continuation.frame; i < inst->frame.staticLink; i++)
fp = fp->staticLink;
box = fp->statics;
i = inst->frame.element;
if (inst->base.opCode != OpStaticRefStore)
ThreadBoxCheck (box, i);
if (inst->base.opCode == OpStatic)
value = BoxValue (box, i);
else
value = NewRef (box, i);
break;
case OpLocal:
case OpLocalRef:
case OpLocalRefStore:
for (i = 0, fp = thread->thread.continuation.frame; i < inst->frame.staticLink; i++)
fp = fp->staticLink;
box = fp->frame;
i = inst->frame.element;
if (inst->base.opCode != OpLocalRefStore)
ThreadBoxCheck (box, i);
if (inst->base.opCode == OpLocal)
value = BoxValue (box, i);
else
value = NewRef (box, i);
break;
case OpFetch:
value = Dereference (value);
break;
case OpConst:
value = inst->constant.constant;
break;
case OpBuildArray:
stack = inst->array.ndim;
value = ThreadArray (thread, inst->array.resizable,
stack, inst->array.type);
break;
case OpBuildArrayInd:
value = ThreadArrayInd (thread, inst->array.resizable,
value, inst->array.type);
break;
case OpInitArray:
stack = 0;
value = ThreadArrayInit (thread, value, inst->ainit.mode,
inst->ainit.dim, &stack, &next);
break;
case OpBuildHash:
value = NewHash (False, inst->hash.type->hash.keyType,
inst->hash.type->hash.type);
break;
case OpInitHash:
w = CStack (1);
v = CStack (0);
stack = 2;
HashSet (w, v, value);
value = w;
break;
case OpInitHashDef:
v = CStack (0);
stack = 1;
HashSetDef (v, value);
value = v;
break;
case OpBuildStruct:
value = NewStruct (inst->structs.structs, False);
break;
case OpInitStruct:
w = CStack(0); stack = 1;
v = StructMemRef (w, inst->atom.atom);
if (!v)
{
RaiseStandardException (exception_invalid_struct_member,
"Invalid struct member",
2, v,
NewStrString (AtomName (inst->atom.atom)));
break;
}
ThreadAssign (v, value, True);
value = w;
break;
case OpBuildUnion:
value = NewUnion (inst->structs.structs, False);
break;
case OpInitUnion:
v = UnionRef (value, inst->atom.atom);
if (!v)
{
RaiseStandardException (exception_invalid_struct_member,
"Invalid union member",
2, value,
NewStrString (AtomName (inst->atom.atom)));
break;
}
w = CStack(0); stack = 1;
ThreadAssign (v, w, True);
break;
case OpArray:
case OpArrayRef:
case OpArrayRefStore:
stack = inst->ints.value;
value = ThreadOpArray (thread, value, stack,
inst->base.opCode == OpArray,
inst->base.opCode != OpArrayRefStore);
break;
case OpVarActual:
if (!ValueIsArray(value))
{
RaiseStandardException (exception_invalid_unop_value,
"Not an array",
1, value);
break;
}
if (value->array.ndim != 1)
{
RaiseStandardException (exception_invalid_unop_value,
"Array not one dimension",
1, value);
break;
}
for (i = 0; i < ArrayLimits(&value->array)[0]; i++)
{
STACK_PUSH (cstack, ArrayValue (&value->array, i));
if (aborting)
{
STACK_DROP (cstack, i + 1);
break;
}
}
if (i != ArrayLimits(&value->array)[0])
break;
complete = True;
value = NewInt (ArrayLimits(&value->array)[0]);
break;
case OpCall:
case OpTailCall:
stack = inst->ints.value;
value = ThreadCall (thread, inst->base.opCode == OpTailCall,
&next, &stack);
break;
case OpArrow:
case OpArrowRef:
case OpArrowRefStore:
if (!ValueIsRef(value))
{
RaiseStandardException (exception_invalid_unop_value,
"Not a reference",
1, value);
break;
}
value = RefValue (value);
/* fall through ... */
case OpDot:
case OpDotRef:
case OpDotRefStore:
value = ThreadOpDot (thread, value, inst->atom.atom,
inst->base.opCode == OpArrow || inst->base.opCode == OpDot);
break;
case OpObj:
value = NewFunc (inst->code.code, thread->thread.continuation.frame);
break;
case OpStaticInit:
/* Always follows OpObj so the function is sitting in value */
ThreadStaticInit (thread, &next);
break;
case OpStaticDone:
if (!thread->thread.continuation.frame)
{
RaiseStandardException (exception_invalid_argument,
"StaticInitDone outside of function",
2, Void, Void);
break;
}
if (aborting)
break;
complete = True;
next = thread->thread.continuation.frame->savePc;
thread->thread.continuation.obj = thread->thread.continuation.frame->saveObj;
thread->thread.continuation.frame = thread->thread.continuation.frame->previous;
/* Fetch the Obj from the stack */
value = CStack (0); stack = 1;
break;
case OpBinOp:
value = BinaryOperate (CStack(0), value, inst->binop.op); stack = 1;
break;
case OpBinFunc:
value = (*inst->binfunc.func) (CStack(0), value); stack = 1;
break;
case OpUnOp:
value = UnaryOperate (value, inst->unop.op);
break;
case OpUnFunc:
value = (*inst->unfunc.func) (value);
break;
case OpPreOp:
v = Dereference (value);
v = ValueIncDec (v, inst->binop.op);
ThreadAssign (value, v, False);
value = v;
break;
case OpPostOp:
v = Dereference (value);
ThreadAssign (value, ValueIncDec (v, inst->binop.op), False);
value = v;
break;
case OpAssign:
ThreadAssign (CStack(0), value, inst->assign.initialize); stack = 1;
break;
case OpAssignOp:
v = BinaryOperate (CStack(0), value, inst->binop.op);
ThreadAssign (CStack(1), v, False); stack = 2;
value = v;
break;
case OpAssignFunc:
v = (*inst->binfunc.func) (CStack(0), value);
ThreadAssign (CStack(1), v, False); stack = 2;
value = v;
break;
case OpFork:
value = NewThread (thread->thread.continuation.frame, inst->obj.obj);
break;
case OpCatch:
if (aborting)
break;
#ifdef DEBUG_JUMP
FilePrintf (FileStdout, " Catch: %A ",
inst->catch.exception->symbol.name);
ThreadCatches (thread);
#endif
thread->thread.continuation.catches = NewCatch (thread,
inst->catch.exception);
complete = True;
next = inst + inst->catch.offset;
break;
case OpEndCatch:
if (aborting)
break;
ThreadEndCatch (thread, inst->ints.value);
complete = True;
break;
case OpRaise:
if (aborting)
break;
value = ThreadRaise (thread, value, inst->raise.argc, inst->raise.exception, &next);
break;
case OpExceptionCall:
ThreadExceptionCall (thread, &next, &stack);
break;
case OpTwixt:
if (aborting)
break;
thread->thread.continuation.twixts = NewTwixt (&thread->thread.continuation,
inst + inst->twixt.enter,
inst + inst->twixt.leave);
complete = True;
break;
case OpTwixtDone:
if (aborting)
break;
thread->thread.continuation.twixts = thread->thread.continuation.twixts->continuation.twixts;
complete = True;
break;
case OpEnterDone:
if (thread->thread.jump)
{
if (aborting)
break;
value = JumpContinue (thread, &next);
if (next)
complete = True;
}
break;
case OpLeaveDone:
if (thread->thread.jump)
{
if (aborting)
break;
value = JumpContinue (thread, &next);
if (next)
complete = True;
}
break;
case OpFarJump:
ThreadFarJump (thread, value, inst->farJump.farJump, &next);
break;
case OpUnwind:
ThreadUnwind (thread, inst->unwind.twixt, inst->unwind.catch);
break;
case OpEnd:
SetSignalFinished ();
break;
case OpDrop:
stack = 1;
break;
default:
break;
}
#if 0
assert (!next ||
(ObjCode (thread->thread.continuation.obj, 0) <= next &&
next <= ObjCode (thread->thread.continuation.obj,
thread->thread.continuation.obj->used)));
#endif
if (aborting && !complete)
{
/*
* Check for pending execution signals
*/
if (signalSuspend)
{
signalSuspend = False;
ThreadSetState (thread, ThreadSuspended);
}
if (signalFinished)
{
signalFinished = False;
ThreadFinish (thread, False);
}
if (signalException)
{
signalException = False;
thread->thread.continuation.value = JumpStandardException (thread, &next);
thread->thread.continuation.pc = next;
}
if (signalError)
{
signalError = False;
ThreadFinish (thread, True);
}
if (signalProfile)
signalProfile = False;
break;
}
/* have to do this before the pc is updated */
if (signalProfile)
{
signalProfile = False;
ProfileInterrupt (running);
}
/* this instruction has been completely executed */
thread->thread.partial = 0;
thread->thread.continuation.value = value;
cstack = thread->thread.continuation.stack;
if (stack)
STACK_DROP (cstack, stack);
if (inst->base.flags & InstPush)
STACK_PUSH (cstack, value);
inst = next;
thread->thread.continuation.pc = inst;
if (thread->thread.next)
{
ThreadStepped (thread);
if (running != thread)
{
break;
}
}
}
EXIT ();
}
}
}
syntax highlighted by Code2HTML, v. 0.9.1