// 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); }