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

commits at source.squeak.org commits at source.squeak.org
Wed Oct 2 16:59:26 UTC 2013


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

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

Name: VMMaker.oscog-eem.423
Author: eem
Time: 2 October 2013, 9:56:44.669 am
UUID: 1a75a970-d33c-4e87-af67-87928d11facf
Ancestors: VMMaker.oscog-eem.422

Add blockAlignment to formalize block entry encoding in native pcs.

Move the ceStoreCheckTrampoline inst var into CogObjectRepresentation
and implement generateObjectRepresentationTrampolines so Spur
can add ceClassAtIndexTrampoline.

More protocol added to CogObjectRepresentationForSpur.

More addressCouldBeObj: => addressCouldBeOop: asserts.

More isIntegerObject: => isImmediate:.

Cogit+Spur now evaluates 3+4.

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

Item was changed:
  ----- Method: CoInterpreter>>bytecodePCFor:cogMethod:startBcpc: (in category 'frame access') -----
  bytecodePCFor: theIP cogMethod: cogMethod startBcpc: startBcpc
  	"Answer the mapping of the native pc theIP to a zero-relative bytecode pc.
  	 See contextInstructionPointer:frame: for the explanation."
  	<var: #cogMethod type: #'CogMethod *'>
  	| cogMethodForIP mcpc |
  	<inline: true>
  	<var: #cogMethodForIP type: #'CogBlockMethod *'>
  	self assert: theIP < 0.
  	(theIP signedBitShift: -16) < -1 "See contextInstructionPointer:frame:"
  		ifTrue:
+ 			[cogMethodForIP := self cCoerceSimple: cogMethod asInteger - ((theIP signedBitShift: -16) * cogit blockAlignment)
- 			[cogMethodForIP := self cCoerceSimple: cogMethod asInteger - ((theIP signedBitShift: -16) * (cogit sizeof: CogBlockMethod))
  									to: #'CogBlockMethod *'.
  			 self assert: cogMethodForIP cmType = CMBlock.
  			 self assert: cogMethodForIP cmHomeMethod = cogMethod.
  			 mcpc := cogMethodForIP asInteger - theIP signedIntFromShort]
  		ifFalse:
  			[cogMethodForIP := self cCoerceSimple: cogMethod to: #'CogBlockMethod *'.
  			 self assert: cogMethodForIP cmType = CMMethod.
  			 mcpc := cogMethod asInteger - theIP].
  	self assert: (mcpc between: cogMethod asInteger and: cogMethod asInteger + cogMethod blockSize).
  	^cogit bytecodePCFor: mcpc startBcpc: startBcpc in: cogMethodForIP!

Item was changed:
  ----- Method: CoInterpreter>>ceMNUFromPICMNUMethod:receiver: (in category 'trampolines') -----
  ceMNUFromPICMNUMethod: aMethodObj receiver: rcvr
  	<api>
  	| cPIC primitiveIndex |
  	<var: #cPIC type: #'CogMethod *'>
+ 	self assert: (objectMemory addressCouldBeOop: rcvr).
- 	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	self assert: (aMethodObj = 0
  				or: [(objectMemory addressCouldBeObj: aMethodObj)
  					and: [objectMemory isOopCompiledMethod: aMethodObj]]).
  	cPIC := self cCoerceSimple: self popStack - cogit mnuOffset to: #'CogMethod *'.
  	self assert: cPIC cmType = CMClosedPIC.
  	argumentCount := cPIC cmNumArgs.
  	messageSelector := cPIC selector.
  	aMethodObj ~= 0 ifTrue:
  		[instructionPointer := self popStack.
  		self createActualMessageTo: (objectMemory fetchClassOf: rcvr).
  		(self maybeMethodHasCogMethod: aMethodObj) ifTrue:
  			[self push: instructionPointer.
  			 self executeCogMethodFromUnlinkedSend: (self cogMethodOf: aMethodObj)
  				 withReceiver: rcvr.
  			 "NOTREACHED"
  			 self assert: false].
  		newMethod := aMethodObj.
  		primitiveIndex := self primitiveIndexOf: aMethodObj.
  		primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: objectMemory nilObject.
  		^self interpretMethodFromMachineCode].
  	self handleMNU: SelectorDoesNotUnderstand
  		InMachineCodeTo: rcvr
  		classForMessage: (objectMemory fetchClassOf: rcvr).
  	"NOTREACHED"
  	self assert: false!

Item was changed:
  ----- Method: CoInterpreter>>encodedNativePCOf:cogMethod: (in category 'frame access') -----
  encodedNativePCOf: mcpc cogMethod: cogMethod
  	"Encode the mcpc in cogMethod as a value that can be stashed in a context.
  	 Mapping native pcs to bytecode pcs is quite expensive, requiring a search
  	 through the method map.  We mitigate this cost by deferring mapping until
  	 we really have to, which is when a context's instruction pointer is accessed
  	 by Smalltalk code.  But to defer mapping we have to be able to distinguish
  	 machine code from bytecode pcs, which we do by using negative values for
  	 machine code pcs.
  
  	 As a whorish performance hack we also include the block method offset in
  	 the pc of a block. The least significant 16 bits are the native pc and the most
  	 significant 15 bits are the block start, in block alignment units.  So when
  	 mapping back we can find the start of the block.
  
  	 See mustMapMachineCodePC:context: for the code that does the actual mapping."
  	<var: #cogMethod type: #'CogBlockMethod *'>
  	| homeMethod blockOffset |
  	<var: #homeMethod type: #'CogMethod *'>
  	mcpc = cogit ceCannotResumePC ifTrue:
  		[^HasBeenReturnedFromMCPC].
  	cogMethod cmType = CMMethod ifTrue:
  		[^objectMemory integerObjectOf: cogMethod asInteger - mcpc].
  	homeMethod := cogMethod cmHomeMethod.
+ 	blockOffset := homeMethod asInteger - cogMethod asInteger / cogit blockAlignment.
- 	blockOffset := homeMethod asInteger - cogMethod asInteger / (cogit sizeof: CogBlockMethod).
  	^objectMemory integerObjectOf: ((blockOffset bitShift: 16) bitOr: (cogMethod asInteger - mcpc bitAnd: 16rFFFF))!

Item was changed:
  ----- Method: CoInterpreter>>handleMNU:InMachineCodeTo:classForMessage: (in category 'message sending') -----
  handleMNU: selectorIndex InMachineCodeTo: rcvr classForMessage: classForMessage
  	"A message send from either an open PIC or an unlinked send has not  been
  	 understood.  Create a message and execute the relevant resulting MNU method.
  	 messageSelector is an implicit argument (yuck)."
  	| errSelIdx classForThisMessage |
  	<var: #cogMethod type: #'CogMethod *'>
+ 	self assert: (objectMemory addressCouldBeOop: rcvr).
- 	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	instructionPointer := self popStack.
  	self createActualMessageTo: classForMessage.
  	messageSelector := objectMemory splObj: selectorIndex.
  	(self lookupInMethodCacheSel: messageSelector classTag: (objectMemory classTagForClass: lkupClass))
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: messageSelector]
  		ifFalse:
  			[errSelIdx := self lookupMethodNoMNUEtcInClass: (classForThisMessage := lkupClass).
  			 errSelIdx ~= 0 ifTrue:
  				[selectorIndex = SelectorDoesNotUnderstand ifTrue:
  					[self error: 'Recursive not understood error encountered'].
  				 self push: instructionPointer.
  				 ^self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: classForThisMessage]].
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[self push: instructionPointer.
  		 self executeCogMethodFromUnlinkedSend: (self cogMethodOf: newMethod)
  			 withReceiver: rcvr.
  		 "NOTREACHED"
  		 self assert: false].
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>makeBaseFrameFor: (in category 'frame access') -----
  makeBaseFrameFor: aContext "<Integer>"
  	"Marry aContext with the base frame of a new stack page.  Build the base
  	 frame to reflect the context's state.  Answer the new page.  Override to
  	 hold the caller context in a different place,  In the StackInterpreter we use
  	 the caller saved ip, but in the Cog VM caller saved ip is the ceBaseReturn:
  	 trampoline.  Simply hold the caller context in the first word of the stack."
  	<returnTypeC: #'StackPage *'>
  	| page pointer theMethod theIP numArgs stackPtrIndex maybeClosure |
  	<inline: false>
  	<var: #page type: #'StackPage *'>
  	<var: #pointer type: #'char *'>
  	<var: #cogMethod type: #'CogMethod *'>
  	self assert: (self isSingleContext: aContext).
  	self assert: (objectMemory goodContextSize: aContext).
  	theIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
  	self assert: HasBeenReturnedFromMCPC signedIntFromLong < 0.
  	theIP := (objectMemory isIntegerObject: theIP)
  				ifTrue: [objectMemory integerValueOf: theIP]
  				ifFalse: [HasBeenReturnedFromMCPC].
  	theMethod := objectMemory fetchPointer: MethodIndex ofObject: aContext.
  	page := self newStackPage.
  	"first word on stack is caller context of base frame"
  	stackPages
  		longAt: (pointer := page baseAddress)
  		put: (objectMemory fetchPointer: SenderIndex ofObject: aContext).
  	"second word is the context itself; needed for cannotReturn processing; see ceBaseReturn:."
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: aContext.
  	"If the frame is a closure activation then the closure should be on the stack in
  	 the pushed receiver position (closures receiver the value[:value:] messages).
  	 Otherwise it should be the receiver proper."
  	maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aContext.
  	maybeClosure ~= objectMemory nilObject
  		ifTrue:
  			[numArgs := self argumentCountOfClosure: maybeClosure.
  			 stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: maybeClosure]
  		ifFalse:
  			[| header |
  			 header := self headerOf: theMethod.
  			 numArgs := self argumentCountOfMethodHeader: header.
  			 self cppIf: MULTIPLEBYTECODESETS
  				ifTrue: "If this is a synthetic context its IP could be pointing at the CallPrimitive opcode.  If so, skip it."
  					[(theIP signedIntFromLong > 0
  					  and: [(self methodHeaderHasPrimitive: header)
  					  and: [theIP = (1 + (objectMemory lastPointerOf: theMethod))]]) ifTrue:
  						[theIP := theIP + (self sizeOfCallPrimitiveBytecode: header)]].
  			 stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: (objectMemory fetchPointer: ReceiverIndex ofObject: aContext)].
  	"Put the arguments on the stack"
  	1 to: numArgs do:
  		[:i|
  		stackPages
  			longAt: (pointer := pointer - BytesPerWord)
  			put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  	"saved caller ip is base return trampoline"
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: cogit ceBaseFrameReturnPC.
  	"base frame's saved fp is null"
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: 0.
  	"N.B.  Don't set the baseFP, which marks the page as in use, until after
  	 ensureMethodIsCogged: and/or instructionPointer:forContext:frame:. These
  	 can cause a compiled code compaction which, if marked as in use, will
  	 examine this partially initialized page and crash."
  	page headFP: pointer.
  	"Create either a machine code frame or an interpreter frame based on the pc.  If the pc is -ve
  	 it is a machine code pc and so we produce a machine code frame.  If +ve an interpreter frame.
  	 N.B. Do *not* change this to try and map from a bytecode pc to a machine code frame under
  	 any circumstances.  See ensureContextIsExecutionSafeAfterAssignToStackPointer:"
  	theIP signedIntFromLong < 0
  		ifTrue:
  			[| cogMethod |
  			 "Since we would have to generate a machine-code method to be able to map
  			  the native pc anyway we should create a native method and native frame."
  			 cogMethod := self ensureMethodIsCogged: theMethod.
  			 theMethod := cogMethod asInteger.
  			 maybeClosure ~= objectMemory nilObject
  				ifTrue:
  					["If the pc is the special HasBeenReturnedFromMCPC pc set the pc
  					  appropriately so that the frame stays in the cannotReturn: state."
  					 theIP = HasBeenReturnedFromMCPC signedIntFromLong
  						ifTrue:
  							[theMethod := (cogit findMethodForStartBcpc: (self startPCOfClosure: maybeClosure)
  												inHomeMethod: (self cCoerceSimple: theMethod
  																	to: #'CogMethod *')) asInteger.
  							 theMethod = 0 ifTrue:
  								[self error: 'cannot find machine code block matching closure''s startpc'].
  							 theIP := cogit ceCannotResumePC]
  						ifFalse:
  							[self assert: (theIP signedBitShift: -16) < -1. "See contextInstructionPointer:frame:"
+ 							 theMethod := theMethod - ((theIP signedBitShift: -16) * cogit blockAlignment).
- 							 theMethod := theMethod - ((theIP signedBitShift: -16) * (cogit sizeof: CogBlockMethod)).
  							 theIP := theMethod - theIP signedIntFromShort].
  					 stackPages
  						longAt: (pointer := pointer - BytesPerWord)
  						put: theMethod + MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag]
  				ifFalse:
  					[self assert: (theIP signedBitShift: -16) >= -1.
  					 "If the pc is the special HasBeenReturnedFromMCPC pc set the pc
  					  appropriately so that the frame stays in the cannotReturn: state."
  					 theIP := theIP = HasBeenReturnedFromMCPC signedIntFromLong
  								ifTrue: [cogit ceCannotResumePC]
  								ifFalse: [theMethod asInteger - theIP].
  					 stackPages
  						longAt: (pointer := pointer - BytesPerWord)
  						put: theMethod + MFMethodFlagHasContextFlag].
  			 stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: aContext]
  		ifFalse:
  			[stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: theMethod.
  			stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: aContext.
  			stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: (self encodeFrameFieldHasContext: true isBlock: maybeClosure ~= objectMemory nilObject numArgs: numArgs).
  			stackPages
  				longAt: (pointer := pointer - BytesPerWord)
  				put: 0. "FoxIFSavedIP"
  			theIP := self iframeInstructionPointerForIndex: theIP method: theMethod].
  	page baseFP: page headFP.
  	self assert: (self frameHasContext: page baseFP).
  	self assert: (self frameNumArgs: page baseFP) == numArgs.
  	stackPages
  		longAt: (pointer := pointer - BytesPerWord)
  		put: (objectMemory fetchPointer: ReceiverIndex ofObject: aContext).
  	stackPtrIndex := self quickFetchInteger: StackPointerIndex ofObject: aContext.
  	self assert: ReceiverIndex + stackPtrIndex < (objectMemory lengthOf: aContext).
  	numArgs + 1 to: stackPtrIndex do:
  		[:i|
  		stackPages
  			longAt: (pointer := pointer - BytesPerWord)
  			put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  	"top of stack is the instruction pointer"
  	stackPages longAt: (pointer := pointer - BytesPerWord) put: theIP.
  	page headSP: pointer.
  	self assert: (self context: aContext hasValidInversePCMappingOf: theIP in: page baseFP).
  
  	"Mark context as married by setting its sender to the frame pointer plus SmallInteger
  	 tags and the InstructionPointer to the saved fp (which ensures correct alignment
  	 w.r.t. the frame when we check for validity) plus SmallInteger tags."
  	objectMemory storePointerUnchecked: SenderIndex
  		ofObject: aContext
  		withValue: (self withSmallIntegerTags: page baseFP).
  	objectMemory storePointerUnchecked: InstructionPointerIndex
  		ofObject: aContext
  		withValue: (self withSmallIntegerTags: 0).
  	self assert: (objectMemory isIntegerObject: (objectMemory fetchPointer: SenderIndex ofObject: aContext)).
  	self assert: (self frameOfMarriedContext: aContext) = page baseFP.
  	self assert: self validStackPageBaseFrames.
  	^page!

Item was changed:
  CogClass subclass: #CogObjectRepresentation
+ 	instanceVariableNames: 'cogit objectMemory ceStoreCheckTrampoline'
- 	instanceVariableNames: 'cogit objectMemory'
  	classVariableNames: ''
  	poolDictionaries: 'CogMethodConstants CogRTLOpcodes VMBasicConstants VMObjectIndices'
  	category: 'VMMaker-JIT'!
  
  !CogObjectRepresentation commentStamp: '<historical>' prior: 0!
  I am an abstract superclass for object representations whose job it is to generate abstract instructions for accessing objects.  It is hoped that this level of indirection between the Cogit code generator and object access makes it easier to adapt the code generator to different garbage collectors, object representations and languages.!

Item was added:
+ ----- Method: CogObjectRepresentation>>generateObjectRepresentationTrampolines (in category 'initialization') -----
+ generateObjectRepresentationTrampolines
+ 	ceStoreCheckTrampoline := cogit
+ 									genTrampolineFor: #ceStoreCheck:
+ 									called: 'ceStoreCheckTrampoline'
+ 									arg: ReceiverResultReg
+ 									result: cogit returnRegForStoreCheck!

Item was changed:
  CogObjectRepresentation subclass: #CogObjectRepresentationForSpur
+ 	instanceVariableNames: 'ceClassAtIndexTrampoline'
- 	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>couldBeObject: (in category 'debug support') -----
+ couldBeObject: oop
+ 	^objectMemory addressCouldBeObj: oop!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genGetClassObjectOf:into:scratchReg: (in category 'compile abstract instructions') -----
+ genGetClassObjectOf: instReg into: destReg scratchReg: scratchReg
+ 	"Fetch the instance's class into destReg."
+ 	| jumpIsImm jumpNotForwarded loop |
+ 	<var: #jumpIsImm type: #'AbstractInstruction *'>
+ 	<var: #jumpNotForwarded type: #'AbstractInstruction *'>
+ 	<var: #loop type: #'AbstractInstruction *'>
+ 	loop := cogit MoveR: instReg R: scratchReg.
+ 	cogit AndCq: objectMemory tagMask R: scratchReg.
+ 	jumpIsImm := cogit JumpNonZero: 0.
+ 	self flag: #endianness.
+ 	"Get least significant half of header word in destReg"
+ 	cogit MoveMw: 0 r: instReg R: scratchReg.
+ 	"mask off class index"
+ 	cogit AndCq: objectMemory classIndexMask R: scratchReg.
+ 	"if it is forwarded..."
+ 	cogit CmpCq: objectMemory isForwardedObjectClassIndexPun R: scratchReg.
+ 	jumpNotForwarded := cogit JumpNonZero: 0.
+ 	"...follow the forwarding pointer and loop to fetch its classIndex"
+ 	cogit MoveMw: objectMemory baseHeaderSize r: instReg R: instReg.
+ 	cogit Jump: loop.
+ 	jumpNotForwarded jmpTarget: (jumpIsImm jmpTarget: cogit Label).
+ 	scratchReg ~= TempReg ifTrue:
+ 		[cogit MoveR: scratchReg R: TempReg].
+ 	cogit CallRT: ceClassAtIndexTrampoline.
+ 	destReg ~= TempReg ifTrue:
+ 		[cogit MoveR: TempReg R: destReg]!

Item was removed:
- ----- Method: CogObjectRepresentationForSpur>>genStoreCheckTrampoline (in category 'initialization') -----
- genStoreCheckTrampoline
- 	"Call ceStoreCheck: with the object stored into"
- 	^cogit
- 		genTrampolineFor: #ceStoreCheck:
- 		called: 'ceStoreCheckTrampoline'
- 		arg: ReceiverResultReg
- 		result: cogit returnRegForStoreCheck!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genStoreSourceReg:slotIndex:destReg:scratchReg: (in category 'compile abstract instructions') -----
  genStoreSourceReg: sourceReg slotIndex: index destReg: destReg scratchReg: scratchReg
  	| jmpImmediate jmpDestYoung jmpSourceOld jmpAlreadyRemembered mask rememberedBitByteOffset |
  	<var: #jmpImmediate type: #'AbstractInstruction *'>
  	<var: #jmpDestYoung type: #'AbstractInstruction *'>
  	<var: #jmpSourceOld type: #'AbstractInstruction *'>
  	<var: #jmpAlreadyRemembered type: #'AbstractInstruction *'>
  	"do the store"
  	cogit MoveR: sourceReg
  		   Mw: index * objectMemory wordSize + objectMemory baseHeaderSize
  		   r: destReg.
  	"now the check.  Is value stored an integer?  If so we're done"
  	cogit MoveR: sourceReg R: scratchReg.
  	cogit AndCq: objectMemory tagMask R: scratchReg.
  	jmpImmediate := cogit JumpNonZero: 0.
  	"Get the old/new boundary in scratchReg"
  	cogit MoveAw: objectMemory newSpaceLimitAddress R: scratchReg.
  	"Is target young?  If so we're done"
  	cogit CmpR: scratchReg R: destReg. "N.B. FLAGS := destReg - scratchReg"
  	jmpDestYoung := cogit JumpBelow: 0.
  	"Is value stored old?  If so we're done."
  	cogit CmpR: scratchReg R: sourceReg. "N.B. FLAGS := sourceReg - scratchReg"
  	jmpSourceOld := cogit JumpAboveOrEqual: 0.
  	"value is young and target is old.
  	 Need to remember this only if the remembered bit is not already set.
  	 Test the remembered bit.  Only need to fetch the byte containing it,
  	 which reduces the size of the mask constant."
  	rememberedBitByteOffset := jmpSourceOld isBigEndian
  									ifTrue: [objectMemory baseHeaderSize - 1 - (objectMemory rememberedBitShift // 8)]
  									ifFalse:[objectMemory rememberedBitShift // 8].
  	mask := 1 << (objectMemory rememberedBitShift \\ 8).
  	cogit MoveMb: rememberedBitByteOffset r: destReg R: scratchReg.
  	cogit AndCq: mask R: scratchReg.
  	jmpAlreadyRemembered := cogit JumpNonZero: 0.
  	"Remembered bit is not set.  Call store check to insert dest into remembered table."
  	self assert: destReg == ReceiverResultReg.
+ 	cogit CallRT: ceStoreCheckTrampoline.
- 	cogit CallRT: cogit ceStoreCheckTrampoline.
  	jmpImmediate jmpTarget:
  	(jmpDestYoung jmpTarget:
  	(jmpSourceOld jmpTarget:
  	(jmpAlreadyRemembered jmpTarget:
  		cogit Label))).
  	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genStoreSourceReg:slotIndex:intoNewObjectInDestReg: (in category 'compile abstract instructions') -----
+ genStoreSourceReg: sourceReg slotIndex: index intoNewObjectInDestReg: destReg
+ 	cogit MoveR: sourceReg
+ 		   Mw: index * objectMemory wordSize + objectMemory baseHeaderSize
+ 		   r: destReg.
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>generateObjectRepresentationTrampolines (in category 'initialization') -----
+ generateObjectRepresentationTrampolines
+ 	super generateObjectRepresentationTrampolines.
+ 	ceClassAtIndexTrampoline := cogit
+ 									genTrampolineFor: #ceClassAtIndex:
+ 									called: 'ceClassAtIndexTrampoline'
+ 									arg: TempReg
+ 									result: TempReg!

Item was removed:
- ----- Method: CogObjectRepresentationForSqueakV3>>genStoreCheckTrampoline (in category 'initialization') -----
- genStoreCheckTrampoline
- 	"Call ceStoreCheck: with the object stored into"
- 	^cogit
- 		genTrampolineFor: #ceStoreCheck:
- 		called: 'ceStoreCheckTrampoline'
- 		arg: ReceiverResultReg
- 		result: cogit returnRegForStoreCheck!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>genStoreSourceReg:slotIndex:destReg:scratchReg: (in category 'compile abstract instructions') -----
  genStoreSourceReg: sourceReg slotIndex: index destReg: destReg scratchReg: scratchReg
  	| jmpImmediate jmpDestYoung jmpSourceOld jmpAlreadyRoot mask rootBitByteOffset |
  	<var: #jmpImmediate type: #'AbstractInstruction *'>
  	<var: #jmpDestYoung type: #'AbstractInstruction *'>
  	<var: #jmpSourceOld type: #'AbstractInstruction *'>
  	<var: #jmpAlreadyRoot type: #'AbstractInstruction *'>
  	"do the store"
  	cogit MoveR: sourceReg Mw: index * BytesPerWord + BaseHeaderSize r: destReg.
  	"now the check.  Is value stored an integer?  If so we're done"
  	cogit MoveR: sourceReg R: scratchReg.
  	cogit AndCq: 1 R: scratchReg.
  	jmpImmediate := cogit JumpNonZero: 0.
  	"Get the old/new boundary in scratchReg"
  	cogit MoveAw: objectMemory youngStartAddress R: scratchReg.
  	"Is target young?  If so we're done"
  	cogit CmpR: scratchReg R: destReg. "N.B. FLAGS := destReg - scratchReg"
  	jmpDestYoung := cogit JumpAboveOrEqual: 0.
  	"Is value stored old?  If so we're done."
  	cogit CmpR: scratchReg R: sourceReg. "N.B. FLAGS := sourceReg - scratchReg"
  	jmpSourceOld := cogit JumpBelow: 0.
  	"value is young and target is old.
  	 Need to make this a root if the root bit is not already set.
  	 Test the root bit.  Only need to fetch the byte containing it,
  	 which reduces the size of the mask constant."
  	rootBitByteOffset := jmpSourceOld isBigEndian
  							ifTrue: [BytesPerWord - RootBitDigitLength]
  							ifFalse:[RootBitDigitLength - 1].
  	mask := RootBitDigitLength > 1
  				ifTrue: [RootBit >> (RootBitDigitLength - 1 * 8)]
  				ifFalse: [RootBit].
  	cogit MoveMb: rootBitByteOffset r: destReg R: scratchReg.
  	cogit AndCq: mask R: scratchReg.
  	jmpAlreadyRoot := cogit JumpNonZero: 0.
  	"Root bit is not set.  Call store check to insert dest into root table."
  	self assert: destReg == ReceiverResultReg.
+ 	cogit CallRT: ceStoreCheckTrampoline.
- 	cogit CallRT: cogit ceStoreCheckTrampoline.
  	jmpImmediate jmpTarget:
  	(jmpDestYoung jmpTarget:
  	(jmpSourceOld jmpTarget:
  	(jmpAlreadyRoot jmpTarget:
  		cogit Label))).
  	^0!

Item was changed:
  CogClass subclass: #Cogit
+ 	instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMissCall missOffset entryPointMask checkedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry dynSuperEntry dynSuperEntryAlignment cmDynSuperEntryOffset mnuCall interpretCall endCPICCase0 endCPICCase1 numPICCases firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes annotations generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes annotationIndex blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxMethodBefore maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceClosureCopyTrampoline ceCreateNewArrayTrampoline ceEnterCogCodePopReceiverReg ceEnterCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceActiveContextTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline cePositive32BitIntegerTrampoline ceImplicitReceiverTrampoline ceExplicitReceiverTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP sendTrampolines superSendTrampolines dynamicSuperSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCEEnterCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB'
- 	instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMissCall missOffset entryPointMask checkedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry dynSuperEntry dynSuperEntryAlignment cmDynSuperEntryOffset mnuCall interpretCall endCPICCase0 endCPICCase1 numPICCases firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes annotations generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes annotationIndex blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxMethodBefore maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceStoreCheckTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceClosureCopyTrampoline ceCreateNewArrayTrampoline ceEnterCogCodePopReceiverReg ceEnterCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceActiveContextTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline cePositive32BitIntegerTrampoline ceImplicitReceiverTrampoline ceExplicitReceiverTrampoline ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP sendTrampolines superSendTrampolines dynamicSuperSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCEEnterCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB'
  	classVariableNames: 'AltBlockCreationBytecodeSize AltNSSendIsPCAnnotated AnnotationConstantNames AnnotationShift BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration EncounteredUnknownBytecode FirstAnnotation HasBytecodePC InsufficientCodeSpace IsAbsPCReference IsDisplacement IsDisplacementX2N IsNSSendCall IsObjectReference IsRelativeCall IsSendCall MapEnd MaxCompiledPrimitiveIndex MaxNegativeErrorCode MaxStackAllocSize MaxUnitDisplacement MaxX2NDisplacement MethodTooBig NSSendIsPCAnnotated NotFullyInitialized NumObjRefsInRuntime NumSendTrampolines NumTrampolines ProcessorClass YoungSelectorInPIC'
  	poolDictionaries: 'CogMethodConstants CogRTLOpcodes VMBasicConstants VMObjectIndices VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  Cogit class
  	instanceVariableNames: 'generatorTable primitiveTable'!
  
  !Cogit commentStamp: 'eem 2/13/2013 15:37' prior: 0!
  I am the code generator for the Cog VM.  My job is to produce machine code versions of methods for faster execution and to manage inline caches for faster send performance.  I can be tested in the current image using my class-side in-image compilation facilities.  e.g. try
  
  	StackToRegisterMappingCogit genAndDis: (Integer >> #benchFib)
  
  I have concrete subclasses that implement different levels of optimization:
  	SimpleStackBasedCogit is the simplest code generator.
  
  	StackToRegisterMappingCogit is the current production code generator  It defers pushing operands
  	to the stack until necessary and implements a register-based calling convention for low-arity sends.
  
  	StackToRegisterMappingCogit is an experimental code generator with support for counting
  	conditional branches, intended to support adaptive optimization.
  
  coInterpreter <CoInterpreterSimulator>
  	the VM's interpreter with which I cooperate
  methodZoneManager <CogMethodZoneManager>
  	the manager of the machine code zone
  objectRepresentation <CogObjectRepresentation>
  	the object used to generate object accesses
  processor <BochsIA32Alien|?>
  	the simulator that executes the IA32/x86 machine code I generate when simulating execution in Smalltalk
  simulatedTrampolines <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap jump addresses to run-time routines used to warp from simulated machine code in to the Smalltalk run-time.
  simulatedVariableGetters <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap read addresses to variables in run-time objects used to allow simulated machine code to read variables in the Smalltalk run-time.
  simulatedVariableSetters <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap write addresses to variables in run-time objects used to allow simulated machine code to write variables in the Smalltalk run-time.
  printRegisters printInstructions clickConfirm <Boolean>
  	flags controlling debug printing and code simulation
  breakPC <Integer>
  	machine code pc breakpoint
  cFramePointer cStackPointer <Integer>
  	the variables representing the C stack & frame pointers, which must change on FFI callback and return
  selectorOop <sqInt>
  	the oop of the methodObj being compiled
  methodObj <sqInt>
  	the bytecode method being compiled
  initialPC endPC <Integer>
  	the start and end pcs of the methodObj being compiled
  methodOrBlockNumArgs <Integer>
  	argument count of current method or block being compiled
  needsFrame <Boolean>
  	whether methodObj or block needs a frame to execute
  primitiveIndex <Integer>
  	primitive index of current method being compiled
  methodLabel <CogAbstractOpcode>
  	label for the method header
  blockEntryLabel <CogAbstractOpcode>
  	label for the start of the block dispatch code
  stackOverflowCall <CogAbstractOpcode>
  	label for the call of ceStackOverflow in the method prolog
  sendMissCall <CogAbstractOpcode>
  	label for the call of ceSICMiss in the method prolog
  entryOffset <Integer>
  	offset of method entry code from start (header) of method
  entry <CogAbstractOpcode>
  	label for the first instruction of the method entry code
  noCheckEntryOffset <Integer>
  	offset of the start of a method proper (after the method entry code) from start (header) of method
  noCheckEntry <CogAbstractOpcode>
  	label for the first instruction of start of a method proper
  fixups <Array of <AbstractOpcode Label | nil>>
  	the labels for forward jumps that will be fixed up when reaching the relevant bytecode.  fixup shas one element per byte in methodObj's bytecode
  abstractOpcodes <Array of <AbstractOpcode>>
  	the code generated when compiling methodObj
  byte0 byte1 byte2 byte3 <Integer>
  	individual bytes of current bytecode being compiled in methodObj
  bytecodePointer <Integer>
  	bytecode pc (same as Smalltalk) of the current bytecode being compiled
  opcodeIndex <Integer>
  	the index of the next free entry in abstractOpcodes (this code is translated into C where OrderedCollection et al do not exist)
  numAbstractOpcodes <Integer>
  	the number of elements in abstractOpcocdes
  blockStarts <Array of <BlockStart>>
  	the starts of blocks in the current method
  blockCount
  	the index into blockStarts as they are being noted, and hence eventuakly teh total number of blocks in the current method
  labelCounter <Integer>
  	a nicety for numbering labels not needed in the production system but probably not expensive enough to worry about
  ceStackOverflowTrampoline <Integer>
  ceSend0ArgsTrampoline <Integer>
  ceSend1ArgsTrampoline <Integer>
  ceSend2ArgsTrampoline <Integer>
  ceSendNArgsTrampoline <Integer>
  ceSendSuper0ArgsTrampoline <Integer>
  ceSendSuper1ArgsTrampoline <Integer>
  ceSendSuper2ArgsTrampoline <Integer>
  ceSendSuperNArgsTrampoline <Integer>
  ceSICMissTrampoline <Integer>
  ceCPICMissTrampoline <Integer>
  ceStoreCheckTrampoline <Integer>
  ceReturnToInterpreterTrampoline <Integer>
  ceBaseFrameReturnTrampoline <Integer>
  ceSendMustBeBooleanTrampoline <Integer>
  ceClosureCopyTrampoline <Integer>
  	the various trampolines (system-call-like jumps from machine code to the run-time).
  	See Cogit>>generateTrampolines for the mapping from trampoline to run-time
  	routine and then read the run-time routine for a funcitonal description.
  ceEnterCogCodePopReceiverReg <Integer>
  	the enilopmart (jump from run-time to machine-code)
  methodZoneBase <Integer>
  !
  Cogit class
  	instanceVariableNames: 'generatorTable primitiveTable'!

Item was added:
+ ----- Method: Cogit>>blockAlignment (in category 'accessing') -----
+ blockAlignment
+ 	<cmacro: '(self) 8'>
+ 	self assert: (methodZone roundUpLength: 1) = 8.
+ 	^8!

Item was removed:
- ----- Method: Cogit>>ceStoreCheckTrampoline (in category 'accessing') -----
- ceStoreCheckTrampoline
- 	<cmacro: '() ceStoreCheckTrampoline'>
- 	^ceStoreCheckTrampoline!

Item was changed:
  ----- Method: Cogit>>compileBlockEntry: (in category 'compile abstract instructions') -----
  compileBlockEntry: blockStart
  	"Compile a block's entry.  This looks like a dummy CogBlockMethod header (for frame parsing)
  	 followed by either a frame build, if a frame is required, or nothing.  The CogMethodHeader's
  	 objectHeader field is a back pointer to the method, but this can't be filled in until code generation."
  	<var: #blockStart type: #'BlockStart *'>
+ 	self AlignmentNops: self blockAlignment.
- 	"Block method headers must be aligned on the correct boundary, just like non-block method headers."
- 	self AlignmentNops: (methodZone roundUpLength: 1).
  	blockStart fakeHeader: self Label.
  	(self sizeof: CogBlockMethod) caseOf:
  		{ [2 * BytesPerWord]	"ObjectMemory"
  			->	[self Fill32: 0.		"gets filled in later with the homeOffset and startpc"
  				 self Fill32: 0].		"gets filled in later with numArgs et al"
  		   [3 * BytesPerWord]	"Spur"
  			->	[self Fill32: 0.		"gets filled in later with the homeOffset and startpc"
  				 self Fill32: 0.		"is left fallow"
  				 self Fill32: 0].		"gets filled in later with numArgs et al"
  		}.
  	blockStart entryLabel: self Label.
  	needsFrame
  		ifTrue:
  			[self compileBlockFrameBuild: blockStart.
  			 self recordBlockTrace ifTrue:
  				[self CallRT: ceTraceBlockActivationTrampoline]]
  		ifFalse:
  			[self compileBlockFramelessEntry: blockStart]!

Item was changed:
  ----- Method: Cogit>>generateRunTimeTrampolines (in category 'initialization') -----
  generateRunTimeTrampolines
  	"Generate the run-time entries at the base of the native code zone and update the base."
+ 	
  	ceSendMustBeBooleanAddFalseTrampoline := self genMustBeBooleanTrampolineFor: objectMemory falseObject
  														called: 'ceSendMustBeBooleanAddFalseTrampoline'.
  	ceSendMustBeBooleanAddTrueTrampoline := self genMustBeBooleanTrampolineFor: objectMemory trueObject
  														called: 'ceSendMustBeBooleanAddTrueTrampoline'.
  	ceClosureCopyTrampoline := self genTrampolineFor: #ceClosureCopyDescriptor:
  									called: 'ceClosureCopyTrampoline'
  									arg: SendNumArgsReg
  									result: ReceiverResultReg.
  	ceActiveContextTrampoline := self genActiveContextTrampoline.
  	ceNonLocalReturnTrampoline := self genNonLocalReturnTrampoline.
  	ceBaseFrameReturnTrampoline := self genTrampolineFor: #ceBaseFrameReturn:
  										called: 'ceBaseFrameReturnTrampoline'
  										arg: ReceiverResultReg.
  	ceCreateNewArrayTrampoline := self genTrampolineFor: #ceNewArraySlotSize:
  										called: 'ceCreateNewArrayTrampoline'
  										arg: SendNumArgsReg
  										result: ReceiverResultReg.
  	ceCheckForInterruptTrampoline := self genCheckForInterruptsTrampoline.
- 	ceStoreCheckTrampoline := objectRepresentation genStoreCheckTrampoline.
  	ceFetchContextInstVarTrampoline := self genTrampolineFor: #ceContext:instVar:
  											called: 'ceFetchContextInstVarTrampoline'
  											arg: ReceiverResultReg
  											arg: SendNumArgsReg
  											result: SendNumArgsReg.
  	ceStoreContextInstVarTrampoline := self genTrampolineFor: #ceContext:instVar:value:
  											called: 'ceStoreContextInstVarTrampoline'
  											arg: ReceiverResultReg
  											arg: SendNumArgsReg
  											arg: ClassReg
  											result: ReceiverResultReg. "to keep ReceiverResultReg live."
  	cePositive32BitIntegerTrampoline := self genTrampolineFor: #cePositive32BitIntegerFor:
  											called: 'cePositive32BitIntegerTrampoline'
  											arg: ReceiverResultReg
  											result: TempReg.
  	ceReturnToInterpreterTrampoline := self genTrampolineFor: #ceReturnToInterpreter:
  											called: 'ceReturnToInterpreterTrampoline'
  											arg: ReceiverResultReg.
  	ceCannotResumeTrampoline := self genTrampolineFor: #ceCannotResume
  											called: 'ceCannotResumeTrampoline'!

Item was changed:
  ----- Method: Cogit>>generateTrampolines (in category 'initialization') -----
  generateTrampolines
  	"Generate the run-time entries and exits at the base of the native code zone and update the base.
  	 Read the class-side method trampolines for documentation on the various trampolines"
  	| methodZoneStart |
  	methodZoneStart := methodZoneBase.
  	self allocateOpcodes: 40 bytecodes: 0.
  	initialPC := 0.
  	endPC := numAbstractOpcodes - 1.
  	hasYoungReferent := false.
  	self generateSendTrampolines.
  	self generateMissAbortTrampolines.
+ 	objectRepresentation generateObjectRepresentationTrampolines.
  	self generateRunTimeTrampolines.
  	self cppIf: NewspeakVM ifTrue: 	[self generateNewspeakRuntime].
  	self generateEnilopmarts.
  	self generateTracingTrampolines.
  
  	"finish up"
  	self recordGeneratedRunTime: 'methodZoneBase' address: methodZoneBase.
  	processor flushICacheFrom: methodZoneStart to: methodZoneBase.
  	self cCode: ''
  		inSmalltalk:
  			[simulatedTrampolines keysAndValuesDo:
  				[:addr :selector|
  				simulatedTrampolines
  					at: addr
  					put: (MessageSend
  							receiver: ((self respondsTo: selector)
  										ifTrue: [self]
  										ifFalse: [(coInterpreter respondsTo: selector)
  													ifTrue: [coInterpreter]
  													ifFalse: [(objectMemory respondsTo: selector)
  														ifTrue: [objectMemory]
  														ifFalse: [self notify: 'cannot find receiver for ', selector]]])
  							selector: selector
  							arguments: (1 to: selector numArgs) asArray)]]!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>ceClassAtIndex: (in category 'trampolines') -----
+ ceClassAtIndex: classIndex
+ 	<api>
+ 	| result |
+ 	result := self classAtIndex: classIndex.
+ 	self assert: (coInterpreter addressCouldBeClassObj: result).
+ 	^result!

Item was changed:
  ----- Method: SpurMemoryManager>>addressCouldBeObj: (in category 'debug support') -----
  addressCouldBeObj: address
+ 	<api>
  	self flag: #temporary. "include futureSpace for now (while debugging the scavenger)"
  	^(address bitAnd: self baseHeaderSize - 1) = 0
  	  and: [(self isInOldSpace: address)
  		or: (self isInEden: address)
  		or: [(self isInSurvivorSpace: address)
  		or: [scavengeInProgress and: [self isInFutureSpace: address]]]]!

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) includes: sel) ifFalse:
- 		instVar:ofContext:) includes: sel) ifFalse:
  		[self halt].
  	^(oop bitAnd: 1) ~= 0!

Item was changed:
  ----- Method: StackInterpreter>>lookupMethodFor:InDictionary: (in category 'message sending') -----
  lookupMethodFor: selector InDictionary: dictionary
  	"Lookup the argument selector in aDictionary and answer either the
  	 method or nil, if not found.
  	This method lookup tolerates integers as Dictionary keys to support
  	 execution of images in which Symbols have been compacted out."
  	| length index mask wrapAround nextSelector methodArray |
  	<inline: true>
  	<asmLabel: false>
  	length := objectMemory fetchWordLengthOf: dictionary.
  	mask := length - SelectorStart - 1.
+ 	index := SelectorStart + (mask bitAnd: ((objectMemory isImmediate: selector)
- 	index := SelectorStart + (mask bitAnd: ((objectMemory isIntegerObject: selector)
  												ifTrue: [objectMemory integerValueOf: selector]
  												ifFalse: [objectMemory hashBitsOf: selector])).
  
  	"It is assumed that there are some nils in this dictionary, and search will 
  	 stop when one is encountered. However, if there are no nils, then wrapAround 
  	 will be detected the second time the loop gets to the end of the table."
  	wrapAround := false.
  	[true] whileTrue:
  		[nextSelector := objectMemory fetchPointer: index ofObject: dictionary.
  		 nextSelector = objectMemory nilObject ifTrue:
  			[^nil].
  		 nextSelector = selector ifTrue:
  			[methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
  			 ^objectMemory fetchPointer: index - SelectorStart ofObject: methodArray].
  		 index := index + 1.
  		 index = length ifTrue:
  			[wrapAround ifTrue: [^nil].
  			 wrapAround := true.
  			 index := SelectorStart]].
  	^nil "for Slang"!



More information about the Vm-dev mailing list