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

commits at source.squeak.org commits at source.squeak.org
Wed Sep 11 05:58:32 UTC 2013


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

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

Name: VMMaker.oscog-eem.369
Author: eem
Time: 10 September 2013, 10:52:00.292 pm
UUID: 241c133a-a1ac-4866-9ecc-50d6fb075dd6
Ancestors: VMMaker.oscog-eem.368

isContextNonInt: => isContextNonImm:

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

Item was changed:
  ----- Method: CoInterpreter>>ceContext:instVar: (in category 'trampolines') -----
  ceContext: maybeContext instVar: slotIndex
  	<api>
  	| result |
+ 	(objectMemory isContextNonImm: maybeContext)
- 	(objectMemory isContextNonInt: maybeContext)
  		ifTrue:
  			[instructionPointer := self popStack.
  			 result := self externalInstVar: slotIndex ofContext: maybeContext.
  			 self push: instructionPointer]
  		ifFalse: [result := objectMemory fetchPointer: slotIndex ofObject: maybeContext].
  	^result!

Item was changed:
  ----- Method: CoInterpreter>>ceContext:instVar:value: (in category 'trampolines') -----
  ceContext: maybeMarriedContext instVar: slotIndex value: anOop
  	<api>
  	"genStorePop:MaybeContextReceiverVariable: filters out unmarried contexts
  	 but not arbitrary objects in subclasses.  It answers maybeMarriedContext so
  	 that the StackToRegisterMappingCogit can keep ReceiverResultReg live."
+ 	(objectMemory isContextNonImm: maybeMarriedContext)
- 	(objectMemory isContextNonInt: maybeMarriedContext)
  		ifTrue:
  			[self assert: (self isMarriedOrWidowedContext: maybeMarriedContext).
  			 instructionPointer := self popStack.
  			 self externalInstVar: slotIndex ofContext: maybeMarriedContext put: anOop.
  			 self push: instructionPointer]
  		ifFalse:
  			[objectMemory storePointer: slotIndex ofObject: maybeMarriedContext withValue: anOop].
  	^maybeMarriedContext!

Item was changed:
  ----- Method: CoInterpreter>>ensureAllContextsHaveBytecodePCsOrAreBereaved (in category 'frame access') -----
  ensureAllContextsHaveBytecodePCsOrAreBereaved
  	"Enumerate all contexts preparing them for a snapshot.  Map all native pcs to bytecoded pcs.
  	 Convert widowed contexts to single contexts so that the snapshot contains only single contexts.
  	 This allows the being married test to avoid checking for a context's frame pointer being in bounds
  	 since all frame pointers must have been created in the current system and so be in bounds.
  	 Thanks to Greg Nuyens for this idea."
  	| oop decodedIP |
  	oop := objectMemory firstObject.
  	[oop < objectMemory freeStart] whileTrue:
  		[((objectMemory isFreeObject: oop) not
+ 		   and: [objectMemory isContextNonImm: oop]) ifTrue:
- 		   and: [objectMemory isContextNonInt: oop]) ifTrue:
  			[(self isMarriedOrWidowedContext: oop)
  				ifTrue: "The stack pages have already been discarded.  Any remaining married contexts are actually widows."
  					[self markContextAsDead: oop]
  				ifFalse:
  					[decodedIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: oop.
  					((objectMemory isIntegerObject: decodedIP)
  					 and: [decodedIP signedIntFromLong < 0]) ifTrue:
  						[decodedIP := self mustMapMachineCodePC: (objectMemory integerValueOf: decodedIP)
  											context: oop.
  						 objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: oop withValue: decodedIP]]].
  		 oop := objectMemory objectAfter: oop]!

Item was changed:
  ----- Method: CoInterpreter>>ensureAllContextsWithMethodHaveBytecodePCs: (in category 'frame access') -----
  ensureAllContextsWithMethodHaveBytecodePCs: methodObj
  	"Map all native pcs to bytecoded pcs in all contexts on methodObj.
  	 Used to implement primitiveVoidVMStateForMethod."
  	| oop |
  	oop := objectMemory firstObject.
  	[oop < objectMemory freeStart] whileTrue:
  		[((objectMemory isFreeObject: oop) not
+ 		  and: [(objectMemory isContextNonImm: oop)
- 		  and: [(objectMemory isContextNonInt: oop)
  		  and: [(objectMemory fetchPointer: MethodIndex ofObject: oop) = methodObj]]) ifTrue:
  			[(self isMarriedOrWidowedContext: oop)
  				ifTrue:
  					[(self checkIsStillMarriedContext: oop currentFP: stackPage headFP) ifTrue:
  						[self assert: (self isMachineCodeFrame: (self frameOfMarriedContext: oop)) not]]
  				ifFalse:
  					[self ensureContextHasBytecodePC: oop]].
  		 oop := objectMemory objectAfter: oop]!

Item was changed:
  ----- Method: NewObjectMemory>>longPrintReferencesTo: (in category 'debug printing') -----
  longPrintReferencesTo: anOop
  	"Scan the heap long printing the oops of any and all objects that refer to anOop"
  	| oop i prntObj |
  	<api>
  	prntObj := false.
  	oop := self firstAccessibleObject.
  	[oop = nil] whileFalse:
  		[((self isPointersNonInt: oop) or: [self isCompiledMethod: oop]) ifTrue:
  			[(self isCompiledMethod: oop)
  				ifTrue:
  					[i := (self literalCountOf: oop) + LiteralStart]
  				ifFalse:
+ 					[(self isContextNonImm: oop)
- 					[(self isContextNonInt: oop)
  						ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: oop)]
  						ifFalse: [i := self lengthOf: oop]].
  			[(i := i - 1) >= 0] whileTrue:
  				[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
  					[self printHex: oop; print: ' @ '; printNum: i; cr.
  					 prntObj := true.
  					 i := 0]].
  			prntObj ifTrue:
  				[prntObj := false.
  				 coInterpreter longPrintOop: oop]].
  		 oop := self accessibleObjectAfter: oop]!

Item was changed:
  ----- Method: NewObjectMemory>>numReferencesTo: (in category 'debug printing') -----
  numReferencesTo: anOop
  	"Answer the number of objects that refer to anOop, other than anOop."
  	| oop i n |
  	oop := self firstAccessibleObject.
  	n := 0.
  	[oop = nil] whileFalse:
  		[((self isPointersNonInt: oop) or: [self isCompiledMethod: oop]) ifTrue:
  			[(self isCompiledMethod: oop)
  				ifTrue:
  					[i := (self literalCountOf: oop) + LiteralStart]
  				ifFalse:
+ 					[(self isContextNonImm: oop)
- 					[(self isContextNonInt: oop)
  						ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: oop)]
  						ifFalse: [i := self lengthOf: oop]].
  			[(i := i - 1) >= 0] whileTrue:
  				[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
  					[anOop ~= oop ifTrue:
  						[n := n + 1].
  					 i := 0]]].
  		 oop := self accessibleObjectAfter: oop].
  	^n!

Item was changed:
  ----- Method: NewObjectMemory>>printReferencesTo: (in category 'debug printing') -----
  printReferencesTo: anOop
  	"Scan the heap printing the oops of any and all objects that refer to anOop"
  	| oop i |
  	<api>
  	oop := self firstAccessibleObject.
  	[oop = nil] whileFalse:
  		[((self isPointersNonInt: oop) or: [self isCompiledMethod: oop]) ifTrue:
  			[(self isCompiledMethod: oop)
  				ifTrue:
  					[i := (self literalCountOf: oop) + LiteralStart]
  				ifFalse:
+ 					[(self isContextNonImm: oop)
- 					[(self isContextNonInt: oop)
  						ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: oop)]
  						ifFalse: [i := self lengthOf: oop]].
  			[(i := i - 1) >= 0] whileTrue:
  				[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
  					[self interpreter printHex: oop; print: ' @ '; printNum: i; space; printOopShort: oop; cr.
  					 i := 0]]].
  		 oop := self accessibleObjectAfter: oop]!

Item was changed:
  ----- Method: NewObjectMemory>>printWronglySizedContexts: (in category 'debug printing') -----
  printWronglySizedContexts: printContexts
  	"Scan the heap printing the oops of any and all contexts whose size is not either SmallContextSize or LargeContextSize"
  	| oop |
  	<api>
  	oop := self firstAccessibleObject.
  	[oop = nil] whileFalse:
+ 		[((self isContextNonImm: oop)
- 		[((self isContextNonInt: oop)
  		   and: [self badContextSize: oop]) ifTrue:
  			[self printHex: oop; space; printNum: (self byteLengthOf: oop); cr.
  			 printContexts ifTrue:
  				[coInterpreter printContext: oop]].
  		 oop := self accessibleObjectAfter: oop]!

Item was removed:
- ----- Method: ObjectMemory>>isContextNonInt: (in category 'contexts') -----
- isContextNonInt: oop
- 	<inline: true>
- 	^self isContextHeader: (self baseHeader: oop)!

Item was changed:
  ----- Method: ObjectMemory>>printReferencesTo: (in category 'debug printing') -----
  printReferencesTo: anOop
  	"Scan the heap printing the oops of any and all objects that refer to anOop"
  	| oop i |
  	<api>
  	oop := self firstAccessibleObject.
  	[oop = nil] whileFalse:
  		[((self isPointersNonInt: oop) or: [self isCompiledMethod: oop]) ifTrue:
  			[(self isCompiledMethod: oop)
  				ifTrue:
  					[i := (self literalCountOf: oop) + LiteralStart]
  				ifFalse:
+ 					[(self isContextNonImm: oop)
- 					[(self isContextNonInt: oop)
  						ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop)]
  						ifFalse: [i := self lengthOf: oop]].
  			[(i := i - 1) >= 0] whileTrue:
  				[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
  					[self interpreter printHex: oop; print: ' @ '; printNum: i; space; printOopShort: oop; cr.
  					 i := 0]]].
  		 oop := self accessibleObjectAfter: oop]!

Item was changed:
  ----- Method: ObjectMemory>>printWronglySizedContexts (in category 'debug printing') -----
  printWronglySizedContexts
  	"Scan the heap printing the oops of any and all contexts whose size is not either SmallContextSize or LargeContextSize"
  	| oop |
  	<api>
  	oop := self firstAccessibleObject.
  	[oop = nil] whileFalse:
+ 		[((self isContextNonImm: oop)
- 		[((self isContextNonInt: oop)
  		   and: [self badContextSize: oop]) ifTrue:
  			[self printHex: oop; space; printNum: (self byteLengthOf: oop); cr].
  		 oop := self accessibleObjectAfter: oop]!

Item was changed:
  ----- Method: StackInterpreter>>bereaveAllMarriedContexts (in category 'frame access') -----
  bereaveAllMarriedContexts
  	"Enumerate all contexts and convert married contexts to widowed contexts so
  	 that the snapshot contains only single contexts.  This allows the test for being
  	 married to avoid checking for a context's frame pointer being in bounds.
  	 Thanks to Greg Nuyens for this idea."
  	| oop |
  	<asmLabel: false>
  	oop := objectMemory firstObject.
  	[oop < objectMemory freeStart] whileTrue:
  		[((objectMemory isFreeObject: oop) not
+ 		   and: [(objectMemory isContextNonImm: oop)
- 		   and: [(objectMemory isContextNonInt: oop)
  		   and: [self isMarriedOrWidowedContext: oop]]) ifTrue:
  			[self markContextAsDead: oop].
  		 oop := objectMemory objectAfter: oop]!

Item was changed:
  ----- Method: StackInterpreter>>commonAt: (in category 'indexing primitive support') -----
  commonAt: stringy
  	"This code is called if the receiver responds primitively to at:.
  	 If this is so, it will be installed in the atCache so that subsequent calls of at:
  	 or next may be handled immediately in bytecode primitive routines."
  	| index rcvr atIx result |
  	self initPrimCall.
  	rcvr := self stackValue: 1.
  	(objectMemory isImmediate: rcvr) ifTrue:
  		[^self primitiveFailFor: PrimErrInappropriate].
  	index := self stackTop.
  	"No need to test for large positive integers here.  No object has 1g elements"
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	index := objectMemory integerValueOf: index.
  
  	"NOTE:  The at-cache, since it is specific to the non-super response to #at:.
  	Therefore we must determine that the message is #at: (not, eg, #basicAt:),
  	and that the send is not a super-send, before using the at-cache."
  	(messageSelector = (self specialSelector: 16)
  	 and: [lkupClass = (objectMemory fetchClassOfNonImm: rcvr)])
  		ifTrue:
  		["OK -- look in the at-cache"
  		atIx := rcvr bitAnd: AtCacheMask.  "Index into atCache = 4N, for N = 0 ... 7"
  		(atCache at: atIx+AtCacheOop) = rcvr ifFalse:
  			["Rcvr not in cache.  Attempt to install it..."
  			(self install: rcvr inAtCache: atCache at: atIx string: stringy) ifFalse:
+ 				[self assert: (objectMemory isContextNonImm: rcvr).
- 				[self assert: (objectMemory isContextNonInt: rcvr).
  				self initPrimCall.
  				^self primitiveContextAt]].
  		self successful ifTrue:
  			[result := self commonVariable: rcvr at: index cacheIndex: atIx].
  		self successful ifTrue:
  			[^ self pop: argumentCount+1 thenPush: result]].
  
  	"The slow but sure way..."
  	self initPrimCall.
  	result := self stObject: rcvr at: index.
  	self successful ifTrue:
  		[stringy ifTrue: [result := self characterForAscii: (objectMemory integerValueOf: result)].
  		^ self pop: argumentCount+1 thenPush: result]!

Item was changed:
  ----- Method: StackInterpreter>>commonAtPut: (in category 'indexing primitive support') -----
  commonAtPut: stringy
  	"This code is called if the receiver responds primitively to at:Put:.
  	If this is so, it will be installed in the atPutCache so that subsequent calls of at:
  	or  next may be handled immediately in bytecode primitive routines."
  	| value index rcvr atIx |
  	value := self stackTop.
  	self initPrimCall.
  	rcvr := self stackValue: 2.
  	(objectMemory isNonImmediate: rcvr) ifFalse:
  		[^self primitiveFailFor: PrimErrInappropriate].
  	index := self stackValue: 1.
  	"No need to test for large positive integers here.  No object has 1g elements"
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	index := objectMemory integerValueOf: index.
  
  	"NOTE:  The atPut-cache, since it is specific to the non-super response to #at:Put:.
  	Therefore we must determine that the message is #at:Put: (not, eg, #basicAt:Put:),
  	and that the send is not a super-send, before using the at-cache."
  	(messageSelector = (self specialSelector: 17)
  		and: [lkupClass = (objectMemory fetchClassOfNonImm: rcvr)])
  		ifTrue:
  		["OK -- look in the at-cache"
  		atIx := (rcvr bitAnd: AtCacheMask) + AtPutBase.  "Index into atPutCache"
  		(atCache at: atIx+AtCacheOop) = rcvr ifFalse:
  			["Rcvr not in cache.  Attempt to install it..."
  			(self install: rcvr inAtCache: atCache at: atIx string: stringy) ifFalse:
+ 				[self assert: (objectMemory isContextNonImm: rcvr).
- 				[self assert: (objectMemory isContextNonInt: rcvr).
  				self initPrimCall.
  				^self primitiveContextAtPut]].
  		self successful ifTrue:
  			[self commonVariable: rcvr at: index put: value cacheIndex: atIx].
  		self successful ifTrue:
  			[^ self pop: argumentCount+1 thenPush: value]].
  
  	"The slow but sure way..."
  	self initPrimCall.
  	stringy
  		ifTrue: [self stObject: rcvr at: index put: (self asciiOfCharacter: value)]
  		ifFalse: [self stObject: rcvr at: index put: value].
  	self successful ifTrue:
  		[^ self pop: argumentCount+1 thenPush: value]!

Item was changed:
  ----- Method: StackInterpreter>>commonVariable:at:cacheIndex: (in category 'indexing primitive support') -----
  commonVariable: rcvr at: index cacheIndex: atIx 
  	"This code assumes the receiver has been identified at location atIx in the atCache."
  	| stSize fmt fixedFields result |
  	<inline: true>
  	stSize := atCache at: atIx+AtCacheSize.
  	((self oop: index isGreaterThanOrEqualTo: 1)
  	 and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue:
  		[fmt := atCache at: atIx+AtCacheFmt.
  		 fmt <= objectMemory weakArrayFormat ifTrue:
+ 			[self assert: (objectMemory isContextNonImm: rcvr) not.
- 			[self assert: (objectMemory isContextNonInt: rcvr) not.
  			 fixedFields := atCache at: atIx+AtCacheFixedFields.
  			 ^objectMemory fetchPointer: index + fixedFields - 1 ofObject: rcvr].
  		 fmt < objectMemory firstByteFormat ifTrue:  "Bitmap"
  			[result := objectMemory fetchLong32: index - 1 ofObject: rcvr.
  			 ^self positive32BitIntegerFor: result].
  		 fmt >= objectMemory firstStringyFakeFormat  "Note fmt >= firstStringyFormat is an artificial flag for strings"
  			ifTrue: "String"
  				[^self characterForAscii: (objectMemory fetchByte: index - 1 ofObject: rcvr)]
  			ifFalse:
  				[(fmt < objectMemory firstCompiledMethodFormat "ByteArray"
  				  or: [index >= (self firstByteIndexOfMethod: rcvr) "CompiledMethod"]) ifTrue:
  					[^objectMemory integerObjectOf: (objectMemory fetchByte: index - 1 ofObject: rcvr)]]].
  
  	^self primitiveFailFor: ((objectMemory isIndexable: rcvr)
  								ifFalse: [PrimErrBadReceiver]
  								ifTrue: [PrimErrBadIndex])!

Item was changed:
  ----- Method: StackInterpreter>>commonVariable:at:put:cacheIndex: (in category 'indexing primitive support') -----
  commonVariable: rcvr at: index put: value cacheIndex: atIx
  	"This code assumes the receiver has been identified at location atIx in the atCache."
  	| stSize fmt fixedFields valToPut isCharacter |
  	<inline: true>
  	stSize := atCache at: atIx+AtCacheSize.
  	((self oop: index isGreaterThanOrEqualTo: 1)
  	  and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue:
  		[fmt := atCache at: atIx+AtCacheFmt.
  		fmt <= objectMemory weakArrayFormat ifTrue:
+ 			[self assert: (objectMemory isContextNonImm: rcvr) not.
- 			[self assert: (objectMemory isContextNonInt: rcvr) not.
  			 fixedFields := atCache at: atIx+AtCacheFixedFields.
  			 ^objectMemory storePointer: index + fixedFields - 1 ofObject: rcvr withValue: value].
  		fmt < objectMemory firstByteFormat ifTrue:  "Bitmap"
  			[valToPut := self positive32BitValueOf: value.
  			 self successful ifTrue:
  				[objectMemory storeLong32: index - 1 ofObject: rcvr withValue: valToPut.
  				^nil].
  			 ^self primitiveFailFor: PrimErrBadArgument].
  		fmt >= objectMemory firstStringyFakeFormat  "Note fmt >= firstStringyFormat is an artificial flag for strings"
  			ifTrue: [isCharacter := objectMemory isCharacterObject: value.
  					isCharacter ifFalse:
  						[^self primitiveFailFor: PrimErrBadArgument].
  					valToPut := objectMemory fetchPointer: CharacterValueIndex ofObject: value]
  			ifFalse:
  				[(fmt >= objectMemory firstCompiledMethodFormat and: [index < (self firstByteIndexOfMethod: rcvr)]) ifTrue: "CompiledMethod"
  					[^self primitiveFailFor: PrimErrBadIndex].
  				valToPut := value].
  		(objectMemory isIntegerObject: valToPut) ifTrue:
  			[valToPut := objectMemory integerValueOf: valToPut.
  			((valToPut >= 0) and: [valToPut <= 255]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument].
  			^objectMemory storeByte: index - 1 ofObject: rcvr withValue: valToPut]].
  
  	^self primitiveFailFor: ((objectMemory isIndexable: rcvr)
  								ifFalse: [PrimErrBadReceiver]
  								ifTrue: [PrimErrBadIndex])!

Item was changed:
  ----- Method: StackInterpreter>>pushMaybeContextReceiverVariable: (in category 'stack bytecodes') -----
  pushMaybeContextReceiverVariable: fieldIndex
  	"Must trap accesses to married and widowed contexts.
  	 But don't want to check on all inst var accesses.  This
  	 method is only used by the long-form bytecodes, evading
  	 the cost. Note that the method, closure and receiver fields
  	 of married contexts are correctly initialized so they don't
  	 need special treatment on read.  Only sender, instruction
  	 pointer and stack pointer need to be intercepted on reads."
  	| rcvr |
  	<inline: true>
  	rcvr := self receiver.
  	((self isReadMediatedContextInstVarIndex: fieldIndex)
+ 	and: [objectMemory isContextNonImm: rcvr])
- 	and: [objectMemory isContextNonInt: rcvr])
  		ifTrue:
  			[self internalPush: (self instVar: fieldIndex ofContext: rcvr)]
  		ifFalse:
  			[self internalPush: (objectMemory fetchPointer: fieldIndex ofObject: rcvr)]!

Item was changed:
  ----- Method: StackInterpreter>>storeMaybeContextReceiverVariable:withValue: (in category 'stack bytecodes') -----
  storeMaybeContextReceiverVariable: fieldIndex withValue: anObject
  	"Must trap accesses to married and widowed contexts.
  	 But don't want to check on all inst var accesses.  This
  	 method is only used by the long-form bytecodes, evading the cost."
  	| rcvr |
  	rcvr := self receiver.
  	((self isWriteMediatedContextInstVarIndex: fieldIndex)
+ 	and: [(objectMemory isContextNonImm: rcvr)
- 	and: [(objectMemory isContextNonInt: rcvr)
  	and: [self isMarriedOrWidowedContext: rcvr]])
  		ifTrue:
  			[self instVar: fieldIndex ofContext: rcvr put: anObject]
  		ifFalse:
  			[objectMemory storePointer: fieldIndex ofObject: rcvr withValue: anObject]
  !

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)."
  
  	| rcvr newCopy |
  	rcvr := self stackTop.
  	(objectMemory isIntegerObject: rcvr)
  		ifTrue:
  			[newCopy := rcvr]
  		ifFalse:
+ 			[(objectMemory isContextNonImm: rcvr)
- 			[(objectMemory isContextNonInt: rcvr)
  				ifTrue:
  					[newCopy := self cloneContext: rcvr]
  				ifFalse:
  					[newCopy := objectMemory clone: rcvr].
  			newCopy = 0 ifTrue:
  				[^self primitiveFailFor: PrimErrNoMemory]].
  	self pop: 1 thenPush: newCopy!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveCopyObject (in category 'object access primitives') -----
  primitiveCopyObject
  	"Primitive. Copy the state of the receiver from the argument. 
  		Fail if receiver and argument are of a different class.
  		Fail if the receiver or argument are non-pointer objects.
  		Fail if the receiver or argument are contexts (because of context-to-stack mapping).
  		Fail if receiver and argument have different lengths (for indexable objects).
  	"
  	| rcvr arg length |
  	self methodArgumentCount = 1 ifFalse:
  		[^self primitiveFail].
  	arg := self stackObjectValue: 0.
  	rcvr := self stackObjectValue: 1.
  
  	self failed ifTrue:[^nil].
  	(objectMemory isPointers: rcvr) ifFalse:
  		[^self primitiveFail].
+ 	((objectMemory isContextNonImm: rcvr)
+ 	 or: [objectMemory isContextNonImm: arg]) ifTrue:
- 	((objectMemory isContextNonInt: rcvr)
- 	 or: [objectMemory isContextNonInt: arg]) ifTrue:
  		[^self primitiveFail].
  	(objectMemory fetchClassOfNonImm: rcvr) = (objectMemory fetchClassOfNonImm: arg) ifFalse:
  		[^self primitiveFail].
  	length := objectMemory lengthOf: rcvr.
  	length = (objectMemory lengthOf: arg) ifFalse:
  		[^self primitiveFail].
  	
  	"Now copy the elements"
  	0 to: length-1 do:
  		[:i|
  		objectMemory storePointer: i ofObject: rcvr withValue: (objectMemory fetchPointer: i ofObject: arg)].
  
  	"Note: The above could be faster for young receivers but I don't think it'll matter"
  	self pop: 1 "pop arg; answer receiver"
  !



More information about the Vm-dev mailing list