[Vm-dev] VM Maker: VMMaker.oscog-eem.392.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Sep 19 20:19:30 UTC 2013


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.392.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.392
Author: eem
Time: 19 September 2013, 1:16:32.803 pm
UUID: b795dbfe-8802-4301-96d4-ce2e941b740d
Ancestors: VMMaker.oscog-eem.391

Abstract remapOop:in: away fom specific GC types (Spur will have
three) and add ObjectMemory/SpurMemMgr>>statNumGCs to sum
them.

Nuke initFreeChunkWithSlots:at: and use freeChunkWithBytes:at:
in init.  Also type it correctly (allow > 31 bit sizes).

followForwarded: needs to cope with immediate targets given 1-way
become. Fix slip in innerBecomeObjectsIn:to:copyHash:.

Refactor SpurMemMgr>>lengthOf:baseHeader:format: to
lengthOf:format:

Add more protocol to SpurMemMgr (due to simulating a
bootstrapping squeak image).

StackInterpreter>>stackObjectValue: uses isImmediate:

=============== Diff against VMMaker.oscog-eem.391 ===============

Item was added:
+ ----- Method: ObjectMemory>>statNumGCs (in category 'accessing') -----
+ statNumGCs
+ 	^statIncrGCs + statFullGCs!

Item was changed:
  ----- Method: SmartSyntaxInterpreterPlugin>>remapOop:in: (in category 'simulation') -----
  remapOop: oopOrList in: aBlock
  	<doNotGenerate>
+ 	| numGCs result |
+ 	numGCs := interpreterProxy statNumGCs.
- 	| numIncrGCs numFullGCs result |
- 	numIncrGCs := interpreterProxy statIncrGCs.
- 	numFullGCs := interpreterProxy statFullGCs.
  	result := aBlock value.
  	"If you really did want to implement remapping you would try and locate the
  	 arguments in the caller context and update them via tempAt:put:.  But beware
  	 ambiguities.  You'd have to parse the bytecode to be sure to get the right temps."
+ 	numGCs ~= interpreterProxy statNumGCs ifTrue:
- 	(numIncrGCs ~= interpreterProxy statIncrGCs
- 	or: [numFullGCs ~= interpreterProxy statFullGCs]) ifTrue:
  		[self error: 'GC occurred in middle of remapOop:in: and remapping in this context is not implemented'].
  	^result!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>booleanValueOf: (in category 'C library simulation') -----
+ booleanValueOf: obj
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter booleanValueOf: obj!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>cCoerce:to: (in category 'memory access') -----
+ cCoerce: value to: cTypeString
+ 	"Type coercion. For translation a cast will be emmitted. When running in Smalltalk
+ 	 answer a suitable wrapper for correct indexing."
+ 
+ 	^value
+ 		ifNil: [value]
+ 		ifNotNil: [value coerceTo: cTypeString sim: self]!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>failed (in category 'simulation only') -----
+ failed
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter failed!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>firstIndexableField: (in category 'object format') -----
+ firstIndexableField: objOop
+ 	"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
+ 	 There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
+ 	 The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
+ 	 of the object).  For 3 we must go to the class."
+ 	| fmt classFormat |
+ 	<returnTypeC: #'void *'>
+ 	fmt := self formatOf: objOop.
+ 	fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
+ 		[fmt = self indexablePointersFormat ifTrue:
+ 			[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
+ 			 ^self cCoerce: (self pointerForOop: objOop
+ 												+ self baseHeaderSize
+ 												+ ((self fixedFieldsOfClassFormat: classFormat) << self wordSize))
+ 					to: #'oop *'].
+ 		^self cCoerce: (self pointerForOop: objOop
+ 											+ self baseHeaderSize
+ 											+ ((self numSlotsOf: objOop) << self wordSize))
+ 				to: #'oop *'].
+ 	"All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
+ 	self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
+ 	^self
+ 		cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
+ 		to: (fmt < self firstByteFormat
+ 				ifTrue:
+ 					[fmt = self sixtyFourBitIndexableFormat
+ 						ifTrue: ["64 bit field objects" #'long long *']
+ 						ifFalse:
+ 							[fmt < self firstShortFormat
+ 								ifTrue: ["32 bit field objects" #'int *']
+ 								ifFalse: ["16-bit field objects" #'short *']]]
+ 				ifFalse: ["byte objects (including CompiledMethod" #'char *'])!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>is:KindOf: (in category 'simulation only') -----
+ is: oop KindOf: classNameString
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter is: oop KindOf: classNameString!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>methodArgumentCount (in category 'simulation only') -----
+ methodArgumentCount
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter methodArgumentCount!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>pop:thenPush: (in category 'simulation only') -----
+ pop: nItems thenPush: oop
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter pop: nItems thenPush: oop!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>stackValue: (in category 'simulation only') -----
+ stackValue: offset
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter stackValue: offset!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>success: (in category 'simulation only') -----
+ success: boolean
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter success: boolean!

Item was changed:
  ----- Method: Spur32BitMemoryManager>>bytesInObject: (in category 'object enumeration') -----
  bytesInObject: objOop
  	"Answer the total number of bytes in an object including header and possible overflow size header."
+ 	<returnTypeC: #usqLong>
  	| halfHeader headerNumSlots numSlots |
  	self flag: #endianness.
  	halfHeader := self longAt: objOop + 4.
  	headerNumSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask.
  	numSlots := headerNumSlots = self numSlotsMask
  					ifTrue: [self longAt: objOop - self baseHeaderSize]
  					ifFalse: [headerNumSlots = 0 ifTrue: [1] ifFalse: [headerNumSlots]].
  	^numSlots + (numSlots bitAnd: 1) << self shiftForWord
  	+ (headerNumSlots = self numSlotsMask
  		ifTrue: [self baseHeaderSize + self baseHeaderSize]
  		ifFalse: [self baseHeaderSize])!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>initFreeChunkWithBytes:at: (in category 'free space') -----
+ initFreeChunkWithBytes: numBytes at: address
+ 	<var: #numBytes type: #usqLong>
+ 	| numSlots |
+ 	"must have room for a header (single or double) plus the next free pointer"
+ 	self assert: (numBytes \\ self allocationUnit = 0
+ 				 and: [numBytes >= (self baseHeaderSize + self wordSize)]).
+ 	self flag: #endianness.
+ 	"double header"
+ 	numBytes >= (self numSlotsMask << self shiftForWord) ifTrue:
+ 		[numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord.
+ 		 self longAt: address put: numSlots;
+ 			longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift;
+ 			longAt: address + 8 put: 0; "0's classIndex; 0 = classIndex of free chunks"
+ 			longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift.
+ 		^address + 8].
+ 	"single header"
+ 	numSlots := numBytes - self baseHeaderSize >> self shiftForWord.
+ 	self longAt: address put: 0; "0's classIndex; 0 = classIndex of free chunks"
+ 		longAt: address + 4 put: numSlots << self numSlotsHalfShift.
+ 	^address!

Item was removed:
- ----- Method: Spur32BitMemoryManager>>initFreeChunkWithSlots:at: (in category 'garbage collection') -----
- initFreeChunkWithSlots: numSlots at: address 
- 	self flag: #endianness.
- 	self longAt: address put: numSlots;
- 		longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift;
- 		longAt: address + 8 put: 0; "0's classIndex; 0 = classIndex of free chunks"
- 		longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift.
- 	^address + 8!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>initFreeChunkWithBytes:at: (in category 'garbage collection') -----
+ initFreeChunkWithBytes: numBytes at: address
+ 	<var: #numBytes type: #usqLong>
+ 	| numSlots |
+ 	"must have room for a header (single or double) plus the next free pointer"
+ 	self assert: (numBytes \\ self allocationUnit = 0
+ 				 and: [numBytes >= (self baseHeaderSize + self wordSize)]).
+ 	self flag: #endianness.
+ 	"double header"
+ 	numBytes >= (self numSlotsMask << self shiftForWord) ifTrue:
+ 		[numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord.
+ 		 self longLongAt: address put: self numSlotsMask << self numSlotsFullShift + numSlots;
+ 			longLongAt: address + 8 put: self numSlotsMask << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks"
+ 		^address + 8].
+ 	"single header"
+ 	numSlots := numBytes - self baseHeaderSize >> self shiftForWord.
+ 	self longLongAt: address put: numSlots << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks"
+ 	^address!

Item was removed:
- ----- Method: Spur64BitMemoryManager>>initFreeChunkWithSlots:at: (in category 'garbage collection') -----
- initFreeChunkWithSlots: numSlots at: address 
- 	self flag: #endianness.
- 	self longAt: address put: self numSlotsMask << self numSlotsFullShift + numSlots;
- 		longAt: address + 8 put: self numSlotsMask << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks"
- 	^address + 8!

Item was changed:
  CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)

Item was added:
+ ----- Method: SpurMemoryManager>>classLargeNegativeInteger (in category 'plugin support') -----
+ classLargeNegativeInteger
+ 	^self knownClassAtIndex: ClassLargeNegativeIntegerCompactIndex!

Item was added:
+ ----- Method: SpurMemoryManager>>classLargePositiveInteger (in category 'plugin support') -----
+ classLargePositiveInteger
+ 	^self knownClassAtIndex: ClassLargePositiveIntegerCompactIndex!

Item was added:
+ ----- Method: SpurMemoryManager>>firstIndexableField: (in category 'object format') -----
+ firstIndexableField: objOop
+ 	"NOTE: overridden in various simulator subclasses to add coercion to CArray, so please duplicate any changes.
+ 	 There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
+ 	 The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
+ 	 of the object).  For 3 we must go to the class."
+ 	| fmt classFormat |
+ 	<returnTypeC: #'void *'>
+ 	fmt := self formatOf: objOop.
+ 	fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
+ 		[fmt = self indexablePointersFormat ifTrue:
+ 			[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
+ 			 ^self pointerForOop: objOop
+ 								+ self baseHeaderSize
+ 								+ ((self fixedFieldsOfClassFormat: classFormat) << self wordSize)].
+ 		^self pointerForOop: objOop
+ 							+ self baseHeaderSize
+ 							+ ((self numSlotsOf: objOop) << self wordSize)].
+ 	"All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
+ 	self assert: fmt < self firstCompiledMethodFormat.
+ 	^self pointerForOop: objOop + self baseHeaderSize!

Item was changed:
  ----- Method: SpurMemoryManager>>followForwarded: (in category 'become api') -----
  followForwarded: objOop
  	"Follow a forwarding pointer.  Alas we cannot prevent forwarders to forwarders
+ 	 being created by lazy become.  Consider the following example by Igor Stasenko:
- 	 being created by lazy become.  Consider the following example by Igor Stasenk:
  		array := { a. b. c }.
  		- array at: 1 points to &a. array at: 2 points to &b. array at: 3 points to &c Ó
  		a becomeForward: b
  		- array at: 1 still points to &a. array at: 2 still points to &b. array at: 3 still points to &c
  		b becomeForward: c.
  		- array at: 1 still points to &a. array at: 2 still points to &b. array at: 3 still points to &c
  		- when accessing array first one has to follow a forwarding chain:
  		&a -> &b -> c"
  	| referent |
  	self assert: (self isForwarded: objOop).
  	referent := self fetchPointer: 0 ofMaybeForwardedObject: objOop.
+ 	[(self isOopForwarded: referent)] whileTrue:
- 	[(self isForwarded: referent)] whileTrue:
  		[referent := self fetchPointer: 0 ofMaybeForwardedObject: referent].
  	^referent!

Item was changed:
  ----- Method: SpurMemoryManager>>freeChunkWithBytes:at: (in category 'free space') -----
  freeChunkWithBytes: bytes at: address
  	<inline: true>
  	| freeChunk |
  	freeChunk := self initFreeChunkWithBytes: bytes at: address.
+ 	self addToFreeList: freeChunk.
+ 	^freeChunk!
- 	self addToFreeList: freeChunk.!

Item was changed:
  ----- Method: SpurMemoryManager>>initFreeChunkWithBytes:at: (in category 'free space') -----
  initFreeChunkWithBytes: numBytes at: address
+ 	<var: #numBytes type: #usqLong>
+ 	^self subclassResponsibility!
- 	| numSlots |
- 	self assert: numBytes \\ self allocationUnit = 0.
- 	numSlots := numBytes >> self shiftForWord
- 				- (numBytes >= (self numSlotsMask << self shiftForWord)
- 					ifTrue: [self baseHeaderSize + self baseHeaderSize / self wordSize]
- 					ifFalse: [self baseHeaderSize / self wordSize]).
- 	^self initFreeChunkWithSlots: numSlots at: address!

Item was removed:
- ----- Method: SpurMemoryManager>>initFreeChunkWithSlots:at: (in category 'free space') -----
- initFreeChunkWithSlots: numSlots at: address 
- 	^self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
  initialize
  	freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0).
  	freeListsMask := 0.
  	checkForLeaks := 0.
  	needGCFlag := signalLowSpace := scavengeInProgress := false.
  	becomeEffectsFlags := 0.
  	heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new].
+ 	statScavenges := statIncrGCs := statFullGCs := 0.
- 	statScavenges := 0.
  	statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := 0.
  	statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0!

Item was changed:
  ----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') -----
  initializeOldSpaceFirstFree: startOfFreeOldSpace
  	<var: 'startOfFreeOldSpace' type: #usqLong>
  	| freeOldStart freeChunk |
  	<var: 'freeOldStart' type: #usqLong>
- 	0 to: NumFreeLists - 1 do:
- 		[:i| freeLists at: i put: 0].
  	freeOldStart := startOfFreeOldSpace.
  	[endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue:
+ 		[freeChunk := self freeChunkWithBytes: (2 raisedTo: 32) at: freeOldStart.
+ 		freeOldStart := freeOldStart + (2 raisedTo: 32).
+ 		self assert: freeOldStart = (self addressAfter: freeChunk)].
+ 	freeOldStart < endOfMemory ifTrue:
+ 		[freeChunk := self freeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart.
+ 		 self assert: (self addressAfter: freeChunk) = endOfMemory].
- 		[freeChunk := self initFreeChunkWithSlots: (2 raisedTo: 32) / self wordSize at: freeOldStart.
- 		self addToFreeList: freeChunk.
- 		freeOldStart := self addressAfter: freeChunk].
- 	freeChunk := self initFreeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart.
- 	self addToFreeList: freeChunk.
- 	self assert: (self addressAfter: freeChunk) = endOfMemory.
  	freeOldSpaceStart := endOfMemory!

Item was changed:
  ----- Method: SpurMemoryManager>>innerBecomeObjectsIn:to:copyHash: (in category 'become implementation') -----
  innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag
  	"Inner loop of one-way become."
  	0 to: (self numSlotsOf: array1) - 1 do:
  		[:i| | obj1 obj2 |
  		obj1 := self fetchPointer: i ofObject: array1.
  		obj2 := self fetchPointer: i ofObject: array2.
+ 		self doBecome: obj1 to: obj2 copyHash: copyHashFlag.
- 		self doBecome: obj1 with: obj2 copyHash: copyHashFlag.
  		(self isForwarded: obj1) ifTrue:
  			[obj1 := self followForwarded: obj1.
  			 self storePointer: i ofObject: array1 withValue: obj1].
  		self assert: (self isForwarded: obj2) not]!

Item was changed:
  ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
  isIntegerObject: oop
  	"This list records the valid senders of isIntegerObject: as we replace uses of
  	  isIntegerObject: by isImmediate: where appropriate."
  	(#(	DoIt
  		DoItIn:
  		makeBaseFrameFor:
  		quickFetchInteger:ofObject:
  		frameOfMarriedContext:
  		objCouldBeClassObj:
  		isMarriedOrWidowedContext:
  		shortPrint:
  		bytecodePrimAt
  		bytecodePrimAtPut
  		commonAt:
  		commonAtPut:
  		loadFloatOrIntFrom:
  		positive32BitValueOf:
  		primitiveExternalCall
  		checkedIntegerValueOf:
  		bytecodePrimAtPut
  		commonAtPut:
  		primitiveVMParameter
  		checkIsStillMarriedContext:currentFP:
  		displayBitsOf:Left:Top:Right:Bottom:
  		fetchStackPointerOf:
  		primitiveContextAt
  		primitiveContextAtPut
  		subscript:with:storing:format:
  		printContext:
  		compare31or32Bits:equal:
+ 		signed64BitValueOf:
+ 		primDigitMultiply:negative:
+ 		digitLength:
+ 		isNegativeIntegerValueOf:
+ 		magnitude64BitValueOf:) includes: thisContext sender method selector) ifFalse:
- 		signed64BitValueOf:) includes: thisContext sender method selector) ifFalse:
  		[self halt].
  	^(oop bitAnd: 1) ~= 0!

Item was changed:
  ----- Method: SpurMemoryManager>>lengthOf: (in category 'object access') -----
  lengthOf: objOop
+ 	"Answer the number of indexable units in the given object.
+ 	 For a CompiledMethod, the size of the method header (in bytes) should
+ 	 be subtracted from the result."
- 	"Answer the number of indexable bytes or words in the given object.
- 	 For a CompiledMethod, the size of the method header (in bytes) should be subtracted from the result."
  
  	<api>
- 	| header |
- 	<var: #header type: #usqLong>
  	<inline: true>
+ 	<asmLabel: false>
+ 	^self lengthOf: objOop format: (self formatOf: objOop)!
- 	<asmLabel: false> 
- 	header := self baseHeader: objOop.
- 	^self lengthOf: objOop baseHeader: header format: (self formatOfHeader: header)!

Item was changed:
  ----- Method: SpurMemoryManager>>lengthOf:baseHeader:format: (in category 'object access') -----
  lengthOf: objOop baseHeader: header format: fmt 
  	<var: #header type: #usqLong>
  	"Compatibility; does not really suit the Spur format.
  	 Answer the number of indexable bytes or words in the given object.
  	 For a CompiledMethod, the size of the method header (in bytes) should
  	 be subtracted from the result of this method."
+ 	^self lengthOf: objOop format: fmt!
- 	| numSlots |
- 	<inline: true>
- 	<asmLabel: false> 
- 	numSlots := self numSlotsOf: objOop.
- 	fmt <= self sixtyFourBitIndexableFormat ifTrue:
- 		[^numSlots].
- 	fmt >= self firstByteFormat ifTrue: "bytes, including CompiledMethod"
- 		[^numSlots << self shiftForWord - (fmt bitAnd: 7)].
- 	fmt >= self firstShortFormat ifTrue:
- 		[^numSlots << (self shiftForWord - 1) - (fmt bitAnd: 3)].
- 	"fmt >= self firstLongFormat"
- 	^numSlots << (self shiftForWord - 2) - (fmt bitAnd: 1)!

Item was added:
+ ----- Method: SpurMemoryManager>>lengthOf:format: (in category 'object access') -----
+ lengthOf: objOop format: fmt
+ 	"Answer the number of indexable units in the given object.
+ 	 For a CompiledMethod, the size of the method header (in bytes)
+ 	 should be subtracted from the result of this method."
+ 	| numSlots |
+ 	<inline: true>
+ 	<asmLabel: false> 
+ 	numSlots := self numSlotsOf: objOop.
+ 	fmt <= self sixtyFourBitIndexableFormat ifTrue:
+ 		[^numSlots].
+ 	fmt >= self firstByteFormat ifTrue: "bytes, including CompiledMethod"
+ 		[^numSlots << self shiftForWord - (fmt bitAnd: 7)].
+ 	fmt >= self firstShortFormat ifTrue:
+ 		[^numSlots << (self shiftForWord - 1) - (fmt bitAnd: 3)].
+ 	"fmt >= self firstLongFormat"
+ 	^numSlots << (self shiftForWord - 2) - (fmt bitAnd: 1)!

Item was added:
+ ----- Method: SpurMemoryManager>>slotSizeOf: (in category 'object access') -----
+ slotSizeOf: oop
+ 	"*DO NOT CONFUSE THIS WITH numSlotsOf:.
+ 	 This is an ObjectMemory compatibility method with quesitonable semantics.
+ 	 Answers the number of slots in the receiver.
+ 	 If the receiver is a byte object, return the number of bytes.
+ 	 Otherwise return the number of words."
+ 	(self isImmediate: oop) ifTrue: [^0].
+ 	^self lengthOf: oop!

Item was added:
+ ----- Method: SpurMemoryManager>>statNumGCs (in category 'accessing') -----
+ statNumGCs
+ 	^statScavenges + statIncrGCs + statFullGCs!

Item was changed:
  ----- Method: StackInterpreter>>stackObjectValue: (in category 'internal interpreter access') -----
  stackObjectValue: offset
  	"Ensures that the given object is a real object, not a SmallInteger."
  	"In the StackInterpreter stacks grow down."
  	| oop |
  	oop := stackPages longAt: stackPointer + (offset * BytesPerWord).
+ 	(objectMemory isImmediate: oop) ifTrue:
+ 		[self primitiveFail. ^ nil].
+ 	^oop!
- 	(objectMemory isIntegerObject: oop) ifTrue: [self primitiveFail. ^ nil].
- 	^ oop
- !



More information about the Vm-dev mailing list