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

commits at source.squeak.org commits at source.squeak.org
Fri Jan 13 20:09:21 UTC 2023


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

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

Name: VMMaker.oscog-eem.3295
Author: eem
Time: 13 January 2023, 12:09:05.276245 pm
UUID: 63e2da98-74ac-444c-882e-5a2cd6a3f7f6
Ancestors: VMMaker.oscog-eem.3294

Change cloneObject: to answer nil on failure rather than 0, to match instantiateClass:indexableSize: et al. Make sure all uses of cloneObject: in plugins test the result appropriately.

Make sure the head frame pointers are written back when cloning a context in primitiveClone.

Fix a receiver of baseHeaderSize in the Cogit.

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

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genFetchRegArgsForPerformWithArguments: (in category 'primitive generators') -----
  genFetchRegArgsForPerformWithArguments: sizeReg
  	"The arguments are imn an array in Arg1Reg. Its size is in sizeReg.
  	 Load Arg0Reg and Arg1Reg with the first two slots.
  	 Since objects always have at least one slot and are aligned to 64-bits
  	 it is safe to load both args without checking."
  
  	cogit
+ 		MoveMw: objectMemory baseHeaderSize r: Arg1Reg R: Arg0Reg;
+ 		MoveMw: objectMemory baseHeaderSize + self wordSize r: Arg1Reg R: Arg1Reg.
- 		MoveMw: self baseHeaderSize r: Arg1Reg R: Arg0Reg;
- 		MoveMw: self baseHeaderSize + self wordSize r: Arg1Reg R: Arg1Reg.
  	^0!

Item was changed:
  ----- Method: CroquetPlugin>>primitiveOrthoNormInverseMatrix (in category 'transforms') -----
  primitiveOrthoNormInverseMatrix
  	<export: true>
  	<primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
  	| srcOop dstOop src dst x y z rx ry rz |
  	<var: #x type: #double>
  	<var: #y type: #double>
  	<var: #z type: #double>
  	<var: #rx type: #double>
  	<var: #ry type: #double>
  	<var: #rz type: #double>
  
  	srcOop := interpreterProxy stackValue: 0.
  	((interpreterProxy isWords: srcOop) and:[(interpreterProxy slotSizeOf: srcOop) = 16]) ifFalse:
  		[^interpreterProxy primitiveFail].
  	dstOop := interpreterProxy cloneObject: srcOop.
+ 	dstOop ifNil:
- 	dstOop = 0 ifTrue:
  		[^interpreterProxy primitiveFail].
  	"reload srcOop in case of GC"
  	self cppIf: #SPURVM ifFalse: [srcOop := interpreterProxy stackValue: 0].
  	src := self cCoerce: (interpreterProxy firstIndexableField: srcOop) to: #'float *'.
  	dst := self cCoerce: (interpreterProxy firstIndexableField: dstOop) to: #'float *'.
  
  	"Transpose upper 3x3 matrix"
  	"dst at: 0 put: (src at: 0)."	dst at: 1 put: (src at: 4). 	dst at: 2 put: (src at: 8). 
  	dst at: 4 put: (src at: 1). 	"dst at: 5 put: (src at: 5)."	dst at: 6 put: (src at: 9). 
  	dst at: 8 put: (src at: 2). 	dst at: 9 put: (src at: 6). 	"dst at: 10 put: (src at: 10)."
  
  	"Compute inverse translation vector"
  	x := src at: 3.
  	y := src at: 7.
  	z := src at: 11.
  	rx := (x * (dst at: 0)) + (y * (dst at: 1)) + (z * (dst at: 2)).
  	ry := (x * (dst at: 4)) + (y * (dst at: 5)) + (z * (dst at: 6)).
  	rz := (x * (dst at: 8)) + (y * (dst at: 9)) + (z * (dst at: 10)).
  
  	dst at: 3 put: 0.0 - rx.
  	dst at: 7 put: 0.0 - ry.
  	dst at: 11 put: 0.0 - rz.
  
  	^interpreterProxy methodReturnValue: dstOop!

Item was changed:
  ----- Method: CroquetPlugin>>primitiveTransformDirection (in category 'transforms') -----
  primitiveTransformDirection
  	<export: true>
  	<primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
  	| x y z rx ry rz matrix vertex v3Oop |
  	<var: #x type: #double>
  	<var: #y type: #double>
  	<var: #z type: #double>
  	<var: #rx type: #double>
  	<var: #ry type: #double>
  	<var: #rz type: #double>
  
  	matrix := self stackMatrix: 1.
  	v3Oop := interpreterProxy stackValue: 0.
  	(matrix notNil and: [(interpreterProxy isWords: v3Oop) and:[(interpreterProxy slotSizeOf: v3Oop) = 3]]) ifFalse:
  		[^interpreterProxy primitiveFail].
  	vertex := self cCoerce: (interpreterProxy firstIndexableField: v3Oop) to: #'float *'.
  
  	x := vertex at: 0.
  	y := vertex at: 1.
  	z := vertex at: 2.
  
  	rx := (x * (matrix at: 0)) + (y * (matrix at: 1)) + (z * (matrix at: 2)).
  	ry := (x * (matrix at: 4)) + (y * (matrix at: 5)) + (z * (matrix at: 6)).
  	rz := (x * (matrix at: 8)) + (y * (matrix at: 9)) + (z * (matrix at: 10)).
  
  	v3Oop := interpreterProxy cloneObject: v3Oop.
+ 	v3Oop ifNil:
- 	v3Oop = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	vertex := self cCoerce: (interpreterProxy firstIndexableField: v3Oop) to: #'float *'.
  
  	vertex at: 0 put: rx.
  	vertex at: 1 put: ry.
  	vertex at: 2 put: rz.
  
  	^interpreterProxy methodReturnValue: v3Oop!

Item was changed:
  ----- Method: CroquetPlugin>>primitiveTransformVector3 (in category 'transforms') -----
  primitiveTransformVector3
  	<export: true>
  	<primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
  	| x y z rx ry rz rw matrix vertex v3Oop |
  	<var: #x type: #double>
  	<var: #y type: #double>
  	<var: #z type: #double>
  	<var: #rx type: #double>
  	<var: #ry type: #double>
  	<var: #rz type: #double>
  	<var: #rw type: #double>
  
  	matrix := self stackMatrix: 1.
  	v3Oop := interpreterProxy stackValue: 0.
  	(matrix notNil and: [(interpreterProxy isWords: v3Oop) and:[(interpreterProxy slotSizeOf: v3Oop) = 3]]) ifFalse:
  		[^interpreterProxy primitiveFail].
  	vertex := self cCoerce: (interpreterProxy firstIndexableField: v3Oop) to: #'float *'.
  
  	x := vertex at: 0.
  	y := vertex at: 1.
  	z := vertex at: 2.
  
  	rx := (x * (matrix at: 0)) + (y * (matrix at: 1)) + (z * (matrix at: 2)) + (matrix at: 3).
  	ry := (x * (matrix at: 4)) + (y * (matrix at: 5)) + (z * (matrix at: 6)) + (matrix at: 7).
  	rz := (x * (matrix at: 8)) + (y * (matrix at: 9)) + (z * (matrix at: 10)) + (matrix at: 11).
  	rw := (x * (matrix at: 12)) + (y * (matrix at: 13)) + (z * (matrix at: 14)) + (matrix at: 15).
  
  	v3Oop := interpreterProxy cloneObject: v3Oop.
+ 	v3Oop ifNil:
- 	v3Oop = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	vertex := self cCoerce: (interpreterProxy firstIndexableField: v3Oop) to: #'float *'.
  
  	rw = 1.0 ifTrue:[
  		vertex at: 0 put: rx.
  		vertex at: 1 put: ry.
  		vertex at: 2 put: rz.
  	] ifFalse:[
  		rw = 0.0 
  			ifTrue:[rw := 0.0]
  			ifFalse:[rw := 1.0 / rw].
  		vertex at: 0 put: rx * rw.
  		vertex at: 1 put: ry * rw.
  		vertex at: 2 put: rz * rw.
  	].
  	^interpreterProxy methodReturnValue: v3Oop!

Item was changed:
  ----- Method: CroquetPlugin>>primitiveTransposeMatrix (in category 'transforms') -----
  primitiveTransposeMatrix
- 	| srcOop dstOop src dst |
  	<export: true>
+ 	<primitiveMetadata: #(FastCPrimitiveFlag FastCPrimitiveAlignForFloatsFlag)>
+ 	| srcOop dstOop src dst |
+ 	<var: #src type: #'float *'>
+ 	<var: #dst type: #'float *'>
- 	<var: #src declareC:'float *src'>
- 	<var: #dst declareC:'float *dst'>
  
+ 	srcOop := interpreterProxy stackValue: 0.
+ 	((interpreterProxy isWords: srcOop) and:[(interpreterProxy slotSizeOf: srcOop) = 16]) ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	interpreterProxy methodArgumentCount = 0
- 		ifFalse:[^interpreterProxy primitiveFail].
- 	srcOop := interpreterProxy stackObjectValue: 0.
- 	interpreterProxy failed ifTrue:[^nil].
- 	((interpreterProxy isWords: srcOop) and:[(interpreterProxy slotSizeOf: srcOop) = 16])
- 		ifFalse:[^interpreterProxy primitiveFail].
  	dstOop := interpreterProxy cloneObject: srcOop.
+ 	dstOop ifNil:
+ 		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
+ 	self cppIf: #SPURVM "reload srcOop in case of GC"
+ 		ifFalse: [srcOop := interpreterProxy stackValue: 0].
- 	"reload srcOop in case of GC"
- 	srcOop := interpreterProxy stackObjectValue: 0.
  	src := interpreterProxy firstIndexableField: srcOop.
  	dst := interpreterProxy firstIndexableField: dstOop.
  
  	"dst at: 0 put: (src at: 0)."
  	dst at: 1 put: (src at: 4). 
  	dst at: 2 put: (src at: 8). 
  	dst at: 3 put: (src at: 12).
  
  	dst at: 4 put: (src at: 1). 
  	"dst at: 5 put: (src at: 5)."
  	dst at: 6 put: (src at: 9). 
  	dst at: 7 put: (src at: 13).
  
  	dst at: 8 put: (src at: 2). 
  	dst at: 9 put: (src at: 6). 
  	"dst at: 10 put: (src at: 10)."
  	dst at: 11 put: (src at: 14).
  
  	dst at: 12 put: (src at: 3). 
  	dst at: 13 put: (src at: 7). 
  	dst at: 14 put: (src at: 11). 
  	"dst at: 15 put: (src at: 15)."
  
+ 	interpreterProxy methodReturnValue: dstOop!
- 	interpreterProxy pop: 1.
- 	^interpreterProxy push: dstOop.
- !

Item was changed:
  ----- Method: Interpreter>>primitiveClone (in category 'object access primitives') -----
  primitiveClone
  	"Return a shallow copy of the receiver."
  
  	| newCopy |
  	newCopy := self cloneObject: self stackTop.
+ 	newCopy ifNil: "not enough memory most likely"
- 	newCopy = 0 ifTrue: "not enough memory most likely"
  		[^self primitiveFail].
  	self pop: argumentCount + 1 thenPush: newCopy!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveClone (in category 'object access primitives') -----
  primitiveClone
  	"Return a shallow copy of the receiver."
  
  	| rcvr newCopy |
  	rcvr := self stackTop.
  	(objectMemory isImmediate: rcvr)
  		ifTrue:
  			[newCopy := rcvr]
  		ifFalse:
  			[(argumentCount = 0
  			  or: [(objectMemory isForwarded: rcvr) not])
+ 				ifTrue: [newCopy := objectMemory cloneObject: rcvr].
+ 			 newCopy ifNil: "not enough memory most likely"
+ 				[^self primitiveFailFor: PrimErrNoMemory]].
+ 	self methodReturnValue: newCopy!
- 				ifTrue: [newCopy := objectMemory cloneObject: rcvr]
- 				ifFalse: [newCopy := 0].
- 			 newCopy = 0 ifTrue: "not enough memory most likely"
- 				[^self primitiveFail]].
- 	self pop: argumentCount + 1 thenPush: newCopy!

Item was changed:
  ----- Method: NewObjectMemory>>allocateChunkAfterGC: (in category 'allocation') -----
  allocateChunkAfterGC: byteSize 
  	"Garbage collect and then allocate a chunk of the given size. Sender must be sure
  	 that the requested size includes enough space for the header word(s)."
  	| newChunk enoughSpace |
  	<inline: true>
  	<var: #newChunk type: #usqInt>
  	enoughSpace := self sufficientSpaceToAllocate: byteSize.
  	enoughSpace ifFalse:
  		["signal that space is running low, but proceed with allocation if possible"
  		 self setSignalLowSpaceFlagAndSaveProcess].
  	(self oop: freeStart + byteSize isGreaterThan: reserveStart) ifTrue:
+ 		[^nil "Allocation failed.  Client should e.g. fail the primtive"].
- 		[^0 "Allocation failed.  Client should e.g. fail the primtive"].
  
  	"if we get here, there is enough space for allocation to succeed "
  	newChunk := freeStart.
  	freeStart := freeStart + byteSize.
  	^self oopForPointer: newChunk!

Item was changed:
  ----- Method: NewObjectMemory>>cloneObject: (in category 'allocation') -----
  cloneObject: obj
  	"Return a shallow copy of the given object. May cause GC.
  	 Assume: Oop is a real object, not a small integer.
  	 Override to assert it's not a married context and maybe fix cloned methods."
  	| extraHdrBytes bytes newChunk remappedOop fromIndex toIndex lastFrom newOop header hash |
  	<inline: false>
  	<var: #lastFrom type: #usqInt>
  	<var: #fromIndex type: #usqInt>
  	self assert: ((self isContext: obj) not
  				or: [(coInterpreter isMarriedOrWidowedContext: obj) not]). 
  
  	self assert: (self isNonIntegerObject: obj).
  	extraHdrBytes := self extraHeaderBytes: obj.
  	bytes := self sizeBitsOf: obj.
  	bytes := bytes + extraHdrBytes.
  
  	"allocate space for the copy, remapping obj in case of a GC"
  	self pushRemappableOop: obj.
+ 	"check it is safe to allocate this much memory. Return nil if not"
+ 	(self sufficientSpaceToAllocate: 2500 + bytes) ifFalse:[^nil].
- 	"check it is safe to allocate this much memory. Return 0 if not"
- 	(self sufficientSpaceToAllocate: 2500 + bytes) ifFalse:[^0].
  	newChunk := self allocateChunk: bytes.
  	remappedOop := self popRemappableOop.
  
  	"copy old to new including all header words"
  	toIndex := newChunk - self wordSize.  "loop below uses pre-increment"
  	fromIndex := (remappedOop - extraHdrBytes) - self wordSize.
  	lastFrom := fromIndex + bytes.
  	[fromIndex < lastFrom] whileTrue:
  		[self longAt: (toIndex := toIndex + self wordSize)
  			put: (self longAt: (fromIndex := fromIndex + self wordSize))].
  	newOop := newChunk + extraHdrBytes.  "convert from chunk to oop"
  
  	"fix base header: compute new hash and clear Mark and Root bits"
  	hash := self newObjectHash.
  	header := (self longAt: newOop) bitAnd: 16r1FFFF.
  	"use old ccIndex, format, size, and header-type fields"
  	header := header bitOr: ((hash << HashBitsOffset) bitAnd: HashBits).
  	self longAt: newOop put: header.
  	(self isCompiledMethodHeader: header) ifTrue:
  		[coInterpreter maybeFixClonedCompiledMethod: newOop].
  	^newOop
  !

Item was changed:
  ----- Method: ObjectMemory>>cloneObject: (in category 'allocation') -----
  cloneObject: obj
  	"Return a shallow copy of the given object. May cause GC"
  	"Assume: Oop is a real object, not a small integer."
  
  	| extraHdrBytes bytes newChunk remappedOop fromIndex toIndex lastFrom newOop header hash |
  	<inline: false>
  	<var: #lastFrom type: #usqInt>
  	<var: #fromIndex type: #usqInt>
  	self assert: (self isNonIntegerObject: obj).
  	extraHdrBytes := self extraHeaderBytes: obj.
  	bytes := self sizeBitsOf: obj.
  	bytes := bytes + extraHdrBytes.
  
  	"allocate space for the copy, remapping obj in case of a GC"
  	self pushRemappableOop: obj.
+ 	"check it is safe to allocate this much memory. Return nil if not"
+ 	(self sufficientSpaceToAllocate: 2500 + bytes) ifFalse:[^nil].
- 	"check it is safe to allocate this much memory. Return 0 if not"
- 	(self sufficientSpaceToAllocate: 2500 + bytes) ifFalse:[^0].
  	newChunk := self allocateChunk: bytes.
  	remappedOop := self popRemappableOop.
  
  	"copy old to new including all header words"
  	toIndex := newChunk - self wordSize.  "loop below uses pre-increment"
  	fromIndex := (remappedOop - extraHdrBytes) - self wordSize.
  	lastFrom := fromIndex + bytes.
  	[fromIndex < lastFrom] whileTrue:
  		[self longAt: (toIndex := toIndex + self wordSize) put: (self longAt: (fromIndex := fromIndex + self wordSize))].
  	newOop := newChunk + extraHdrBytes.  "convert from chunk to oop"
  
  	"fix base header: compute new hash and clear Mark and Root bits"
  	hash := self newObjectHash.
  	header := (self longAt: newOop) bitAnd: 16r1FFFF.
  	"use old ccIndex, format, size, and header-type fields"
  	header := header bitOr: ((hash << HashBitsOffset) bitAnd: HashBits).
  	self longAt: newOop put: header.
  	^newOop
  !

Item was changed:
  ----- Method: SpurMemoryManager>>cloneObject: (in category 'allocation') -----
  cloneObject: objOop
  	| numSlots fmt newObj |
  	numSlots := self numSlotsOf: objOop.
  	fmt := self formatOf: objOop.
  	numSlots > self maxSlotsForNewSpaceAlloc
  		ifTrue:
  			[newObj := self allocateSlotsInOldSpace: numSlots
  							format: fmt
  							classIndex: (self classIndexOf: objOop)]
  		ifFalse:
  			[newObj := self allocateSlots: numSlots
  							format: fmt
  							classIndex: (self classIndexOf: objOop)].
+ 	newObj ifNotNil:
+ 		[(self isPointersFormat: fmt)
+ 			ifTrue:
+ 				[| hasYoung |
+ 				 hasYoung := false.
+ 				 0 to: numSlots - 1 do:
+ 					[:i| | oop |
+ 					oop := self fetchPointer: i ofObject: objOop.
+ 					(self isNonImmediate: oop) ifTrue:
+ 						[(self isForwarded: oop) ifTrue:
+ 							[oop := self followForwarded: oop].
+ 						((self isNonImmediate: oop)
+ 						 and: [self isYoungObject: oop]) ifTrue:
+ 							[hasYoung := true]].
+ 					self storePointerUnchecked: i
+ 						ofObject: newObj
+ 						withValue: oop].
+ 				(hasYoung
+ 				 and: [(self isYoungObject: newObj) not]) ifTrue:
+ 					[scavenger remember: newObj]]
+ 			ifFalse:
+ 				[0 to: numSlots - 1 do:
+ 					[:i|
+ 					self storePointerUnchecked: i
+ 						ofObject: newObj
+ 						withValue: (self fetchPointer: i ofObject: objOop)].
+ 				 fmt >= self firstCompiledMethodFormat ifTrue:
+ 					[coInterpreter maybeFixClonedCompiledMethod: newObj.
+ 					 ((self isOldObject: newObj)
+ 					  and: [(self isYoungObject: objOop) or: [self isRemembered: objOop]]) ifTrue:
+ 						[scavenger remember: newObj]]]].
- 	newObj ifNil:
- 		[^0].
- 	(self isPointersFormat: fmt)
- 		ifTrue:
- 			[| hasYoung |
- 			 hasYoung := false.
- 			 0 to: numSlots - 1 do:
- 				[:i| | oop |
- 				oop := self fetchPointer: i ofObject: objOop.
- 				(self isNonImmediate: oop) ifTrue:
- 					[(self isForwarded: oop) ifTrue:
- 						[oop := self followForwarded: oop].
- 					((self isNonImmediate: oop)
- 					 and: [self isYoungObject: oop]) ifTrue:
- 						[hasYoung := true]].
- 				self storePointerUnchecked: i
- 					ofObject: newObj
- 					withValue: oop].
- 			(hasYoung
- 			 and: [(self isYoungObject: newObj) not]) ifTrue:
- 				[scavenger remember: newObj]]
- 		ifFalse:
- 			[0 to: numSlots - 1 do:
- 				[:i|
- 				self storePointerUnchecked: i
- 					ofObject: newObj
- 					withValue: (self fetchPointer: i ofObject: objOop)].
- 			 fmt >= self firstCompiledMethodFormat ifTrue:
- 				[coInterpreter maybeFixClonedCompiledMethod: newObj.
- 				 ((self isOldObject: newObj)
- 				  and: [(self isYoungObject: objOop) or: [self isRemembered: objOop]]) ifTrue:
- 					[scavenger remember: newObj]]].
  	^newObj!

Item was changed:
  ----- Method: SpurMemoryManager>>outOfPlaceBecome:and:copyHashFlag: (in category 'become implementation') -----
  outOfPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag
  	<inline: #never> "in an effort to fix a compiler bug with two-way become post r3427"
+ 	"Allocate two new objects, n1 & n2.  Copy the contents appropriately. Convert obj1 and obj2
+ 	 into forwarding objects pointing to n2 and n1 respectively. No need to check if cloneObject:
+ 	 succeeds because an earlier pass over objects ensured that there is enough memory."
- 	"Allocate two new objects, n1 & n2.  Copy the contents appropriately. Convert
- 	 obj1 and obj2 into forwarding objects pointing to n2 and n1 respectively"
  	| clone1 clone2 |
  	clone1 := (self isContextNonImm: obj1)
  				ifTrue: [coInterpreter cloneContext: obj1]
  				ifFalse: [self cloneObject: obj1].
  	clone2 := (self isContextNonImm: obj2)
  				ifTrue: [coInterpreter cloneContext: obj2]
  				ifFalse: [self cloneObject: obj2].
  	(self isObjImmutable: obj1) ifTrue:
  		[self setIsImmutableOf: clone1 to: true].
  	(self isObjImmutable: obj2) ifTrue:
  		[self setIsImmutableOf: clone2 to: true].
  	copyHashFlag
  		ifTrue:
  			[self setHashBitsOf: clone1 to: (self rawHashBitsOf: obj1).
  			 self setHashBitsOf: clone2 to: (self rawHashBitsOf: obj2)]
  		ifFalse:
  			[self setHashBitsOf: clone1 to: (self rawHashBitsOf: obj2).
  			 self setHashBitsOf: clone2 to: (self rawHashBitsOf: obj1)].
  	self
  		forward: obj1 to: clone2;
  		forward: obj2 to: clone1.
  	((self isYoungObject: obj1) ~= (self isYoungObject: clone2)
  	 or: [(self isYoungObject: obj2) ~= (self isYoungObject: clone1)]) ifTrue:
  		[becomeEffectsFlags := becomeEffectsFlags bitOr: OldBecameNewFlag]!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>cloneContext: (in category 'primitive support') -----
  cloneContext: aContext 
  	| sz cloned spouseFP sp |
  	<var: #spouseFP type: #'char *'>
  	sz := objectMemory numSlotsOf: aContext.
  	cloned := objectMemory eeInstantiateMethodContextSlots: sz.
+ 	self deny: cloned = 0.
+ 	0 to: StackPointerIndex do:
+ 		[:i|
+ 		objectMemory
+ 			storePointerUnchecked: i
+ 			ofObject: cloned
+ 			withValue: (self externalInstVar: i ofContext: aContext)].
+ 	MethodIndex to: ReceiverIndex do:
+ 		[:i|
+ 		objectMemory
+ 			storePointerUnchecked: i
+ 			ofObject: cloned
+ 			withValue: (objectMemory fetchPointer: i ofObject: aContext)].
+ 	(self isStillMarriedContext: aContext)
+ 		ifTrue:
+ 			[spouseFP := self frameOfMarriedContext: aContext.
+ 			 sp := (self stackPointerIndexForFrame: spouseFP) - 1.
+ 			 0 to: sp do:
+ 				[:i|
+ 				objectMemory
+ 					storePointerUnchecked: i + CtxtTempFrameStart
+ 					ofObject: cloned
+ 					withValue: (self temporary: i in: spouseFP)]]
+ 		ifFalse:
+ 			[sp := (self fetchStackPointerOf: aContext) - 1.
+ 			 0 to: sp do:
+ 				[:i|
+ 				objectMemory
+ 					storePointerUnchecked: i + CtxtTempFrameStart
+ 					ofObject: cloned
+ 					withValue: (objectMemory fetchPointer: i + CtxtTempFrameStart ofObject: aContext)]].
- 	cloned ~= 0 ifTrue:
- 		[0 to: StackPointerIndex do:
- 			[:i|
- 			objectMemory
- 				storePointerUnchecked: i
- 				ofObject: cloned
- 				withValue: (self externalInstVar: i ofContext: aContext)].
- 		MethodIndex to: ReceiverIndex do:
- 			[:i|
- 			objectMemory
- 				storePointerUnchecked: i
- 				ofObject: cloned
- 				withValue: (objectMemory fetchPointer: i ofObject: aContext)].
- 		(self isStillMarriedContext: aContext)
- 			ifTrue:
- 				[spouseFP := self frameOfMarriedContext: aContext.
- 				 sp := (self stackPointerIndexForFrame: spouseFP) - 1.
- 				 0 to: sp do:
- 					[:i|
- 					objectMemory
- 						storePointerUnchecked: i + CtxtTempFrameStart
- 						ofObject: cloned
- 						withValue: (self temporary: i in: spouseFP)]]
- 			ifFalse:
- 				[sp := (self fetchStackPointerOf: aContext) - 1.
- 				 0 to: sp do:
- 					[:i|
- 					objectMemory
- 						storePointerUnchecked: i + CtxtTempFrameStart
- 						ofObject: cloned
- 						withValue: (objectMemory fetchPointer: i + CtxtTempFrameStart ofObject: aContext)]]].
  	^cloned!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveClone (in category 'object access primitives') -----
  primitiveClone
  	"Return a shallow copy of the receiver.
  	 Special-case non-single contexts (because of context-to-stack mapping).
  	 Can't fail for contexts cuz of image context instantiation code (sigh)."
  
  	<primitiveMetadata: #(PrimCallMayEndureCodeCompaction PrimCallNeedsNewMethod)> "because of cloneContext: below"
  	| rcvr newCopy |
  	rcvr := self stackTop.
  	(objectMemory isImmediate: rcvr)
  		ifTrue:
  			[newCopy := rcvr]
  		ifFalse:
  			[(objectMemory isContextNonImm: rcvr)
  				ifTrue:
+ 					[self externalWriteBackHeadFramePointers.
+ 					 newCopy := self cloneContext: rcvr]
- 					[newCopy := self cloneContext: rcvr]
  				ifFalse:
  					[(argumentCount = 0
  					  or: [(objectMemory isForwarded: rcvr) not])
+ 						ifTrue: [newCopy := objectMemory cloneObject: rcvr]].
+ 			newCopy ifNil:
- 						ifTrue: [newCopy := objectMemory cloneObject: rcvr]
- 						ifFalse: [newCopy := 0]].
- 			newCopy = 0 ifTrue:
  				[^self primitiveFailFor: PrimErrNoMemory]].
  	self methodReturnValue: newCopy!



More information about the Vm-dev mailing list