C++ OTE类代码示例

LRESULT CALLBACK Interpreter::CbtFilterHook(int code, WPARAM wParam, LPARAM lParam)
{
	// Looking for HCBT_CREATEWND, just pass others on...
	if (code == HCBT_CREATEWND)
	{
		//ASSERT(lParam != NULL);
		//LPCREATESTRUCT lpcs = ((LPCBT_CREATEWND)lParam)->lpcs;
		//ASSERT(lpcs != NULL);

		OTE* underConstruction = m_oteUnderConstruction;

		if (!underConstruction->isNil())
		{
			// Nil this out as soon as possible
			m_oteUnderConstruction = Pointers.Nil;
			underConstruction->countDown();

			ASSERT(wParam != NULL); // should be non-NULL HWND

			// set m_bDlgCreate to TRUE if it is a dialog box
			//  (this controls what kind of subclassing is done later)
			//pThreadState->m_bDlgCreate = (lpcs->lpszClass == WC_DIALOG);

			// Pass to Smalltalk for subclassing (catch unwind failures so not thrown out)
			subclassWindow(underConstruction, HWND(wParam));
		}
	}

	return ::CallNextHookEx(hHookOldCbtFilter, code, wParam, lParam);
}

// Free up a pool of objects maintained by the interpreter on request
void ObjectMemory::OTEPool::clear()
{
	#ifdef MEMSTATS
	{
		tracelock lock(TRACESTREAM);
		TRACESTREAM << "OTEPool(" << this << ") before clear, " << dec << m_nAllocated << " allocated, " 
			<< m_nFree << " free" << endl;
	}
	#endif

	while (m_pFreeList)
	{
		OTE* ote = m_pFreeList;
		ote->beAllocated();
		
		// All objects on the free list originated from pool space, so we need to
		// send them back there
		ote->m_flags.m_space = OTEFlags::PoolSpace;

		VariantObject* pObj = static_cast<VariantObject*>(ote->m_location);
		m_pFreeList = reinterpret_cast<OTE*>(pObj->m_fields[0]);
		ObjectMemory::deallocate(ote);
	}

	#ifdef MEMSTATS
	{
		ASSERT(m_nFree <= m_nAllocated);
		m_nAllocated -= m_nFree;
		m_nFree = 0;
		tracelock lock(TRACESTREAM);
		TRACESTREAM << "OTEPool(" << this << ") after clear, " << dec << m_nAllocated << " allocated" << endl;
	}
	#endif
}

template <MWORD ImageNullTerms> HRESULT ObjectMemory::LoadPointers(ibinstream& imageFile, const ImageHeader* pHeader, size_t& cbRead)
{
	ASSERT(pHeader->nGlobalPointers == NumPointers);

	::ZeroMemory(m_pConstObjs, CONSTSPACESIZE);

	size_t cbPerm = 0;
	BYTE* pNextConst = reinterpret_cast<BYTE*>(m_pConstObjs);
	int i;
	for (i = 0; i < NumPermanent; i++)
	{
		VariantObject* pConstObj = reinterpret_cast<VariantObject*>(pNextConst);

		OTE* ote = m_pOT + i;
		MWORD bytesToRead;
		MWORD allocSize;
		if (ote->isNullTerminated())
		{
			MWORD byteSize = ote->getSize();
			allocSize = byteSize + NULLTERMSIZE;
			bytesToRead = byteSize + ImageNullTerms;
		}
		else
		{
			allocSize = bytesToRead = ote->getSize();
		}

		if (bytesToRead > 0)
		{
			// Now load the rest of the object (size includes itself)
			if (!imageFile.read(&(pConstObj->m_fields), bytesToRead))
				return ImageReadError(imageFile);
		}
		else
		{
			if (allocSize == 0) pConstObj = NULL;
		}

		cbPerm += bytesToRead;
		pNextConst += _ROUND2(allocSize, 4);

		markObject(ote);
		Oop* oldLocation = reinterpret_cast<Oop*>(ote->m_location);
		ote->m_location = pConstObj;

		ote->beSticky();
		// Repair the object
		FixupObject(ote, oldLocation, pHeader);
	}

#ifdef _DEBUG
	TRACESTREAM << i<< L" permanent objects loaded totalling " << cbPerm<< L" bytes" << std::endl;
#endif

	memcpy(const_cast<VMPointers*>(&Pointers), &_Pointers, sizeof(Pointers));

	cbRead += cbPerm;
	return S_OK;
}

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

// N.B. Like the other instantiate methods in ObjectMemory, this method for instantiating
// objects in virtual space (used for allocating Processes, for example), does not adjust
// the ref. count of the class, because this is often unecessary, and does not adjust the
// sizes to allow for fixed fields - callers must do this
VirtualOTE* ObjectMemory::newVirtualObject(BehaviorOTE* classPointer, MWORD initialSize, MWORD maxSize)
{
	#ifdef _DEBUG
	{
		ASSERT(isBehavior(Oop(classPointer)));
		Behavior& behavior = *classPointer->m_location;
		ASSERT(behavior.isIndexable());
	}
	#endif

	// Trim the sizes to acceptable bounds
	if (initialSize <= dwOopsPerPage)
		initialSize = dwOopsPerPage;
	else
		initialSize = _ROUND2(initialSize, dwOopsPerPage);

	if (maxSize < initialSize)
		maxSize = initialSize;
	else
		maxSize = _ROUND2(maxSize, dwOopsPerPage);

	// We have to allow for the virtual allocation overhead. The allocation function will add in
	// space for this. The maximum size should include this, the initial size should not
	initialSize -= sizeof(VirtualObjectHeader)/sizeof(MWORD);

	unsigned byteSize = initialSize*sizeof(MWORD);
	VariantObject* pLocation = reinterpret_cast<VariantObject*>(AllocateVirtualSpace(maxSize * sizeof(MWORD), byteSize));
	if (pLocation)
	{
		// No need to alter ref. count of process class, as it is sticky

		// Fill space with nils for initial values
		const Oop nil = Oop(Pointers.Nil);
		const unsigned loopEnd = initialSize;
		for (unsigned i = 0; i < loopEnd; i++)
			pLocation->m_fields[i] = nil;

		OTE* ote = ObjectMemory::allocateOop(static_cast<POBJECT>(pLocation));
		ote->setSize(byteSize);
		ote->m_oteClass = classPointer;
		classPointer->countUp();
		ote->m_flags = m_spaceOTEBits[OTEFlags::VirtualSpace];
		ASSERT(ote->isPointers());

		return reinterpret_cast<VirtualOTE*>(ote);
	}

	return nullptr;
}

void ObjectMemory::EmptyZct()
{
	if (m_bIsReconcilingZct)
		__debugbreak();
#ifdef _DEBUG
	nDeleted = 0;

	if (!alwaysReconcileOnAdd || Interpreter::executionTrace)
		CHECKREFSNOFIX
	else
		checkStackRefs();
#endif

	// Bump the refs from the stack. Any objects remaining in the ZCT with zero counts
	// are truly garbage.
	Interpreter::IncStackRefs();

	OTE** pZct = m_pZct;
	// This tells us that we are in the process of reconcilation
	m_bIsReconcilingZct = true;
	const int nOldZctEntries = m_nZctEntries;
	m_nZctEntries = -1;

	for (int i=0;i<nOldZctEntries;i++)
	{
		OTE* ote = pZct[i];
		if (!ote->isFree() && ote->m_flags.m_count == 0)
		{
			// Note that deallocate cannot make new Zct entries
			// Because we have bumped the ref. counts of all stack ref'd objects, only true
			// garbage objects can ever have a ref. count of zero. Therefore if recursively
			// counting down throws up new zero ref. counts, these should not be added to 
			// the Zct, but deallocated. To achieve this we set a global flag to indicate
			// that we are reconciling, see AddToZct() above. 
#ifdef _DEBUG
			nDeleted++;
#endif
			recursiveFree(ote);
		}
	}

//	CHECKREFSNOFIX
}

// Compact an object by updating all the Oops it contains using the
// forwarding pointers in the old OT.
void ObjectMemory::compactObject(OTE* ote)
{
	// We shouldn't come in here unless OTE already fixed for this object
	HARDASSERT(ote >= m_pOT && ote < m_pFreePointerList);

	// First fix up the class (remember that the new object pointer is stored in the
	// old one's object location slot
	compactOop(ote->m_oteClass);

	if (ote->isPointers())
	{
		VariantObject* varObj = static_cast<VariantObject*>(ote->m_location);
		const MWORD lastPointer = ote->pointersSize();
		for (MWORD i = 0; i < lastPointer; i++)
		{
			// This will get nicely optimised by the Compiler
			Oop fieldPointer = varObj->m_fields[i];

			// We don't need to visit SmallIntegers and objects we've already visited
			if (!isIntegerObject(fieldPointer))
			{
				OTE* fieldOTE = reinterpret_cast<OTE*>(fieldPointer);
				// If pointing at a free'd object ,then it has been moved
				if (fieldOTE->isFree())
				{
					// Should be one of the old OT entries, pointing outside the o
					Oop movedTo = reinterpret_cast<Oop>(fieldOTE->m_location);
					HARDASSERT(movedTo >= (Oop)m_pOT && movedTo < (Oop)m_pFreePointerList);
					// Get the new OTE from the old ...
					varObj->m_fields[i] = movedTo;
				}
			}
		}
	}
	// else, we don't even need to look at the body of byte objects any more
}

BOOL __fastcall Interpreter::primitiveHookWindowCreate()
{
	Oop argPointer = stackTop();
	OTE* underConstruction = m_oteUnderConstruction;
	OTE* receiverPointer = reinterpret_cast<OTE*>(stackValue(1));

	if (!underConstruction->isNil() && underConstruction != receiverPointer)
	{
		// Hooked by another window - fail the primitive
		return primitiveFailureWith(1, underConstruction);
	}


	if (argPointer == Oop(Pointers.True))
	{
		// Hooking

		if (underConstruction != receiverPointer)
		{
			ASSERT(underConstruction->isNil());
			m_oteUnderConstruction= receiverPointer;
			receiverPointer->countUp();
		}
	}
	else
	{
		if (argPointer == Oop(Pointers.False))
		{
			// Unhooking
			if (underConstruction == receiverPointer)
			{
				tracelock lock(TRACESTREAM);
				TRACESTREAM << "WARNING: Unhooking create for " << hex << underConstruction << " before HCBT_CREATEWND" << endl;
				ObjectMemory::nilOutPointer(m_oteUnderConstruction);
			}
			else
				ASSERT(underConstruction->isNil());
		}
		else
			return primitiveFailureWith(0, argPointer);	// Invalid argument
	}

	popStack();
	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);
}

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

// Perform a compacting GC
size_t ObjectMemory::compact(Oop* const sp)
{
	TRACE("Compacting OT, size %d, free %d, ...\n", m_nOTSize, m_pOT + m_nOTSize - m_pFreePointerList);
	EmptyZct(sp);

	// First perform a normal GC
	reclaimInaccessibleObjects(GCNormal);

	Interpreter::freePools();

	// Walk the OT from the bottom to locate free entries, and from the top to locate candidates to move
	// 

	size_t moved = 0;
	OTE* last = m_pOT + m_nOTSize - 1;
	OTE* first = m_pOT;
#pragma warning(push)
#pragma warning(disable : 4127)
	while(true)
#pragma warning(pop)
	{
		// Look for a tail ender
		while (last > first && last->isFree())
			last--;
		// Look for a free slot
		while (first < last && !first->isFree())
			first++;
		if (first == last)
			break;	// Met in the middle, we're done
		
		HARDASSERT(first->isFree());
		HARDASSERT(!last->isFree());

		// Copy the tail ender over the free slot
		*first = *last;
		moved++;
		// Leave forwarding pointer in the old slot
		last->m_location = reinterpret_cast<POBJECT>(first);
		last->beFree();
		last->m_count = 0;
		// Advance last as we've moved this slot
		last--;
	}

	HARDASSERT(last == first);
	// At this point, last == first, and the first free slot will be that after last

	TRACE("%d OTEs compacted\n", moved);

	// Now we can update the objects using the forwarding pointers in the old slots

	// We must remove the const. spaces memory protect for the duration of the pointer update
	ProtectConstSpace(PAGE_READWRITE);

	// New head of free list is first OTE after the single contiguous block of used OTEs
	// Need to set this before compacting as 
	m_pFreePointerList = last+1;

	// Now run through the new OT and update the Oops in the objects
	OTE* pOTE = m_pOT;
	while (pOTE <= last)
	{
		compactObject(pOTE);
		pOTE++;
	}

	// Note that this copies VMPointers to cache area
	ProtectConstSpace(PAGE_READONLY);

	// We must inform the interpreter that it needs to update any cached Oops from the forward pointers
	// before we rebuild the free list (which will destroy those pointers to the new OTEs)
	Interpreter::OnCompact();

	// The last used slot will be the slot before the first entry in the free list
	// Using this, round up from the last used slot to the to commit granularity, then uncommit any later slots
	// 
	
	OTE* end = (OTE*)_ROUND2(reinterpret_cast<ULONG_PTR>(m_pFreePointerList + 1), dwAllocationGranularity);

#ifdef _DEBUG
	m_nFreeOTEs = end - m_pFreePointerList;
#endif

	SIZE_T bytesToDecommit = reinterpret_cast<ULONG_PTR>(m_pOT + m_nOTSize) - reinterpret_cast<ULONG_PTR>(end);
	::VirtualFree(end, bytesToDecommit, MEM_DECOMMIT);
	m_nOTSize = end - m_pOT;

	// Now fix up the free list
	OTE* cur = m_pFreePointerList;
	while (cur < end)
	{
		HARDASSERT(cur->isFree());
		cur->m_location = reinterpret_cast<POBJECT>(cur + 1);
		cur++;
	}

	// Could do this before or after check refs, since that can account for Zct state
	PopulateZct(sp);

//.........这里部分代码省略.........

template <MWORD ImageNullTerms> HRESULT ObjectMemory::LoadObjects(ibinstream & imageFile, const ImageHeader * pHeader, size_t & cbRead)
{
	// Other free OTEs will be threaded in front of the first OTE off the end
	// of the currently committed table space. We set the free list pointer
	// to that OTE rather than NULL to distinguish attemps to access off the
	// end of the current table, which then allows us to dynamically grow it
	// on demand
	OTE* pEnd = m_pOT + pHeader->nTableSize;
	m_pFreePointerList = reinterpret_cast<OTE*>(pEnd);

#ifdef _DEBUG
	unsigned numObjects = NumPermanent;	// Allow for VM registry, etc!
	m_nFreeOTEs = m_nOTSize - pHeader->nTableSize;
#endif

	size_t nDataSize = 0;
	for (OTE* ote = m_pOT + NumPermanent; ote < pEnd; ote++)
	{
		if (!ote->isFree())
		{
			MWORD byteSize = ote->getSize();

			MWORD* oldLocation = reinterpret_cast<MWORD*>(ote->m_location);

			Object* pBody;

			// Allocate space for the object, and copy into that space
			if (ote->heapSpace() == OTEFlags::VirtualSpace)
			{
				MWORD dwMaxAlloc;
				if (!imageFile.read(&dwMaxAlloc, sizeof(MWORD)))
					return ImageReadError(imageFile);
				cbRead += sizeof(MWORD);

				pBody = reinterpret_cast<Object*>(AllocateVirtualSpace(dwMaxAlloc, byteSize));
				ote->m_location = pBody;
			}
			else
			{
				if (ote->isNullTerminated())
				{
					ASSERT(!ote->isPointers());
					pBody = AllocObj(ote, byteSize + NULLTERMSIZE);
					if (NULLTERMSIZE > ImageNullTerms)
					{
						// Ensure we have a full null-terminator
						*reinterpret_cast<NULLTERMTYPE*>(static_cast<VariantByteObject*>(pBody)->m_fields+byteSize) = 0;
					}
					byteSize += ImageNullTerms;
				}
				else
				{
					pBody = AllocObj(ote, byteSize);
				}

			}

			markObject(ote);
			if (!imageFile.read(pBody, byteSize))
				return ImageReadError(imageFile);

			cbRead += byteSize;
			FixupObject(ote, oldLocation, pHeader);

#ifdef _DEBUG
			numObjects++;
#endif
		}
		else
		{
			// Thread onto the free list
			ote->m_location = (reinterpret_cast<POBJECT>(m_pFreePointerList));
			m_pFreePointerList = ote;
#ifdef _DEBUG
			m_nFreeOTEs++;
#endif
		}
	}

	// Note that we don't terminate the free list with a null, because
	// it must point off into space in order to get a GPF when it
	// needs to be expanded (at which point we commit more pages)

#ifdef _DEBUG
	ASSERT(numObjects + m_nFreeOTEs == m_nOTSize);
	ASSERT(m_nFreeOTEs = CountFreeOTEs());
	TRACESTREAM << std::dec << numObjects<< L", " << m_nFreeOTEs<< L" free" << std::endl;
#endif

	cbRead += nDataSize;
	return S_OK;
}

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