// 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();
}
Oop* Interpreter::primitiveCopyFromTo(Oop* const sp, unsigned)
{
Oop oopToArg = *sp;
Oop oopFromArg = *(sp - 1);
OTE* oteReceiver = reinterpret_cast<OTE*>(*(sp - 2));
if (ObjectMemoryIsIntegerObject(oopToArg) && ObjectMemoryIsIntegerObject(oopFromArg))
{
SMALLINTEGER from = ObjectMemoryIntegerValueOf(oopFromArg);
SMALLINTEGER to = ObjectMemoryIntegerValueOf(oopToArg);
if (from > 0)
{
SMALLINTEGER count = to - from + 1;
if (count >= 0)
{
OTE* oteAnswer = ObjectMemory::CopyElements(oteReceiver, from - 1, count);
if (oteAnswer != nullptr)
{
*(sp - 2) = (Oop)oteAnswer;
ObjectMemory::AddToZct(oteAnswer);
return sp - 2;
}
}
}
// Bounds error
return primitiveFailure(1);
}
else
{
// Non-SmallInteger from and/or to
return primitiveFailure(0);
}
}
// 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::primitiveStringSearch()
{
Oop* const sp = m_registers.m_stackPointer;
Oop integerPointer = *sp;
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(0); // startingAt not an integer
const SMALLINTEGER startingAt = ObjectMemoryIntegerValueOf(integerPointer);
Oop oopSubString = *(sp-1);
BytesOTE* oteReceiver = reinterpret_cast<BytesOTE*>(*(sp-2));
if (ObjectMemory::fetchClassOf(oopSubString) != oteReceiver->m_oteClass)
return primitiveFailure(2);
// We know it can't be a SmallInteger because it has the same class as the receiver
BytesOTE* oteSubString = reinterpret_cast<BytesOTE*>(oopSubString);
VariantByteObject* bytesPattern = oteSubString->m_location;
VariantByteObject* bytesReceiver = oteReceiver->m_location;
const int M = oteSubString->bytesSize();
const int N = oteReceiver->bytesSize();
// Check 'startingAt' is in range
if (startingAt < 1 || startingAt > N)
return primitiveFailure(1); // out of bounds
int nOffset = M == 0 || ((startingAt + M) - 1 > N)
? -1
: stringSearch(bytesReceiver->m_fields, N, bytesPattern->m_fields, M, startingAt - 1);
*(sp-2) = ObjectMemoryIntegerObjectOf(nOffset+1);
return sp-2;
}
Oop* __fastcall Interpreter::primitiveNewPinned(Oop* const sp, unsigned)
{
BehaviorOTE* oteClass = reinterpret_cast<BehaviorOTE*>(*(sp - 1));
Oop oopArg = (*sp);
SMALLINTEGER size;
if (isIntegerObject(oopArg) && (size = ObjectMemoryIntegerValueOf(oopArg)) >= 0)
{
InstanceSpecification instSpec = oteClass->m_location->m_instanceSpec;
if (!(instSpec.m_pointers || instSpec.m_nonInstantiable))
{
BytesOTE* newObj = ObjectMemory::newByteObject<true, true>(oteClass, size);
*(sp - 1) = reinterpret_cast<Oop>(newObj);
ObjectMemory::AddToZct(reinterpret_cast<OTE*>(newObj));
return sp - 1;
}
else
{
// Not indexable, or non-instantiable
return primitiveFailure(instSpec.m_nonInstantiable ? 1 : 2);
}
}
else
{
return primitiveFailure(0); // Size must be positive SmallInteger
}
}
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);
}
}
Oop* __fastcall Interpreter::primitiveNewInitializedObject(Oop* sp, unsigned argCount)
{
Oop oopReceiver = *(sp - argCount);
BehaviorOTE* oteClass = reinterpret_cast<BehaviorOTE*>(oopReceiver);
InstanceSpecification instSpec = oteClass->m_location->m_instanceSpec;
if ((instSpec.m_value & (InstanceSpecification::PointersMask | InstanceSpecification::NonInstantiableMask)) == InstanceSpecification::PointersMask)
{
size_t minSize = instSpec.m_fixedFields;
size_t i;
if (instSpec.m_indexable)
{
i = max(minSize, argCount);
}
else
{
if (argCount > minSize)
{
// Not indexable, and too many fields
return primitiveFailure(2);
}
i = minSize;
}
// Note that instantiateClassWithPointers counts up the class,
PointersOTE* oteObj = ObjectMemory::newUninitializedPointerObject(oteClass, i);
VariantObject* obj = oteObj->m_location;
// nil out any extra fields
const Oop nil = reinterpret_cast<Oop>(Pointers.Nil);
while (i > argCount)
{
obj->m_fields[--i] = nil;
}
while (i != 0)
{
i--;
Oop oopArg = *sp--;
ObjectMemory::countUp(oopArg);
obj->m_fields[i] = oopArg;
}
// Save down SP in case ZCT is reconciled on adding result, allowing unref'd args to be reclaimed
m_registers.m_stackPointer = sp;
*sp = reinterpret_cast<Oop>(oteObj);
ObjectMemory::AddToZct((OTE*)oteObj);
return sp;
}
else
{
return primitiveFailure(instSpec.m_nonInstantiable ? 1 : 0);
}
}
Oop* __fastcall Interpreter::primitiveMakePoint(CompiledMethod&, unsigned argCount)
{
Oop* sp = m_registers.m_stackPointer;
Oop oopReceiver = *(sp-argCount);
if (!ObjectMemory::isBehavior(oopReceiver))
return primitiveFailure(0);
BehaviorOTE* oteClass = reinterpret_cast<BehaviorOTE*>(oopReceiver);
Behavior* behavior = oteClass->m_location;
if (behavior->isBytes())
return primitiveFailure(1);
size_t minSize = behavior->fixedFields();
size_t i;
if (behavior->isIndexable())
{
i = max(minSize, argCount);
}
else
{
if (argCount > minSize)
{
// Not indexable, and too many fields
return primitiveFailure(2);
}
i = minSize;
}
// Note that instantiateClassWithPointers counts up the class,
PointersOTE* oteObj = ObjectMemory::newUninitializedPointerObject(oteClass, i);
VariantObject* obj = oteObj->m_location;
// nil out any extra fields
const Oop nil = reinterpret_cast<Oop>(Pointers.Nil);
while (i > argCount)
{
obj->m_fields[--i] = nil;
}
while (i != 0)
{
i--;
Oop oopArg = *sp--;
ObjectMemory::countUp(oopArg);
obj->m_fields[i] = oopArg;
}
// Save down SP in case ZCT is reconciled on adding result, allowing unref'd args to be reclaimed
m_registers.m_stackPointer = sp;
*sp = reinterpret_cast<Oop>(oteObj);
ObjectMemory::AddToZct((OTE*)oteObj);
return sp;
}
// 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();
}
Oop* __fastcall Interpreter::primitiveNewFromStack(Oop* const stackPointer, unsigned)
{
BehaviorOTE* oteClass = reinterpret_cast<BehaviorOTE*>(*(stackPointer - 1));
Oop oopArg = (*stackPointer);
SMALLINTEGER count;
if (isIntegerObject(oopArg) && (count = ObjectMemoryIntegerValueOf(oopArg)) >= 0)
{
// Note that instantiateClassWithPointers counts up the class,
PointersOTE* oteObj = ObjectMemory::newUninitializedPointerObject(oteClass, count);
VariantObject* obj = oteObj->m_location;
Oop* sp = stackPointer;
sp = sp - count - 1;
while (--count >= 0)
{
oopArg = *(sp + count);
ObjectMemory::countUp(oopArg);
obj->m_fields[count] = oopArg;
}
// Save down SP in case ZCT is reconciled on adding result
m_registers.m_stackPointer = sp;
*sp = reinterpret_cast<Oop>(oteObj);
ObjectMemory::AddToZct((OTE*)oteObj);
return sp;
}
else
{
return primitiveFailure(0);
}
}
// 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
}
// Answer a new process with an initial stack size specified by the first argument, and a maximum
// stack size specified by the second argument.
Oop* __fastcall Interpreter::primitiveNewVirtual(Oop* const sp, unsigned)
{
Oop maxArg = *sp;
SMALLINTEGER maxSize;
if (ObjectMemoryIsIntegerObject(maxArg) && (maxSize = ObjectMemoryIntegerValueOf(maxArg)) >= 0)
{
Oop initArg = *(sp - 1);
SMALLINTEGER initialSize;
if (ObjectMemoryIsIntegerObject(initArg) && (initialSize = ObjectMemoryIntegerValueOf(initArg)) >= 0)
{
BehaviorOTE* receiverClass = reinterpret_cast<BehaviorOTE*>(*(sp - 2));
InstanceSpecification instSpec = receiverClass->m_location->m_instanceSpec;
if (instSpec.m_indexable && !instSpec.m_nonInstantiable)
{
unsigned fixedFields = instSpec.m_fixedFields;
VirtualOTE* newObject = ObjectMemory::newVirtualObject(receiverClass, initialSize + fixedFields, maxSize);
if (newObject)
{
*(sp - 2) = reinterpret_cast<Oop>(newObject);
// No point saving down SP before potential Zct reconcile as the init & max args must be SmallIntegers
ObjectMemory::AddToZct((OTE*)newObject);
return sp - 2;
}
else
return primitiveFailure(4); // OOM
}
else
{
return primitiveFailure(instSpec.m_nonInstantiable ? 3 : 2); // Non-indexable or abstract class
}
}
else
{
return primitiveFailure(1); // initialSize arg not a SmallInteger
}
}
else
{
return primitiveFailure(0); // maxsize arg not a SmallInteger
}
}
Oop* __fastcall Interpreter::primitiveNewWithArg(Oop* const sp, unsigned)
{
BehaviorOTE* oteClass = reinterpret_cast<BehaviorOTE*>(*(sp - 1));
Oop oopArg = (*sp);
// Unfortunately the compiler can't be persuaded to perform this using just the sar and conditional jumps on no-carry and signed;
// it generates both the bit test and the shift.
SMALLINTEGER size;
if (isIntegerObject(oopArg) && (size = ObjectMemoryIntegerValueOf(oopArg)) >= 0)
{
InstanceSpecification instSpec = oteClass->m_location->m_instanceSpec;
if ((instSpec.m_value & (InstanceSpecification::IndexableMask | InstanceSpecification::NonInstantiableMask)) == InstanceSpecification::IndexableMask)
{
if (instSpec.m_pointers)
{
PointersOTE* newObj = ObjectMemory::newPointerObject(oteClass, size + instSpec.m_fixedFields);
*(sp - 1) = reinterpret_cast<Oop>(newObj);
ObjectMemory::AddToZct(reinterpret_cast<OTE*>(newObj));
return sp - 1;
}
else
{
BytesOTE* newObj = ObjectMemory::newByteObject<true, true>(oteClass, size);
*(sp - 1) = reinterpret_cast<Oop>(newObj);
ObjectMemory::AddToZct(reinterpret_cast<OTE*>(newObj));
return sp - 1;
}
}
else
{
// Not indexable, or non-instantiable
return primitiveFailure(instSpec.m_nonInstantiable ? 1 : 2);
}
}
else
{
return primitiveFailure(0); // Size must be positive SmallInteger
}
}
Expr* PrimInliner::tryConstantFold() {
// Returns the result if the primitive call has been constant folded
// successfully; returns NULL otherwise.
// Note: The result may be a marked oop - which has to be unmarked
// before using it - and which indicates that the primitive will fail
// always.
if (!_pdesc->can_be_constant_folded()) {
// check for Symbol>>at: before declaring failure
if ((equal(_pdesc->name(), "primitiveIndexedByteAt:ifFail:") ||
equal(_pdesc->name(), "primitiveIndexedByteCharacterAt:ifFail:")) &&
parameter(0)->hasKlass() && parameter(0)->klass() == Universe::symbolKlassObj()) {
// the at: primitive can be constant-folded for symbols
// what if the receiver is a constant string? unfortunately, Smalltalk has
// "assignable constants" like Fortran...
} else {
return NULL;
}
}
// get parameters
int i = number_of_parameters();
oop* args = NEW_RESOURCE_ARRAY(oop, i);
while (i > 0) {
i--;
Expr* arg = parameter(i);
if (!arg->isConstantExpr()) return NULL;
args[i] = arg->constant();
}
// all parameters are constants, so call primitive
oop res = _pdesc->eval(args);
if (res->is_mark()) {
// primitive failed
return primitiveFailure(unmarkSymbol(res));
} else if (res->is_mem() && !res->is_old()) {
// must tenure result because nmethods aren't scavenged
if (res->is_double()) {
res = oopFactory::clone_double_to_oldspace(doubleOop(res));
} else {
// don't know how to tenure non-doubles
warning("const folding: primitive %s is returning non-tenured object", _pdesc->name());
return NULL;
}
}
ConstPReg* constResult = new_ConstPReg(_scope, res);
SAPReg* result = new SAPReg(_scope);
_gen->append(NodeFactory::new_AssignNode(constResult, result));
if (CompilerDebug) cout(PrintInlining)->print("%*sconstant-folding %s --> %#x\n", _scope->depth + 2, "", _pdesc->name(), res);
assert(!constResult->constant->is_mark(), "result must not be marked");
return new ConstantExpr(res, constResult, _gen->current());
}
BOOL __fastcall Interpreter::primitiveMakePoint(CompiledMethod&, unsigned argCount)
{
Oop oopReceiver = stackValue(argCount);
if (!ObjectMemory::isBehavior(oopReceiver))
return primitiveFailure(0);
BehaviorOTE* oteClass = reinterpret_cast<BehaviorOTE*>(oopReceiver);
Behavior* behavior = oteClass->m_location;
if (behavior->isBytes())
return primitiveFailure(1);
MWORD oops = argCount;
if (behavior->isIndexable())
{
oops += behavior->fixedFields();
}
else
{
if (behavior->fixedFields() != oops)
return primitiveFailure(2);
}
// Note that instantiateClassWithPointers counts up the class,
PointersOTE* oteObj = ObjectMemory::newPointerObject(oteClass, oops);
VariantObject* obj = oteObj->m_location;
for (int i=oops-1;i>=0;i--)
{
Oop oopArg = popStack();
ObjectMemory::countUp(oopArg);
obj->m_fields[i] = oopArg;
}
replaceStackTopWithNew(oteObj);
return TRUE;
}
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);
}
Oop* __fastcall Interpreter::primitiveNew(Oop* const sp, unsigned)
{
// This form of C code results in something very close to the hand-coded assembler original for primitiveNew
BehaviorOTE* oteClass = reinterpret_cast<BehaviorOTE*>(*sp);
InstanceSpecification instSpec = oteClass->m_location->m_instanceSpec;
if (!(instSpec.m_indexable || instSpec.m_nonInstantiable))
{
PointersOTE* newObj = ObjectMemory::newPointerObject(oteClass, instSpec.m_fixedFields);
*sp = reinterpret_cast<Oop>(newObj);
ObjectMemory::AddToZct((OTE*)newObj);
return sp;
}
else
{
return primitiveFailure(instSpec.m_nonInstantiable ? 1 : 0);
}
}
Expr* PrimInliner::tryTypeCheck() {
// Check if we have enough type information to prove that the primitive is going to fail;
// if so, directly compile failure block (important for mixed-mode arithmetic).
// Returns the failure result if the primitive call has been proven
// to fail; returns NULL otherwise.
// Should extend code to do general type compatibility test (including MergeExprs, e.g. for
// booleans) -- fix this later. -Urs 11/95
int num = number_of_parameters();
for (int i = 0; i < num; i++) {
Expr* a = parameter(i);
if (a->hasKlass()) {
Expr* primArgType = _pdesc->parameter_klass(i, a->preg(), NULL);
if (primArgType && primArgType->hasKlass() && (a->klass() != primArgType->klass())) {
// types differ -> primitive must fail
return primitiveFailure(failureSymbolForArg(i));
}
}
}
return NULL;
}
Oop* __fastcall Interpreter::primitiveAsyncDLL32Call(Oop* const, unsigned argCount)
{
CompiledMethod* method = m_registers.m_oopNewMethod->m_location;
#if TRACING == 1
{
TRACELOCK();
TRACESTREAM << L"primAsync32: Prepare to call " << *method << L" from " << Interpreter::actualActiveProcessPointer() << std::endl;
}
#endif
OverlappedCall* pCall = OverlappedCall::Do(method, argCount);
if (pCall == NULL)
// Nested overlapped calls are not supported
return primitiveFailure(0);
HARDASSERT(newProcessWaiting());
// The overlapped call may already have returned, in which case a process switch
// will not occur, so we must notify the overlapped call that it can complete as
// it will not receive a notification from either finishing the handling of an interrupt
// or by switching back to the process
if (!CheckProcessSwitch())
{
HARDASSERT(pCall->m_nCallDepth == 1);
pCall->OnActivateProcess();
}
#if TRACING == 1
{
TRACELOCK();
TRACESTREAM << L"registers.sp = " << m_registers.m_stackPointer<< L" frame.sp = " <<
m_registers.m_pActiveFrame->stackPointer() << std::endl;
}
#endif
return m_registers.m_stackPointer;
}
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);
}
}
// This is a double dispatched primitive which knows that the argument is a byte object (though
// we still check this to avoid GPFs), and the receiver is guaranteed to be a byte object. e.g.
//
// aByteObject replaceBytesOf: anOtherByteObject from: start to: stop startingAt: startAt
//
BOOL __fastcall Interpreter::primitiveReplaceBytes()
{
Oop integerPointer = stackTop();
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(0); // startAt is not an integer
SMALLINTEGER startAt = ObjectMemoryIntegerValueOf(integerPointer);
integerPointer = stackValue(1);
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(1); // stop is not an integer
SMALLINTEGER stop = ObjectMemoryIntegerValueOf(integerPointer);
integerPointer = stackValue(2);
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(2); // start is not an integer
SMALLINTEGER start = ObjectMemoryIntegerValueOf(integerPointer);
OTE* argPointer = reinterpret_cast<OTE*>(stackValue(3));
if (ObjectMemoryIsIntegerObject(argPointer) || !argPointer->isBytes())
return primitiveFailure(3); // Argument MUST be a byte object
// Empty move if stop before start, is considered valid regardless (strange but true)
// this is the convention adopted by most implementations.
if (stop >= start)
{
if (startAt < 1 || start < 1)
return primitiveFailure(4); // Out-of-bounds
// We still permit the argument to be an address to cut down on the number of primitives
// and double dispatch methods we must implement (2 rather than 4)
BYTE* pTo;
Behavior* behavior = argPointer->m_oteClass->m_location;
if (behavior->isIndirect())
{
AddressOTE* oteBytes = reinterpret_cast<AddressOTE*>(argPointer);
// We don't know how big the object is the argument points at, so cannot check length
// against stop point
pTo = static_cast<BYTE*>(oteBytes->m_location->m_pointer);
}
else
{
// We can test that we're not going to write off the end of the argument
int length = argPointer->bytesSize();
// We can only be in here if stop>=start, so => stop-start >= 0
// therefore if startAt >= 1 then => stopAt >= 1, for similar
// reasons (since stopAt >= startAt) we don't need to test
// that startAt <= length
if (stop > length)
return primitiveFailure(4); // Bounds error
VariantByteObject* argBytes = reinterpret_cast<BytesOTE*>(argPointer)->m_location;
pTo = argBytes->m_fields;
}
BytesOTE* receiverPointer = reinterpret_cast<BytesOTE*>(stackValue(4));
// Now validate that the interval specified for copying from the receiver
// is within the bounds of the receiver (we've already tested startAt)
{
int length = receiverPointer->bytesSize();
// We can only be in here if stop>=start, so if start>=1, then => stop >= 1
// furthermore if stop <= length then => start <= length
int stopAt = startAt+stop-start;
if (stopAt > length)
return primitiveFailure(4);
}
// Only works for byte objects
ASSERT(receiverPointer->isBytes());
VariantByteObject* receiverBytes = receiverPointer->m_location;
#ifdef _DEBUG
{
Behavior* behavior = receiverPointer->m_oteClass->m_location;
ASSERT(!behavior->isIndirect());
}
#endif
BYTE* pFrom = receiverBytes->m_fields;
memmove(pTo+start-1, pFrom+startAt-1, stop-start+1);
}
// Answers the argument by moving it down over the receiver
stackValue(4) = reinterpret_cast<Oop>(argPointer);
pop(4);
return TRUE;
}
// 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 is a double dispatched primitive which knows that the argument is a byte object (though
// we still check this to avoid GPFs), and the receiver is guaranteed to be an address object. e.g.
//
// anExternalAddress replaceBytesOf: anOtherByteObject from: start to: stop startingAt: startAt
//
BOOL __fastcall Interpreter::primitiveIndirectReplaceBytes()
{
Oop integerPointer = stackTop();
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(0); // startAt is not an integer
SMALLINTEGER startAt = ObjectMemoryIntegerValueOf(integerPointer);
integerPointer = stackValue(1);
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(1); // stop is not an integer
SMALLINTEGER stop = ObjectMemoryIntegerValueOf(integerPointer);
integerPointer = stackValue(2);
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(2); // start is not an integer
SMALLINTEGER start = ObjectMemoryIntegerValueOf(integerPointer);
OTE* argPointer = reinterpret_cast<OTE*>(stackValue(3));
if (ObjectMemoryIsIntegerObject(argPointer) || !argPointer->isBytes())
return primitiveFailure(3); // Argument MUST be a byte object
// Empty move if stop before start, is considered valid regardless (strange but true)
if (stop >= start)
{
if (start < 1 || startAt < 1)
return primitiveFailure(4); // out-of-bounds
AddressOTE* receiverPointer = reinterpret_cast<AddressOTE*>(stackValue(4));
// Only works for byte objects
ASSERT(receiverPointer->isBytes());
ExternalAddress* receiverBytes = receiverPointer->m_location;
#ifdef _DEBUG
{
Behavior* behavior = receiverPointer->m_oteClass->m_location;
ASSERT(behavior->isIndirect());
}
#endif
// Because the receiver is an address, we do not know the size of the object
// it points at, and so cannot perform any bounds checks - BEWARE
BYTE* pFrom = static_cast<BYTE*>(receiverBytes->m_pointer);
// We still permit the argument to be an address to cut down on the double dispatching
// required.
BYTE* pTo;
Behavior* behavior = argPointer->m_oteClass->m_location;
if (behavior->isIndirect())
{
AddressOTE* oteBytes = reinterpret_cast<AddressOTE*>(argPointer);
// Cannot check length
pTo = static_cast<BYTE*>(oteBytes->m_location->m_pointer);
}
else
{
// Can check that not writing off the end of the argument
int length = argPointer->bytesSize();
// We can only be in here if stop>=start, so => stop-start >= 0
// therefore if startAt >= 1 then => stopAt >= 1, for similar
// reasons (since stopAt >= startAt) we don't need to test
// that startAt <= length
if (stop > length)
return primitiveFailure(4); // Bounds error
VariantByteObject* argBytes = reinterpret_cast<BytesOTE*>(argPointer)->m_location;
pTo = argBytes->m_fields;
}
memmove(pTo+start-1, pFrom+startAt-1, stop-start+1);
}
// Answers the argument by moving it down over the receiver
stackValue(4) = reinterpret_cast<Oop>(argPointer);
pop(4);
return TRUE;
}
/*
Implements
String>>replaceFrom: start
to: stop
with: aString
startingAt: startAt
But is also used for ByteArray
Does not use successFlag, and nils out argument (if successful)
to leave a clean stack
*/
BOOL __fastcall Interpreter::primitiveStringReplace()
{
Oop integerPointer = stackTop();
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(0);
SMALLINTEGER startAt = ObjectMemoryIntegerValueOf(integerPointer);
OTE* argPointer = reinterpret_cast<OTE*>(stackValue(1));
integerPointer = stackValue(2);
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(1);
SMALLINTEGER stop = ObjectMemoryIntegerValueOf(integerPointer);
integerPointer = stackValue(3);
if (!ObjectMemoryIsIntegerObject(integerPointer))
return primitiveFailure(2);
SMALLINTEGER start = ObjectMemoryIntegerValueOf(integerPointer);
OTE* receiverPointer = reinterpret_cast<OTE*>(stackValue(4));
// Validity checks
TODO("Try to do cleverer faster check here - too many (reproducing V behaviour)")
// Only works for byte objects
#ifdef _DEBUG
if (!receiverPointer->isBytes())
return primitiveFailure(0);
#else
// Assume primitive used correctly - i.e. only in byte objects
#endif
if (ObjectMemoryIsIntegerObject(argPointer) || !argPointer->isBytes())
return primitiveFailure(3);
// Empty move if stop before start, is considered valid regardless (strange but true)
TODO("Change this so that does fail if stop or start < 1, only like this for V compatibility")
if (stop >= start)
{
POBJECT receiverBytes = receiverPointer->m_location;
// The receiver can be an indirect pointer (e.g. an instance of ExternalAddress)
BYTE* pTo;
Behavior* byteClass = receiverPointer->m_oteClass->m_location;
if (byteClass->isIndirect())
pTo = static_cast<BYTE*>(static_cast<ExternalAddress*>(receiverBytes)->m_pointer);
else
{
int length = receiverPointer->bytesSize();
// We can only be in here if stop>=start, so if start>=1, then => stop >= 1
// furthermore if stop <= length then => start <= length
if (start < 1 || stop > length)
return primitiveFailure(4);
pTo = static_cast<ByteArray*>(receiverBytes)->m_elements;
}
POBJECT argBytes = argPointer->m_location;
// The argument can also be an indirect pointer (e.g. an instance of ExternalAddress)
BYTE* pFrom;
Behavior* argClass = argPointer->m_oteClass->m_location;
if (argClass->isIndirect())
pFrom = static_cast<BYTE*>(static_cast<ExternalAddress*>(argBytes)->m_pointer);
else
{
int length = argPointer->bytesSize();
// We can only be in here if stop>=start, so => stop-start >= 0
// therefore if startAt >= 1 then => stopAt >= 1, for similar
// reasons (since stopAt >= startAt) we don't need to test
// that startAt <= length
int stopAt = startAt+stop-start;
if (startAt < 1 || stopAt > length)
return primitiveFailure(4);
pFrom = static_cast<ByteArray*>(argBytes)->m_elements;
}
// Remember that Smalltalk indices are 1 based
// Might be overlapping
memmove(pTo+start-1, pFrom+startAt-1, stop-start+1);
}
pop(4);
return TRUE;
}
// 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
}
// Non-standard, but has very beneficial effect on performance
BOOL __fastcall Interpreter::primitiveNextPutAll()
{
Oop* sp = m_registers.m_stackPointer;
WriteStreamOTE* streamPointer = reinterpret_cast<WriteStreamOTE*>(*(sp-1)); // Access receiver under argument
WriteStream* writeStream = streamPointer->m_location;
// Ensure valid stream - checks from Blue Book
if (!ObjectMemoryIsIntegerObject(writeStream->m_index) ||
!ObjectMemoryIsIntegerObject(writeStream->m_writeLimit))
return primitiveFailure(0); // Fails invariant check
SMALLINTEGER index = ObjectMemoryIntegerValueOf(writeStream->m_index);
SMALLINTEGER limit = ObjectMemoryIntegerValueOf(writeStream->m_writeLimit);
if (index < 0)
return primitiveFailure(2);
Oop value = *(sp);
OTE* oteBuf = writeStream->m_array;
BehaviorOTE* bufClass = oteBuf->m_oteClass;
MWORD newIndex;
if (bufClass == Pointers.ClassString)
{
BehaviorOTE* oteClass = ObjectMemory::fetchClassOf(value);
if (oteClass != Pointers.ClassString && oteClass != Pointers.ClassSymbol)
return primitiveFailure(4); // Attempt to put non-string
StringOTE* oteString = reinterpret_cast<StringOTE*>(value);
String* str = oteString->m_location;
MWORD valueSize = oteString->bytesSize();
newIndex = MWORD(index)+valueSize;
if (newIndex >= static_cast<MWORD>(limit)) // Beyond write limit
return primitiveFailure(2);
if (static_cast<int>(newIndex) >= oteBuf->bytesSizeForUpdate())
return primitiveFailure(3); // Attempt to write off end of buffer
String* buf = static_cast<String*>(oteBuf->m_location);
memcpy(buf->m_characters+index, str->m_characters, valueSize);
}
else if (bufClass == Pointers.ClassByteArray)
{
if (ObjectMemory::fetchClassOf(value) != bufClass)
return primitiveFailure(4); // Attempt to put non-ByteArray
ByteArrayOTE* oteBytes = reinterpret_cast<ByteArrayOTE*>(value);
ByteArray* bytes = oteBytes->m_location;
MWORD valueSize = oteBytes->bytesSize();
newIndex = MWORD(index)+valueSize;
if (newIndex >= (MWORD)limit) // Beyond write limit
return primitiveFailure(2);
if (static_cast<int>(newIndex) >= oteBuf->bytesSizeForUpdate())
return primitiveFailure(3); // Attempt to write off end of buffer
ByteArray* buf = static_cast<ByteArray*>(oteBuf->m_location);
memcpy(buf->m_elements+index, bytes->m_elements, valueSize);
}
else if (bufClass == Pointers.ClassArray)
{
if (ObjectMemory::fetchClassOf(value) != Pointers.ClassArray)
return primitiveFailure(4); // Attempt to put non-Array
ArrayOTE* oteArray = reinterpret_cast<ArrayOTE*>(value);
Array* array = oteArray->m_location;
MWORD valueSize = oteArray->pointersSize();
newIndex = MWORD(index) + valueSize;
if (newIndex >= (MWORD)limit) // Beyond write limit
return primitiveFailure(2);
if (static_cast<int>(newIndex) >= oteBuf->pointersSizeForUpdate())
return primitiveFailure(3); // Attempt to write off end of buffer
Array* buf = static_cast<Array*>(oteBuf->m_location);
for (MWORD i = 0; i < valueSize; i++)
{
ObjectMemory::storePointerWithValue(buf->m_elements[index + i], array->m_elements[i]);
}
}
else
return primitiveFailure(1);
writeStream->m_index = Integer::NewUnsigned32WithRef(newIndex); // Increment the stream index
// As we no longer pop stack here, the receiver is still under the argument
*(sp-1) = value;
return sizeof(Oop); // Pop 4 bytes
}
// This primitive handles WriteStream>>NextPut:, but only for Arrays, Strings & ByteArrays
// Uses but does not modify stack pointer, instead returns the number of bytes to
// pop from the Smalltalk stack.
BOOL __fastcall Interpreter::primitiveNextPut()
{
Oop* sp = m_registers.m_stackPointer;
WriteStreamOTE* streamPointer = reinterpret_cast<WriteStreamOTE*>(*(sp-1)); // Access receiver under argument
//ASSERT(!ObjectMemoryIsIntegerObject(streamPointer) && ObjectMemory::isKindOf(streamPointer, Pointers.ClassPositionableStream));
WriteStream* writeStream = streamPointer->m_location;
// Ensure valid stream - checks from Blue Book
if (!ObjectMemoryIsIntegerObject(writeStream->m_index) ||
!ObjectMemoryIsIntegerObject(writeStream->m_writeLimit))
return primitiveFailure(0); // Fails invariant check
SMALLINTEGER index = ObjectMemoryIntegerValueOf(writeStream->m_index);
SMALLINTEGER limit = ObjectMemoryIntegerValueOf(writeStream->m_writeLimit);
// Within the bounds of the limit
if (index < 0 || index >= limit)
return primitiveFailure(2);
Oop value = *(sp);
OTE* oteBuf = writeStream->m_array;
BehaviorOTE* bufClass = oteBuf->m_oteClass;
if (bufClass == Pointers.ClassString)
{
if (ObjectMemory::fetchClassOf(value) != Pointers.ClassCharacter)
return primitiveFailure(4); // Attempt to put non-character
StringOTE* oteString = reinterpret_cast<StringOTE*>(oteBuf);
if (index >= oteString->bytesSizeForUpdate())
return primitiveFailure(3); // Attempt to put non-character or off end of String
String* buf = oteString->m_location;
CharOTE* oteChar = reinterpret_cast<CharOTE*>(value);
buf->m_characters[index] = static_cast<char>(oteChar->getIndex() - ObjectMemory::FirstCharacterIdx);
}
else if (bufClass == Pointers.ClassArray)
{
ArrayOTE* oteArray = reinterpret_cast<ArrayOTE*>(oteBuf);
// In bounds of Array?
if (index >= oteArray->pointersSizeForUpdate())
return primitiveFailure(3);
Array* buf = oteArray->m_location;
// We must ref. count value here as we're storing into a heap object slot
ObjectMemory::storePointerWithValue(buf->m_elements[index], value);
}
else if (bufClass == Pointers.ClassByteArray)
{
if (!ObjectMemoryIsIntegerObject(value))
return primitiveFailure(4); // Attempt to put non-SmallInteger
SMALLINTEGER intValue = ObjectMemoryIntegerValueOf(value);
if (intValue < 0 || intValue > 255)
return primitiveFailure(4); // Can only store 0..255
ByteArrayOTE* oteByteArray = reinterpret_cast<ByteArrayOTE*>(oteBuf);
if (index >= oteByteArray->bytesSizeForUpdate())
return primitiveFailure(3); // Attempt to put non-character or off end of String
oteByteArray->m_location->m_elements[index] = static_cast<BYTE>(intValue);
}
else
return primitiveFailure(1);
writeStream->m_index = Integer::NewSigned32WithRef(index + 1); // Increment the stream index
// As we no longer pop stack here, the receiver is still under the argument
*(sp-1) = value;
return sizeof(Oop); // Pop 4 bytes
}
