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

commits at source.squeak.org commits at source.squeak.org
Wed Oct 2 22:59:19 UTC 2013


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

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

Name: VMMaker.oscog-eem.426
Author: eem
Time: 2 October 2013, 3:55:44.433 pm
UUID: 1be04936-02a2-40ae-8c57-bab042496204
Ancestors: VMMaker.oscog-eem.425

Several of the ceSend: lookup and bind routines should add
successful lookups to the 1st-level methodCache.

Implement CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveAt:.

Add a couple fo accessors to CogVMSimulator for bootstrap and/or
debugging.

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

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].
+ 		 self addNewMethodToCache: (objectMemory classForClassTag: classTag)].
- 			 ^condition]].
  
  	(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 addNewMethodToCache: (objectMemory classForClassTag: classTag)].
- 				self assert: false "NOTREACHED"]].
  	"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 addNewMethodToCache: (objectMemory classForClassTag: classTag)].
- 				self assert: false "NOTREACHED"]].
  	"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 addNewMethodToCache: (objectMemory classForClassTag: classTag)].
- 				self assert: false]].
  	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 addNewMethodToCache: (objectMemory classForClassTag: classTag)].
- 				self assert: false]].
  	instructionPointer := self popStack.
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[self executeNewMethod.
  		 self assert: false
  		 "NOTREACHED"].
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genAddSmallIntegerTagsTo: (in category 'compile abstract instructions') -----
+ genAddSmallIntegerTagsTo: aRegister
+ 	cogit AddCq: 1 R: aRegister.
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveAt: (in category 'primitive generators') -----
+ genInnerPrimitiveAt: retNoffset
+ 	"Implement the guts of primitiveAt; dispatch on size"
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	| formatReg jumpNotIndexable jumpSmallSize jumpImmediate jumpBadIndex
+ 	  jumpBytesDone jumpShortsDone jumpWordsDone jumpFixedFieldsDone
+ 	  jumpIsBytes jumpIsShorts jumpIsWords jumpWordTooBig jumpIsArray jumpHasFixedFields jumpIsContext
+ 	  jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds |
+ 	<inline: true>
+ 	"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
+ 	<var: #jumpIsBytes type: #'AbstractInstruction *'>
+ 	<var: #jumpIsShorts type: #'AbstractInstruction *'>
+ 	<var: #jumpBadIndex type: #'AbstractInstruction *'>
+ 	<var: #jumpSmallSize type: #'AbstractInstruction *'>
+ 	<var: #jumpIsContext type: #'AbstractInstruction *'>
+ 	<var: #jumpImmediate type: #'AbstractInstruction *'>
+ 	<var: #jumpBytesDone type: #'AbstractInstruction *'>
+ 	<var: #jumpShortsDone type: #'AbstractInstruction *'>
+ 	<var: #jumpWordsDone type: #'AbstractInstruction *'>
+ 	<var: #jumpWordTooBig type: #'AbstractInstruction *'>
+ 	<var: #jumpNotIndexable type: #'AbstractInstruction *'>
+ 	<var: #jumpHasFixedFields type: #'AbstractInstruction *'>
+ 	<var: #jumpFixedFieldsDone type: #'AbstractInstruction *'>
+ 	<var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
+ 	<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
+ 	<var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
+ 	<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
+ 	<var: #jumpFixedFieldsOutOfBounds type: #'AbstractInstruction *'>
+ 
+ 	cogit MoveR: ReceiverResultReg R: TempReg.
+ 	jumpImmediate := self genJumpImmediateInScratchReg: TempReg.
+ 	cogit MoveR: Arg0Reg R: TempReg.
+ 	jumpBadIndex := self genJumpNotSmallIntegerInScratchReg: TempReg.
+ 	self genConvertSmallIntegerToIntegerInScratchReg: Arg0Reg.
+ 	cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
+ 
+ 	formatReg := SendNumArgsReg.
+ 	cogit
+ 		MoveMw: 0 r: ReceiverResultReg R: formatReg;				"formatReg := least significant half of self baseHeader: receiver"
+ 		MoveR: formatReg R: TempReg;
+ 		LogicalShiftRightCq: objectMemory formatShift R: formatReg;
+ 		AndCq: objectMemory formatMask R: formatReg.	"formatReg := self formatOfHeader: destReg"
+ 
+ 	"get numSlots into ClassReg."
+ 	cogit MoveMb: 7 r: ReceiverResultReg R: ClassReg. "MSB of header"
+ 	cogit CmpCq: objectMemory numSlotsMask R: ClassReg.
+ 	jumpSmallSize := cogit JumpLess: 0.
+ 	cogit MoveMw: -8 r: ReceiverResultReg R: ClassReg. "LSW of overflow size header"
+ 
+ 	"dispatch on format in a combination of highest dynamic frequency order first and convenience.
+ 		  0 = 0 sized objects (UndefinedObject True False et al)
+ 		  1 = non-indexable objects with inst vars (Point et al)
+ 		  2 = indexable objects with no inst vars (Array et al)
+ 		  3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 		  4 = weak indexable objects with inst vars (WeakArray et al)
+ 		  5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 		  6 unused, reserved for exotic pointer objects?
+ 		  7 Forwarded Object, 1st field is pointer, rest of fields are ignored
+ 		  8 unused, reserved for exotic non-pointer objects?
+ 		  9 (?) 64-bit indexable
+ 		10 - 11 32-bit indexable
+ 		12 - 15 16-bit indexable
+ 		16 - 23 byte indexable
+ 		24 - 31 compiled method"
+ 	jumpSmallSize jmpTarget:
+ 					(cogit CmpCq: objectMemory firstByteFormat R: formatReg).
+ 	jumpIsBytes := cogit JumpGreaterOrEqual: 0.
+ 					cogit CmpCq: objectMemory arrayFormat R: formatReg.
+ 	jumpIsArray := cogit JumpZero: 0.
+ 	jumpNotIndexable := cogit JumpLess: 0.
+ 					cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
+ 	jumpHasFixedFields := cogit JumpLessOrEqual: 0.
+ 					cogit CmpCq: objectMemory firstShortFormat R: formatReg.
+ 	jumpIsShorts := cogit JumpGreaterOrEqual: 0.
+ 					cogit CmpCq: objectMemory firstLongFormat R: formatReg.
+ 	jumpIsWords := cogit JumpGreaterOrEqual: 0.
+ 	"For now ignore 64-bit indexability."
+ 	jumpNotIndexable jmpTarget: cogit Label.
+ 	jumpNotIndexable := cogit Jump: 0.
+ 
+ 	jumpIsBytes jmpTarget:
+ 		(cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg).
+ 		cogit AndCq: objectMemory wordSize - 1 R: formatReg.
+ 		cogit SubR: formatReg R: ClassReg;
+ 		CmpR: Arg0Reg R: ClassReg.
+ 	jumpBytesOutOfBounds := cogit JumpAboveOrEqual: 0.
+ 	cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
+ 	cogit MoveXbr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg.
+ 	self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg.
+ 	jumpBytesDone := cogit Jump: 0.
+ 
+ 	jumpIsShorts jmpTarget:
+ 		(cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg).
+ 		cogit AndCq: 1 R: formatReg.
+ 		cogit SubR: formatReg R: ClassReg;
+ 		CmpR: Arg0Reg R: ClassReg.
+ 	jumpShortsOutOfBounds := cogit JumpAboveOrEqual: 0.
+ 	cogit AddR: Arg0Reg R: ReceiverResultReg.
+ 	cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
+ 	self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg.
+ 	jumpShortsDone := cogit Jump: 0.
+ 
+ 	jumpIsWords jmpTarget:
+ 		(cogit CmpR: Arg0Reg R: ClassReg).
+ 	jumpWordsOutOfBounds := cogit JumpAboveOrEqual: 0.
+ 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
+ 	cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: TempReg.
+ 	cogit SubCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
+ 	jumpWordTooBig := self jumpNotSmallIntegerUnsignedValueInRegister: TempReg.
+ 	cogit MoveR: TempReg R: ReceiverResultReg.
+ 	self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg.
+ 	jumpWordsDone := cogit Jump: 0.
+ 
+ 	jumpHasFixedFields jmpTarget:
+ 		(cogit AndCq: objectMemory classIndexMask R: TempReg).
+ 	cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
+ 	jumpIsContext := cogit JumpZero: 0.
+ 	self flag: 'sometime soon we could inline the class fetch; it is only two indirections'.
+ 	cogit CallRT: ceClassAtIndexTrampoline.
+ 	self genLoadSlot: InstanceSpecificationIndex sourceReg: TempReg destReg: formatReg.
+ 	self genConvertSmallIntegerToIntegerInScratchReg: formatReg.
+ 	cogit
+ 		AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
+ 		SubR: formatReg R: ClassReg;
+ 		CmpR: Arg0Reg R: ClassReg.
+ 	jumpFixedFieldsOutOfBounds := cogit JumpAboveOrEqual: 0.
+ 	"index is (formatReg (fixed fields) + Arg0Reg (0-rel index)) * wordSize + baseHeaderSize"
+ 	cogit AddR: formatReg R: Arg0Reg.
+ 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
+ 	cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg.
+ 	jumpFixedFieldsDone := cogit Jump: 0.
+ 
+ 	jumpIsArray jmpTarget:
+ 		(cogit CmpR: Arg0Reg R: ClassReg).
+ 	jumpArrayOutOfBounds := cogit JumpAboveOrEqual: 0.	
+ 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
+ 	cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg.
+ 
+ 	jumpFixedFieldsDone jmpTarget:
+ 	(jumpWordsDone jmpTarget:
+ 	(jumpShortsDone jmpTarget:
+ 	(jumpBytesDone jmpTarget:
+ 		(cogit RetN: retNoffset)))).
+ 
+ 	jumpFixedFieldsOutOfBounds jmpTarget:
+ 	(jumpArrayOutOfBounds jmpTarget:
+ 	(jumpBytesOutOfBounds jmpTarget:
+ 	(jumpShortsOutOfBounds jmpTarget:
+ 	(jumpWordsOutOfBounds jmpTarget:
+ 	(jumpWordTooBig jmpTarget:
+ 	(jumpNotIndexable jmpTarget:
+ 	(jumpIsContext jmpTarget: cogit Label))))))).
+ 
+ 	cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
+ 	self genConvertIntegerToSmallIntegerInScratchReg: Arg0Reg.
+ 
+ 	(jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label)).
+ 
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>jumpNotSmallIntegerUnsignedValueInRegister: (in category 'primitive generators') -----
+ jumpNotSmallIntegerUnsignedValueInRegister: reg
+ 	cogit CmpCq: 16r3FFFFFFF R: reg.
+ 	^cogit JumpAbove: 0!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>numSmallIntegerBits (in category 'compile abstract instructions') -----
+ numSmallIntegerBits
+ 	^31!

Item was added:
+ ----- Method: CogVMSimulator>>CStackPointer (in category 'debug support') -----
+ CStackPointer
+ 	^self longAt: self inMemoryCStackPointerAddress!

Item was added:
+ ----- Method: CogVMSimulator>>methodCache (in category 'spur bootstrap') -----
+ methodCache
+ 	^methodCache!

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].
+ 		 self addNewMethodToCache: (objectMemory classForClassTag: classTag)].
- 			[^false]].
  	((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].
+ 		 self addNewMethodToCache: (objectMemory classForClassTag: classTag)].
- 			[^false]].
  	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!



More information about the Vm-dev mailing list