// The primitive handles PositionableStream>>atEnd, but only for arrays/strings
// Does not use successFlag. Unary, so does not modify the stack pointer
BOOL __fastcall Interpreter::primitiveAtEnd()
{
PosStreamOTE* streamPointer = reinterpret_cast<PosStreamOTE*>(stackTop()); // Access receiver
//ASSERT(!ObjectMemoryIsIntegerObject(streamPointer) && ObjectMemory::isKindOf(streamPointer, Pointers.ClassPositionableStream));
PositionableStream* readStream = streamPointer->m_location;
// Ensure valid stream (see BBB p632)
if (!ObjectMemoryIsIntegerObject(readStream->m_index) ||
!ObjectMemoryIsIntegerObject(readStream->m_readLimit))
return primitiveFailure(0);
SMALLINTEGER index = ObjectMemoryIntegerValueOf(readStream->m_index);
SMALLINTEGER limit = ObjectMemoryIntegerValueOf(readStream->m_readLimit);
BehaviorOTE* bufClass = readStream->m_array->m_oteClass;
OTE* boolResult;
if (bufClass == Pointers.ClassString || bufClass == Pointers.ClassByteArray)
boolResult = index >= limit || (MWORD(index) >= readStream->m_array->bytesSize()) ?
Pointers.True : Pointers.False;
else if (bufClass == Pointers.ClassArray)
boolResult = index >= limit || (MWORD(index) >= readStream->m_array->pointersSize()) ?
Pointers.True : Pointers.False;
else
return primitiveFailure(1); // Doesn't work for non-Strings/ByteArrays/Arrays, or if out of bounds
stackTop() = reinterpret_cast<Oop>(boolResult);
return primitiveSuccess();
}
static BOOL AnswerNewStructure(BehaviorOTE* oteClass, void* ptr)
{
if (oteClass->isNil())
return Interpreter::primitiveFailure(4);
Interpreter::replaceStackTopWithNew(ExternalStructure::New(oteClass, ptr));
return primitiveSuccess();
}
Oop* __fastcall Interpreter::primitivePerform(CompiledMethod& , unsigned argCount)
{
SymbolOTE* performSelector = m_oopMessageSelector; // Save in case we need to restore
SymbolOTE* selectorToPerform = reinterpret_cast<SymbolOTE*>(stackValue(argCount-1));
if (ObjectMemoryIsIntegerObject(selectorToPerform))
return primitiveFailure(1);
m_oopMessageSelector = selectorToPerform;
Oop newReceiver = stackValue(argCount);
// lookupMethodInClass returns the Oop of the new CompiledMethod
// if the selector is found, or Pointers.DoesNotUnderstand if the class
// does not understand the selector. We succeed if either the argument
// count of the returned method matches that passed to this primitive,
// or if the selector is not understood, because by this time the
// detection of the 'does not understand' will have triggered
// the create of a Message object (see createActualMessage) into
// which all the arguments will have been moved, and which then replaces
// those arguments on the Smalltalk context stack. i.e. the primitive
// will succeed if the message is not understood, but will result in
// the execution of doesNotUnderstand: rather than the selector we've
// been asked to perform. This works because
// after a doesNotUnderstand detection, the stack has a Message at stack
// top, the selector is still there, and argCount is now 1. Consequently
// the Message gets shuffled over the selector, and doesNotUnderstand is
// sent
MethodOTE* methodPointer = findNewMethodInClass(ObjectMemory::fetchClassOf(newReceiver), (argCount-1));
CompiledMethod* method = methodPointer->m_location;
if (method->m_header.argumentCount == (argCount-1) ||
m_oopMessageSelector == Pointers.DoesNotUnderstandSelector)
{
// Shuffle arguments down over the selector (use argumentCount of
// method found which may not equal argCount)
const unsigned methodArgCount = method->m_header.argumentCount;
// #pragma message("primitivePerform: Instead of shuffling args down 1, why not just deduct 1 from calling frames suspended SP after exec?")
Oop* const sp = m_registers.m_stackPointer - methodArgCount;
// We don't need to count down the overwritten oop anymore, since we don't ref. count stack ops
// Not worth overhead of calling memmove here since argumentCount
// normally small
for (unsigned i=0;i<methodArgCount;i++)
sp[i] = sp[i+1];
popStack();
executeNewMethod(methodPointer, methodArgCount);
return primitiveSuccess(0);
}
else
{
// The argument count did not match, so drop out into the Smalltalk
// having restored the selector
ASSERT(m_oopMessageSelector!=Pointers.DoesNotUnderstandSelector);
m_oopMessageSelector = performSelector;
return primitiveFailure(0);
}
}
static BOOL AnswerNewInterfacePointer(BehaviorOTE* oteClass, IUnknown* punk)
{
if (oteClass->isNil())
return Interpreter::primitiveFailure(4);
if (punk)
punk->AddRef();
OTE* poteUnk = ExternalStructure::NewPointer(oteClass, punk);
poteUnk->beFinalizable();
Interpreter::replaceStackTopWithNew(poteUnk);
return primitiveSuccess();
}
// Locate the next occurrence of the given character in the receiver between the specified indices.
BOOL __fastcall Interpreter::primitiveStringNextIndexOfFromTo()
{
Oop integerPointer = stackTop();
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(0); // to not an integer
const SMALLINTEGER to = ObjectMemoryIntegerValueOf(integerPointer);
integerPointer = stackValue(1);
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(1); // from not an integer
SMALLINTEGER from = ObjectMemoryIntegerValueOf(integerPointer);
Oop valuePointer = stackValue(2);
StringOTE* receiverPointer = reinterpret_cast<StringOTE*>(stackValue(3));
Oop answer = ZeroPointer;
if ((ObjectMemory::fetchClassOf(valuePointer) == Pointers.ClassCharacter) && to >= from)
{
ASSERT(!receiverPointer->isPointers());
// Search a byte object
const SMALLINTEGER length = receiverPointer->bytesSize();
// We can only be in here if to>=from, so if to>=1, then => from >= 1
// furthermore if to <= length then => from <= length
if (from < 1 || to > length)
return primitiveFailure(2);
// Search is in bounds, lets do it
CharOTE* oteChar = reinterpret_cast<CharOTE*>(valuePointer);
Character* charObj = oteChar->m_location;
const char charValue = static_cast<char>(ObjectMemoryIntegerValueOf(charObj->m_asciiValue));
String* chars = receiverPointer->m_location;
from--;
while (from < to)
{
if (chars->m_characters[from++] == charValue)
{
answer = ObjectMemoryIntegerObjectOf(from);
break;
}
}
}
stackValue(3) = answer;
pop(3);
return primitiveSuccess();
}
// This primitive handles PositionableStream>>nextSDWORD, but only for byte-arrays
// Unary message, so does not modify stack pointer
BOOL __fastcall Interpreter::primitiveNextSDWORD()
{
PosStreamOTE* streamPointer = reinterpret_cast<PosStreamOTE*>(stackTop()); // Access receiver
PositionableStream* readStream = streamPointer->m_location;
// Ensure valid stream - unusually this validity check is included in the Blue Book spec
// and appears to be implemented in most Smalltalks, so we implement here too.
if (!ObjectMemoryIsIntegerObject(readStream->m_index) ||
!ObjectMemoryIsIntegerObject(readStream->m_readLimit))
return primitiveFailure(0); // Receiver fails invariant check
SMALLINTEGER index = ObjectMemoryIntegerValueOf(readStream->m_index);
SMALLINTEGER limit = ObjectMemoryIntegerValueOf(readStream->m_readLimit);
// Is the current index within the limits of the collection?
// Remember that the index is 1 based (it's a Smalltalk index), and we're 0 based,
// so we don't need to increment it until after we've got the next object
if (index < 0 || index >= limit)
return primitiveFailure(2); // No, fail it
OTE* oteBuf = readStream->m_array;
BehaviorOTE* bufClass = oteBuf->m_oteClass;
if (bufClass != Pointers.ClassByteArray)
return primitiveFailure(1); // Collection cannot be handled by primitive, rely on Smalltalk code
ByteArrayOTE* oteBytes = reinterpret_cast<ByteArrayOTE*>(oteBuf);
const int newIndex = index + sizeof(SDWORD);
if (MWORD(newIndex) > oteBytes->bytesSize())
return primitiveFailure(3);
const Oop oopNewIndex = ObjectMemoryIntegerObjectOf(newIndex);
if (int(oopNewIndex) < 0)
return primitiveFailure(4); // index overflowed SmallInteger range
// When incrementing the index we must allow for it overflowing a SmallInteger, even though
// this is extremely unlikely in practice
readStream->m_index = oopNewIndex;
// Receiver is overwritten
ByteArray* byteArray = oteBytes->m_location;
replaceStackTopWithNew(Integer::NewSigned32(*reinterpret_cast<SDWORD*>(byteArray->m_elements+index)));
return primitiveSuccess(); // Succeed
}
Oop* __fastcall Interpreter::primitivePerformMethod(CompiledMethod& , unsigned)
{
Oop * sp = m_registers.m_stackPointer;
ArrayOTE* oteArg = reinterpret_cast<ArrayOTE*>(*(sp));
if (ObjectMemory::fetchClassOf(Oop(oteArg)) != Pointers.ClassArray)
return primitiveFailure(0); // Arguments not an Array
Array* arguments = oteArg->m_location;
Oop receiverPointer = *(sp-1);
MethodOTE* oteMethod = reinterpret_cast<MethodOTE*>(*(sp-2));
// Adjust sp to point at slot where receiver will be moved
sp -= 2;
//ASSERT(ObjectMemory::isKindOf(oteMethod, Pointers.ClassCompiledMethod));
CompiledMethod* method = oteMethod->m_location;
if (!ObjectMemory::isKindOf(receiverPointer, method->m_methodClass))
return primitiveFailure(1); // Wrong class of receiver
const unsigned argCount = oteArg->pointersSize();
const unsigned methodArgCount = method->m_header.argumentCount;
if (methodArgCount != argCount)
return primitiveFailure(2); // Wrong number of arguments
// Push receiver and arguments on stack (over the top of array and receiver)
sp[0] = receiverPointer; // Write receiver over the top of the method
for (MWORD i = 0; i < argCount; i++)
{
Oop pushee = arguments->m_elements[i];
// Don't count up because we are adding a stack ref.
sp[i+1] = pushee;
}
m_registers.m_stackPointer = sp+argCount;
// Don't count down any args
executeNewMethod(oteMethod, argCount);
return primitiveSuccess(0);
}
BOOL __fastcall Interpreter::primitiveSnapshot(CompiledMethod&, unsigned argCount)
{
Oop arg = stackValue(argCount - 1);
char* szFileName;
if (arg == Oop(Pointers.Nil))
szFileName = 0;
else if (ObjectMemory::fetchClassOf(arg) == Pointers.ClassString)
{
StringOTE* oteString = reinterpret_cast<StringOTE*>(arg);
String* fileName = oteString->m_location;
szFileName = fileName->m_characters;
}
else
return primitiveFailure(0);
bool bBackup;
if (argCount >= 2)
bBackup = reinterpret_cast<OTE*>(stackValue(argCount - 2)) == Pointers.True;
else
bBackup = false;
SMALLINTEGER nCompressionLevel;
if (argCount >= 3)
{
Oop oopCompressionLevel = stackValue(argCount - 3);
nCompressionLevel = ObjectMemoryIsIntegerObject(oopCompressionLevel) ? ObjectMemoryIntegerValueOf(oopCompressionLevel) : 0;
}
else
nCompressionLevel = 0;
SMALLUNSIGNED nMaxObjects = 0;
if (argCount >= 4)
{
Oop oopMaxObjects = stackValue(argCount - 4);
if (ObjectMemoryIsIntegerObject(oopMaxObjects))
{
nMaxObjects = ObjectMemoryIntegerValueOf(oopMaxObjects);
}
}
// N.B. It is not necessary to clear down the memory pools as the free list is rebuild on every image
// load and the pool members, though not on the free list at present, are marked as free entries
// in the object table
// ZCT is reconciled, so objects may be deleted
flushAtCaches();
// Store the active frame of the active process before saving so available on image reload
// We're not actually suspending the process now, but it appears like that to the snapshotted
// image on restarting
m_registers.PrepareToSuspendProcess();
#ifdef OAD
DWORD timeStart = timeGetTime();
#endif
int saveResult = ObjectMemory::SaveImageFile(szFileName, bBackup, nCompressionLevel, nMaxObjects);
#ifdef OAD
DWORD timeEnd = timeGetTime();
TRACESTREAM << "Time to save image: " << (timeEnd - timeStart) << " mS" << endl;
#endif
if (!saveResult)
{
// Success
popStack();
return primitiveSuccess();
}
else
{
// Failure
return primitiveFailure(saveResult);
}
}
// Value with args takes an array of arguments
Oop* __fastcall Interpreter::primitiveValueWithArgs()
{
Oop* bp = m_registers.m_stackPointer;
ArrayOTE* argumentArray = reinterpret_cast<ArrayOTE*>(*(bp));
BlockOTE* oteBlock = reinterpret_cast<BlockOTE*>(*(bp-1));
ASSERT(ObjectMemory::fetchClassOf(Oop(oteBlock)) == Pointers.ClassBlockClosure);
BlockClosure* block = oteBlock->m_location;
const MWORD blockArgumentCount = block->m_info.argumentCount;
BehaviorOTE* arrayClass = ObjectMemory::fetchClassOf(Oop(argumentArray));
if (arrayClass != Pointers.ClassArray)
return primitiveFailure(1);
const MWORD arrayArgumentCount = argumentArray->pointersSize();
if (arrayArgumentCount != blockArgumentCount)
return primitiveFailure(0);
pop(2); // N.B. ref count of Block will be assumed by storing into frame
// Store old context details from interpreter registers
m_registers.StoreContextRegisters();
// Overwrite receiver block with receiver at time of closure.
Oop closureReceiver = block->m_receiver;
*(bp-1) = closureReceiver;
// No need to count up the receiver since we've written it into a stack slot
Array* args = argumentArray->m_location;
// Code this carefully so compiler generates optimal code (it makes a poor job on its own)
Oop* sp = bp;
// Push the args from the array
{
for (unsigned i=0;i<arrayArgumentCount;i++)
{
Oop pushee = args->m_elements[i];
*sp++ = pushee;
// No need to count up since pushing on the stack
}
}
const unsigned copiedValues = block->copiedValuesCount(oteBlock);
{
for (unsigned i=0;i<copiedValues;i++)
{
Oop oopCopied = block->m_copiedValues[i];
*sp++ = oopCopied;
// No need to count up since pushing on the stack
}
}
// Nil out any extra stack temp slots we need
const unsigned extraTemps = block->stackTempsCount();
{
const Oop nilPointer = Oop(Pointers.Nil);
for (unsigned i=0;i<extraTemps;i++)
*sp++ = nilPointer;
}
// Stack frame follows args...
StackFrame* pFrame = reinterpret_cast<StackFrame*>(sp);
pFrame->m_bp = reinterpret_cast<Oop>(bp)+1;
m_registers.m_basePointer = reinterpret_cast<Oop*>(bp);
// stack ref. removed so don't need to count down
pFrame->m_caller = m_registers.activeFrameOop();
// Having set caller can update the active frame Oop
m_registers.m_pActiveFrame = pFrame;
// Note that ref. count remains the same due dto overwritten receiver slot
const unsigned envTemps = block->envTempsCount();
if (envTemps > 0)
{
ContextOTE* oteContext = Context::New(envTemps, reinterpret_cast<Oop>(block->m_outer));
pFrame->m_environment = reinterpret_cast<Oop>(oteContext);
Context* context = oteContext->m_location;
context->m_block = oteBlock;
// Block has been written into a heap object slot, so must count up
oteBlock->countUp();
}
else
pFrame->m_environment = reinterpret_cast<Oop>(oteBlock);
// We don't need to store down the IP and SP into the frame until it is suspended
pFrame->m_ip = ZeroPointer;
pFrame->m_sp = ZeroPointer;
MethodOTE* oteMethod = block->m_method;
pFrame->m_method = oteMethod;
// Don't need to inc ref count for stack frame ref to method
CompiledMethod* method = oteMethod->m_location;
m_registers.m_pMethod = method;
m_registers.m_instructionPointer = ObjectMemory::ByteAddressOfObjectContents(method->m_byteCodes) +
block->initialIP() - 1;
// New stack pointer points at last field of stack frame
m_registers.m_stackPointer = reinterpret_cast<Oop*>(reinterpret_cast<BYTE*>(pFrame)+sizeof(StackFrame)) - 1;
ASSERT(m_registers.m_stackPointer == &pFrame->m_bp);
return primitiveSuccess(0);
}
Oop* __fastcall Interpreter::primitivePerformWithArgs()
{
Oop* const sp = m_registers.m_stackPointer;
ArrayOTE* argumentArray = reinterpret_cast<ArrayOTE*>(*(sp));
BehaviorOTE* arrayClass = ObjectMemory::fetchClassOf(Oop(argumentArray));
if (arrayClass != Pointers.ClassArray)
return primitiveFailure(0);
// N.B. We're using a large stack, so don't bother checking for overflow
// (standard stack overflow mechanism should catch it)
// We must not get the length outside, in case small integer arg
const unsigned argCount = argumentArray->pointersSize();
// Save old message selector in case of prim failure (need to reinstate)
SymbolOTE* performSelector = m_oopMessageSelector;
// To ensure the argumentArray doesn't go away when we push its contents
// onto the stack, in case we need it for recovery from an argument
// count mismatch we leave its ref. count elevated
SymbolOTE* selectorToPerform = reinterpret_cast<SymbolOTE*>(*(sp-1));
if (ObjectMemoryIsIntegerObject(selectorToPerform))
return primitiveFailure(1);
m_oopMessageSelector = selectorToPerform; // Get selector from stack
// Don't need to count down the stack ref.
ASSERT(!selectorToPerform->isFree());
Oop newReceiver = *(sp-2); // receiver is under selector and arg array
// Push the args from the array onto the stack. We must do this before
// looking up the method, because if the receiver does not understand
// the method then the lookup routines copy the arguments off the stack
// into a Message object
Array* args = argumentArray->m_location;
for (MWORD i=0; i<argCount; i++)
{
Oop pushee = args->m_elements[i];
// Note no need to inc the ref. count when pushing on the stack
sp[i-1] = pushee;
}
// Args written over top of selector and argument array (hence -2)
m_registers.m_stackPointer = sp+argCount-2;
// There is a subtle complication here when the receiver does not
// understand the message, by which lookupMethodInClass() converts
// the message we're trying to perform to a #doesNotUnderstand: with
// all arguments moved to a Message. We still want to execute this
// does not understand, so we also execute the method if the argument
// counts do not match, but it was not understood. Note that it is
// possible for a doesNotUnderstand: to be executed thru the first
// test if the argumentArray contained only one argument. We allow
// this to happen to avoid testing for not understood in the normal
// case - just be aware of this anomaly.
MethodOTE* methodPointer = findNewMethodInClass(ObjectMemory::fetchClassOf(newReceiver), argCount);
CompiledMethod& method = *methodPointer->m_location;
const unsigned methodArgCount = method.m_header.argumentCount;
if (methodArgCount == argCount ||
m_oopMessageSelector == Pointers.DoesNotUnderstandSelector)
{
// WE no longer need the argument array, but don't count it down since we only have a stack ref.
executeNewMethod(methodPointer, methodArgCount);
return primitiveSuccess(0);
}
else
{
// Receiver must have understood the message, but we had wrong
// number of arguments, so reinstate the stack and fail the primitive
pop(argCount);
pushObject((OTE*)m_oopMessageSelector);
// Argument array already has artificially increased ref. count
push(Oop(argumentArray));
m_oopMessageSelector = performSelector;
return primitiveFailure(1);
}
}
// Uses object identity to locate the next occurrence of the argument in the receiver from
// the specified index to the specified index
Oop* __fastcall Interpreter::primitiveNextIndexOfFromTo()
{
Oop integerPointer = stackTop();
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(0); // to not an integer
const SMALLINTEGER to = ObjectMemoryIntegerValueOf(integerPointer);
integerPointer = stackValue(1);
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(1); // from not an integer
SMALLINTEGER from = ObjectMemoryIntegerValueOf(integerPointer);
Oop valuePointer = stackValue(2);
OTE* receiverPointer = reinterpret_cast<OTE*>(stackValue(3));
// #ifdef _DEBUG
if (ObjectMemoryIsIntegerObject(receiverPointer))
return primitiveFailure(2); // Not valid for SmallIntegers
// #endif
Oop answer = ZeroPointer;
if (to >= from)
{
if (!receiverPointer->isPointers())
{
// Search a byte object
BytesOTE* oteBytes = reinterpret_cast<BytesOTE*>(receiverPointer);
if (ObjectMemoryIsIntegerObject(valuePointer))// Arg MUST be an Integer to be a member
{
const MWORD byteValue = ObjectMemoryIntegerValueOf(valuePointer);
if (byteValue < 256) // Only worth looking for 0..255
{
const SMALLINTEGER length = oteBytes->bytesSize();
// We can only be in here if to>=from, so if to>=1, then => from >= 1
// furthermore if to <= length then => from <= length
if (from < 1 || to > length)
return primitiveFailure(2);
// Search is in bounds, lets do it
VariantByteObject* bytes = oteBytes->m_location;
from--;
while (from < to)
if (bytes->m_fields[from++] == byteValue)
{
answer = ObjectMemoryIntegerObjectOf(from);
break;
}
}
}
}
else
{
// Search a pointer object - but only the indexable vars
PointersOTE* oteReceiver = reinterpret_cast<PointersOTE*>(receiverPointer);
VariantObject* receiver = oteReceiver->m_location;
Behavior* behavior = receiverPointer->m_oteClass->m_location;
const MWORD length = oteReceiver->pointersSize();
const MWORD fixedFields = behavior->m_instanceSpec.m_fixedFields;
// Similar reasoning with to/from as for byte objects, but here we need to
// take account of the fixed fields.
if (from < 1 || (to + fixedFields > length))
return primitiveFailure(2); // Out of bounds
Oop* indexedFields = receiver->m_fields + fixedFields;
from--;
while (from < to)
if (indexedFields[from++] == valuePointer)
{
answer = ObjectMemoryIntegerObjectOf(from);
break;
}
}
}
else
answer = ZeroPointer; // Range is non-inclusive, cannot be there
stackValue(3) = answer;
return primitiveSuccess(3);
}
// This primitive handles PositionableStream>>next, but only for Arrays, Strings and ByteArrays
// Unary message, so does not modify stack pointer, and is therefore called directly from the ASM
// primitive table without indirection through an ASM thunk.
BOOL __fastcall Interpreter::primitiveNext()
{
PosStreamOTE* streamPointer = reinterpret_cast<PosStreamOTE*>(stackTop()); // Access receiver
// Only works for subclasses of PositionableStream (or look alikes)
//ASSERT(!ObjectMemoryIsIntegerObject(streamPointer) && ObjectMemory::isKindOf(streamPointer, Pointers.ClassPositionableStream));
PositionableStream* readStream = streamPointer->m_location;
// Ensure valid stream - unusually this validity check is included in the Blue Book spec
// and appears to be implemented in most Smalltalks, so we implement here too.
if (!ObjectMemoryIsIntegerObject(readStream->m_index) ||
!ObjectMemoryIsIntegerObject(readStream->m_readLimit))
return primitiveFailure(0); // Receiver fails invariant check
SMALLINTEGER index = ObjectMemoryIntegerValueOf(readStream->m_index);
SMALLINTEGER limit = ObjectMemoryIntegerValueOf(readStream->m_readLimit);
// Is the current index within the limits of the collection?
// Remember that the index is 1 based (it's a Smalltalk index), and we're 0 based,
// so we don't need to increment it until after we've got the next object
if (index < 0 || index >= limit)
return primitiveFailure(2); // No, fail it
OTE* oteBuf = readStream->m_array;
BehaviorOTE* bufClass = oteBuf->m_oteClass;
if (bufClass == Pointers.ClassString)
{
StringOTE* oteString = reinterpret_cast<StringOTE*>(oteBuf);
// A sanity check - ensure within bounds of object too (again in Blue Book spec)
if (MWORD(index) >= oteString->bytesSize())
return primitiveFailure(3);
String* buf = oteString->m_location;
stackTop() = reinterpret_cast<Oop>(Character::New(buf->m_characters[index]));
}
// We also support ByteArrays in our primitiveNext (unlike BB).
else if (bufClass == Pointers.ClassByteArray)
{
ByteArrayOTE* oteBytes = reinterpret_cast<ByteArrayOTE*>(oteBuf);
if (MWORD(index) >= oteBytes->bytesSize())
return primitiveFailure(3);
ByteArray* buf = oteBytes->m_location;
stackTop() = ObjectMemoryIntegerObjectOf(buf->m_elements[index]);
}
else if (bufClass == Pointers.ClassArray)
{
ArrayOTE* oteArray = reinterpret_cast<ArrayOTE*>(oteBuf);
if (MWORD(index) >= oteArray->pointersSize())
return primitiveFailure(3);
Array* buf = oteArray->m_location;
stackTop() = buf->m_elements[index];
}
else
return primitiveFailure(1); // Collection cannot be handled by primitive, rely on Smalltalk code
// When incrementing the index we must allow for it overflowing a SmallInteger, even though
// this is extremely unlikely in practice
readStream->m_index = Integer::NewSigned32WithRef(index+1);
return primitiveSuccess(); // Succeed
}
// Signal a specified semaphore after the specified milliseconds duration (the argument).
// NOTE: NOT ABSOLUTE VALUE!
// If the specified time has already passed, then the TimingSemaphore is signalled immediately.
Oop* __fastcall Interpreter::primitiveSignalAtTick(CompiledMethod&, unsigned argumentCount)
{
Oop tickPointer = stackTop();
SMALLINTEGER nDelay;
if (ObjectMemoryIsIntegerObject(tickPointer))
nDelay = ObjectMemoryIntegerValueOf(tickPointer);
else
{
OTE* oteArg = reinterpret_cast<OTE*>(tickPointer);
return primitiveFailureWith(PrimitiveFailureNonInteger, oteArg); // ticks must be SmallInteger
}
// To avoid any race conditions against the global timerID value (it is quite
// common for the timer to fire, for example, before the timeSetEvent() call
// has actually returned in the duration is very short because the timer thread
// is operating at a very high priority), we use an interlocked operation
UINT outstandingID = InterlockedExchange(reinterpret_cast<SHAREDLONG*>(&timerID), 0);
// If outstanding timer now fires, it will do nothing. We'll end up killing something which is already
// dead of course, but that should be OK
if (outstandingID)
{
#ifdef OAD
TRACESTREAM << "Killing existing timer with id " << outstandingID << endl;
#endif
UINT kill = ::timeKillEvent(outstandingID);
if (kill != TIMERR_NOERROR)
trace("Failed to kill timer %u (%d,%d)!\n\r", outstandingID, kill, GetLastError());
}
if (nDelay > 0)
{
// Temporarily handle old image code that passes timer semaphore as an argument
if (argumentCount > 1 && (POTE)Pointers.TimingSemaphore == Pointers.Nil)
{
ObjectMemory::ProtectConstSpace(PAGE_READWRITE);
_Pointers.TimingSemaphore = (SemaphoreOTE*)stackValue(1);
ObjectMemory::ProtectConstSpace(PAGE_READONLY);
}
// Clamp the requested delay to the maximum if it is too large. This simplifies the Delay code in the image a little.
if (nDelay > SMALLINTEGER(wTimerMax))
{
nDelay = wTimerMax;
}
// Set the timerID to a non-zero value just in case the timer fires before timeSetEvent() returns.
// This allows the TimerProc to recognise the timer as valid (it doesn't really care about the
// timerID anyway, just that we're interested in it).
// N.B. We shouldn't need an interlocked operation here because, assuming no bugs in the Win32 MM
// timers, we've killed any outstanding timer, and the timer thread should be dormant
timerID = UINT(-1); // -1 is not used as a timer ID.
UINT newTimerID = ::timeSetEvent(nDelay, 0, TimeProc, 0, TIME_ONESHOT);
if (newTimerID && newTimerID != UINT(-1))
{
// Unless timer has already fired, record the timer id so can cancel if necessary
_InterlockedCompareExchange(reinterpret_cast<SHAREDLONG*>(&timerID), newTimerID, -1);
pop(argumentCount); // No ref. counting required
}
else
{
// System refused to set timer for some reason
DWORD error = GetLastError();
trace("Oh no, failed to set a timer for %d mS (%d)!\n\r", nDelay, error);
return primitiveFailureWithInt(PrimitiveFailureSystemError, error);
}
}
else if (nDelay == 0)
{
#ifdef _DEBUG
TRACESTREAM << "Requested delay " << dec << nDelay << " passed, signalling immediately" << endl;
#endif
// The request time has already passed, or does not fall within the
// available timer resolution (i.e. it will happen too soon), so signal
// it immediately
// We must adjust stack before signalling, as may change Process (and therefore stack!)
pop(argumentCount);
// N.B. Signalling may detect a process switch, but does not actually perform it
signalSemaphore(Pointers.TimingSemaphore);
}
// else requested delay was negative - we allow this to clear down the existing timer
#ifdef _DEBUG
if (newProcessWaiting())
{
ASSERT(m_oteNewProcess->m_oteClass == Pointers.ClassProcess);
ProcessOTE* activeProcess = scheduler()->m_activeProcess;
TRACESTREAM << "signalAtTick: Caused process switch to " << m_oteNewProcess
<< endl << "\t\tfrom " << activeProcess << endl
<< "\tasync signals " << m_qAsyncSignals.isEmpty() << ')' << endl;
}
#endif
// Delay could already have fired
CheckProcessSwitch();
return primitiveSuccess(0);
}
