/******************************** -*- C -*- ****************************
 *
 *	The Smalltalk Virtual Machine in itself.
 *
 *	This, together with oop.c, is the `bridge' between Smalltalk and
 *	the underlying machine
 *
 *	$Revision: 1.7.5$
 *	$Date: 2000/05/28 16:56:52$
 *	$Author: pb$
 *
 ***********************************************************************/

/***********************************************************************
 *
 * Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
 * Written by Steve Byrne.
 *
 * This file is part of GNU Smalltalk.
 *
 * GNU Smalltalk is free software; you can redistribute it and/or modify it
 * under the terms of the GNU General Public License as published by the Free
 * Software Foundation; either version 2, or (at your option) any later
 * version.
 *
 * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
 * more details.
 *
 * You should have received a copy of the GNU General Public License along with
 * GNU Smalltalk; see the file COPYING.	 If not, write to the Free Software
 * Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *
 ***********************************************************************/

#include "gst.h"
#include "alloc.h"
#include "interp.h"
#include "register.h"
#include "dict.h"
#include "oop.h"
#include "save.h"
#include "sym.h"
#include "comp.h"
#include "callin.h"
#include "cint.h"
#include "sysdep.h"
#include "lex.h"
#include "lib.h"
#include "byte.h"
#include <math.h>
#include <stdio.h>
#include <signal.h>
#include <sys/stat.h>
#include <sys/types.h>
#include <setjmp.h>

#ifdef STDC_HEADERS
#include <string.h>
#include <stdlib.h>
#endif /* STDC_HEADERS */
#ifdef HAVE_IO_H
#include <io.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif


/* The local regs concept hopes, by caching the values of IP and SP in local
 * register variables, to increase performance.	 You only need to export the
 * variables when calling out to routines that might change them and that
 * create objects.  This is because creating objects may trigger the GC, which
 * can change the values of IP and SP (since they point into the object space).
 * It's easy to deal with that, however, it's just a matter of importing and
 * exporting the registers at the correct places: for example stack operations
 * are innocuous, while message sends can result in a GC (because stack chunks
 * are exhausted or because primitive #new is invoked), so they export the
 * registers and import them (possibly with their value changed by the GC)
 * after the send.  I'm leaving the code to deal with them as local registers
 * conditionally compiled in so that you can disable it easily if necessary. */
#define LOCAL_REGS

#ifdef HAVE_GOTO_VOID_P

/* New-style dispatching obtains a 30/40% speed boost over standard
 * switch-statement dispatching.  It works by replacing the switch statement
 * with a `computed goto'.  The checks for asynchronous events (semaphore
 * signals, timers, etc.) are skipped because code that handles these events
 * modifies the interpreter's status so that the next `computed goto' jumps to
 * where the event is passed to Smalltalk.  The default is to use new-style
 * dispatch with GNU C; comment this to use old-style dispatching with GCC
 * too. */
#define USE_GCC_DISPATCH
#endif /* HAVE_GOTO_VOID_P */

/* By "hard wiring" the definitions of the special math operators (bytecodes
 * 176-191), we get a performance boost of more than 50%.  Yes, it means that
 * we cannot redefine + et al for SmallInteger and Float, but I think the
 * trade is worth it.  Besides, the Blue Book does it. */
#define OPEN_CODE_MATH

/* Jump lookahead uses special machinery after open-coded boolean selectors
 * (<, =, >, <=, >=, ~= for Integers and Floats; ==, isNil and notNil for all
 * objects) that executes conditional jump bytecodes without pushing and
 * popping the result of the comparison.  This catches the common
 * "a < b ifTrue: [ ... ]" and "[ ... a < b ] whileTrue: [ ... ]" patterns,
 * as well as code generated for #to:do:, #timesRepeat: and #to:by:do: .
 * Jump lookahead only works with the GCC bytecode interpreter (that is,
 * USE_GCC_DISPATCH defined, USE_DYNAMIC_TRANSLATION not defined). */
#define JUMP_LOOKAHEAD

/* Used to handle the case when the user types a ^C while executing callout
 * code.  If STACK_JMPBUFS is defined, the C callout primitive saves the
 * old jmp_buf on the stacks and uses a new one; if it is not defined, a ^C
 * will immediately jump outside ALL the callouts.  The former behavior is
 * usually cleaner, so I define it. */
#define STACK_JMPBUFS

/* This symbol does not control execution speed.  Instead, it causes
 * sendMessage to print every message that is ever sent in the
 * SmallInteger(Object)>>#printString form.  Can be useful to find out
 * the last method sent before an error, if the context stack is
 * trashed when the debugger gets control and printing a backtrace
 * is impossible. */
/* #define DEBUG_CODE_FLOW */

/* The method cache is a hash table used to cache the most commonly used
 * methods.  Its size is determined by this preprocessor constant.  It is
 * currently 2048, a mostly random choice; you can modify it, but be sure
 * it is a power of two.
 * Additionally, separately from this, the interpreter caches the last
 * primitive numbers used for sends of #at:, #at:put: and #size, in an
 * attempt to speed up these messages for Arrays, Strings, and
 * ByteArrays. */
#define METHOD_CACHE_SIZE		(1 << 11)

#define ASYNC_QUEUE_SIZE		100 /* way too much */

/* Max number of C-style signals on a machine */
#ifdef NSIG
#define NUM_SIGNALS	NSIG
#else
#define NUM_SIGNALS	64		/* should be enough */
#endif


/* If this is true, for each byte code that is executed, we print on
 * stdout the byte index within the current CompiledMethod and a
 * decoded interpretation of the byte code. */
mst_Boolean			executionTracing;

/* When this is true, and an interrupt occurs (such as SIGSEGV), Smalltalk
 * will terminate itself by making a core dump (normally it produces a
 * backtrace). */
mst_Boolean			makeCoreFile = false;

/* When true, this indicates that there is no top level loop for control
 * to return to, so it causes the system to exit. */
mst_Boolean			nonInteractive = true;

/* Number of samples, i.e. cache lookups - either hits or misses */
unsigned long			sampleCounter;

unsigned long			literalReturns, instVarReturns, selfReturns;
unsigned long			primitivesExecuted;
unsigned long			byteCodeCounter;
unsigned long			cacheMisses;

typedef Byte			InstructionType;

OOP				thisMethod;
OOP				*outerSP;
static InstructionType		*outerIP, *methodBase;


#ifdef PROFBLOCK
struct profStruct ps;
static long		byteCodes[256];
static long		primitives[1024];
#endif

typedef struct MethodCacheEntryStruct {
  OOP		selectorOOP;
  OOP		startingClassOOP;
  OOP		methodOOP;
  OOP		methodClassOOP;
  MethodHeader	methodHeader;
} MethodCacheEntry;




/* points into method or context to start of literals, arguments and temporaries */
static OOP		*temporaries, *literals;
static OOP		self;
static OOP		thisContextOOP;
static mst_Boolean	inInterpreter = false;

static MethodCacheEntry methodCache[METHOD_CACHE_SIZE];
static OOP		atCacheClass, atPutCacheClass, sizeCacheClass;
static int		atCachePrim, atPutCachePrim, sizeCachePrim;
static int		lastPrimitive;

static OOP		switchToProcess; /* non-nil when proc switch wanted */

/* Holds the semaphore to signal when the processor interval timesout */
static volatile OOP		timeoutSem;
static volatile OOP		semIntVec[NUM_SIGNALS];

/* Queue for async (outside the interpreter) semaphore signals */
static volatile OOP		queuedAsyncSignals[ASYNC_QUEUE_SIZE];
static volatile int		asyncQueueIndex;

/* When not nil, this causes the byte code interpeter to immediately send
 * the message whose selector is here to the current stack top. */
static volatile char		*abortExecution = nil;

static volatile mst_Boolean	exceptFlag;

/* When this is true, it means that the system is executing external C code,
 * which can be used by the ^C handler to know whether it should longjmp to
 * the end of the C callout primitive in executePrimitiveOperation. */
static mst_Boolean		inCCode = false;

/* This type hides the implementation of the jmp_buf type.  The original
 * reason was that if jmp_buf is implemented as an array, taking its
 * address caused the compiler to warn about taking the address of an
 * array, and there was no way to tell at compile time whether this is
 * going to be a problem.  Now I built the jmpBuf chain in the structure
 * (a provision for possible future changes) so the structure is needed
 * anyway.
 */

typedef struct InterpJmpBufStruct {
  jmp_buf			jmpBuf;
  struct InterpJmpBufStruct	*old;
} InterpJmpBuf;

static InterpJmpBuf		baseCalloutJmpBuf,
				*cCalloutJmpBuf = &baseCalloutJmpBuf;

/* when this flag is on and execution tracing is in effect, the top
 * of the stack is printed as well as the byte code */
static mst_Boolean		verboseExecTracing = false;


static OOP			highestPriorityProcess(), removeFirstLink(),
				nextScheduledProcess();

static void			stopExecuting(),
				sleepProcess(), activateProcess(),
				changeProcessContext(), addLastLink(),
				markSemaphoreOOPs(), syncSignal(),
				emptyContextStack();

static mst_Boolean		sendBlockValue(), resumeProcess(),
				isProcessReady(), executePrimitiveOperation(),
				lookupMethod();

static MethodContext		allocNewChunk();

static inline void		unwindToContext(), deallocStackContext(),
				prepareContext(), unwindLastContext();

static inline long		mulWithCheck();

static inline mst_Boolean	isEmpty(), isProcessTerminating(),
				*boolAddrIndex();

static inline OOP		getActiveProcess(), semaphoreNew();

static inline MethodContext	allocStackContext(), activateNewContext();

static RETSIGTYPE		interruptHandler(SIG_ARG_TYPE),
				timeoutHandler(SIG_ARG_TYPE),
				semIntHandler(SIG_ARG_TYPE);

#define activeProcessYield() \
  activateProcess(nextScheduledProcess());

#define getProcessLists() \
  (((ProcessorScheduler)oopToObj(processorOOP))->processLists)

/* SET_EXCEPT_FLAG is defined in bytecode.inl */
#define setExceptFlag(x) {						\
  exceptFlag = (x);							\
  SET_EXCEPT_FLAG(x);							\
}

#define methodCacheHash(sendSelector, methodClass)			\
    (( ((long)(sendSelector)) ^ ((long)(methodClass)) >> LONG_SHIFT+1)	\
      & (METHOD_CACHE_SIZE - 1))


#ifdef OPTIMIZE
#define receiverVariable(receiver, index) \
  (oopToObj(receiver)->data[index])
#else
#define receiverVariable(receiver, index) \
  (inBounds(receiver, index) ? oopToObj(receiver)->data[index] \
    : (errorf("Index out of bounds %d", index), debug(), nilOOP))
#endif /* OPTIMIZE */


#define methodTemporary(index) \
  (temporaries[index])

#define methodLiteral(index) \
  (literals[index])

#define methodVariable(index) \
  (associationValue(literals[index]))

#define noParentContext(methodOOP) \
  (isNil(((MethodContext)oopToObj(methodContextOOP))->parentContext))

#define sendToSuper(sendSelector, sendArgs, dummy) \
    { register OOP __oop; \
      register mst_Object __obj; \
      __oop = thisMethod; \
      __obj = oopToObj(__oop); \
      do { \
        __oop = ((Method) __obj)->descriptor; \
        __obj = oopToObj(__oop); \
      } while (__obj->objClass != methodInfoClass); \
      __oop = ((MethodInfo) __obj)->class; \
      sendMessageInternal(sendSelector, sendArgs, self, superClass(__oop)); }

#ifdef OPTIMIZE
#define storeReceiverVariable(receiver, index, oop) \
  oopToObj(receiver)->data[index] = (oop)

#else /* !optimize */
#define storeReceiverVariable(receiver, index, oop) \
{  \
  OOP __storeRecVarOOP = (oop); \
  if (!inBounds(receiver, index)) { \
    errorf("Index out of bounds %d", index); \
    debug(); \
  } \
  oopToObj(receiver)->data[index] = __storeRecVarOOP; \
}
#endif /* OPTIMIZE */

#define storeMethodTemporary(index, oop) \
  temporaries[index] = (oop)

#define storeMethodVariable(index, oop) \
  setAssociationValue(literals[index], oop)

#define storeMethodLiteral(index, oop) \
  (literals[index] = (oop))

#ifdef OPTIMIZE
#define inBounds(oop, index) true
#else /* !optimize */
#define inBounds(oop, index) ((index) < numOOPs(oopToObj(oop)))
#endif

#define isMethodContext(context) \
  isInt( ((MethodContext)(context)) ->flags)

#define isExecutionEnvironmentContext(context) \
  ( ((MethodContext)(context)) ->flags == fromInt(1) )

#define FIXED_CTX_SIZE	(sizeof(struct MethodContextStruct) / sizeof(long) - 1)
#define CTX_SIZE(depth) (((depth) << DEPTH_SCALE) + FIXED_CTX_SIZE)

/* I made CHUNK_SIZE a nice power of two.  Allocate 64KB at a time, never
   use more than 3 MB;	anyway these are here so behavior can be fine
   tuned.  MAX_LIFO_DEPTH is enough to have room for an entire stack
   chunk and avoid testing for overflows in lifoContexts. */

#define CHUNK_SIZE			16384
#define MAX_CHUNKS_IN_MEMORY		48
#define MAX_LIFO_DEPTH			(CHUNK_SIZE / CTX_SIZE(0))


static OOP		*curChunkBegin = nil, *curChunkEnd = nil;
static OOP		*chunks[MAX_CHUNKS_IN_MEMORY];
static OOP		**chunk = chunks - 1;

static struct OOPStruct lifoContexts[MAX_LIFO_DEPTH];
static OOP		freeLifoContext = lifoContexts;

#include "bytecode.inl"


void
emptyContextPool()
{
  curChunkBegin = curChunkEnd = nil;
  chunk = chunks - 1;
}

void
emptyContextStack()
{
  register OOP		 contextOOP, last, oop;
  register MethodContext context;

  /* printf("[[[[ Gosh, not lifo anymore! (free = %p, base = %p)\n",
    freeLifoContext, lifoContexts); */
  if (freeLifoContext != lifoContexts) {
    freeLifoContext = contextOOP = lifoContexts;
    last = thisContextOOP;
    context = (MethodContext) oopToObj(contextOOP);

    for (;;) {
      oop = allocOOP(context);
      oop->flags = F_POOLED | F_CONTEXT;

      /* Fill the object's uninitialized fields. */
      context->objClass = isMethodContext(context)
	? methodContextClass : blockContextClass;

      /* The last context is not referenced anywhere, so we're done with it. */
      if(contextOOP++ == last) {
	break;
      }

      /* Else we redirect its sender field to the main OOP table */
      context = (MethodContext) oopToObj(contextOOP);
      context->parentContext = oop;
    }
    thisContextOOP = oop;
  } else {
    if (!ip) {
      return;
    }
    context = (MethodContext) oopToObj(thisContextOOP);
  }

  /* When a context gets out of the context stack it must be a fully
   * formed Smalltalk object.  These fields were left uninitialized
   * in sendMessageInternal and sendBlockValue -- set them here. */
  context->method = thisMethod;
  context->receiver = self;
  context->spOffset = fromInt(sp - context->contextStack);
  context->ipOffset = fromInt(ip - methodBase);
}

MethodContext
allocNewChunk()
{
  register MethodContext newContext;

  if (++chunk >= &chunks[MAX_CHUNKS_IN_MEMORY]) {
    /* No more chunks available - GC */
    minorGCFlip();
    ++chunk;
  } else {
    emptyContextStack();
  }
  if (!(newContext = (MethodContext) *chunk)) {
    /* Allocate memory only the first time we're using the chunk.
     * emptyContextPool resets the status but doesn't free the
     * memory. */
    curChunkBegin = curChunkEnd = *chunk = (OOP *)
      xmalloc(size2Bytes(CHUNK_SIZE));

    newContext = (MethodContext) curChunkBegin;
  } else {
    curChunkBegin = curChunkEnd = *chunk;
  }

  curChunkEnd += CHUNK_SIZE;
  return (newContext);
}

MethodContext
allocStackContext(size)
     register int size;
{
  register MethodContext newContext;

#ifdef PROFBLOCK
  ps.numMethodAllocs++;
#endif

  size = CTX_SIZE(size);
  newContext = (MethodContext) curChunkBegin;
  curChunkBegin += size;
  if (curChunkBegin >= curChunkEnd) {
    /* Not enough room in the current chunk */
    newContext = allocNewChunk();
    curChunkBegin += size;
  }

  newContext->objSize = size;
  return (newContext);
}

MethodContext
activateNewContext(size, sendArgs)
     register int size;
     int	  sendArgs;
{
  register OOP		 oop;
  register MethodContext newContext;
  register MethodContext thisContext;

#ifndef OPTIMIZE
  if (isNil(thisContextOOP)) {
    printf("Somebody forgot prepareExecutionEnvironment!\n");
    debug();
  }
#endif

  /* We cannot overflow lifoContexts, because it is designed to contain
   * all of the contexts in a chunk, and we empty lifoContexts when we
   * exhaust a chunk.  So we can get the oop the easy way. */
  newContext = allocStackContext(size);
  oop = freeLifoContext++;

  /* printf("[[[[ Context (size %d) allocated at %p (oop = %p)\n", size, newContext, oop); */
  setOOPObject(oop, newContext);
  newContext->parentContext = thisContextOOP;

  /* save old context information */
  /* leave sp pointing to receiver, which is replaced on return with value */
  thisContext = (MethodContext)oopToObj(thisContextOOP);
  thisContext->method = thisMethod;
  thisContext->receiver = self;
  thisContext->spOffset = fromInt((sp - thisContext->contextStack) - sendArgs);
  thisContext->ipOffset = fromInt(ip - methodBase);

  thisContextOOP = oop;

  return (newContext);
}

void
deallocStackContext(context)
     register BlockContext	context;
{
#ifndef OPTIMIZE
  if (freeLifoContext == lifoContexts
      || (oopToObj(freeLifoContext - 1) != (mst_Object) context)) {
    errorf("Deallocating a non-LIFO context!!!");
    debug();
  }
#endif

  curChunkBegin = (OOP *) context;
  freeLifoContext--;

#ifdef PROFBLOCK
  ps.numMethodFrees++;
#endif
}

/* Now that's what I call an unrolled loop!!! */
void
prepareContext(context, args, temps)
     BlockContext context;
     int	  args;
     int	  temps;
{
  REGISTER(1, OOP *mySP);
  temporaries = mySP = context->contextStack;
  if (args) {
    REGISTER(2, unsigned int num);
    REGISTER(3, OOP *src);
    num = args;
    src = &sp[1-num];
  __switch:
    switch(num) {
      default:
	do {
	  mySP[0] = src[0]; mySP[1] = src[1];
	  mySP[2] = src[2]; mySP[3] = src[3];
	  mySP[4] = src[4]; mySP[5] = src[5];
	  mySP[6] = src[6]; mySP[7] = src[7];
	  mySP += 8; src += 8; num -= 8;
	} while(num > 8);
	goto __switch;

      case 8: mySP[7] = src[7];
      case 7: mySP[6] = src[6];
      case 6: mySP[5] = src[5];
      case 5: mySP[4] = src[4];
      case 4: mySP[3] = src[3];
      case 3: mySP[2] = src[2];
      case 2: mySP[1] = src[1];
      case 1: mySP[0] = src[0];
      case 0: break;
    }
    mySP += num;
  }
  mySP = nilFill(mySP, temps);
  sp = --mySP;
}

mst_Boolean
lookupMethod(sendSelector, methodData, sendArgs, methodClass)
     register OOP		methodClass, sendSelector;
     int			sendArgs;
     register MethodCacheEntry	*methodData;
{
  IncPtr	inc;
  long		i;
  OOP		argsArray;

#ifdef PROFBLOCK
  if (methodData->selectorOOP != nil) {
    ps.numCacheCollisions++;
  }
#endif
  methodData->startingClassOOP = methodClass;
  methodData->selectorOOP = sendSelector;
  for (; !isNil(methodClass); methodClass = superClass(methodClass)) {
    OOP methodOOP = findClassMethod(methodClass, sendSelector);
    if (!isNil(methodOOP)) {
      methodData->methodOOP = methodOOP;
      methodData->methodClassOOP = methodClass;
      methodData->methodHeader = getMethodHeader(methodOOP);
      cacheMisses++;
      return (true);
    }
  }


  inc = incSavePointer();
  argsArray = arrayNew(sendArgs);
  incAddOOP(argsArray);
  for (i = 0; i < sendArgs; i++) {
    arrayAtPut(argsArray, i+1, stackAt(sendArgs-i-1));
  }
  popNOOPs(sendArgs);
  pushOOP(messageNewArgs(sendSelector, argsArray));
  incRestorePointer(inc);
  sendMessage(doesNotUnderstandColonSymbol, 1, false);
  return(false);
}

/* On entry to this routine, the stack should have the receiver and the
 * arguments pushed on the stack.  We need to get a new context, setup
 * things like the IP, SP, and Temporary pointers, and then return.   Note
 * that this routine DOES NOT invoke the interpreter; it merely sets up a
 * new context so that calling (or, more typically, returning to) the
 * interpreter will operate properly.  This kind of sending is for normal
 * messages only.  Things like sending a "value" message to a block context are
 * handled by primitives which do similar things, but they use information from
 * BlockClosure objects that we don't have available (nor need) here.
 */

#include "prims.inl"

void
sendMessageInternal(sendSelector, sendArgs, receiver, methodClass)
     OOP	sendSelector;
     int	sendArgs;
     OOP	receiver;
     OOP	methodClass;	/* the class in which to start the search */
{
  long				hashIndex;
  REGISTER(1, MethodContext	newContext);
  REGISTER(2, MethodCacheEntry	*methodData);
  REGISTER(3, MethodHeader	header);

  /* hash the selector and the class of the receiver together using XOR.
   * Since both are addresses in the oopTable, and since oopTable entries
   * are 2 longs in size, shift over by 3 bits (4 on 64-bit architectures)
   * to remove the useless low order zeros. */

#ifdef PROFBLOCK
  ps.numMessageSends++;
#endif
  sampleCounter++;
  hashIndex = methodCacheHash(sendSelector, methodClass);
  methodData = &methodCache[hashIndex];

  if (methodData->selectorOOP != sendSelector
      || methodData->startingClassOOP != methodClass) {
    /* :-( cache miss )-: */
    if (!lookupMethod (sendSelector, methodData, sendArgs, methodClass)) {
      return;
    }
  }

  header = methodData->methodHeader;

#ifndef OPTIMIZE
#ifdef DEBUG_CODE_FLOW
  {
#else /* !DEBUG_CODE_FLOW */
  if (header.numArgs != (unsigned)sendArgs) {
#endif /* !DEBUG_CODE_FLOW */
    OOP receiverClass;
    if (isInt(receiver)) {
      receiverClass = smallIntegerClass;
    } else {
      receiverClass = oopClass(receiver);
    }
    printObject(receiverClass);
    if (receiverClass != methodData->methodClassOOP) {
      printf("(");
      printObject(methodData->methodClassOOP);
      printf(")");
    }
    printf(">>");
    printObject(methodData->selectorOOP);
    printf("\n");
    if (header.numArgs != (unsigned)sendArgs) {
      debug();
      errorf("invalid number of arguments %d, expecting %d", sendArgs,
	     header.numArgs);

      return;
    }
  }
#endif /* !OPTIMIZE */

  if (header.headerFlag) {
    switch (header.headerFlag) {
    case 1:
      /* 1, return the receiver - self is already on the stack...so we leave it */
      selfReturns++;
      return;

    case 2: {
      register long primIndex = header.primitiveIndex;
      /* 2, return instance variable */
      /* replace receiver with the returned instance variable */
      setStackTop(receiverVariable(receiver, primIndex));
      instVarReturns++;
      return;
    }

    case 3: {
      /* 3, return literal constant */
      /* replace receiver with the returned literal constant */
      setStackTop( getMethodLiterals(methodData->methodOOP) [0] );
      literalReturns++;
      return;
    }

    case 4:
      if (!executePrimitiveOperation(
	header.primitiveIndex, sendArgs, methodData->methodOOP)) {

	/* primitive succeeded.	 Continue with the parent context */
	return;
      }
      /* primitive failed.  Invoke the normal method.  methodData
       * may be clobbered by a setjmp in executePrimitiveOperation */
      methodData = &methodCache[hashIndex];
      break;

    case 0:	/* only here so that the compiler skips a range check */
    case 5:
    case 6:
    case 7:
    default: break;
    }
  }

#ifdef PROFBLOCK
  ps.stackDepth++;
  if (ps.stackDepth > ps.maxStackDepth) {
    ps.maxStackDepth = ps.stackDepth;
  }
#endif

  /* prepare new state */
  newContext = activateNewContext(header.stackDepth, sendArgs);
  newContext->flags = fromInt(0);
  setThisMethod(methodData->methodOOP, 0);
  self = receiver;

  /* push args and temps, set sp and temporaries */
  prepareContext(newContext, sendArgs, header.numTemps);
}


/*
 *	static mst_Boolean sendBlockValue(numArgs)
 *
 * Description
 *
 *	This is the equivalent of sendMessage, but is for blocks.  The block
 *	context that is to the the receiver of the "value" message should be
 *	"numArgs" into the stack.  Temporaries come from the block's method
 *	context, as does self.	IP is set to the proper
 *	place within the block's method's byte codes, and SP is set to the top
 *	of the arguments in the block context, which have been copied out of
 *	the caller's context.
 *
 * Inputs
 *
 *	numArgs:
 *		The number of arguments sent to the block.
 *
 * Outputs
 *
 *	true if failed, false if numArgs matches what the BlockClosure says.
 */
static mst_Boolean
sendBlockValue(numArgs)
     int	numArgs;
{
  OOP				closureOOP;
  REGISTER(1, BlockContext	blockContext);
  REGISTER(2, BlockClosure	closure);
  REGISTER(3, BlockHeader	header);

  closureOOP = stackAt(numArgs);
  closure = (BlockClosure)oopToObj(closureOOP);
  header = ((Block)oopToObj(closure->block))->header;
  if(numArgs != header.numArgs) {
    /* check numArgs asap */
    return (true);
  }

#ifdef PROFBLOCK
  ps.numValues++;
  ps.stackDepth++;
  if (ps.stackDepth > ps.maxStackDepth) {
    ps.maxStackDepth = ps.stackDepth;
  }
#endif

  /* prepare the new state, loading data from the closure */
  /* gc might happen - so reload everything. */
  blockContext = (BlockContext)activateNewContext(header.depth, numArgs);
  closure = (BlockClosure)oopToObj(closureOOP);
  blockContext->outerContext = closure->outerContext;
  self = closure->receiver;
  setThisMethod(closure->block, 0);

  /* push args and temps */
  prepareContext(blockContext, numArgs, header.numTemps);
  return(false);
}

/*
 *	static void unwindToContext(returnContext)
 *
 * Description
 *
 *	Unwind up to context "returnContext", not including it.	 Note that
 *	that context won't in general be the current context.  If returnContext
 *	is not a block context, then we need to carefully unwind the method call
 *	stack.	That is, we examine each context and we only deallocate those
 *	that, during their execution, did not create a block context; the others
 *	need to be marked as returned.	We continue up the call chain until we
 *	finally reach returnContext.  The status of the VM is NOT restored, and
 *	the last context is not unwound -- if you need this you have to manually
 *	call unwindLastContext.
 *
 * Inputs
 *
 *	returnContext:
 *		The context that we're going to return from, an OOP.  This may
 *		not be, and in general won't be, the current context.
 */
void
unwindToContext(returnContext)
     REGISTER(1, OOP		returnContext);
{
  REGISTER(2, BlockContext	oldContext);
  REGISTER(3, OOP		oldContextOOP);

  oldContextOOP = thisContextOOP;
  while (oldContextOOP != returnContext) {
#ifdef PROFBLOCK
    ps.stackDepth--;
#endif
    oldContext = (BlockContext)oopToObj(oldContextOOP);
    oldContextOOP = oldContext->parentContext;
    if (freeLifoContext > lifoContexts) {
      deallocStackContext(oldContext);
    } else {
      /* This context created a full block.  We must keep it around so that
       * the blocks it created can reference arguments and temporaries in it.
       * Method contexts, however, need to be marked as non-returnable so that
       * attempts to return from them to an undefined place will lose; doing
       * that for block context too, we skip a test and are also able to
       * garbage collect more context objects.	*/
      oldContext->parentContext = nilOOP;
    }
  }
  thisContextOOP = oldContextOOP;
}

/*
 *	static void unwindLastContext()
 *
 * Description
 *
 *	Return from the current context and restore the virtual machine's
 *	status (ip, sp, thisMethod, self, ...)
 *
 */
void
unwindLastContext()
{
  REGISTER(1, BlockContext	oldContext);
  REGISTER(2, OOP		oldContextOOP);
  REGISTER(3, OOP		methodOOP);

#ifdef PROFBLOCK
  ps.stackDepth--;
#endif
  oldContextOOP = thisContextOOP;
  oldContext = (BlockContext)oopToObj(oldContextOOP);
  oldContextOOP = oldContext->parentContext;

  if (freeLifoContext > lifoContexts) {
    deallocStackContext(oldContext);
  } else {
    /* This context created a full block.  We must keep it around so that
     * the blocks it created can reference arguments and temporaries in it.
     * Method contexts, however, need to be marked as non-returnable so that
     * attempts to return from them to an undefined place will lose; doing
     * that for block context too, we skip a test and are also able to
     * garbage collect more context objects.  */
    oldContext->parentContext = nilOOP;
  }

  oldContext = (BlockContext)oopToObj(oldContextOOP);
  thisContextOOP = oldContextOOP;
  temporaries = oldContext->contextStack;
  sp = oldContext->contextStack + toInt(oldContext->spOffset);
  self = oldContext->receiver;
  methodOOP = oldContext->method;

  setThisMethod(methodOOP, toInt(oldContext->ipOffset));
}


void
changeProcessContext(newProcess)
     OOP	newProcess;
{
  MethodContext thisContext;
  OOP		processOOP;
  Process	process;
  ProcessorScheduler processor;

  switchToProcess = nilOOP;

  /* save old context information */
  if (ip) {
    emptyContextStack();
  }

  processor = (ProcessorScheduler)oopToObj(processorOOP);
  processOOP = processor->activeProcess;
  if (processOOP != newProcess && !isProcessTerminating(processOOP)) {
    process = (Process)oopToObj(processOOP);
    process->suspendedContext = thisContextOOP;
  }

  processor->activeProcess = newProcess;
  process = (Process)oopToObj(newProcess);

  thisContextOOP = process->suspendedContext;
  thisContext = (MethodContext)oopToObj(thisContextOOP);

  setThisMethod(thisContext->method, toInt(thisContext->ipOffset));
  sp = thisContext->contextStack + toInt(thisContext->spOffset);

  temporaries = thisContext->contextStack;
  self = thisContext->receiver;
}


OOP
getActiveProcess()
{
  ProcessorScheduler processor;

  if (!isNil(switchToProcess)) {
    return (switchToProcess);
  } else {
    processor = (ProcessorScheduler)oopToObj(processorOOP);
    return (processor->activeProcess);
  }
}

static void
addFirstLink(semaphoreOOP, processOOP)
     OOP	semaphoreOOP, processOOP;
{
  Semaphore	sem;
  Process	process, lastProcess;
  OOP		lastProcessOOP;

  process = (Process)oopToObj(processOOP);
  if (!isNil(process->myList)) {
    sem = (Semaphore)oopToObj(process->myList);
    if (sem->firstLink == processOOP) {
      sem->firstLink = process->nextLink;
      if (sem->lastLink == processOOP) {
	/* It was the only process in the list */
	sem->lastLink = nilOOP;
      }
    } else if (sem->lastLink == processOOP) {
      /* Find the new last link */
      lastProcessOOP = sem->firstLink;
      lastProcess = (Process) oopToObj(lastProcessOOP);
      while(lastProcess->nextLink != processOOP) {
	lastProcessOOP = lastProcess->nextLink;
	lastProcess = (Process) oopToObj(lastProcessOOP);
      }
      sem->lastLink = lastProcessOOP;
      lastProcess->nextLink = nilOOP;
    }
  }

  sem = (Semaphore)oopToObj(semaphoreOOP);
  process->myList = semaphoreOOP;
  process->nextLink = sem->firstLink;

  sem->firstLink = processOOP;
  if (isNil(sem->lastLink)) {
    sem->lastLink = processOOP;
  }
}

static void
addLastLink(semaphoreOOP, processOOP)
     OOP	semaphoreOOP, processOOP;
{
  Semaphore	sem;
  Process	process, lastProcess;
  OOP		lastProcessOOP;

  process = (Process)oopToObj(processOOP);
  if (!isNil(process->myList)) {
    sem = (Semaphore)oopToObj(process->myList);
    if (sem->firstLink == processOOP) {
      sem->firstLink = process->nextLink;
      if (sem->lastLink == processOOP) {
	/* It was the only process in the list */
	sem->lastLink = nilOOP;
      }
    } else if (sem->lastLink == processOOP) {
      /* Find the new last link */
      lastProcessOOP = sem->firstLink;
      lastProcess = (Process) oopToObj(lastProcessOOP);
      while(lastProcess->nextLink != processOOP) {
	lastProcessOOP = lastProcess->nextLink;
	lastProcess = (Process) oopToObj(lastProcessOOP);
      }
      sem->lastLink = lastProcessOOP;
      lastProcess->nextLink = nilOOP;
    }
  }

  sem = (Semaphore)oopToObj(semaphoreOOP);
  process->myList = semaphoreOOP;
  process->nextLink = nilOOP;

  if (isNil(sem->lastLink)) {
    sem->firstLink = sem->lastLink = processOOP;
  } else {
    lastProcessOOP = sem->lastLink;
    lastProcess = (Process)oopToObj(lastProcessOOP);
    lastProcess->nextLink = processOOP;
    sem->lastLink = processOOP;
  }
}

mst_Boolean
isEmpty(processListOOP)
     OOP	processListOOP;
{
  Semaphore	processList;

  processList = (Semaphore)oopToObj(processListOOP);
  return (isNil(processList->firstLink));
}


static void
syncSignal(semaphoreOOP)
     OOP	semaphoreOOP;
{
  Semaphore sem;
  OOP	    freedOOP;

  sem = (Semaphore)oopToObj(semaphoreOOP);
  do {
    if (isEmpty(semaphoreOOP)) {
      sem->signals = incrInt(sem->signals);
      break;
    }
    freedOOP = removeFirstLink(semaphoreOOP);

    /* If they terminated this process, well, try another */
  } while (!resumeProcess(freedOOP));
}

void
asyncSignal(semaphoreOOP)
     OOP semaphoreOOP;
{
  IntState oldSigMask;

  oldSigMask = disableInterrupts(); /* block out everything! */
  queuedAsyncSignals[asyncQueueIndex++] = semaphoreOOP;
  setExceptFlag(true);
  enableInterrupts(oldSigMask);
}


static OOP
removeFirstLink(semaphoreOOP)
     OOP	semaphoreOOP;
{
  Semaphore	sem;
  Process	process;
  OOP		processOOP;

  sem = (Semaphore)oopToObj(semaphoreOOP);
  processOOP = sem->firstLink;
  process = (Process)oopToObj(processOOP);

  sem = (Semaphore)oopToObj(semaphoreOOP);
  sem->firstLink = process->nextLink;
  if (isNil(sem->firstLink)) {
    sem->lastLink = nilOOP;
  }

  /* Unlink the process from any list it was in! */
  process->myList = nilOOP;
  process->nextLink = nilOOP;
  return (processOOP);
}

static
mst_Boolean resumeProcess(processOOP)
     OOP	processOOP;
{
  int		priority;
  OOP		activeOOP;
  OOP		processLists;
  OOP		processList;
  Process	process, active;

  activeOOP = getActiveProcess();
  active = (Process)oopToObj(activeOOP);
  process = (Process)oopToObj(processOOP);

  if (process == active) {
    return(true);
  }
  if (isProcessTerminating(processOOP)) {
    /* The process was terminated - nothing to resume, fail */
    return(false);
  }

  priority = toInt(process->priority);
  processLists = getProcessLists();
  processList = arrayAt(processLists, priority);

  if (priority >= toInt(active->priority)) {
    /*
     * we're resuming a process with a *equal or higher* priority, so sleep
     * the current one and activate the new one
     */
    sleepProcess(activeOOP);
    activateProcess(processOOP);
  } else {
    /* this process has a lower priority than the active one, so the policy is
     * that it doesn't preempt the currently running one. Anyway, it must be
     * the first in its priority queue - so don't put it to sleep. */
    addFirstLink(processList, processOOP);
  }

  /* printObject( ((Process)(processOOP->object)) ->name ); */
  return(true);
}

static void
activateProcess(processOOP)
     OOP	processOOP;
{
  Process	process;
  int		priority;
  OOP		processLists;
  OOP		processList;

  if (processOOP == nilOOP) {
    return;
  }

  if (processOOP != getActiveProcess()) {
    process = (Process)oopToObj(processOOP);
    priority = toInt(process->priority);
    processLists = getProcessLists();
    processList = arrayAt(processLists, priority);
    addFirstLink(processList, processOOP);
  }

  setExceptFlag(true);
  switchToProcess = processOOP;
}

static mst_Boolean
isProcessTerminating(processOOP)
     OOP	processOOP;
{
  Process	process;

  process = (Process)oopToObj(processOOP);
  return (isNil(process->suspendedContext));
}

static mst_Boolean
isProcessReady(processOOP)
     OOP	processOOP;
{
  Process	process;
  int		priority;
  OOP		processLists;
  OOP		processList;

  process = (Process)oopToObj(processOOP);
  priority = toInt(process->priority);
  processLists = getProcessLists();
  processList = arrayAt(processLists, priority);

  /* check if process is in the priority queue */
  return (process->myList == processList);
}

static void
sleepProcess(processOOP)
     OOP	processOOP;
{
  Process	process;
  int		priority;
  OOP		processLists;
  OOP		processList;

  process = (Process)oopToObj(processOOP);
  priority = toInt(process->priority);
  processLists = getProcessLists();
  processList = arrayAt(processLists, priority);

  /* add process to end of priority queue */
  addLastLink(processList, processOOP);
}


/*
 *	static OOP highestPriorityProcess()
 *
 * Description
 *
 *	Locates and returns the highest priority process from the ??runlist??.
 *	(except the currently active one).  Removes it from the list.
 *
 * Outputs
 *
 *	The highest priority process, or nilOOP (after stopExecuting has been
 *	called).
 */
static OOP
highestPriorityProcess()
{
  OOP		processLists, processList;
  int		priority;
  OOP		processOOP;

  processLists = getProcessLists();
  priority = numOOPs(oopToObj(processLists));
  for (; priority > 0 ; priority--) {
    processList = arrayAt(processLists, priority);
    if (!isEmpty(processList)) {
      processOOP = removeFirstLink(processList);
      if (processOOP == getActiveProcess()) {
	/* The current process has yielded control, i.e. it has been
	   moved to the end of its list - but if there's only one element
	   it is still looks like the highest one, and we must discard it */
	/*printf("Current process discarded");*/
	addLastLink(processList, processOOP);
      } else {
	return(processOOP);
      }
    }
  }
  return (nilOOP);
}

static OOP
nextScheduledProcess()
{
  OOP			processLists, processList;
  OOP			processOOP;
  ProcessorScheduler	processor;
  Process		process;
  MethodContext		dummyContext;
  int			priority;

  processOOP = highestPriorityProcess();

  if(!isNil(processOOP)) {
    return(processOOP);
  }

  if(isProcessReady(getActiveProcess())) {
    return (nilOOP);
  }

  /* instead of returning nilOOP, let's return a newly created
     initial process and see what happens 10-Oct-93 14:17:48
     -- didn't work -- system hung

     pb -- Let's instead return the current process, modifying it so that
     it stops the Smalltalk interpreter. */

  /* printProcessState(); */
  /* initProcessSystem(); */		/* reset things */

  /* now make a dummy context to run with. */
  emptyContextStack();
  dummyContext = allocStackContext(4);
  dummyContext->parentContext = nilOOP;
  dummyContext->method = getTerminationMethod();
  dummyContext->flags = fromInt(1);
  dummyContext->receiver = nilOOP; /* make self be real (well, nil) */
  dummyContext->ipOffset = fromInt(0);
  dummyContext->spOffset = fromInt(-1);

  processor = (ProcessorScheduler)oopToObj(processorOOP);
  process = (Process) oopToObj(processor->activeProcess);
  priority = toInt(process->priority);
  processLists = getProcessLists();
  processList = arrayAt(processLists, priority);

  process->suspendedContext = allocOOP(dummyContext);
  process->myList	    = processList;

  /* stopExecuting("noRunnableProcess"); */

  return (processor->activeProcess);
}

/* Mainly for being invoked from a debugger */
void
printProcessState()
{
  OOP		processLists, processListOOP, processOOP;
  int		priority;
  Semaphore	processList;
  Process	process;

  processLists = getProcessLists();
  priority = numOOPs(oopToObj(processLists));
  for (; priority > 0 ; priority--) {
    printf("Priority %d: ", priority);
    processListOOP = arrayAt(processLists, priority);
    processList = (Semaphore)oopToObj(processListOOP);

    printf("First %p last %p ", processList->firstLink,
	   processList->lastLink);

    for (processOOP = processList->firstLink; !isNil(processOOP);
	 processOOP = process->nextLink) {
      process = (Process)oopToObj(processOOP);
      printf("<Proc %p prio: %ld next %p context %p> ",
	     processOOP, toInt(process->priority), process->nextLink,
	     process->suspendedContext);
    }


    printf("\n");
  }
}

OOP
semaphoreNew()
{
  Semaphore	sem;

  sem = (Semaphore)instantiate(semaphoreClass);
  sem->signals = fromInt(0);

  return (allocOOP(sem));
}

/* runs before every evaluation (executeStatements) and before GC turned on.
   Note that we don't use the incubator because processorOOP is a global. */
void
initProcessSystem()
{
  OOP		processLists;
  int		i;
  ProcessorScheduler processor;
  Process	initialProcess;
  OOP		initialProcessOOP, initialProcessListOOP;

  processor = (ProcessorScheduler)oopToObj(processorOOP);
  if (isNil(processor->processLists)) {
    processLists = processor->processLists = arrayNew(NUM_PRIORITIES);
    for (i = 1; i <= NUM_PRIORITIES; i++) {
      arrayAtPut(processLists, i, semaphoreNew()); /* ### should be linked list */
    }
  } else {
    processLists = processor->processLists;
  }

  /* No process is active -- so highestPriorityProcess() need not worry
     about discarding an active process. */
  processor->activeProcess = nilOOP;

  initialProcessOOP = highestPriorityProcess();
  if (isNil(initialProcessOOP)) {
    initialProcess = (Process)instantiate(processClass);
    initialProcess->priority = fromInt(4); /* userSchedulingPriority */
    initialProcessOOP = allocOOP(initialProcess);

    /* This is quite a problem. The initialProcess has undoubtedly a suspended
       context -- the #executeStatements context -- but it hasn't been created
       yet. But suspendedContext must not be nil, otherwise changeProcessContext
       will think that it belongs to a terminated process. No problem, we just
       set it to a bogus value.
       I chose this Integer because it is likely to cause a SIGSEGV/SIGBUS if
       changeProcessContext behaves differently from what we think -- i.e.
       if it uses the suspendedContext read from the suspended process
       to do something more interesting than comparing it to nil . */

    initialProcess->suspendedContext = fromInt(0);
  }

  initialProcessListOOP = arrayAt(processLists, 4);
  addFirstLink(initialProcessListOOP, initialProcessOOP);
  /* initialProcessOOP now is in the root set */

  processor->activeProcess = initialProcessOOP;
  switchToProcess = nilOOP;
}



/*
 *	static mst_Boolean *boolAddrIndex(index)
 *
 * Description
 *
 *	Used to help minimize the number of primitives used to control the
 *	various debugging flags, this routine maps an index to the address
 *	of a boolean debug flag, which it returns.
 *
 * Inputs
 *
 *	index : An integer (0 based) index to the set of debug variables
 *
 * Outputs
 *
 *	Address of the C debug variable, or NULL on failure.
 */
mst_Boolean *
boolAddrIndex(index)
int	index;
{
  switch (index) {
  case 0: return (&declareTracing);
  case 1: return (&executionTracing);
  case 2: return (&verboseExecTracing);
  case 3: return (&gcMessage);
  default: return (NULL);	/* index out of range, signal the error */
  }
}


void
initInterpreter()
{
  unsigned int		i;

  thisContextOOP = nilOOP;
  asyncQueueIndex = 0;
  ip = nil;

  for (i = 0; i < MAX_LIFO_DEPTH; i++) {
    lifoContexts[i].flags = F_POOLED | F_CONTEXT;
  }

  timeoutSem = nilOOP;
  for (i = 0; i < NUM_SIGNALS; i++) {
    semIntVec[i] = nilOOP;
  }
  initProcessSystem();
}

void
prepareExecutionEnvironment()
{
  register MethodContext newContext;

  emptyContextStack();

  /* now make a dummy context to run with */
  /* the first +1 accounts for the receiver (which must be pushed on this
     context too); the second +1 accounts for any needed extra space, just to be
     sure */
  newContext = allocStackContext(((MAX_NUM_ARGS + 1) >> DEPTH_SCALE) + 1);
  newContext->objClass = methodContextClass;
  newContext->parentContext = thisContextOOP;
  newContext->flags = fromInt(1);

  setThisMethod(getTerminationMethod(), 0);

  sp = newContext->contextStack - 1;
  temporaries = newContext->contextStack;
  self = nilOOP;
  thisContextOOP = allocOOP(newContext);
  thisContextOOP->flags = F_POOLED | F_CONTEXT;

  invalidateMethodCache();
}

OOP
finishExecutionEnvironment()
{
  BlockContext	oldContext;
  OOP		oldContextOOP, returnedValue;

  returnedValue = stackTop();
  oldContextOOP = thisContextOOP;
  oldContext = (BlockContext)oopToObj(oldContextOOP);
  oldContextOOP = oldContext->parentContext;

  if (freeLifoContext > lifoContexts) {
    deallocStackContext(oldContext);
  }

  oldContext = (BlockContext)oopToObj(oldContextOOP);
  thisContextOOP = oldContextOOP;

  if (!isNil(thisContextOOP)) {
    MethodContext thisContext;

    /* restore old context information */
    thisContext = (MethodContext)oopToObj(thisContextOOP);
    setThisMethod(thisContext->method, toInt(thisContext->ipOffset));
    sp = thisContext->contextStack + toInt(thisContext->spOffset);
    temporaries = thisContext->contextStack;
    self = thisContext->receiver;
  } else {
    /* restore dummy context information */
    methodBase = ip = nil;
    literals = temporaries = nil;
    self = thisMethod = nilOOP;
  }
  return (returnedValue);
}

void
invalidateMethodCache()
{
  int	i;

  cacheMisses = sampleCounter = 0;

  for (i = 0; i < METHOD_CACHE_SIZE; i++) {
    methodCache[i].selectorOOP = nil;
  }
  atCacheClass = atPutCacheClass = sizeCacheClass = nil;

#ifdef USE_DYNAMIC_TRANSLATION
  invalidateThreadedCodeCache();
#endif
}

#ifdef PROFBLOCK
initByteCodeCounter()
{
  int i;

#ifndef CANNOT_COUNT_BYTECODES
  for (i = 0; i < 256; i++) {
    byteCodes[i] = 0;
  }
#endif
  for (i = 0; i < 1024; i++) {
    primitives[i] = 0;
  }
}

printByteCodeCounts()
{
  int i;

#ifndef CANNOT_COUNT_BYTECODES
  for (i = 0; i < 256; i++) {
    if (byteCodes[i]) {
      printf("Byte code %d = %d\n", i, byteCodes[i]);
    }
  }
#endif

  printf("\n---> primitives:\n");
  for (i = 0; i < 1024; i++) {
    if (primitives[i]) {
      printf("Primitive %d = %d\n", i, primitives[i]);
    }
  }

}
#endif /* PROFBLOCK */




void
markProcessorRegisters()
{
  markSemaphoreOOPs();

  if (ip) {
    /* Get everything into the main OOP table first. */
    emptyContextStack();
    maybeMarkOOP(thisContextOOP);
  }

  /* everything else is pointed to by thisContextOOP, either directly or
   * indirectly; processorOOP has already been marked by the global oop
   * scan. */
}

void
fixupObjectPointers()
{
  register MethodContext	thisContext;

  if (ip) {
    thisContext = (MethodContext)oopToObj(thisContextOOP);
#ifdef DEBUG_FIXUP
    fflush(stderr);
    printf("\nF sp %x %d    ip %x %d	thisMethod %x  thisContext %x",
	sp, sp - thisContext->contextStack,
	ip, ip - methodBase,
	thisMethod->object,
	thisContext);
    fflush(stdout);
#endif
    thisContext->method = thisMethod;
    thisContext->receiver = self;
    thisContext->spOffset = fromInt(sp - thisContext->contextStack);
    thisContext->ipOffset = fromInt(ip - methodBase);
  }
}

void
restoreObjectPointers()
{
  register MethodContext thisContext;	/* may be block context, but doesn't matter */

  /* !!! The objects can move after the growing or compact phase. But, all
     this information is re-computable, so we pick up thisMethod to adjust the
     ip and literals accordingly, and we also pick up the context to adjust sp
     and the temps accordingly. */

  if (ip) {
    thisContext = (MethodContext)oopToObj(thisContextOOP);
    temporaries = thisContext->contextStack;

#ifndef OPTIMIZE /* Mon Jul  3 01:21:06 1995 */
    /* these should not be necessary */
    if (thisMethod != thisContext->method) {
      printf("$$$$$$$$$$$$$$$$$$$ GOT ONE!!!!\n");
      printf("this method "); printObject(thisMethod); printf("\n");
      printf("this context "); printObject(thisContext->method); printf("\n");
      debug();
      thisMethod = thisContext->method;
    }
    if (self != thisContext->receiver) {
      printf("$$$$$$$$$$$$$$$$$$$ GOT ONE!!!!\n");
      printf("self "); printObject(self); printf("\n");
      printf("this context "); printObject(thisContext->receiver); printf("\n");
      debug();
      self = thisContext->receiver;
    }
#endif /* OPTIMIZE Mon Jul  3 01:21:06 1995 */

    setThisMethod(thisMethod, toInt(thisContext->ipOffset));
    sp = toInt(thisContext->spOffset) + thisContext->contextStack;

#ifdef DEBUG_FIXUP
    fflush(stderr);
    printf("\nR sp %x %d    ip %x %d	thisMethod %x  thisContext %x\n",
	sp, sp - thisContext->contextStack,
	ip, ip - methodBase,
	thisMethod->object,
	thisContext);
    fflush(stdout);
#endif
  }

  setExceptFlag(true);		  /* force to import registers */
}

/*
 *	static void markSemaphoreOOPs()
 *
 * Description
 *
 *	This routine is to be called during the root set copying part of a GC
 *	flip to copy any Smalltalk Semaphore related to asynchronous signals.
 *
 */
static void
markSemaphoreOOPs()
{
  int		i;
  IntState	oldSigMask;

  oldSigMask = disableInterrupts(); /* block out everything! */

  for (i = 0; i < asyncQueueIndex; i++) {
    maybeMarkOOP(queuedAsyncSignals[i]);
  }
  maybeMarkOOP(timeoutSem);

  /* there does seem to be a window where this is not valid */
  maybeMarkOOP(switchToProcess);

  for (i = 0; i < NUM_SIGNALS; i++) {
    maybeMarkOOP(semIntVec[i]);
  }
  enableInterrupts(oldSigMask);
}



/*
 *	void initSignals()
 *
 * Description
 *
 *	Trap the signals that we care about, basically SIGBUS and SIGSEGV.
 *	These are sent to the back trace routine so we can at least have some
 *	idea of where we were when we died.
 *
 */
void
initSignals()
{
  if (!makeCoreFile) {
#ifdef SIGBUS
    setSignalHandler(SIGBUS, interruptHandler);
#endif
    setSignalHandler(SIGSEGV, interruptHandler);
  }
  setSignalHandler(SIGINT, interruptHandler);
  setSignalHandler(SIGFPE, interruptHandler);
}


/*
 *	static void stopExecuting(msg)
 *
 * Description
 *
 *	Sets flags so that the interpreter starts returning immediately from
 *	whatever byte codes it's executing.  It returns via a normal message
 *	send, so that the world is in a consistent state when it's done.
 *
 * Inputs
 *
 *	msg   : error message to be passed to Smalltalk.
 *
 */

static void
stopExecuting(msg)
char *msg;
{
  abortExecution = msg;
  setExceptFlag(true);
  if (inCCode) {
    longjmp(cCalloutJmpBuf->jmpBuf, 1); /* throw out from C code */
  }
}

RETSIGTYPE
timeoutHandler(sig)
     int	sig;
{
  setSignalHandler(sig, SIG_DFL);
  asyncSignal(timeoutSem);
  timeoutSem = nilOOP;
}

RETSIGTYPE
semIntHandler(sig)
     int	sig;
{
  setSignalHandler(sig, SIG_DFL);

  if (!isNil(semIntVec[sig])) {
    if (isClass(semIntVec[sig], semaphoreClass)) {
      asyncSignal(semIntVec[sig]);
    } else {
      errorf("C signal trapped, but no semaphore was waiting");
      kill(getpid(), sig);
    }
  }
}


/*
 *	static RETSIGTYPE interruptHandler(sig)
 *
 * Description
 *
 *	Called to handle signals, such as interrupts or segmentation violation.
 *	In the latter case, try to show a method invocation backtrace if possibly,
 *	otherwise try to show where the system was in the file it was procesing when
 *	the error occurred.
 *
 * Inputs
 *
 *	sig   : Signal number, an integer
 *
 * Outputs
 *
 *	not used.
 */
RETSIGTYPE
interruptHandler(sig)
     int	sig;
{
  setSignalHandler(sig, SIG_DFL);

  switch (sig) {
  case SIGFPE:
    if (inInterpreter) {
      setSignalHandler(sig, interruptHandler);
    } else {
      kill(getpid(), sig);
    }
    return;

  case SIGINT:
    if (nonInteractive) {
      printf("Signal %d, exiting...\n", sig);
      if (ip) {
        showBacktrace();
      }
      exit(1);
    } else {
      setSignalHandler(sig, interruptHandler);
      stopExecuting("userInterrupt");
      return;
    }

#ifdef SIGBUS
  case SIGBUS:
    errorf("Bus error");
    break;
#endif

  case SIGSEGV:
    errorf("Segmentation violation");
    break;

  default:
    errorf("Unknown signal caught: %d", sig);
  }

  debug();
  if (inInterpreter) {
    /* Avoid recursive signals */
    inInterpreter = false;
    showBacktrace();
  } else {
    errorf("Error occurred while not in byte code interpreter!!");
  }

  kill(getpid(), sig);
}

void
showBacktrace()
{
  OOP		contextOOP;
  MethodContext context;
  Block		block;
  Method	method;
  MethodInfo	methodInfo;

/* printf("In showbacktrace\n"); */
  emptyContextStack();
  for (contextOOP = thisContextOOP; !isNil(contextOOP); contextOOP = context->parentContext) {
    context = (MethodContext)oopToObj(contextOOP);
    if (isExecutionEnvironmentContext(context)) {
      printf("<bottom>\n");
      continue;
    }

    if (isMethodContext(context)) {
      OOP	    receiver, receiverClass;

      /* a method context */
      method = (Method)oopToObj(context->method);
      methodInfo = (MethodInfo)oopToObj(method->descriptor);
      receiver = context->receiver;
      if (isInt(receiver)) {
	receiverClass = smallIntegerClass;
      } else {
	receiverClass = oopClass(receiver);
      }
      printObject(receiverClass);
      if (receiverClass != methodInfo->class) {
	printf("(");
	printObject(methodInfo->class);
	printf(")");
      }
    } else {
      /* a block context */
      block = (Block)oopToObj(context->method);
      method = (Method)oopToObj(block->method);
      methodInfo = (MethodInfo)oopToObj(method->descriptor);
      printf("[] in ");
      printObject(methodInfo->class);
    }
    printf(">>");
    printObject(methodInfo->selector);
    printf("\n");
  }
}

/*
 *	long mulWithCheck(a, b)
 *
 * Description
 *
 *	Called to handle multiplication with overflow checking.	 In case of
 *	an overflow, answer OVERFLOWING_INT so that we can work it out the
 *	same way we do with adds and subtracts.
 *	Is there a better way to do this?!?
 *
 * Inputs
 *
 *	a, b   : The two factors
 *
 * Outputs
 *
 *	either a valid integer in the MIN_ST_INT to MAX_ST_INT range, or
 *	OVERFLOWING_INT
 */

long
mulWithCheck(a, b)
     register long a;
     register long b;
{
#define LIMIT		   ( ((long)1) << (ST_INT_SIZE / 2))

  register long result = a * b;
  if ((a | b) < LIMIT || b == 0 || (result / b == a)) {
    return (result);
  } else {
    return (OVERFLOWING_INT);
  }

#ifdef old_code
/**/#define HIGHPART(x)	       ((x) >> (ST_INT_SIZE / 2))
/**/#define LOWPART(x)	       ((x) & (LIMIT - 1))
/**/#define COMPOSE(u, h, l)   ((l) | ((h) * LIMIT) | ((u) * LIMIT * LIMIT) )
/**/  if ((a | b) < LIMIT) {
/**/	return (a * b);
/**/  } else {
/**/	long upperBits, highBits, lowBits;
/**/
/**/#ifdef DEBUG_BIGINT
/**/	printf("(%ld << 15 + %ld) * (%ld << 15 + %ld) = %ld << 30 + %ld << 15 + %ld",
/**/	  HIGHPART(a), LOWPART(a), HIGHPART(b), LOWPART(b),
/**/	  HIGHPART(a) * HIGHPART(b),
/**/	  LOWPART(a) * HIGHPART(b) + LOWPART(b) * HIGHPART(a),
/**/	  LOWPART(a) * LOWPART(b));
/**/#endif
/**/
/**/	upperBits = HIGHPART(a) * HIGHPART(b);
/**/
/**/	if (upperBits != 0 && upperBits != -1)
/**/	  return (OVERFLOWING_INT);
/**/
/**/	lowBits = LOWPART(a) * LOWPART(b);
/**/	highBits = LOWPART(a) * HIGHPART(b) + LOWPART(b) * HIGHPART(a);
/**/
/**/	highBits += HIGHPART(lowBits);
/**/	lowBits	 &= LIMIT - 1;
/**/
/**/	if (highBits >= LIMIT || highBits < -LIMIT)
/**/	  return (OVERFLOWING_INT);
/**/
/**/	return (COMPOSE(upperBits, highBits, lowBits));
/**/  }
#endif
}
