[Vm-dev] [commit][2866] CogVM source as per VMMaker.oscog-eem.612

commits at squeakvm.org commits at squeakvm.org
Fri Feb 7 19:21:43 UTC 2014


Revision: 2866
Author:   eliot
Date:     2014-02-07 11:21:40 -0800 (Fri, 07 Feb 2014)
Log Message:
-----------
CogVM source as per VMMaker.oscog-eem.612
Author: eem
Time: 7 February 2014, 11:07:27.365 am
UUID: 54335642-7834-48fb-936d-b567fb9857b3
Ancestors: VMMaker.oscog-eem.611

Fix the at cache for wide strings in Spur given that Spur supports
the String at:[put:] primitives on WideString.

Fix isWordsOrBytesNonImm: to answer false for forwarders.
Fix fixedFieldsOf:format:length: to fall through to an assert fail for
forwarders.

Prettify the primitiveAccessorDepthTable literal so I can see what's what.

Fix slip in StackInterpreter>>postBecomeAction:.  Must follow
receivers after every become (even if become effects flags are 0)
since e.g. a becommed string can be the receiver in a super send,
and so, because super sends don't trap, must be unforwarded.

Add some asserts to catch this error in *activateNewMethod &
slowPrimitiveResponse.

Make StackInterpreterPrimitives>>primitiveObjectPointsTo correct
for both Spur and SqueakV3.

Fix Spur's changeClassOf:to:

Following forwarders in Spur markAndTrace: requires a store check.

Fix bad bug in Spur>>firstIndexableField: that shifted by wordSize
instead of shiftForWord.  Change some uses of wordSize to bytesPerSlot.

Fix NewObjectMemory>>shorten:toIndexableSize: for large arrays (3 word header) and make it work for variable objects with fixed fields. Change return value to be number of bytes freed, to permit sender to check for success.

Fix method comment in ObjectMemory>>lengthOf:baseHeader:format:

Add primitiveAllObjects, adapted from VMMaker-dtl.339.mcz

Add primitiveTestShortenIndexableSize for testing shorten:toIndexableSize: from the image.

Make ObjectMemory>>allObjectsDo: use objectAfter: instead of
objectAfterWhileForwarding:.  Introduce allObjectsDoSafely: to use
objectAfterWhileForwarding:.  Add a compatibility method to Sour.
Use allObjectsDoSafely: where appropriate.

Refactor InterpreterPrimitives>>primitiveAllObjects to move
creation and enumeration into objectMemory.

Improve ObjectMemory>>allObjects by using fact that allocated
object is always last object in heap.

Implement SpurMemoryManager>>allObjects.
For this, implement small/largeObjectBytesForSlots:
and hence move allocateSlots:format:classIndex: et al up into
SpurMemoryManager.

Modified Paths:
--------------
    branches/Cog/nscogsrc/vm/cointerp.c
    branches/Cog/nscogsrc/vm/cointerp.h
    branches/Cog/nscogsrc/vm/gcc3x-cointerp.c
    branches/Cog/nscogsrc/vm/interp.h
    branches/Cog/nscogsrc/vm/vmCallback.h
    branches/Cog/nsspurstacksrc/vm/gcc3x-interp.c
    branches/Cog/nsspurstacksrc/vm/interp.c
    branches/Cog/nsspurstacksrc/vm/interp.h
    branches/Cog/nsspurstacksrc/vm/vmCallback.h
    branches/Cog/spursrc/vm/cointerp.c
    branches/Cog/spursrc/vm/cointerp.h
    branches/Cog/spursrc/vm/gcc3x-cointerp.c
    branches/Cog/spursrc/vm/interp.h
    branches/Cog/spursrc/vm/vmCallback.h
    branches/Cog/spurstacksrc/vm/gcc3x-interp.c
    branches/Cog/spurstacksrc/vm/interp.c
    branches/Cog/spurstacksrc/vm/interp.h
    branches/Cog/spurstacksrc/vm/vmCallback.h
    branches/Cog/src/vm/cointerp.c
    branches/Cog/src/vm/cointerp.h
    branches/Cog/src/vm/cointerpmt.c
    branches/Cog/src/vm/cointerpmt.h
    branches/Cog/src/vm/gcc3x-cointerp.c
    branches/Cog/src/vm/gcc3x-cointerpmt.c
    branches/Cog/src/vm/interp.h
    branches/Cog/src/vm/vmCallback.h
    branches/Cog/stacksrc/vm/gcc3x-interp.c
    branches/Cog/stacksrc/vm/interp.c
    branches/Cog/stacksrc/vm/interp.h
    branches/Cog/stacksrc/vm/vmCallback.h

Property Changed:
----------------
    branches/Cog/platforms/Cross/vm/sqSCCSVersion.h

Modified: branches/Cog/nscogsrc/vm/cointerp.c
===================================================================
--- branches/Cog/nscogsrc/vm/cointerp.c	2014-02-01 01:04:05 UTC (rev 2865)
+++ branches/Cog/nscogsrc/vm/cointerp.c	2014-02-07 19:21:40 UTC (rev 2866)
@@ -1,9 +1,9 @@
 /* Automatically generated by
-	CCodeGeneratorGlobalStructure VMMaker.oscog-eem.600 uuid: 48f5953c-233c-4026-96a0-ffef9cea1c72
+	CCodeGeneratorGlobalStructure VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
    from
-	CoInterpreter VMMaker.oscog-eem.600 uuid: 48f5953c-233c-4026-96a0-ffef9cea1c72
+	CoInterpreter VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
  */
-static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.600 uuid: 48f5953c-233c-4026-96a0-ffef9cea1c72 " __DATE__ ;
+static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3 " __DATE__ ;
 char *__interpBuildInfo = __buildInfo;
 
 
@@ -822,6 +822,7 @@
 static void primitiveAdd(void);
 EXPORT(void) primitiveAddLargeIntegers(void);
 static void primitiveAdoptInstance(void);
+EXPORT(sqInt) primitiveAllObjects(void);
 static void primitiveArctan(void);
 static void primitiveArrayBecome(void);
 static void primitiveArrayBecomeOneWay(void);
@@ -1144,7 +1145,7 @@
 static void rewriteMethodCacheEntryForExternalPrimitiveToFunction(void (*localPrimAddress)(void));
 static sqInt roomToPushNArgs(sqInt n);
 static void runLeakCheckerForFullGC(sqInt fullGCFlag);
-static usqInt safeObjectAfter(sqInt oop);
+static sqInt safeObjectAfter(sqInt oop);
 static sqInt safePrintStringOf(sqInt oop);
 usqInt scavengeThresholdAddress(void);
 EXPORT(sqInt) sendInvokeCallbackContext(VMCallbackContext *vmCallbackContext);
@@ -1158,6 +1159,7 @@
 void setSavedWindowSize(sqInt value);
 static void setSignalLowSpaceFlagAndSaveProcess(void);
 static void setTraceFlagOnContextsFramesPageIfNeeded(sqInt aContext);
+static sqInt shortentoIndexableSize(sqInt obj, sqInt nSlots);
 static sqInt shortPrintContext(sqInt aContext);
 static sqInt shortPrintFrameAndCallers(char *theFP);
 EXPORT(void) shortPrintFramesInPage(StackPage *thePage);
@@ -2030,7 +2032,7 @@
 	/* 574 */ (void (*)(void))0,
 	/* 575 */ (void (*)(void))0,
  0 };
-const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreter_VMMaker.oscog-eem.600";
+const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreter_VMMaker.oscog-eem.612";
 sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 10 */;
 volatile int sendTrace;
 
@@ -5299,6 +5301,7 @@
 						GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
 						primTraceLogIndex(GIV(primTraceLogIndex) + 1);
 					}
+					assert(!(isOopForwarded(stackValue(GIV(argumentCount)))));
 					nArgs = GIV(argumentCount);
 					savedStackPointer = GIV(stackPointer);
 					savedFramePointer = GIV(framePointer);
@@ -5366,6 +5369,7 @@
 					/* could new rcvr be set at point of send? */
 
 					rcvr = longAtPointer(localSP + (GIV(argumentCount) * BytesPerOop));
+					assert(!(isOopForwarded(rcvr)));
 					/* begin internalPush: */
 					longAtPointerput((localSP -= BytesPerOop), localIP);
 					/* begin internalPush: */
@@ -5667,7 +5671,6 @@
 						/* begin internalPush: */
 						longAtPointerput((localSP -= BytesPerOop), longAt((rcvr + BaseHeaderSize) + (byte3 << ShiftForWord)));
 					}
-					null;
 					goto l4;
 				}
 				if (opType == 3) {
@@ -5677,7 +5680,6 @@
 					assert(GIV(method) == (iframeMethod(localFP)));
 					object = longAt((GIV(method) + BaseHeaderSize) + ((byte3 + LiteralStart) << ShiftForWord));
 					longAtPointerput((localSP -= BytesPerOop), object);
-					null;
 					goto l4;
 				}
 				if (opType == 4) {
@@ -5691,7 +5693,6 @@
 					object2 = longAt((oop + BaseHeaderSize) + (ValueIndex << ShiftForWord));
 					longAtPointerput((localSP -= BytesPerOop), object2);
 
-					null;
 					goto l4;
 				}
 				top = longAtPointer(localSP);
@@ -8368,10 +8369,12 @@
 
 								/* Note fmt >= firstStringyFormat is an artificial flag for strings */
 								/* String */
+								/* Spur supports the String at:[put:] primitives on WideString */
 
+								result1 = byteAt((rcvr + BaseHeaderSize) + (((index >> 1)) - 1));
 								result = (CharacterTable == null
-									? characterObjectOf(byteAt((rcvr + BaseHeaderSize) + (((index >> 1)) - 1)))
-									: longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CharacterTable << ShiftForWord))) + BaseHeaderSize) + ((byteAt((rcvr + BaseHeaderSize) + (((index >> 1)) - 1))) << ShiftForWord)));
+									? characterObjectOf(result1)
+									: longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CharacterTable << ShiftForWord))) + BaseHeaderSize) + (result1 << ShiftForWord)));
 								goto l120;
 							}
 							else {
@@ -8582,7 +8585,6 @@
 								valToPut = positive32BitValueOf(value);
 								if (!GIV(primFailCode)) {
 									long32Atput((rcvr + BaseHeaderSize) + ((((index >> 1)) - 1) << 2), valToPut);
-									null;
 									goto l123;
 								}
 								GIV(primFailCode) = PrimErrBadArgument;
@@ -8617,6 +8619,7 @@
 									? (valToPut >> 1)
 									: -1);
 
+								
 							}
 							else {
 								if ((fmt >= 12)
@@ -11258,10 +11261,12 @@
 
 								/* Note fmt >= firstStringyFormat is an artificial flag for strings */
 								/* String */
+								/* Spur supports the String at:[put:] primitives on WideString */
 
+								result1 = byteAt((rcvr + BaseHeaderSize) + (((index >> 1)) - 1));
 								result = (CharacterTable == null
-									? characterObjectOf(byteAt((rcvr + BaseHeaderSize) + (((index >> 1)) - 1)))
-									: longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CharacterTable << ShiftForWord))) + BaseHeaderSize) + ((byteAt((rcvr + BaseHeaderSize) + (((index >> 1)) - 1))) << ShiftForWord)));
+									? characterObjectOf(result1)
+									: longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CharacterTable << ShiftForWord))) + BaseHeaderSize) + (result1 << ShiftForWord)));
 								goto l259;
 							}
 							else {
@@ -11472,7 +11477,6 @@
 								valToPut = positive32BitValueOf(value);
 								if (!GIV(primFailCode)) {
 									long32Atput((rcvr + BaseHeaderSize) + ((((index >> 1)) - 1) << 2), valToPut);
-									null;
 									goto l262;
 								}
 								GIV(primFailCode) = PrimErrBadArgument;
@@ -11507,6 +11511,7 @@
 									? (valToPut >> 1)
 									: -1);
 
+								
 							}
 							else {
 								if ((fmt >= 12)
@@ -13189,17 +13194,9 @@
 	numArgs = (((usqInt) methodHeader) >> 25) & 15;
 
 	/* could new rcvr be set at point of send? */
-	/* Because this is an uncogged method we need to continue via the interpreter.
-	   We could have been reached either from the interpreter, in which case we
-	   should simply return, or from a machine code frame or from a compiled
-	   primitive.  In these latter two cases we must longjmp back to the interpreter.
-	   The instructionPointer tells us which path we took.
-	   If the sender was an interpreter frame but called through a (failing) primitive
-	   then make sure we restore the saved instruction pointer and avoid pushing
-	   ceReturnToInterpreterPC which is only valid between an interpreter caller
-	   frame and a machine code callee frame. */
 
 	rcvr = longAt(GIV(stackPointer) + (numArgs * BytesPerWord));
+	assert(!(isOopForwarded(rcvr)));
 	if (!((inInterpreter = GIV(instructionPointer) >= (startOfMemory())))) {
 		if (GIV(instructionPointer) == (ceReturnToInterpreterPC())) {
 			GIV(instructionPointer) = longAt(GIV(framePointer) + FoxIFSavedIP);
@@ -14352,7 +14349,8 @@
 		}
 	}
 	/* begin postBecomeAction: */
-	;
+	followForwardingPointersInStackZone(0);
+	
 	cogitPostGCAction(GIV(gcMode));
 	GIV(lastCoggableInterpretedBlockMethod) = (GIV(lastUncoggableInterpretedBlockMethod) = null);
 	GIV(gcMode) = 0;
@@ -16287,7 +16285,7 @@
     sqInt sz1;
 
 	ok = 1;
-	/* begin allObjectsDo: */
+	/* begin allObjectsDoSafely: */
 	/* begin oopFromChunk: */
 	chunk = startOfMemory();
 	oop1 = chunk + (headerTypeBytes[(longAt(chunk)) & TypeMask]);
@@ -19837,27 +19835,19 @@
     sqInt chunk;
     sqInt chunk1;
     sqInt fmt;
-    sqInt fwdBlock;
-    sqInt fwdBlock1;
     sqInt header;
     sqInt header1;
-    sqInt header11;
-    sqInt header2;
     sqInt methodHeader;
     sqInt obj;
     sqInt oop;
     sqInt oop1;
     sqInt oop2;
-    sqInt realHeader;
-    sqInt realHeader1;
     sqInt startAddr;
     sqInt stopAddr;
     sqInt stopAddr1;
     sqInt swapFloatWords;
     sqInt sz;
     sqInt sz1;
-    sqInt sz11;
-    sqInt sz2;
     sqInt temp;
     sqInt temp1;
     sqInt wordAddr;
@@ -19920,40 +19910,21 @@
 				}
 
 			}
-			/* begin objectAfterWhileForwarding: */
-			header2 = longAt(oop1);
-			if ((header2 & MarkBit) == 0) {
-				/* begin objectAfter: */
-				if (!(asserta(oopisLessThan(oop1, GIV(freeStart))))) {
-					error("no objects after the end of memory");
-				}
-				if (((longAt(oop1)) & TypeMask) == HeaderTypeFree) {
-					sz11 = (longAt(oop1)) & AllButTypeMask;
-				}
-				else {
-					/* begin sizeBitsOf: */
-					header11 = longAt(oop1);
-					sz11 = ((header11 & TypeMask) == HeaderTypeSizeAndClass
-						? (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask
-						: header11 & SizeMask);
-				}
-				oop1 = (oop1 + sz11) + (headerTypeBytes[(longAt(oop1 + sz11)) & TypeMask]);
-				goto l3;
+			/* begin objectAfter: */
+			if (!(asserta(oopisLessThan(oop1, GIV(freeStart))))) {
+				error("no objects after the end of memory");
 			}
-			fwdBlock1 = (header2 & AllButMarkBitAndTypeMask) << 1;
-			assert(fwdBlockValid(fwdBlock1));
-
-			/* following code is like sizeBitsOf: */
-
-			realHeader1 = longAt(fwdBlock1 + BytesPerWord);
-			if ((realHeader1 & TypeMask) == HeaderTypeSizeAndClass) {
-				sz2 = (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask;
+			if (((longAt(oop1)) & TypeMask) == HeaderTypeFree) {
+				sz1 = (longAt(oop1)) & AllButTypeMask;
 			}
 			else {
-				sz2 = realHeader1 & SizeMask;
+				/* begin sizeBitsOf: */
+				header1 = longAt(oop1);
+				sz1 = ((header1 & TypeMask) == HeaderTypeSizeAndClass
+					? (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask
+					: header1 & SizeMask);
 			}
-			oop1 = (oop1 + sz2) + (headerTypeBytes[(longAt(oop1 + sz2)) & TypeMask]);
-		l3:	/* end objectAfterWhileForwarding: */;
+			oop1 = (oop1 + sz1) + (headerTypeBytes[(longAt(oop1 + sz1)) & TypeMask]);
 		}
 	}
 	else {
@@ -19976,40 +19947,21 @@
 				}
 
 			}
-			/* begin objectAfterWhileForwarding: */
-			header = longAt(oop);
-			if ((header & MarkBit) == 0) {
-				/* begin objectAfter: */
-				if (!(asserta(oopisLessThan(oop, GIV(freeStart))))) {
-					error("no objects after the end of memory");
-				}
-				if (((longAt(oop)) & TypeMask) == HeaderTypeFree) {
-					sz1 = (longAt(oop)) & AllButTypeMask;
-				}
-				else {
-					/* begin sizeBitsOf: */
-					header1 = longAt(oop);
-					sz1 = ((header1 & TypeMask) == HeaderTypeSizeAndClass
-						? (longAt(oop - (BytesPerWord * 2))) & LongSizeMask
-						: header1 & SizeMask);
-				}
-				oop = (oop + sz1) + (headerTypeBytes[(longAt(oop + sz1)) & TypeMask]);
-				goto l2;
+			/* begin objectAfter: */
+			if (!(asserta(oopisLessThan(oop, GIV(freeStart))))) {
+				error("no objects after the end of memory");
 			}
-			fwdBlock = (header & AllButMarkBitAndTypeMask) << 1;
-			assert(fwdBlockValid(fwdBlock));
-
-			/* following code is like sizeBitsOf: */
-
-			realHeader = longAt(fwdBlock + BytesPerWord);
-			if ((realHeader & TypeMask) == HeaderTypeSizeAndClass) {
-				sz = (longAt(oop - (BytesPerWord * 2))) & LongSizeMask;
+			if (((longAt(oop)) & TypeMask) == HeaderTypeFree) {
+				sz = (longAt(oop)) & AllButTypeMask;
 			}
 			else {
-				sz = realHeader & SizeMask;
+				/* begin sizeBitsOf: */
+				header = longAt(oop);
+				sz = ((header & TypeMask) == HeaderTypeSizeAndClass
+					? (longAt(oop - (BytesPerWord * 2))) & LongSizeMask
+					: header & SizeMask);
 			}
 			oop = (oop + sz) + (headerTypeBytes[(longAt(oop + sz)) & TypeMask]);
-		l2:	/* end objectAfterWhileForwarding: */;
 		}
 	l1:	/* end convertFloatsToPlatformOrder */;
 	}
@@ -23709,15 +23661,17 @@
     sqInt header1;
     sqInt header2;
     sqInt header3;
+    sqInt header4;
     usqInt lastWord;
     sqInt newFreeChunk;
     sqInt newOop;
-    usqInt next;
+    sqInt next;
     sqInt oop;
     sqInt realHeader;
     sqInt sz;
     sqInt sz1;
     sqInt sz2;
+    sqInt sz3;
     sqInt target;
     usqInt w;
 
@@ -23728,7 +23682,21 @@
 		/* begin objectAfterWhileForwarding: */
 		header2 = longAt(oop);
 		if ((header2 & MarkBit) == 0) {
-			next = ((sqInt) (objectAfter(oop)));
+			/* begin objectAfter: */
+			if (!(asserta(oopisLessThan(oop, GIV(freeStart))))) {
+				error("no objects after the end of memory");
+			}
+			if (((longAt(oop)) & TypeMask) == HeaderTypeFree) {
+				sz2 = (longAt(oop)) & AllButTypeMask;
+			}
+			else {
+				/* begin sizeBitsOf: */
+				header3 = longAt(oop);
+				sz2 = ((header3 & TypeMask) == HeaderTypeSizeAndClass
+					? (longAt(oop - (BytesPerWord * 2))) & LongSizeMask
+					: header3 & SizeMask);
+			}
+			next = (oop + sz2) + (headerTypeBytes[(longAt(oop + sz2)) & TypeMask]);
 			goto l1;
 		}
 		fwdBlock1 = (header2 & AllButMarkBitAndTypeMask) << 1;
@@ -23743,7 +23711,7 @@
 		else {
 			sz1 = realHeader & SizeMask;
 		}
-		next = ((sqInt) ((oop + sz1) + (headerTypeBytes[(longAt(oop + sz1)) & TypeMask])));
+		next = (oop + sz1) + (headerTypeBytes[(longAt(oop + sz1)) & TypeMask]);
 	l1:	/* end objectAfterWhileForwarding: */;
 		if (!(((longAt(oop)) & TypeMask) == HeaderTypeFree)) {
 
@@ -23797,18 +23765,18 @@
 	}
 	/* begin safeObjectAfter: */
 	if (((longAt(newFreeChunk)) & TypeMask) == HeaderTypeFree) {
-		sz2 = (longAt(newFreeChunk)) & AllButTypeMask;
+		sz3 = (longAt(newFreeChunk)) & AllButTypeMask;
 	}
 	else {
 		/* begin sizeBitsOf: */
-		header3 = longAt(newFreeChunk);
-		sz2 = ((header3 & TypeMask) == HeaderTypeSizeAndClass
+		header4 = longAt(newFreeChunk);
+		sz3 = ((header4 & TypeMask) == HeaderTypeSizeAndClass
 			? (longAt(newFreeChunk - (BytesPerWord * 2))) & LongSizeMask
-			: header3 & SizeMask);
+			: header4 & SizeMask);
 	}
-	next = ((newFreeChunk + sz2) >= GIV(freeStart)
+	next = ((newFreeChunk + sz3) >= GIV(freeStart)
 		? GIV(freeStart)
-		: (newFreeChunk + sz2) + (headerTypeBytes[(longAt(newFreeChunk + sz2)) & TypeMask]));
+		: (newFreeChunk + sz3) + (headerTypeBytes[(longAt(newFreeChunk + sz3)) & TypeMask]));
 	assert((next == GIV(freeStart))
 	 || (next == (oopFromChunk(GIV(compEnd)))));
 	if (next == GIV(freeStart)) {
@@ -24621,6 +24589,7 @@
 				GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
 				primTraceLogIndex(GIV(primTraceLogIndex) + 1);
 			}
+			assert(!(isOopForwarded(stackValue(GIV(argumentCount)))));
 			nArgs = GIV(argumentCount);
 			savedStackPointer = GIV(stackPointer);
 			savedFramePointer = GIV(framePointer);
@@ -25546,10 +25515,12 @@
 }
 
 
-/*	Return the number of indexable bytes or words in the given object. Assume
-	the given oop is not an integer. For a CompiledMethod, the size of the
-	method header (in bytes) should be subtracted from the result of this
-	method. 
+/*	Return the number of fixed and indexable bytes, words, or object pointers
+	in the
+	given object. Assume the given oop is not an integer. For a
+	CompiledMethod, the size
+	of the method header (in bytes) should be subtracted from the result of
+	this method.
  */
 
 static sqInt
@@ -30397,6 +30368,99 @@
 	return;
 }
 
+
+/*	Answer an array of all objects that exist when the primitive
+	is called, excluding those that may be garbage collected as
+	a side effect of allocating the result array. */
+
+EXPORT(sqInt)
+primitiveAllObjects(void)
+{   DECL_MAYBE_SQ_GLOBAL_STRUCT
+    sqInt chunk;
+    sqInt chunk1;
+    sqInt count;
+    sqInt header;
+    sqInt header1;
+    sqInt ign;
+    sqInt newCount;
+    sqInt obj;
+    sqInt oop;
+    sqInt result;
+    sqInt resultArray;
+    char *sp;
+    sqInt sz;
+    sqInt sz1;
+
+	/* begin allObjects */
+	count = 0;
+	/* begin allObjectsDo: */
+	/* begin oopFromChunk: */
+	chunk = startOfMemory();
+	oop = chunk + (headerTypeBytes[(longAt(chunk)) & TypeMask]);
+	while (oop < GIV(freeStart)) {
+		if (!(((longAt(oop)) & TypeMask) == HeaderTypeFree)) {
+			count += 1;
+
+		}
+		/* begin objectAfter: */
+		if (!(asserta(oopisLessThan(oop, GIV(freeStart))))) {
+			error("no objects after the end of memory");
+		}
+		if (((longAt(oop)) & TypeMask) == HeaderTypeFree) {
+			sz1 = (longAt(oop)) & AllButTypeMask;
+		}
+		else {
+			/* begin sizeBitsOf: */
+			header1 = longAt(oop);
+			sz1 = ((header1 & TypeMask) == HeaderTypeSizeAndClass
+				? (longAt(oop - (BytesPerWord * 2))) & LongSizeMask
+				: header1 & SizeMask);
+		}
+		oop = (oop + sz1) + (headerTypeBytes[(longAt(oop + sz1)) & TypeMask]);
+	}
+	resultArray = instantiateClassindexableSize(longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassArray << ShiftForWord)), count);
+	if (resultArray == null) {
+		result = 0;
+		goto l1;
+	}
+	newCount = 0;
+	/* begin oopFromChunk: */
+	chunk1 = startOfMemory();
+	obj = chunk1 + (headerTypeBytes[(longAt(chunk1)) & TypeMask]);
+	while (obj < resultArray) {
+		if (!(((longAt(obj)) & TypeMask) == HeaderTypeFree)) {
+			newCount += 1;
+			longAtput((resultArray + BaseHeaderSize) + (newCount << ShiftForWord), obj);
+		}
+		/* begin objectAfter: */
+		if (!(asserta(oopisLessThan(obj, GIV(freeStart))))) {
+			error("no objects after the end of memory");
+		}
+		if (((longAt(obj)) & TypeMask) == HeaderTypeFree) {
+			sz = (longAt(obj)) & AllButTypeMask;
+		}
+		else {
+			/* begin sizeBitsOf: */
+			header = longAt(obj);
+			sz = ((header & TypeMask) == HeaderTypeSizeAndClass
+				? (longAt(obj - (BytesPerWord * 2))) & LongSizeMask
+				: header & SizeMask);
+		}
+		obj = (obj + sz) + (headerTypeBytes[(longAt(obj + sz)) & TypeMask]);
+	}
+	if (newCount < count) {
+		shortentoIndexableSize(resultArray, newCount);
+	}
+	result = resultArray;
+l1:	/* end allObjects */;
+	if (result == 0) {
+		return (GIV(primFailCode) = PrimErrNoMemory);
+	}
+	/* begin pop:thenPush: */
+	longAtput((sp = GIV(stackPointer) + (((GIV(argumentCount) + 1) - 1) * BytesPerWord)), result);
+	GIV(stackPointer) = sp;
+}
+
 static void
 primitiveArctan(void)
 {   DECL_MAYBE_SQ_GLOBAL_STRUCT
@@ -34596,6 +34660,7 @@
 		GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
 		primTraceLogIndex(GIV(primTraceLogIndex) + 1);
 	}
+	assert(!(isOopForwarded(stackValue(GIV(argumentCount)))));
 	nArgs = GIV(argumentCount);
 	savedStackPointer = GIV(stackPointer);
 	savedFramePointer = GIV(framePointer);
@@ -36720,9 +36785,7 @@
 {   DECL_MAYBE_SQ_GLOBAL_STRUCT
     sqInt chunk;
     sqInt firstBytecode;
-    sqInt fwdBlock;
     sqInt header;
-    sqInt header1;
     sqInt i;
     sqInt i1;
     sqInt i2;
@@ -36733,9 +36796,7 @@
     sqInt oop1;
     sqInt primBits;
     sqInt primIdx;
-    sqInt realHeader;
     sqInt sz;
-    sqInt sz1;
 
 	/* begin flushExternalPrimitives */
 	/* begin allObjectsDo: */
@@ -36773,40 +36834,21 @@
 			}
 
 		}
-		/* begin objectAfterWhileForwarding: */
-		header = longAt(oop1);
-		if ((header & MarkBit) == 0) {
-			/* begin objectAfter: */
-			if (!(asserta(oopisLessThan(oop1, GIV(freeStart))))) {
-				error("no objects after the end of memory");
-			}
-			if (((longAt(oop1)) & TypeMask) == HeaderTypeFree) {
-				sz1 = (longAt(oop1)) & AllButTypeMask;
-			}
-			else {
-				/* begin sizeBitsOf: */
-				header1 = longAt(oop1);
-				sz1 = ((header1 & TypeMask) == HeaderTypeSizeAndClass
-					? (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask
-					: header1 & SizeMask);
-			}
-			oop1 = (oop1 + sz1) + (headerTypeBytes[(longAt(oop1 + sz1)) & TypeMask]);
-			goto l1;
+		/* begin objectAfter: */
+		if (!(asserta(oopisLessThan(oop1, GIV(freeStart))))) {
+			error("no objects after the end of memory");
 		}
-		fwdBlock = (header & AllButMarkBitAndTypeMask) << 1;
-		assert(fwdBlockValid(fwdBlock));
-
-		/* following code is like sizeBitsOf: */
-
-		realHeader = longAt(fwdBlock + BytesPerWord);
-		if ((realHeader & TypeMask) == HeaderTypeSizeAndClass) {
-			sz = (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask;
+		if (((longAt(oop1)) & TypeMask) == HeaderTypeFree) {
+			sz = (longAt(oop1)) & AllButTypeMask;
 		}
 		else {
-			sz = realHeader & SizeMask;
+			/* begin sizeBitsOf: */
+			header = longAt(oop1);
+			sz = ((header & TypeMask) == HeaderTypeSizeAndClass
+				? (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask
+				: header & SizeMask);
 		}
 		oop1 = (oop1 + sz) + (headerTypeBytes[(longAt(oop1 + sz)) & TypeMask]);
-	l1:	/* end objectAfterWhileForwarding: */;
 	}
 	/* begin flushMethodCache */
 	for (i = 1; i <= MethodCacheSize; i += 1) {
@@ -40206,10 +40248,11 @@
 {   DECL_MAYBE_SQ_GLOBAL_STRUCT
     sqInt fmt;
     sqInt header;
+    sqInt header1;
     sqInt i;
-    sqInt lastField;
     sqInt methodHeader;
     sqInt methodHeader1;
+    sqInt numSlots;
     sqInt rcvr;
     char *sp;
     char *sp1;
@@ -40217,6 +40260,7 @@
     char *sp3;
     char *sp4;
     char *sp5;
+    sqInt sz;
     sqInt thang;
     sqInt trueOrFalse;
 
@@ -40257,10 +40301,15 @@
 					return;
 				}
 			}
-			lastField = (CtxtTempFrameStart + (fetchStackPointerOf(rcvr))) * BytesPerOop;
+			numSlots = CtxtTempFrameStart + (fetchStackPointerOf(rcvr));
 		}
 		else {
-			lastField = (sizeBitsOfSafe(rcvr)) - (BaseHeaderSize);
+			/* begin numSlotsOf: */
+			header1 = longAt(rcvr);
+			sz = ((header1 & TypeMask) == HeaderTypeSizeAndClass
+				? (longAt(rcvr - (BytesPerWord * 2))) & AllButTypeMask
+				: header1 & SizeMask);
+			numSlots = ((usqInt) (sz - BaseHeaderSize)) >> ShiftForWord;
 		}
 	}
 	else {
@@ -40285,11 +40334,12 @@
 			GIV(stackPointer) = sp3;
 			return;
 		}
-		lastField = ((((((sqInt) methodHeader)) < 0
+		numSlots = (((((sqInt) methodHeader)) < 0
 		? (((usqInt) methodHeader) >> 1) & 0xFFFF
-		: (((usqInt) methodHeader) >> 10) & 0xFF)) + 1) * BytesPerOop;
+		: (((usqInt) methodHeader) >> 10) & 0xFF)) + 1;
 	}
-	for (i = (BaseHeaderSize); i <= lastField; i += BytesPerOop) {
+	assert((((numSlots - 1) * BytesPerOop) + (BaseHeaderSize)) == (lastPointerOf(rcvr)));
+	for (i = (BaseHeaderSize); i <= (((numSlots - 1) * BytesPerOop) + (BaseHeaderSize)); i += BytesPerOop) {
 		if ((longAt(rcvr + i)) == thang) {
 			/* begin pop:thenPushBool: */
 			longAtput((sp4 = GIV(stackPointer) + ((2 - 1) * BytesPerWord)), GIV(trueObj));
@@ -44525,9 +44575,7 @@
 {   DECL_MAYBE_SQ_GLOBAL_STRUCT
     sqInt chunk;
     sqInt firstBytecode;
-    sqInt fwdBlock;
     sqInt header;
-    sqInt header1;
     sqInt i;
     sqInt i1;
     sqInt i2;
@@ -44539,9 +44587,7 @@
     sqInt oop1;
     sqInt primBits;
     sqInt primIdx;
-    sqInt realHeader;
     sqInt sz;
-    sqInt sz1;
 
 	if (!(GIV(argumentCount) == 1)) {
 		/* begin primitiveFail */
@@ -44609,40 +44655,21 @@
 			}
 
 		}
-		/* begin objectAfterWhileForwarding: */
-		header = longAt(oop1);
-		if ((header & MarkBit) == 0) {
-			/* begin objectAfter: */
-			if (!(asserta(oopisLessThan(oop1, GIV(freeStart))))) {
-				error("no objects after the end of memory");
-			}
-			if (((longAt(oop1)) & TypeMask) == HeaderTypeFree) {
-				sz1 = (longAt(oop1)) & AllButTypeMask;
-			}
-			else {
-				/* begin sizeBitsOf: */
-				header1 = longAt(oop1);
-				sz1 = ((header1 & TypeMask) == HeaderTypeSizeAndClass
-					? (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask
-					: header1 & SizeMask);
-			}
-			oop1 = (oop1 + sz1) + (headerTypeBytes[(longAt(oop1 + sz1)) & TypeMask]);
-			goto l1;
+		/* begin objectAfter: */
+		if (!(asserta(oopisLessThan(oop1, GIV(freeStart))))) {
+			error("no objects after the end of memory");
 		}
-		fwdBlock = (header & AllButMarkBitAndTypeMask) << 1;
-		assert(fwdBlockValid(fwdBlock));
-
-		/* following code is like sizeBitsOf: */
-
-		realHeader = longAt(fwdBlock + BytesPerWord);
-		if ((realHeader & TypeMask) == HeaderTypeSizeAndClass) {
-			sz = (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask;
+		if (((longAt(oop1)) & TypeMask) == HeaderTypeFree) {
+			sz = (longAt(oop1)) & AllButTypeMask;
 		}
 		else {
-			sz = realHeader & SizeMask;
+			/* begin sizeBitsOf: */
+			header = longAt(oop1);
+			sz = ((header & TypeMask) == HeaderTypeSizeAndClass
+				? (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask
+				: header & SizeMask);
 		}
 		oop1 = (oop1 + sz) + (headerTypeBytes[(longAt(oop1 + sz)) & TypeMask]);
-	l1:	/* end objectAfterWhileForwarding: */;
 	}
 	/* begin flushMethodCache */
 	for (i = 1; i <= MethodCacheSize; i += 1) {
@@ -45471,9 +45498,7 @@
     sqInt divorcedSome;
     sqInt divorcedSome1;
     sqInt firstBytecode;
-    sqInt fwdBlock;
     sqInt header;
-    sqInt header1;
     sqInt i;
     sqInt i1;
     sqInt i2;
@@ -45489,10 +45514,8 @@
     sqInt primBits;
     sqInt primIdx;
     sqInt probe;
-    sqInt realHeader;
     char *sp;
     sqInt sz;
-    sqInt sz1;
     char *theFrame;
     StackPage *thePage;
     sqInt top;
@@ -45615,40 +45638,21 @@
 				}
 
 			}
-			/* begin objectAfterWhileForwarding: */
-			header = longAt(oop1);
-			if ((header & MarkBit) == 0) {
-				/* begin objectAfter: */
-				if (!(asserta(oopisLessThan(oop1, GIV(freeStart))))) {
-					error("no objects after the end of memory");
-				}
-				if (((longAt(oop1)) & TypeMask) == HeaderTypeFree) {
-					sz1 = (longAt(oop1)) & AllButTypeMask;
-				}
-				else {
-					/* begin sizeBitsOf: */
-					header1 = longAt(oop1);
-					sz1 = ((header1 & TypeMask) == HeaderTypeSizeAndClass
-						? (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask
-						: header1 & SizeMask);
-				}
-				oop1 = (oop1 + sz1) + (headerTypeBytes[(longAt(oop1 + sz1)) & TypeMask]);
-				goto l2;
+			/* begin objectAfter: */
+			if (!(asserta(oopisLessThan(oop1, GIV(freeStart))))) {
+				error("no objects after the end of memory");
 			}
-			fwdBlock = (header & AllButMarkBitAndTypeMask) << 1;
-			assert(fwdBlockValid(fwdBlock));
-
-			/* following code is like sizeBitsOf: */
-
-			realHeader = longAt(fwdBlock + BytesPerWord);
-			if ((realHeader & TypeMask) == HeaderTypeSizeAndClass) {
-				sz = (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask;
+			if (((longAt(oop1)) & TypeMask) == HeaderTypeFree) {
+				sz = (longAt(oop1)) & AllButTypeMask;
 			}
 			else {
-				sz = realHeader & SizeMask;
+				/* begin sizeBitsOf: */
+				header = longAt(oop1);
+				sz = ((header & TypeMask) == HeaderTypeSizeAndClass
+					? (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask
+					: header & SizeMask);
 			}
 			oop1 = (oop1 + sz) + (headerTypeBytes[(longAt(oop1 + sz)) & TypeMask]);
-		l2:	/* end objectAfterWhileForwarding: */;
 		}
 		unlinkSendsToandFreeIf(methodObj, 1);
 		if ((((longAt((activeContext + BaseHeaderSize) + (SenderIndex << ShiftForWord))) & 1))
@@ -46053,7 +46057,7 @@
 	print("suspended processes");
 	semaphoreClass = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassSemaphore << ShiftForWord));
 	mutexClass = longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (ClassMutex << ShiftForWord));
-	/* begin allObjectsDo: */
+	/* begin allObjectsDoSafely: */
 	/* begin oopFromChunk: */
 	chunk = startOfMemory();
 	oop = chunk + (headerTypeBytes[(longAt(chunk)) & TypeMask]);
@@ -47122,9 +47126,7 @@
     sqInt ccIndex1;
     sqInt chunk;
     sqInt classOop;
-    sqInt fwdBlock;
     sqInt header;
-    sqInt header1;
     sqInt i;
     sqInt methodClassAssociation;
     char *name;
@@ -47135,9 +47137,7 @@
     sqInt oop;
     sqInt oop1;
     sqInt penultimateLiteral;
-    sqInt realHeader;
     sqInt sz;
-    sqInt sz1;
 
 	/* begin allObjectsDo: */
 	/* begin oopFromChunk: */
@@ -47183,7 +47183,7 @@
 						/* begin printChar: */
 						putchar(')');
 
-						goto l3;
+						goto l2;
 					}
 					if (!(((oop1 & 3) == 0)
 						 && (((((usqInt)oop1)) >= (startOfMemory()))
@@ -47192,13 +47192,13 @@
 						print(((oop1 & (BytesPerWord - 1)) != 0
 							? " is misaligned"
 							: " is not on the heap"));
-						goto l3;
+						goto l2;
 					}
 					
 					if (((oop1 & 1) == 0)
 					 && (ClassFloatCompactIndex == ((((usqInt) (longAt(oop1))) >> 12) & 0x1F))) {
 						printFloat(dbgFloatValueOf(oop1));
-						goto l3;
+						goto l2;
 					}
 					classOop = (((ccIndex = (((usqInt) (longAt(oop1))) >> 12) & 0x1F)) == 0
 						? (longAt(oop1 - BaseHeaderSize)) & AllButTypeMask
@@ -47208,28 +47208,28 @@
 						 && (((((usqInt)classOop)) < GIV(freeStart))
 						 && (((longAt(classOop)) & TypeMask) != HeaderTypeGC))))) {
 						print("a ??");
-						goto l3;
+						goto l2;
 					}
 					if ((numSlotsOf(classOop)) == GIV(metaclassNumSlots)) {
 						printNameOfClasscount(oop1, 5);
-						goto l3;
+						goto l2;
 					}
 					if (oop1 == GIV(nilObj)) {
 						print("nil");
-						goto l3;
+						goto l2;
 					}
 					if (oop1 == GIV(trueObj)) {
 						print("true");
-						goto l3;
+						goto l2;
 					}
 					if (oop1 == GIV(falseObj)) {
 						print("false");
-						goto l3;
+						goto l2;
 					}
 					nameLen = lengthOfNameOfClass(classOop);
 					if (nameLen == 0) {
 						print("a ??");
-						goto l3;
+						goto l2;
 					}
 					name = nameOfClass(classOop);
 					if (nameLen == 10) {
@@ -47243,7 +47243,7 @@
 							/* begin printChar: */
 							putchar('\'');
 
-							goto l3;
+							goto l2;
 						}
 						if (!(strncmp(name, "ByteSymbol", 10))) {
 
@@ -47252,7 +47252,7 @@
 							/* begin printChar: */
 							putchar('#');
 							printStringOf(oop1);
-							goto l3;
+							goto l2;
 						}
 					}
 					if ((nameLen == 9)
@@ -47262,7 +47262,7 @@
 						/* begin printChar: */
 						putchar(((longAt((oop1 + BaseHeaderSize) + (0 << ShiftForWord))) >> 1));
 
-						goto l3;
+						goto l2;
 					}
 					print("a(n) ");
 					for (i = 0; i < nameLen; i += 1) {
@@ -47282,47 +47282,28 @@
 						print(" -> ");
 						printHex(longAt((oop1 + BaseHeaderSize) + (ValueIndex << ShiftForWord)));
 					}
-				l3:	/* end printOopShortInner: */;
+				l2:	/* end printOopShortInner: */;
 					/* begin cr */
 					printf("\n");
 				}
 			}
 
 		}
-		/* begin objectAfterWhileForwarding: */
-		header = longAt(oop);
-		if ((header & MarkBit) == 0) {
-			/* begin objectAfter: */
-			if (!(asserta(oopisLessThan(oop, GIV(freeStart))))) {
-				error("no objects after the end of memory");
-			}
-			if (((longAt(oop)) & TypeMask) == HeaderTypeFree) {
-				sz1 = (longAt(oop)) & AllButTypeMask;
-			}
-			else {
-				/* begin sizeBitsOf: */
-				header1 = longAt(oop);
-				sz1 = ((header1 & TypeMask) == HeaderTypeSizeAndClass
-					? (longAt(oop - (BytesPerWord * 2))) & LongSizeMask
-					: header1 & SizeMask);
-			}
-			oop = (oop + sz1) + (headerTypeBytes[(longAt(oop + sz1)) & TypeMask]);
-			goto l1;
+		/* begin objectAfter: */
+		if (!(asserta(oopisLessThan(oop, GIV(freeStart))))) {
+			error("no objects after the end of memory");
 		}
-		fwdBlock = (header & AllButMarkBitAndTypeMask) << 1;
-		assert(fwdBlockValid(fwdBlock));
-
-		/* following code is like sizeBitsOf: */
-
-		realHeader = longAt(fwdBlock + BytesPerWord);
-		if ((realHeader & TypeMask) == HeaderTypeSizeAndClass) {
-			sz = (longAt(oop - (BytesPerWord * 2))) & LongSizeMask;
+		if (((longAt(oop)) & TypeMask) == HeaderTypeFree) {
+			sz = (longAt(oop)) & AllButTypeMask;
 		}
 		else {
-			sz = realHeader & SizeMask;
+			/* begin sizeBitsOf: */
+			header = longAt(oop);
+			sz = ((header & TypeMask) == HeaderTypeSizeAndClass
+				? (longAt(oop - (BytesPerWord * 2))) & LongSizeMask
+				: header & SizeMask);
 		}
 		oop = (oop + sz) + (headerTypeBytes[(longAt(oop + sz)) & TypeMask]);
-	l1:	/* end objectAfterWhileForwarding: */;
 	}
 }
 
@@ -47333,9 +47314,9 @@
     sqInt selectorMethodOrProcess;
     sqInt source;
     char * traceSources[] = {
-		"?", "m", "i", "callbackEnter", "callbackLeave", "enterCritical",
-		"exitCritical", "resume", "signal", "suspend", "wait", "yield", "eventcheck",
-		"threadsched", "ownVM", "bindToThread", "switchIfNecessary"
+		"?", "m", "i", "callbackEnter", "callbackLeave", "enterCritical", "exitCritical",
+		"resume", "signal", "suspend", "wait", "yield", "eventcheck", "threadsched",
+		"ownVM", "bindToThread", "switchIfNecessary"
 	};
 
 	intOrClass = GIV(traceLog)[i];
@@ -50195,7 +50176,7 @@
 	given object or free chunk in memory. Return freeStart when
 	enumeration is complete. This is for assertion checking only. */
 
-static usqInt
+static sqInt
 safeObjectAfter(sqInt oop)
 {   DECL_MAYBE_SQ_GLOBAL_STRUCT
     sqInt header;
@@ -50437,6 +50418,7 @@
 	/* could new rcvr be set at point of send? */
 
 	rcvr = longAt(GIV(stackPointer) + (numArgs * BytesPerWord));
+	assert(!(isOopForwarded(rcvr)));
 	if (activateCogMethod
 	 && (GIV(instructionPointer) >= (startOfMemory()))) {
 		/* begin iframeSavedIP:put: */
@@ -50671,6 +50653,7 @@
 	/* could new rcvr be set at point of send? */
 
 	rcvr = longAt(GIV(stackPointer) + (numArgs * BytesPerWord));
+	assert(!(isOopForwarded(rcvr)));
 	if (activateCogMethod
 	 && (GIV(instructionPointer) >= (startOfMemory()))) {
 		/* begin iframeSavedIP:put: */
@@ -50900,7 +50883,111 @@
 	}
 }
 
+
+/*	Reduce the number if indexable fields in obj, a pointer object, to nSlots.
+	Convert the
+	unused residual to a free chunk. Word and byte indexable objects are not
+	changed. Answer the number of bytes returned to free memory, which may be
+	zero if no change
+	was possible.
+ */
+
 static sqInt
+shortentoIndexableSize(sqInt obj, sqInt nSlots)
+{   DECL_MAYBE_SQ_GLOBAL_STRUCT
+    sqInt ccIndex;
+    sqInt class;
+    sqInt classFormat;
+    sqInt deltaBytes;
+    sqInt desiredLength;
+    sqInt fixedFields;
+    sqInt fmt;
+    sqInt hdr;
+    usqInt i;
+    sqInt indexableFields;
+    sqInt sz;
+    sqInt totalLength;
+
+	if (!(((((usqInt) (longAt(obj))) >> (instFormatFieldLSB())) & 15) <= 4)) {
+		return 0;
+	}
+	if (!(nSlots > 0)) {
+		return 0;
+	}
+	hdr = longAt(obj);
+	fmt = (((usqInt) hdr) >> (instFormatFieldLSB())) & 15;
+	/* begin lengthOf:baseHeader:format: */
+	if ((hdr & TypeMask) == HeaderTypeSizeAndClass) {
+		sz = (longAt(obj - (BytesPerWord * 2))) & LongSizeMask;
+	}
+	else {
+		sz = hdr & SizeMask;
+	}
+	sz -= hdr & Size4Bit;
+	if (fmt <= 4) {
+		totalLength = ((usqInt) (sz - BaseHeaderSize)) >> ShiftForWord;
+		goto l1;
+	}
+	totalLength = (fmt < 8
+		? ((usqInt) (sz - BaseHeaderSize)) >> 2
+		: (sz - BaseHeaderSize) - (fmt & 3));
+l1:	/* end lengthOf:baseHeader:format: */;
+	/* begin fixedFieldsOf:format:length: */
+	if ((fmt > 4)
+	 || (fmt == 2)) {
+		fixedFields = 0;
+		goto l2;
+	}
+	if (fmt < 2) {
+		fixedFields = totalLength;
+		goto l2;
+	}
+	class = (((ccIndex = (((usqInt) (longAt(obj))) >> 12) & 0x1F)) == 0
+		? (longAt(obj - BaseHeaderSize)) & AllButTypeMask
+		: longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CompactClasses << ShiftForWord))) + BaseHeaderSize) + ((ccIndex - 1) << ShiftForWord)));
+	classFormat = (longAt((class + BaseHeaderSize) + (InstanceSpecificationIndex << ShiftForWord))) - 1;
+	fixedFields = (((((usqInt) classFormat) >> 11) & 192) + ((((usqInt) classFormat) >> 2) & 0x3F)) - 1;
+l2:	/* end fixedFieldsOf:format:length: */;
+	indexableFields = totalLength - fixedFields;
+	if (nSlots >= indexableFields) {
+		return 0;
+	}
+	desiredLength = fixedFields + nSlots;
+	deltaBytes = (totalLength - desiredLength) * BytesPerWord;
+	if (((obj + BaseHeaderSize) + (totalLength * BytesPerWord)) == GIV(freeStart)) {
+
+		/* Shortening the last object.  Need to reduce freeStart. */
+
+		/* begin maybeFillWithAllocationCheckFillerFrom:to: */
+		for (i = ((obj + BaseHeaderSize) + (desiredLength * BytesPerWord)); i <= GIV(freeStart); i += BytesPerWord) {
+			longAtput(i, i);
+		}
+
+		GIV(freeStart) = (obj + BaseHeaderSize) + (desiredLength * BytesPerWord);
+	}
+	else {
+
+		/* Shortening some interior object.  Need to create a free block. */
+
+		/* begin setSizeOfFree:to: */
+		longAtput((obj + BaseHeaderSize) + (desiredLength * BytesPerWord), (deltaBytes & AllButTypeMask) | HeaderTypeFree);
+	}
+	
+	switch ((longAt(obj)) & TypeMask) {
+	case HeaderTypeSizeAndClass:
+		longAtput(obj - (BaseHeaderSize * 2), (longAt(obj - (BytesPerWord * 2))) - deltaBytes);
+		break;
+	case HeaderTypeClass:
+	case HeaderTypeShort:
+		longAtput(obj, (((hdr | SizeMask) - SizeMask)) | ((hdr & SizeMask) - deltaBytes));
+		break;
+	default:
+		error("Case not found and no otherwise clause");
+	}
+	return deltaBytes;
+}
+
+static sqInt
 shortPrintContext(sqInt aContext)
 {   DECL_MAYBE_SQ_GLOBAL_STRUCT
     sqInt home;
@@ -51734,6 +51821,7 @@
 		GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
 		primTraceLogIndex(GIV(primTraceLogIndex) + 1);
 	}
+	assert(!(isOopForwarded(stackValue(GIV(argumentCount)))));
 	nArgs = GIV(argumentCount);
 	savedStackPointer = GIV(stackPointer);
 	savedFramePointer = GIV(framePointer);
@@ -51873,6 +51961,7 @@
 		/* could new rcvr be set at point of send? */
 
 		rcvr1 = longAt(GIV(stackPointer) + (numArgs * BytesPerWord));
+		assert(!(isOopForwarded(rcvr1)));
 		if (activateCogMethod
 		 && (GIV(instructionPointer) >= (startOfMemory()))) {
 			/* begin iframeSavedIP:put: */
@@ -54572,17 +54661,13 @@
     sqInt activeContext1;
     sqInt chunk;
     sqInt fmt;
-    sqInt fwdBlock;
     sqInt header;
-    sqInt header1;
     sqInt i;
     sqInt iLimiT;
     sqInt obj;
     sqInt oop;
     sqInt pc;
-    sqInt realHeader;
     sqInt sz;
-    sqInt sz1;
 
 
 	/* in case of code compactions. */
@@ -54633,40 +54718,21 @@
 			}
 
 		}
-		/* begin objectAfterWhileForwarding: */
-		header = longAt(oop);
-		if ((header & MarkBit) == 0) {
-			/* begin objectAfter: */
-			if (!(asserta(oopisLessThan(oop, GIV(freeStart))))) {
-				error("no objects after the end of memory");
-			}
-			if (((longAt(oop)) & TypeMask) == HeaderTypeFree) {
-				sz1 = (longAt(oop)) & AllButTypeMask;
-			}
-			else {
-				/* begin sizeBitsOf: */
-				header1 = longAt(oop);
-				sz1 = ((header1 & TypeMask) == HeaderTypeSizeAndClass
-					? (longAt(oop - (BytesPerWord * 2))) & LongSizeMask
-					: header1 & SizeMask);
-			}
-			oop = (oop + sz1) + (headerTypeBytes[(longAt(oop + sz1)) & TypeMask]);
-			goto l1;
+		/* begin objectAfter: */
+		if (!(asserta(oopisLessThan(oop, GIV(freeStart))))) {
+			error("no objects after the end of memory");
 		}
-		fwdBlock = (header & AllButMarkBitAndTypeMask) << 1;
-		assert(fwdBlockValid(fwdBlock));
-
-		/* following code is like sizeBitsOf: */
-
-		realHeader = longAt(fwdBlock + BytesPerWord);
-		if ((realHeader & TypeMask) == HeaderTypeSizeAndClass) {
-			sz = (longAt(oop - (BytesPerWord * 2))) & LongSizeMask;
+		if (((longAt(oop)) & TypeMask) == HeaderTypeFree) {
+			sz = (longAt(oop)) & AllButTypeMask;
 		}
 		else {
-			sz = realHeader & SizeMask;
+			/* begin sizeBitsOf: */
+			header = longAt(oop);
+			sz = ((header & TypeMask) == HeaderTypeSizeAndClass
+				? (longAt(oop - (BytesPerWord * 2))) & LongSizeMask
+				: header & SizeMask);
 		}
 		oop = (oop + sz) + (headerTypeBytes[(longAt(oop + sz)) & TypeMask]);
-	l1:	/* end objectAfterWhileForwarding: */;
 	}
 	activeContext = activeContext1;
 	voidCogCompiledCode();
@@ -54992,6 +55058,7 @@
 	{"", "dumpImage", (void*)dumpImage},
 	{"", "moduleUnloaded", (void*)moduleUnloaded},
 	{"", "primitiveAddLargeIntegers", (void*)primitiveAddLargeIntegers},
+	{"", "primitiveAllObjects", (void*)primitiveAllObjects},
 	{"", "primitiveBitAndLargeIntegers", (void*)primitiveBitAndLargeIntegers},
 	{"", "primitiveBitOrLargeIntegers", (void*)primitiveBitOrLargeIntegers},
 	{"", "primitiveBitShiftLargeIntegers", (void*)primitiveBitShiftLargeIntegers},

Modified: branches/Cog/nscogsrc/vm/cointerp.h
===================================================================
--- branches/Cog/nscogsrc/vm/cointerp.h	2014-02-01 01:04:05 UTC (rev 2865)
+++ branches/Cog/nscogsrc/vm/cointerp.h	2014-02-07 19:21:40 UTC (rev 2866)
@@ -1,5 +1,5 @@
 /* Automatically generated by
-	CCodeGeneratorGlobalStructure VMMaker.oscog-eem.600 uuid: 48f5953c-233c-4026-96a0-ffef9cea1c72
+	CCodeGeneratorGlobalStructure VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
  */
 
 

Modified: branches/Cog/nscogsrc/vm/gcc3x-cointerp.c
===================================================================
--- branches/Cog/nscogsrc/vm/gcc3x-cointerp.c	2014-02-01 01:04:05 UTC (rev 2865)
+++ branches/Cog/nscogsrc/vm/gcc3x-cointerp.c	2014-02-07 19:21:40 UTC (rev 2866)
@@ -2,11 +2,11 @@
 
 
 /* Automatically generated by
-	CCodeGeneratorGlobalStructure VMMaker.oscog-eem.600 uuid: 48f5953c-233c-4026-96a0-ffef9cea1c72
+	CCodeGeneratorGlobalStructure VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
    from
-	CoInterpreter VMMaker.oscog-eem.600 uuid: 48f5953c-233c-4026-96a0-ffef9cea1c72
+	CoInterpreter VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3
  */
-static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.600 uuid: 48f5953c-233c-4026-96a0-ffef9cea1c72 " __DATE__ ;
+static char __buildInfo[] = "CoInterpreter VMMaker.oscog-eem.612 uuid: 54335642-7834-48fb-936d-b567fb9857b3 " __DATE__ ;
 char *__interpBuildInfo = __buildInfo;
 
 
@@ -825,6 +825,7 @@
 static void primitiveAdd(void);
 EXPORT(void) primitiveAddLargeIntegers(void);
 static void primitiveAdoptInstance(void);
+EXPORT(sqInt) primitiveAllObjects(void);
 static void primitiveArctan(void);
 static void primitiveArrayBecome(void);
 static void primitiveArrayBecomeOneWay(void);
@@ -1147,7 +1148,7 @@
 static void rewriteMethodCacheEntryForExternalPrimitiveToFunction(void (*localPrimAddress)(void));
 static sqInt roomToPushNArgs(sqInt n);
 static void runLeakCheckerForFullGC(sqInt fullGCFlag);
-static usqInt safeObjectAfter(sqInt oop);
+static sqInt safeObjectAfter(sqInt oop);
 static sqInt safePrintStringOf(sqInt oop);
 usqInt scavengeThresholdAddress(void);
 EXPORT(sqInt) sendInvokeCallbackContext(VMCallbackContext *vmCallbackContext);
@@ -1161,6 +1162,7 @@
 void setSavedWindowSize(sqInt value);
 static void setSignalLowSpaceFlagAndSaveProcess(void);
 static void setTraceFlagOnContextsFramesPageIfNeeded(sqInt aContext);
+static sqInt shortentoIndexableSize(sqInt obj, sqInt nSlots);
 static sqInt shortPrintContext(sqInt aContext);
 static sqInt shortPrintFrameAndCallers(char *theFP);
 EXPORT(void) shortPrintFramesInPage(StackPage *thePage);
@@ -2033,7 +2035,7 @@
 	/* 574 */ (void (*)(void))0,
 	/* 575 */ (void (*)(void))0,
  0 };
-const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreter_VMMaker.oscog-eem.600";
+const char *interpreterVersion = "Newspeak Virtual Machine CoInterpreter_VMMaker.oscog-eem.612";
 sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* 10 */;
 volatile int sendTrace;
 
@@ -5308,6 +5310,7 @@
 						GIV(primTraceLog)[GIV(primTraceLogIndex)] = GIV(messageSelector);
 						primTraceLogIndex(GIV(primTraceLogIndex) + 1);
 					}
+					assert(!(isOopForwarded(stackValue(GIV(argumentCount)))));
 					nArgs = GIV(argumentCount);
 					savedStackPointer = GIV(stackPointer);
 					savedFramePointer = GIV(framePointer);
@@ -5375,6 +5378,7 @@
 					/* could new rcvr be set at point of send? */
 
 					rcvr = longAtPointer(localSP + (GIV(argumentCount) * BytesPerOop));
+					assert(!(isOopForwarded(rcvr)));
 					/* begin internalPush: */
 					longAtPointerput((localSP -= BytesPerOop), localIP);
 					/* begin internalPush: */
@@ -5676,7 +5680,6 @@
 						/* begin internalPush: */
 						longAtPointerput((localSP -= BytesPerOop), longAt((rcvr + BaseHeaderSize) + (byte3 << ShiftForWord)));
 					}
-					null;
 					goto l4;
 				}
 				if (opType == 3) {
@@ -5686,7 +5689,6 @@
 					assert(GIV(method) == (iframeMethod(localFP)));
 					object = longAt((GIV(method) + BaseHeaderSize) + ((byte3 + LiteralStart) << ShiftForWord));
 					longAtPointerput((localSP -= BytesPerOop), object);
-					null;
 					goto l4;
 				}
 				if (opType == 4) {
@@ -5700,7 +5702,6 @@
 					object2 = longAt((oop + BaseHeaderSize) + (ValueIndex << ShiftForWord));
 					longAtPointerput((localSP -= BytesPerOop), object2);
 
-					null;
 					goto l4;
 				}
 				top = longAtPointer(localSP);
@@ -8377,10 +8378,12 @@
 
 								/* Note fmt >= firstStringyFormat is an artificial flag for strings */
 								/* String */
+								/* Spur supports the String at:[put:] primitives on WideString */
 
+								result1 = byteAt((rcvr + BaseHeaderSize) + (((index >> 1)) - 1));
 								result = (CharacterTable == null
-									? characterObjectOf(byteAt((rcvr + BaseHeaderSize) + (((index >> 1)) - 1)))
-									: longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CharacterTable << ShiftForWord))) + BaseHeaderSize) + ((byteAt((rcvr + BaseHeaderSize) + (((index >> 1)) - 1))) << ShiftForWord)));
+									? characterObjectOf(result1)
+									: longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CharacterTable << ShiftForWord))) + BaseHeaderSize) + (result1 << ShiftForWord)));
 								goto l120;
 							}
 							else {
@@ -8591,7 +8594,6 @@
 								valToPut = positive32BitValueOf(value);
 								if (!GIV(primFailCode)) {
 									long32Atput((rcvr + BaseHeaderSize) + ((((index >> 1)) - 1) << 2), valToPut);
-									null;
 									goto l123;
 								}
 								GIV(primFailCode) = PrimErrBadArgument;
@@ -8626,6 +8628,7 @@
 									? (valToPut >> 1)
 									: -1);
 
+								
 							}
 							else {
 								if ((fmt >= 12)
@@ -11267,10 +11270,12 @@
 
 								/* Note fmt >= firstStringyFormat is an artificial flag for strings */
 								/* String */
+								/* Spur supports the String at:[put:] primitives on WideString */
 
+								result1 = byteAt((rcvr + BaseHeaderSize) + (((index >> 1)) - 1));
 								result = (CharacterTable == null
-									? characterObjectOf(byteAt((rcvr + BaseHeaderSize) + (((index >> 1)) - 1)))
-									: longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CharacterTable << ShiftForWord))) + BaseHeaderSize) + ((byteAt((rcvr + BaseHeaderSize) + (((index >> 1)) - 1))) << ShiftForWord)));
+									? characterObjectOf(result1)
+									: longAt(((longAt((GIV(specialObjectsOop) + BaseHeaderSize) + (CharacterTable << ShiftForWord))) + BaseHeaderSize) + (result1 << ShiftForWord)));
 								goto l259;
 							}
 							else {
@@ -11481,7 +11486,6 @@
 								valToPut = positive32BitValueOf(value);
 								if (!GIV(primFailCode)) {
 									long32Atput((rcvr + BaseHeaderSize) + ((((index >> 1)) - 1) << 2), valToPut);
-									null;
 									goto l262;
 								}
 								GIV(primFailCode) = PrimErrBadArgument;
@@ -11516,6 +11520,7 @@
 									? (valToPut >> 1)
 									: -1);
 
+								
 							}
 							else {
 								if ((fmt >= 12)
@@ -13198,17 +13203,9 @@
 	numArgs = (((usqInt) methodHeader) >> 25) & 15;
 
 	/* could new rcvr be set at point of send? */
-	/* Because this is an uncogged method we need to continue via the interpreter.
-	   We could have been reached either from the interpreter, in which case we
-	   should simply return, or from a machine code frame or from a compiled
-	   primitive.  In these latter two cases we must longjmp back to the interpreter.
-	   The instructionPointer tells us which path we took.
-	   If the sender was an interpreter frame but called through a (failing) primitive
-	   then make sure we restore the saved instruction pointer and avoid pushing
-	   ceReturnToInterpreterPC which is only valid between an interpreter caller
-	   frame and a machine code callee frame. */
 
 	rcvr = longAt(GIV(stackPointer) + (numArgs * BytesPerWord));
+	assert(!(isOopForwarded(rcvr)));
 	if (!((inInterpreter = GIV(instructionPointer) >= (startOfMemory())))) {
 		if (GIV(instructionPointer) == (ceReturnToInterpreterPC())) {
 			GIV(instructionPointer) = longAt(GIV(framePointer) + FoxIFSavedIP);
@@ -14361,7 +14358,8 @@
 		}
 	}
 	/* begin postBecomeAction: */
-	;
+	followForwardingPointersInStackZone(0);
+	
 	cogitPostGCAction(GIV(gcMode));
 	GIV(lastCoggableInterpretedBlockMethod) = (GIV(lastUncoggableInterpretedBlockMethod) = null);
 	GIV(gcMode) = 0;
@@ -16296,7 +16294,7 @@
     sqInt sz1;
 
 	ok = 1;
-	/* begin allObjectsDo: */
+	/* begin allObjectsDoSafely: */
 	/* begin oopFromChunk: */
 	chunk = startOfMemory();
 	oop1 = chunk + (headerTypeBytes[(longAt(chunk)) & TypeMask]);
@@ -19846,27 +19844,19 @@
     sqInt chunk;
     sqInt chunk1;
     sqInt fmt;
-    sqInt fwdBlock;
-    sqInt fwdBlock1;
     sqInt header;
     sqInt header1;
-    sqInt header11;
-    sqInt header2;
     sqInt methodHeader;
     sqInt obj;
     sqInt oop;
     sqInt oop1;
     sqInt oop2;
-    sqInt realHeader;
-    sqInt realHeader1;
     sqInt startAddr;
     sqInt stopAddr;
     sqInt stopAddr1;
     sqInt swapFloatWords;
     sqInt sz;
     sqInt sz1;
-    sqInt sz11;
-    sqInt sz2;
     sqInt temp;
     sqInt temp1;
     sqInt wordAddr;
@@ -19929,40 +19919,21 @@
 				}
 
 			}
-			/* begin objectAfterWhileForwarding: */
-			header2 = longAt(oop1);
-			if ((header2 & MarkBit) == 0) {
-				/* begin objectAfter: */
-				if (!(asserta(oopisLessThan(oop1, GIV(freeStart))))) {
-					error("no objects after the end of memory");
-				}
-				if (((longAt(oop1)) & TypeMask) == HeaderTypeFree) {
-					sz11 = (longAt(oop1)) & AllButTypeMask;
-				}
-				else {
-					/* begin sizeBitsOf: */
-					header11 = longAt(oop1);
-					sz11 = ((header11 & TypeMask) == HeaderTypeSizeAndClass
-						? (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask
-						: header11 & SizeMask);
-				}
-				oop1 = (oop1 + sz11) + (headerTypeBytes[(longAt(oop1 + sz11)) & TypeMask]);
-				goto l3;
+			/* begin objectAfter: */
+			if (!(asserta(oopisLessThan(oop1, GIV(freeStart))))) {
+				error("no objects after the end of memory");
 			}
-			fwdBlock1 = (header2 & AllButMarkBitAndTypeMask) << 1;
-			assert(fwdBlockValid(fwdBlock1));
-
-			/* following code is like sizeBitsOf: */
-
-			realHeader1 = longAt(fwdBlock1 + BytesPerWord);
-			if ((realHeader1 & TypeMask) == HeaderTypeSizeAndClass) {
-				sz2 = (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask;
+			if (((longAt(oop1)) & TypeMask) == HeaderTypeFree) {
+				sz1 = (longAt(oop1)) & AllButTypeMask;
 			}
 			else {
-				sz2 = realHeader1 & SizeMask;
+				/* begin sizeBitsOf: */
+				header1 = longAt(oop1);
+				sz1 = ((header1 & TypeMask) == HeaderTypeSizeAndClass
+					? (longAt(oop1 - (BytesPerWord * 2))) & LongSizeMask
+					: header1 & SizeMask);
 			}
-			oop1 = (oop1 + sz2) + (headerTypeBytes[(longAt(oop1 + sz2)) & TypeMask]);
-		l3:	/* end objectAfterWhileForwarding: */;
+			oop1 = (oop1 + sz1) + (headerTypeBytes[(longAt(oop1 + sz1)) & TypeMask]);
 		}
 	}
 	else {
@@ -19985,40 +19956,21 @@
 				}
 
 			}
-			/* begin objectAfterWhileForwarding: */
-			header = longAt(oop);
-			if ((header & MarkBit) == 0) {
-				/* begin objectAfter: */
-				if (!(asserta(oopisLessThan(oop, GIV(freeStart))))) {
-					error("no objects after the end of memory");
-				}
-				if (((longAt(oop)) & TypeMask) == HeaderTypeFree) {
-					sz1 = (longAt(oop)) & AllButTypeMask;
-				}
-				else {
-					/* begin sizeBitsOf: */
-					header1 = longAt(oop);
-					sz1 = ((header1 & TypeMask) == HeaderTypeSizeAndClass
-						? (longAt(oop - (BytesPerWord * 2))) & LongSizeMask
-						: header1 & SizeMask);
-				}
-				oop = (oop + sz1) + (headerTypeBytes[(longAt(oop + sz1)) & TypeMask]);
-				goto l2;
+			/* begin objectAfter: */
+			if (!(asserta(oopisLessThan(oop, GIV(freeStart))))) {
+				error("no objects after the end of memory");
 			}
-			fwdBlock = (header & AllButMarkBitAndTypeMask) << 1;

@@ Diff output truncated at 50000 characters. @@


More information about the Vm-dev mailing list