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

commits at source.squeak.org commits at source.squeak.org
Thu Oct 3 00:33:53 UTC 2013


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

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

Name: VMMaker.oscog-eem.427
Author: eem
Time: 2 October 2013, 5:31:09.792 pm
UUID: 15aece3d-713b-4408-938b-597a7d88854e
Ancestors: VMMaker.oscog-eem.426

I am a bozo!  lookupMethodNoMNUEtcInClass: adds to cache anyway!
Revert the relevant ceSend: methods.

Add more CogObjectRepresentationForSpur.  Change genPrimitiveIdentityHash
so that memory managers (such as Spur) can use 0 as an
uninitialized identityHash and call the interpreter prim if uninitialized.

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

Item was changed:
  ----- Method: CoInterpreter>>ceCounterTripped: (in category 'cog jit support') -----
  ceCounterTripped: condition
  	<api>
  	<option: #SistaStackToRegisterMappingCogit>
  	"Send e.g. thisContext conditionalBranchCounterTrippedOn: boolean."
  	| context counterTrippedSelector classTag |
  	counterTrippedSelector := objectMemory maybeSplObj: SelectorCounterTripped.
  	(counterTrippedSelector isNil
  	or: [counterTrippedSelector = objectMemory nilObject]) ifTrue:
  		[cogit resetCountersIn: (self mframeHomeMethod: framePointer).
  		 ^condition].
  	
  	classTag := objectMemory
  					classTagForSpecialObjectsIndex: ClassMethodContext
  					compactClassIndex: ClassMethodContextCompactIndex.
  	(self lookupInMethodCacheSel: counterTrippedSelector classTag: classTag) ifFalse:
  	 	[messageSelector := counterTrippedSelector.
  		 (self lookupMethodNoMNUEtcInClass: (objectMemory classTagForClass: classTag)) ~= 0 ifTrue:
  			[cogit resetCountersIn: (self mframeHomeMethod: framePointer).
+ 			 ^condition]].
- 			 ^condition].
- 		 self addNewMethodToCache: (objectMemory classForClassTag: classTag)].
  
  	(primitiveFunctionPointer ~= 0
  	or: [(self argumentCountOf: newMethod) ~= 1]) ifTrue:
  		[cogit resetCountersIn: (self mframeHomeMethod: framePointer).
  		 ^condition].
  
  	instructionPointer := self popStack.
  	context := self ensureFrameIsMarried: framePointer SP: stackPointer.
  	self push: context.
  	self push: condition.
  	self ifAppropriateCompileToNativeCode: newMethod selector: counterTrippedSelector.
  	self activateNewMethod.
  	"not reached"
  	^true!

Item was changed:
  ----- Method: CoInterpreter>>ceDynamicSuperSend:to:numArgs: (in category 'trampolines') -----
  ceDynamicSuperSend: selector to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked dynamic super send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
  	<option: #NewspeakVM>
  	| class classTag canLinkCacheTag errSelIdx cogMethod mClassMixin mixinApplication |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: (objectMemory addressCouldBeOop: rcvr).
  	self sendBreakpoint: selector receiver: rcvr.
  	mClassMixin := self mMethodClass.
  	mixinApplication := self 
  							findApplicationOfTargetMixin: mClassMixin
  							startingAtBehavior: (objectMemory fetchClassOf: rcvr).
  	self assert: (objectMemory lengthOf: mixinApplication) > (InstanceSpecificationIndex + 1).
  	classTag := self classTagForClass: (self superclassOf: mixinApplication).
  	class := objectMemory fetchClassOf: rcvr. "what about the read barrier??"
  	canLinkCacheTag := (objectMemory isYoungObject: class) not or: [cogit canLinkToYoungClasses].
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[messageSelector := selector.
  			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
+ 				self assert: false "NOTREACHED"]].
- 				self assert: false "NOTREACHED"].
- 			 self addNewMethodToCache: (objectMemory classForClassTag: classTag)].
  	"Method found and has a cog method.  Attempt to link to it."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
  		 cogMethod selector = objectMemory nilObject
  			ifTrue: [cogit setSelectorOf: cogMethod to: selector]
  			ifFalse:
  				["Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the correct
  				  selector.  If not, try and compile a new method with the correct selector."
  				 cogMethod selector ~= selector ifTrue:
  					[(cogit cog: newMethod selector: selector) ifNotNil:
  						[:newCogMethod| cogMethod := newCogMethod]]].
  		 (cogMethod selector = selector
  		 and: [canLinkCacheTag]) ifTrue:
  			[cogit
  				linkSendAt: (stackPages longAt: stackPointer)
  				in: (self mframeHomeMethod: framePointer)
  				to: cogMethod
  				offset: cogit dynSuperEntryOffset
  				receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
  		 self assert: false "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceSend:super:to:numArgs: (in category 'trampolines') -----
  ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
  	| classTag canLinkCacheTag errSelIdx cogMethod |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: (objectMemory addressCouldBeOop: rcvr).
  	self sendBreakpoint: selector receiver: rcvr.
  	superNormalBar = 0
  		ifTrue: [classTag := objectMemory fetchClassTagOf: rcvr]
  		ifFalse: [classTag := objectMemory classTagForClass: (self superclassOf: (self methodClassOf: (self frameMethodObject: framePointer)))].
  	canLinkCacheTag := objectMemory hasSpurMemoryManagerAPI
  						or: [(objectMemory isYoungObject: classTag) not or: [cogit canLinkToYoungClasses]].
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[messageSelector := selector.
  			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  				[(canLinkCacheTag
  				  and: [errSelIdx = SelectorDoesNotUnderstand
  				  and: [(cogMethod := cogit cogMNUPICSelector: messageSelector
  											methodOperand: (self mnuMethodOrNilFor: rcvr)
  											numArgs: argumentCount) asUnsignedInteger
  						> cogit minCogMethodAddress]]) ifTrue:
  						[cogit
  							linkSendAt: (stackPages longAt: stackPointer)
  							in: (self mframeHomeMethod: framePointer)
  							to: cogMethod
  							offset: (superNormalBar = 0
  									ifTrue: [cogit entryOffset]
  									ifFalse: [cogit noCheckEntryOffset])
  							receiver: rcvr].
  				self handleMNU: errSelIdx
  					InMachineCodeTo: rcvr
  					classForMessage: (objectMemory classForClassTag: classTag).
+ 				self assert: false "NOTREACHED"]].
- 				self assert: false "NOTREACHED"].
- 			self addNewMethodToCache: (objectMemory classForClassTag: classTag)].
  	"Method found and has a cog method.  Attempt to link to it.  The receiver's class may be young.
  	 If the Cogit can't store young classes in inline caches we can link to an open PIC instead."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
  		 cogMethod selector = objectMemory nilObject
  			ifTrue: [cogit setSelectorOf: cogMethod to: selector]
  			ifFalse:
  				["Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the
  				  correct selector.  If not, try and compile a new method with the correct selector."
  				 cogMethod selector ~= selector ifTrue:
  					[(cogit cog: newMethod selector: selector) ifNotNil:
  						[:newCogMethod| cogMethod := newCogMethod]]].
  		 (cogMethod selector = selector
  		  and: [canLinkCacheTag])
  			ifTrue:
  				[cogit
  					linkSendAt: (stackPages longAt: stackPointer)
  					in: (self mframeHomeMethod: framePointer)
  					to: cogMethod
  					offset: (superNormalBar = 0
  								ifTrue: [cogit entryOffset]
  								ifFalse: [cogit noCheckEntryOffset])
  					receiver: rcvr]
  			ifFalse: "If patchToOpenPICFor:.. returns we're out of code memory"
  				[cogit
  					patchToOpenPICFor: selector
  					numArgs: numArgs
  					receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
  		 self assert: false "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceSendAbort:to:numArgs: (in category 'trampolines') -----
  ceSendAbort: selector to: rcvr numArgs: numArgs
  	"Entry-point for an abort send in a CogMethod (aboutToReturn:through:, cannotReturn: et al).
  	 Try and dispatch the send, but the send may turn into an MNU in which case defer to
  	 handleMNUInMachineCodeTo:... which will dispatch the MNU.
  
  	 Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	 depending on whether the target method is cogged or not."
  	<api>
  	| classTag errSelIdx |
  	<inline: false>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: (objectMemory addressCouldBeOop: rcvr).
  	self sendBreakpoint: selector receiver: rcvr.
  	argumentCount := numArgs.
  	classTag := objectMemory fetchClassTagOf: rcvr.
  	(self lookupInMethodCacheSel: selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[messageSelector := selector.
  			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
  				"NOTREACHED"
+ 				self assert: false]].
- 				self assert: false].
- 			 self addNewMethodToCache: (objectMemory classForClassTag: classTag)].
  	instructionPointer := self popStack.
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[self executeNewMethod.
  		 self assert: false
  		 "NOTREACHED"].
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceSendFromInLineCacheMiss: (in category 'trampolines') -----
  ceSendFromInLineCacheMiss: oPIC
  	"Send from an Open PIC when the first-level method lookup probe has failed,
  	 or to continue when PIC creation has failed (e.g. because we're out of code space)."
  	<api>
  	<var: #oPIC type: #'CogMethod *'>
  	| numArgs rcvr classTag errSelIdx |
  	"self printFrame: stackPage headFP WithSP: stackPage headSP"
  	"self printStringOf: selector"
  	numArgs := oPIC cmNumArgs.
  	rcvr := self stackValue: numArgs + 1. "skip return pc"
  	self assert: (objectMemory addressCouldBeOop: rcvr).
  	classTag := objectMemory fetchClassTagOf: rcvr.
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: oPIC selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: oPIC selector]
  		ifFalse:
  			[messageSelector := oPIC selector.
  			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
  				"NOTREACHED"
+ 				self assert: false]].
- 				self assert: false].
- 			 self addNewMethodToCache: (objectMemory classForClassTag: classTag)].
  	instructionPointer := self popStack.
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[self executeNewMethod.
  		 self assert: false
  		 "NOTREACHED"].
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was added:
+ ----- Method: CogObjectRepresentation>>isHashSetOnInstanceCreation (in category 'testing') -----
+ isHashSetOnInstanceCreation
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: CogObjectRepresentation>>isSmallIntegerTagNonZero (in category 'testing') -----
+ isSmallIntegerTagNonZero
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genGetHashFieldNonImmOf:asSmallIntegerInto: (in category 'compile abstract instructions') -----
+ genGetHashFieldNonImmOf: instReg asSmallIntegerInto: destReg
+ 	"Fetch the instance's identity hash into destReg, encoded as a SmallInteger."
+ 	"Get header word in scratchReg"
+ 	cogit MoveMw: 4 r: instReg R: destReg.
+ 	"Shift and mask the field leaving room for the SmallInteger tag."
+ 	cogit AndCq: objectMemory identityHashHalfWordMask R: destReg.
+ 	self genConvertIntegerToSmallIntegerInScratchReg: destReg.
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>isHashSetOnInstanceCreation (in category 'testing') -----
+ isHashSetOnInstanceCreation
+ 	^false!

Item was changed:
+ ----- Method: CogObjectRepresentationForSqueakV3>>compactClassFieldMask (in category 'object representation') -----
- ----- Method: CogObjectRepresentationForSqueakV3>>compactClassFieldMask (in category 'compile abstract instructions') -----
  compactClassFieldMask
  	"This is the mask for the field when shifted into the least significant bits"
  	<inline: true>
  	^(1 << objectMemory compactClassFieldWidth) - 1!

Item was added:
+ ----- Method: CogObjectRepresentationForSqueakV3>>genGetHashFieldNonImmOf:asSmallIntegerInto: (in category 'compile abstract instructions') -----
+ genGetHashFieldNonImmOf: instReg asSmallIntegerInto: destReg
+ 	"Fetch the instance's identity hash into destReg, encoded as a SmallInteger."
+ 	"Get header word in scratchReg"
+ 	cogit MoveMw: 0 r: instReg R: destReg.
+ 	"Shift and mask the field leaving room for the SmallInteger tag."
+ 	cogit LogicalShiftRightCq: HashBitsOffset - 1 R: destReg.
+ 	cogit AndCq: HashMaskUnshifted << 1 R: destReg.
+ 	"Set the SmallInteger tag."
+ 	cogit AddCq: 1 R: destReg.
+ 	^0!

Item was removed:
- ----- Method: CogObjectRepresentationForSqueakV3>>genGetHashFieldNonIntOf:asSmallIntegerInto: (in category 'compile abstract instructions') -----
- genGetHashFieldNonIntOf: instReg asSmallIntegerInto: destReg
- 	"Fetch the instance's identity hash into destReg, encoded as a SmallInteger."
- 	"Get header word in scratchReg"
- 	cogit MoveMw: 0 r: instReg R: destReg.
- 	"Shift and mask the field leaving room for the SmallInteger tag."
- 	cogit LogicalShiftRightCq: HashBitsOffset - 1 R: destReg.
- 	cogit AndCq: HashMaskUnshifted << 1 R: destReg.
- 	"Set the SmallInteger tag."
- 	cogit AddCq: 1 R: destReg.
- 	^0!

Item was changed:
+ ----- Method: CogObjectRepresentationForSqueakV3>>instFormatFieldMask (in category 'object representation') -----
- ----- Method: CogObjectRepresentationForSqueakV3>>instFormatFieldMask (in category 'compile abstract instructions') -----
  instFormatFieldMask
  	"This is the mask for the field when shifted into the least significant bits"
  	<inline: true>
  	^(1 << objectMemory instFormatFieldWidth) - 1!

Item was added:
+ ----- Method: CogObjectRepresentationForSqueakV3>>isHashSetOnInstanceCreation (in category 'testing') -----
+ isHashSetOnInstanceCreation
+ 	^true!

Item was changed:
+ ----- Method: CogObjectRepresentationForSqueakV3>>numSmallIntegerBits (in category 'object representation') -----
- ----- Method: CogObjectRepresentationForSqueakV3>>numSmallIntegerBits (in category 'compile abstract instructions') -----
  numSmallIntegerBits
  	^31!

Item was changed:
+ ----- Method: CogObjectRepresentationForSqueakV3>>numSmallIntegerTagBits (in category 'object representation') -----
- ----- Method: CogObjectRepresentationForSqueakV3>>numSmallIntegerTagBits (in category 'compile abstract instructions') -----
  numSmallIntegerTagBits
  	^1!

Item was changed:
  ----- Method: CogVMSimulator>>ceSend:super:to:numArgs: (in category 'trampolines') -----
  ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs
  	"self stringOf: selector"
  	"self printOop: rcvr"
+ 	(superNormalBar ~= 0 and: [(self stringOf: selector) = #bitShift:]) ifTrue:
+ 		[self halt].
  	self logSend: selector.
  	cogit assertCStackWellAligned.
  	self maybeCheckStackDepth: numArgs + 1 sp: stackPointer pc: (stackPages longAt: stackPointer).
  	^super ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveIdentityHash (in category 'primitive generators') -----
  genPrimitiveIdentityHash
  	| jumpSI |
  	<var: #jumpSI type: #'AbstractInstruction *'>
  	self MoveR: ReceiverResultReg R: ClassReg.
  	jumpSI := objectRepresentation genJumpSmallIntegerInScratchReg: ClassReg.
+ 	objectRepresentation genGetHashFieldNonImmOf: ReceiverResultReg asSmallIntegerInto: TempReg.
- 	objectRepresentation genGetHashFieldNonIntOf: ReceiverResultReg asSmallIntegerInto: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
  	self flag: 'currently caller pushes result'.
  	self RetN: BytesPerWord.
  	jumpSI jmpTarget: self Label.
  	^0!

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

Item was changed:
  ----- Method: SpurMemoryManager>>classTagForClass: (in category 'interpreter access') -----
  classTagForClass: classObj
  	"Answer the classObj's identityHash to use as a tag in the first-level method lookup cache."
+ 	self assert: (coInterpreter addressCouldBeClassObj: classObj).
+ 	^self ensureBehaviorHash: classObj!
- 	self assert: (self rawHashBitsOf: classObj) ~= 0.
- 	^self rawHashBitsOf: classObj!

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."
  	| sel |
  	sel := thisContext sender method selector.
  	(#(	DoIt
  		DoItIn:
  		on:do: "from the debugger"
  		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:
  		primitiveMakePoint
  		primitiveAsCharacter
  		primitiveInputSemaphore
  		baseFrameReturn
  		primitiveExternalCall
  		primDigitCompare:
  		isLiveContext:
  		numPointerSlotsOf:
  		fileValueOf:
  		loadBitBltDestForm
  		fetchIntOrFloat:ofObject:ifNil:
  		fetchIntOrFloat:ofObject:
  		loadBitBltSourceForm
  		loadPoint:from:
  		primDigitAdd:
  		primDigitSubtract:
  		positive64BitValueOf:
  		digitBitLogic:with:opIndex:
  		signed32BitValueOf:
  		isNormalized:
  		primDigitDiv:negative:
  		bytesOrInt:growTo:
  		primitiveNewMethod
  		isCogMethodReference:
  		functionForPrimitiveExternalCall:
  		genSpecialSelectorArithmetic
  		genSpecialSelectorComparison
  		ensureContextHasBytecodePC:
  		instVar:ofContext:
  		ceBaseFrameReturn:
  		inlineCacheTagForInstance:
  		primitiveObjectAtPut
+ 		commonVariable:at:put:cacheIndex:
+ 		primDigitBitShiftMagnitude:) includes: sel) ifFalse:
- 		commonVariable:at:put:cacheIndex:) includes: sel) ifFalse:
  		[self halt].
  	^(oop bitAnd: 1) ~= 0!

Item was changed:
  ----- Method: StackInterpreter>>sendInvokeCallback:Stack:Registers:Jmpbuf: (in category 'callback support') -----
  sendInvokeCallback: thunkPtr Stack: stackPtr Registers: regsPtr Jmpbuf: jmpBufPtr
  	"Send the 4 argument callback message invokeCallback:stack:registers:jmpbuf:
  	 to Alien class with the supplied args.  The arguments are raw C addresses
  	 and are converted to integer objects on the way."
  	<export: true>
  	| classTag |
  	classTag := self fetchClassTagOfNonImm: (self splObj: ClassAlien).
  	messageSelector := self splObj: SelectorInvokeCallback.
  	argumentCount := 4.
  	(self lookupInMethodCacheSel: messageSelector classTag: classTag) ifFalse:
  	 	[(self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
+ 			[^false]].
- 			[^false].
- 		 self addNewMethodToCache: (objectMemory classForClassTag: classTag)].
  	((self argumentCountOf: newMethod) = 4
  	and: [primitiveFunctionPointer = 0]) ifFalse:
  		[^false].
  	self push: (self splObj: ClassAlien). "receiver"
  	self push: (self positive32BitIntegerFor: thunkPtr).
  	self push: (self positive32BitIntegerFor: stackPtr).
  	self push: (self positive32BitIntegerFor: regsPtr).
  	self push: (self positive32BitIntegerFor: jmpBufPtr).
  	self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector.
  	self justActivateNewMethod.
  	(self isMachineCodeFrame: framePointer) ifFalse:
  		[self maybeFlagMethodAsInterpreted: newMethod].
  	self externalWriteBackHeadFramePointers.
  	self handleStackOverflow.
  	self enterSmalltalkExecutiveFromCallback.
  	"not reached"
  	^true!

Item was changed:
  ----- Method: StackInterpreter>>sendInvokeCallbackContext: (in category 'callback support') -----
  sendInvokeCallbackContext: vmCallbackContext
  	"Send the calllback message to Alien class with the supplied arg(s).  Use either the
  	 1 arg invokeCallbackContext: or the 4 arg invokeCallback:stack:registers:jmpbuf:
  	 message, depending on what selector is installed in the specialObjectsArray.
  	 Note that if invoking the legacy invokeCallback:stack:registers:jmpbuf: we pass the
  	 vmCallbackContext as the jmpbuf argument (see reestablishContextPriorToCallback:).
  	 The arguments are raw C addresses and are converted to integer objects on the way."
  	<export: true>
  	<var: #vmCallbackContext type: #'VMCallbackContext *'>
  	| classTag |
  	classTag := self fetchClassTagOfNonImm: (self splObj: ClassAlien).
  	messageSelector := self splObj: SelectorInvokeCallback.
  	(self lookupInMethodCacheSel: messageSelector classTag: classTag) ifFalse:
  	 	[(self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
+ 			[^false]].
- 			[^false].
- 		 self addNewMethodToCache: (objectMemory classForClassTag: classTag)].
  	primitiveFunctionPointer ~= 0 ifTrue:
  		[^false].
  	self saveCStackStateForCallbackContext: vmCallbackContext.
  	self push: (self splObj: ClassAlien). "receiver"
  	self cppIf: BytesPerWord = 8
  		ifTrue:
  			[(self argumentCountOf: newMethod) = 4 ifTrue:
  				[self push: (self positive64BitIntegerFor: vmCallbackContext thunkp asUnsignedInteger).
  				 self push: (self positive64BitIntegerFor: vmCallbackContext stackp asUnsignedInteger).
  				 self push: (self positive64BitIntegerFor: vmCallbackContext intregargsp asUnsignedInteger)].
  			 self push: (self positive64BitIntegerFor: vmCallbackContext asUnsignedInteger)]
  		ifFalse:
  			[(self argumentCountOf: newMethod) = 4 ifTrue:
  				[self push: (self positive32BitIntegerFor: vmCallbackContext thunkp asUnsignedInteger).
  				 self push: (self positive32BitIntegerFor: vmCallbackContext stackp asUnsignedInteger).
  				 self push: (self positive32BitIntegerFor: vmCallbackContext intregargsp asUnsignedInteger)].
  			 self push: (self positive32BitIntegerFor: vmCallbackContext asUnsignedInteger)].
  	self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector.
  	self justActivateNewMethod.
  	(self isMachineCodeFrame: framePointer) ifFalse:
  		[self maybeFlagMethodAsInterpreted: newMethod].
  	self externalWriteBackHeadFramePointers.
  	self handleStackOverflow.
  	self enterSmalltalkExecutiveFromCallback.
  	"not reached"
  	^true!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveIdentityHash (in category 'primitive generators') -----
  genPrimitiveIdentityHash
+ 	| jumpSI jumpNotSet |
- 	| jumpSI |
  	<var: #jumpSI type: #'AbstractInstruction *'>
  	self MoveR: ReceiverResultReg R: ClassReg.
  	jumpSI := objectRepresentation genJumpSmallIntegerInScratchReg: ClassReg.
+ 	objectRepresentation genGetHashFieldNonImmOf: ReceiverResultReg asSmallIntegerInto: TempReg.
+ 	objectRepresentation isHashSetOnInstanceCreation ifFalse:
+ 		[self CmpCq: 0 R: TempReg.
+ 		 jumpNotSet := self JumpZero: 0].
- 	objectRepresentation genGetHashFieldNonIntOf: ReceiverResultReg asSmallIntegerInto: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpSI jmpTarget: self Label.
+ 	objectRepresentation isHashSetOnInstanceCreation ifFalse:
+ 		[jumpNotSet jmpTarget: jumpSI getJmpTarget].
  	^0!



More information about the Vm-dev mailing list