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;
}
// There are some fixups that we can only apply after all the objects are loaded, because
// they involve reference from one object to other objects which may not be available
// during the normal load process. These fixes are applied here
void ObjectMemory::PostLoadFix()
{
// Special case handling for Contexts because we store
// the sp's as integers in the image file, but at
// run-time they are expected to be direct pointers
const OTE* pEnd = m_pOT + m_nOTSize; // Loop invariant
for (OTE* ote = m_pOT; ote < pEnd; ote++)
{
if (!ote->isFree())
{
if (ote->isBytes())
{
#ifdef _DEBUG
{
// Its a byte object, and may be null terminated
const Behavior* behavior = ote->m_oteClass->m_location;
const BytesOTE* oteBytes = reinterpret_cast<const BytesOTE*>(ote);
const VariantByteObject* object = oteBytes->m_location;
ASSERT(behavior->m_instanceSpec.m_nullTerminated == ote->isNullTerminated());
}
#endif
}
else if (ote->m_oteClass == _Pointers.ClassProcess)
{
ASSERT(ote->heapSpace() == OTEFlags::VirtualSpace);
ProcessOTE* oteProcess = reinterpret_cast<ProcessOTE*>(ote);
Process* process = oteProcess->m_location;
process->PostLoadFix(oteProcess);
}
}
}
ProtectConstSpace(PAGE_READONLY);
#if defined(_DEBUG) && 0
{
// Dump out the pointers
TRACESTREAM << NumPointers<< L" VM Pointers..." << std::endl;
for (int i = 0; i < NumPointers; i++)
{
VariantObject* obj = static_cast<VariantObject*>(m_pConstObjs);
POTE pote = POTE(obj->m_fields[i]);
TRACESTREAM << i<< L": " << pote << std::endl;
}
}
#endif
}
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
}
BytesOTE* __fastcall ObjectMemory::shallowCopy(BytesOTE* ote)
{
ASSERT(ote->isBytes());
// Copying byte objects is simple and fast
VariantByteObject& bytes = *ote->m_location;
BehaviorOTE* classPointer = ote->m_oteClass;
MWORD objectSize = ote->sizeOf();
OTE* copyPointer;
// Allocate an uninitialized object ...
VariantByteObject* pLocation = static_cast<VariantByteObject*>(allocObject(objectSize, copyPointer));
ASSERT((objectSize > MaxSizeOfPoolObject && copyPointer->heapSpace() == OTEFlags::NormalSpace)
|| copyPointer->heapSpace() == OTEFlags::PoolSpace);
ASSERT(copyPointer->getSize() == objectSize);
// This set does not want to copy over the immutability bit - i.e. even if the original was immutable, the
// copy will never be.
copyPointer->setSize(ote->getSize());
copyPointer->m_dwFlags = (copyPointer->m_dwFlags & ~OTEFlags::WeakMask) | (ote->m_dwFlags & OTEFlags::WeakMask);
ASSERT(copyPointer->isBytes());
copyPointer->m_oteClass = classPointer;
classPointer->countUp();
// Copy the entire object over the other one, including any null terminator and object header
memcpy(pLocation, &bytes, objectSize);
return reinterpret_cast<BytesOTE*>(copyPointer);
}
PointersOTE* __fastcall ObjectMemory::newUninitializedPointerObject(BehaviorOTE* classPointer, MWORD oops)
{
// Total size must fit in a DWORD bits
ASSERT(oops < ((DWORD(1) << 30) - ObjectHeaderSize));
// Don't worry, compiler will not really use multiply instruction here
MWORD objectSize = SizeOfPointers(oops);
OTE* ote;
allocObject(objectSize, ote);
ASSERT((objectSize > MaxSizeOfPoolObject && ote->heapSpace() == OTEFlags::NormalSpace)
|| ote->heapSpace() == OTEFlags::PoolSpace);
// These are stored in the object itself
ASSERT(ote->getSize() == objectSize);
classPointer->countUp();
ote->m_oteClass = classPointer;
// DO NOT Initialise the fields to nils
ASSERT(ote->isPointers());
return reinterpret_cast<PointersOTE*>(ote);
}
// 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;
}
OTE* ObjectMemory::CopyElements(OTE* oteObj, MWORD startingAt, MWORD count)
{
// Note that startingAt is expected to be a zero-based index
ASSERT(startingAt >= 0);
OTE* oteSlice;
if (oteObj->isBytes())
{
BytesOTE* oteBytes = reinterpret_cast<BytesOTE*>(oteObj);
size_t elementSize = ObjectMemory::GetBytesElementSize(oteBytes);
if (count == 0 || ((startingAt + count) * elementSize <= oteBytes->bytesSize()))
{
MWORD objectSize = elementSize * count;
if (oteBytes->m_flags.m_weakOrZ)
{
// TODO: Allocate the correct number of null term bytes based on the encoding
auto newBytes = static_cast<VariantByteObject*>(allocObject(objectSize + NULLTERMSIZE, oteSlice));
// When copying strings, the slices has the same string class
(oteSlice->m_oteClass = oteBytes->m_oteClass)->countUp();
memcpy(newBytes->m_fields, oteBytes->m_location->m_fields + (startingAt * elementSize), objectSize);
*reinterpret_cast<NULLTERMTYPE*>(&newBytes->m_fields[objectSize]) = 0;
oteSlice->beNullTerminated();
return oteSlice;
}
else
{
VariantByteObject* newBytes = static_cast<VariantByteObject*>(allocObject(objectSize, oteSlice));
// When copying bytes, the slice is always a ByteArray
oteSlice->m_oteClass = Pointers.ClassByteArray;
oteSlice->beBytes();
memcpy(newBytes->m_fields, oteBytes->m_location->m_fields + (startingAt * elementSize), objectSize);
return oteSlice;
}
}
}
else
{
// Pointers
PointersOTE* otePointers = reinterpret_cast<PointersOTE*>(oteObj);
BehaviorOTE* oteClass = otePointers->m_oteClass;
InstanceSpecification instSpec = oteClass->m_location->m_instanceSpec;
if (instSpec.m_indexable)
{
startingAt += instSpec.m_fixedFields;
if (count == 0 || (startingAt + count) <= otePointers->pointersSize())
{
MWORD objectSize = SizeOfPointers(count);
auto pSlice = static_cast<VariantObject*>(allocObject(objectSize, oteSlice));
// When copying pointers, the slice is always an Array
oteSlice->m_oteClass = Pointers.ClassArray;
VariantObject* pSrc = otePointers->m_location;
for (MWORD i = 0; i < count; i++)
{
countUp(pSlice->m_fields[i] = pSrc->m_fields[startingAt + i]);
}
return oteSlice;
}
}
}
return nullptr;
}
// 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);
CHECKREFERENCES
HeapCompact();
TRACE("... OT compacted, size %d, free %d.\n", m_nOTSize, end - m_pFreePointerList);
Interpreter::scheduleFinalization();
return m_pFreePointerList - m_pOT;
}
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;
}
template <bool MaybeZ, bool Initialized> BytesOTE* ObjectMemory::newByteObject(BehaviorOTE* classPointer, MWORD elementCount)
{
Behavior& byteClass = *classPointer->m_location;
OTE* ote;
if (!MaybeZ || !byteClass.m_instanceSpec.m_nullTerminated)
{
ASSERT(!classPointer->m_location->m_instanceSpec.m_nullTerminated);
VariantByteObject* newBytes = static_cast<VariantByteObject*>(allocObject(elementCount + SizeOfPointers(0), ote));
ASSERT((elementCount > MaxSizeOfPoolObject && ote->heapSpace() == OTEFlags::NormalSpace)
|| ote->heapSpace() == OTEFlags::PoolSpace);
ASSERT(ote->getSize() == elementCount + SizeOfPointers(0));
if (Initialized)
{
// Byte objects are initialized to zeros (but not the header)
// Note that we round up to initialize to the next DWORD
// This can be useful when working on a 32-bit word machine
ZeroMemory(newBytes->m_fields, _ROUND2(elementCount, sizeof(DWORD)));
classPointer->countUp();
}
ote->m_oteClass = classPointer;
ote->beBytes();
}
else
{
ASSERT(classPointer->m_location->m_instanceSpec.m_nullTerminated);
MWORD objectSize;
switch (reinterpret_cast<const StringClass&>(byteClass).Encoding)
{
case StringEncoding::Ansi:
case StringEncoding::Utf8:
objectSize = elementCount * sizeof(AnsiString::CU);
break;
case StringEncoding::Utf16:
objectSize = elementCount * sizeof(Utf16String::CU);
break;
case StringEncoding::Utf32:
objectSize = elementCount * sizeof(Utf32String::CU);
break;
default:
__assume(false);
break;
}
// TODO: Allocate the correct number of null term bytes based on the encoding
objectSize += NULLTERMSIZE;
VariantByteObject* newBytes = static_cast<VariantByteObject*>(allocObject(objectSize + SizeOfPointers(0), ote));
ASSERT((objectSize > MaxSizeOfPoolObject && ote->heapSpace() == OTEFlags::NormalSpace)
|| ote->heapSpace() == OTEFlags::PoolSpace);
ASSERT(ote->getSize() == objectSize + SizeOfPointers(0));
if (Initialized)
{
// Byte objects are initialized to zeros (but not the header)
// Note that we round up to initialize to the next DWORD
// This can be useful when working on a 32-bit word machine
ZeroMemory(newBytes->m_fields, _ROUND2(objectSize, sizeof(DWORD)));
classPointer->countUp();
}
else
{
// We still want to ensure the null terminator is set, even if not initializing the rest of the object
*reinterpret_cast<NULLTERMTYPE*>(&newBytes->m_fields[objectSize - NULLTERMSIZE]) = 0;
}
ote->m_oteClass = classPointer;
ote->beNullTerminated();
HARDASSERT(ote->isBytes());
}
return reinterpret_cast<BytesOTE*>(ote);
}
/*
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;
}
// 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;
}