[Vm-dev] VM Maker: VMMaker.oscog-eem.372.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Sep 12 02:43:30 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.372.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.372
Author: eem
Time: 11 September 2013, 7:40:40.986 pm
UUID: 2f3d9e40-4644-4c04-bd31-b2e675d52efc
Ancestors: VMMaker.oscog-eem.371
Introduce the classTag abstraction that allows Spur to use
classIndices as cache tags in the first-level method lookup cache
(and hence, soon, follow forwarding objects), while keeping things
unchanged for NewObjectMemory.
The new abstractions are
classForClassTag: => noop in NME
classTagForClass: => noop in NME
fetchClassTagOf: => fetchClassOf: in NME
fetchClassTagOfNonImm: => fetchClassOfNonImm: in NME
Add a mustn't-be-forwarded check to numSlotsOf: and add
numSlotsOfAny: for unchecked access to free and forwarded objs.
Fix shortPrint: for forwarded objects.
=============== Diff against VMMaker.oscog-eem.371 ===============
Item was changed:
----- Method: CoInterpreter>>bytecodePrimAt (in category 'common selector sends') -----
bytecodePrimAt
"BytecodePrimAt will only succeed if the receiver is in the atCache.
Otherwise it will fail so that the more general primitiveAt will put it in the
cache after validating that message lookup results in a primitive response.
Override to insert in the at: cache here. This is necessary since once there
is a compiled at: primitive method (which doesn't use the at: cache) the only
way something can get installed in the atCache is here."
| index rcvr result atIx |
index := self internalStackTop.
rcvr := self internalStackValue: 1.
((objectMemory isIntegerObject: rcvr) not
and: [objectMemory isIntegerObject: index]) ifTrue:
[atIx := rcvr bitAnd: AtCacheMask. "Index into atCache = 4N, for N = 0 ... 7"
(atCache at: atIx+AtCacheOop) ~= rcvr ifTrue:
+ [lkupClassTag := objectMemory fetchClassTagOfNonImm: rcvr.
- [lkupClass := objectMemory fetchClassOfNonImm: rcvr.
messageSelector := self specialSelector: 16.
+ (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
- (self lookupInMethodCacheSel: messageSelector class: lkupClass) ifFalse:
[argumentCount := 1.
^self commonSend].
primitiveFunctionPointer == #primitiveAt
ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: false]
ifFalse:
[primitiveFunctionPointer == #primitiveStringAt
ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: true]
ifFalse:
[argumentCount := 1.
^self commonSend]]].
self successful ifTrue:
[result := self commonVariable: rcvr at: (objectMemory integerValueOf: index) cacheIndex: atIx].
self successful ifTrue:
[self fetchNextBytecode.
^self internalPop: 2 thenPush: result].
self initPrimCall].
messageSelector := self specialSelector: 16.
argumentCount := 1.
self normalSend!
Item was changed:
----- Method: CoInterpreter>>bytecodePrimAtPut (in category 'common selector sends') -----
bytecodePrimAtPut
"BytecodePrimAtPut will only succeed if the receiver is in the atCache.
Otherwise it will fail so that the more general primitiveAtPut will put it in the
cache after validating that message lookup results in a primitive response.
Override to insert in the atCache here. This is necessary since once there
is a compiled at:[put:] primitive method (which doesn't use the at: cache) the
only way something can get installed in the atCache is here."
| index rcvr atIx value |
value := self internalStackTop.
index := self internalStackValue: 1.
rcvr := self internalStackValue: 2.
((objectMemory isIntegerObject: rcvr) not
and: [objectMemory isIntegerObject: index]) ifTrue:
[atIx := (rcvr bitAnd: AtCacheMask) + AtPutBase. "Index into atPutCache"
(atCache at: atIx+AtCacheOop) ~= rcvr ifTrue:
+ [lkupClassTag := objectMemory fetchClassTagOfNonImm: rcvr.
- [lkupClass := objectMemory fetchClassOfNonImm: rcvr.
messageSelector := self specialSelector: 17.
+ (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
- (self lookupInMethodCacheSel: messageSelector class: lkupClass) ifFalse:
[argumentCount := 2.
^self commonSend].
primitiveFunctionPointer == #primitiveAtPut
ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: false]
ifFalse:
[primitiveFunctionPointer == #primitiveStringAtPut
ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: true]
ifFalse:
[argumentCount := 2.
^self commonSend]]].
self successful ifTrue:
[self commonVariable: rcvr at: (objectMemory integerValueOf: index) put: value cacheIndex: atIx].
self successful ifTrue:
[self fetchNextBytecode.
^self internalPop: 3 thenPush: value].
self initPrimCall].
messageSelector := self specialSelector: 17.
argumentCount := 2.
self normalSend!
Item was changed:
----- Method: CoInterpreter>>ceCounterTripped: (in category 'cog jit support') -----
ceCounterTripped: condition
<api>
<option: #SistaStackToRegisterMappingCogit>
"Send e.g. thisContext conditionalBranchCounterTrippedOn: boolean."
| context counterTrippedSelector |
counterTrippedSelector := objectMemory maybeSplObj: SelectorCounterTripped.
(counterTrippedSelector isNil
or: [counterTrippedSelector = objectMemory nilObject]) ifTrue:
[cogit resetCountersIn: (self mframeHomeMethod: framePointer).
^condition].
+ lkupClassTag := objectMemory
+ classTagForSpecialObjectsIndex: ClassMethodContext
+ compactClassIndex: ClassMethodContextCompactIndex.
+ (self lookupInMethodCacheSel: counterTrippedSelector classTag: lkupClassTag) ifFalse:
- lkupClass := self splObj: ClassMethodContext.
- (self lookupInMethodCacheSel: counterTrippedSelector class: lkupClass) ifFalse:
[messageSelector := counterTrippedSelector.
+ lkupClass := objectMemory classTagForClass: lkupClassTag.
(self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
[cogit resetCountersIn: (self mframeHomeMethod: framePointer).
^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: messageSelector.
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 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 isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
self sendBreak: selector + BaseHeaderSize
point: (objectMemory lengthOf: selector)
receiver: rcvr.
mClassMixin := self mMethodClass.
mixinApplication := self
findApplicationOfTargetMixin: mClassMixin
startingAtBehavior: (objectMemory fetchClassOf: rcvr).
self assert: (objectMemory lengthOf: mixinApplication) > (InstanceSpecificationIndex + 1).
lkupClass := self superclassOf: mixinApplication.
class := objectMemory fetchClassOf: rcvr.
canLinkCacheTag := (objectMemory isYoungObject: class) not or: [cogit canLinkToYoungClasses].
"We set the messageSelector and lkupClass for executeMethod below since things
like the at cache read messageSelector and lkupClass and so they cannot be left stale."
messageSelector := selector.
+ lkupClassTag := objectMemory classTagForClass: (self superclassOf: mixinApplication).
- lkupClass := self superclassOf: mixinApplication.
argumentCount := numArgs.
+ (self lookupInMethodCacheSel: selector classTag: lkupClassTag)
- (self lookupInMethodCacheSel: selector class: lkupClass)
ifTrue:"check for coggability because method is in the cache"
[self
ifAppropriateCompileToNativeCode: newMethod
selector: selector]
ifFalse:
+ [lkupClass := objectMemory classTagForClass: lkupClassTag.
+ (errSelIdx := self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
- [(errSelIdx := self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: lkupClass.
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 |
- | class canLinkCacheTag errSelIdx cogMethod |
<inline: false>
<var: #cogMethod type: #'CogMethod *'>
<var: #newCogMethod type: #'CogMethod *'>
"self printExternalHeadFrame"
"self printStringOf: selector"
cogit assertCStackWellAligned.
self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
self sendBreak: selector + BaseHeaderSize
point: (objectMemory lengthOf: 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]].
- ifTrue: [class := objectMemory fetchClassOf: rcvr]
- ifFalse: [class := self superclassOf: (self methodClassOf: (self frameMethodObject: framePointer))].
- canLinkCacheTag := (objectMemory isYoungObject: class) not or: [cogit canLinkToYoungClasses].
"We set the messageSelector and lkupClass for executeMethod below since things
like the at cache read messageSelector and lkupClass and so they cannot be left stale."
messageSelector := selector.
+ lkupClass := objectMemory classForClassTag: classTag.
- lkupClass := class.
argumentCount := numArgs.
+ (self lookupInMethodCacheSel: selector classTag: classTag)
- (self lookupInMethodCacheSel: selector class: class)
ifTrue:"check for coggability because method is in the cache"
[self
ifAppropriateCompileToNativeCode: newMethod
selector: selector]
ifFalse:
+ [(errSelIdx := self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
- [(errSelIdx := self lookupMethodNoMNUEtcInClass: class) ~= 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: lkupClass.
- self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: class.
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 |
- | class errSelIdx |
<inline: false>
"self printExternalHeadFrame"
"self printStringOf: selector"
cogit assertCStackWellAligned.
self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
self sendBreak: selector + BaseHeaderSize
point: (objectMemory lengthOf: selector)
receiver: rcvr.
argumentCount := numArgs.
"We set the messageSelector and lkupClass for executeMethod below since things
like the at cache read messageSelector and lkupClass and so they cannot be left stale."
messageSelector := selector.
+ classTag := objectMemory fetchClassTagOf: rcvr.
+ lkupClass := objectMemory classForClassTag: classTag.
+ (self lookupInMethodCacheSel: selector classTag: classTag)
- lkupClass := class := objectMemory fetchClassOf: rcvr.
- (self lookupInMethodCacheSel: selector class: class)
ifTrue:"check for coggability because method is in the cache"
[self
ifAppropriateCompileToNativeCode: newMethod
selector: selector]
ifFalse:
+ [(errSelIdx := self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
+ [self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: lkupClass.
- [(errSelIdx := self lookupMethodNoMNUEtcInClass: class) ~= 0 ifTrue:
- [self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: class.
"NOTREACHED"
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 |
- | numArgs rcvr class 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 isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
+ classTag := objectMemory fetchClassTagOf: rcvr.
- class := objectMemory fetchClassOf: rcvr.
argumentCount := numArgs.
"We set the messageSelector and lkupClass for executeMethod below since things
like the at cache read messageSelectorand lkupClass and so they cannot be left stale."
messageSelector := oPIC selector.
+ lkupClass := objectMemory classForClassTag: classTag.
+ (self lookupInMethodCacheSel: oPIC selector classTag: classTag)
- lkupClass := class.
- (self lookupInMethodCacheSel: oPIC selector class: class)
ifTrue:"check for coggability because method is in the cache"
[self
ifAppropriateCompileToNativeCode: newMethod
selector: oPIC selector]
ifFalse:
+ [(errSelIdx := self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
+ [self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: lkupClass.
- [(errSelIdx := self lookupMethodNoMNUEtcInClass: class) ~= 0 ifTrue:
- [self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: class.
"NOTREACHED"
self assert: false]].
instructionPointer := self popStack.
(self maybeMethodHasCogMethod: newMethod) ifTrue:
[self executeNewMethod.
self assert: false
"NOTREACHED"].
^self interpretMethodFromMachineCode
"NOTREACHED"!
Item was removed:
- ----- Method: CoInterpreter>>findNewMethodInClass: (in category 'message sending') -----
- findNewMethodInClass: class
- "Find the compiled method to be run when the current messageSelector is
- sent to the given class, setting the values of newMethod and primitiveIndex."
- | ok |
- <inline: false>
- ok := self lookupInMethodCacheSel: messageSelector class: class.
- ok ifTrue:
- [self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]
- ifFalse:
- ["entry was not found in the cache; look it up the hard way "
- self lookupMethodInClass: class.
- self addNewMethodToCache: class]!
Item was added:
+ ----- Method: CoInterpreter>>findNewMethodInClassTag: (in category 'message sending') -----
+ findNewMethodInClassTag: classTag
+ "Find the compiled method to be run when the current messageSelector is
+ sent to the given classTag, setting the values of newMethod and primitiveIndex."
+ | ok class |
+ <inline: false>
+ ok := self lookupInMethodCacheSel: messageSelector classTag: classTag.
+ ok ifTrue:
+ [self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]
+ ifFalse:
+ ["entry was not found in the cache; look it up the hard way "
+ class := objectMemory classForClassTag: classTag.
+ self lookupMethodInClass: class.
+ self addNewMethodToCache: class]!
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. Execute the relevant resulting MNU method."
| errSelIdx classForThisMessage |
<var: #cogMethod type: #'CogMethod *'>
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))
- (self lookupInMethodCacheSel: messageSelector class: 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>>internalFindNewMethod (in category 'message sending') -----
internalFindNewMethod
"Find the compiled method to be run when the current messageSelector is
sent to the given class, setting the values of newMethod and primitiveIndex."
| ok |
<inline: true>
+ ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag.
- ok := self lookupInMethodCacheSel: messageSelector class: lkupClass.
ok ifTrue:
[self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]
ifFalse:
["entry was not found in the cache; look it up the hard way"
+ lkupClass := objectMemory classForClassTag: lkupClassTag.
self externalizeIPandSP.
self lookupMethodInClass: lkupClass.
self internalizeIPandSP.
self addNewMethodToCache: lkupClass]!
Item was changed:
----- Method: CoInterpreter>>lookup:receiver: (in category 'cog jit support') -----
lookup: selector receiver: rcvr
<api>
"Lookup selector in rcvr, without doing MNU processing, and answer either a
method or nil if the message was not understood. Used to populate closed PICs."
+ | classTag erridx |
- | class erridx |
"self printFrame: stackPage headFP WithSP: stackPage headSP"
"self printStringOf: selector"
+ classTag := objectMemory fetchClassTagOf: rcvr.
+ (self lookupInMethodCacheSel: selector classTag: classTag) ifFalse:
- class := objectMemory fetchClassOf: rcvr.
- (self lookupInMethodCacheSel: selector class: class) ifFalse:
[messageSelector := selector.
+ (erridx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
- (erridx := self lookupMethodNoMNUEtcInClass: class) ~= 0 ifTrue:
[^erridx]].
^newMethod!
Item was added:
+ ----- Method: CogObjectRepresentationForSqueakV3>>genGetClassTagOf:into:scratchReg: (in category 'compile abstract instructions') -----
+ genGetClassTagOf: instReg into: destReg scratchReg: scratchReg
+ "Compatibility with SpurObjectRepresentation/purMemorymanager."
+ ^self genGetClassObjectOf: instReg into: destReg scratchReg: scratchReg!
Item was removed:
- ----- Method: CogVMSimulator>>findNewMethodInClass: (in category 'testing') -----
- findNewMethodInClass: class
- "
- | cName |
- traceOn ifTrue:
- [cName := (self sizeBitsOf: class) = 16r20
- ifTrue: ['class ' , (self nameOfClass: (self fetchPointer: 6 ofObject: class))]
- ifFalse: [(self nameOfClass: class)].
- self cr; print: cName , '>>' , (self stringOf: messageSelector)].
- "
- (self stringOf: messageSelector) = 'doesNotUnderstand:' ifTrue: [self halt].
-
- sendCount := sendCount + 1.
-
- printSends ifTrue:
- [self cr; print: byteCount; space; printStringOf: messageSelector; cr].
- "
- (sendCount > 1000 and: [sendCount\\10 = 0]) ifTrue:
- [Transcript print: sendCount; space.
- self validate].
- "
- "
- (sendCount > 100150) ifTrue:
- [self qvalidate.
- messageQueue == nil ifTrue: [messageQueue := OrderedCollection new].
- messageQueue addLast: (self stringOf: messageSelector)].
- "
- super findNewMethodInClass: class.!
Item was added:
+ ----- Method: CogVMSimulator>>findNewMethodInClassTag: (in category 'testing') -----
+ findNewMethodInClassTag: classTag
+ "
+ | cName |
+ traceOn ifTrue:
+ [cName := (self sizeBitsOf: class) = 16r20
+ ifTrue: ['class ' , (self nameOfClass: (self fetchPointer: 6 ofObject: class))]
+ ifFalse: [(self nameOfClass: class)].
+ self cr; print: cName , '>>' , (self stringOf: messageSelector)].
+ "
+ (self stringOf: messageSelector) = 'doesNotUnderstand:' ifTrue: [self halt].
+
+ sendCount := sendCount + 1.
+
+ printSends ifTrue:
+ [self cr; print: byteCount; space; printStringOf: messageSelector; cr].
+ "
+ (sendCount > 1000 and: [sendCount\\10 = 0]) ifTrue:
+ [Transcript print: sendCount; space.
+ self validate].
+ "
+ "
+ (sendCount > 100150) ifTrue:
+ [self qvalidate.
+ messageQueue == nil ifTrue: [messageQueue := OrderedCollection new].
+ messageQueue addLast: (self stringOf: messageSelector)].
+ "
+ ^super findNewMethodInClassTag: classTag!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveInvokeObjectAsMethod (in category 'control primitives') -----
primitiveInvokeObjectAsMethod
"Primitive. 'Invoke' an object like a function, sending the special message
run: originalSelector with: arguments in: aReceiver.
"
<returnTypeC: #void>
+ | runReceiver runArgs lookupClassTag |
- | runReceiver runArgs lookupClass |
runArgs := objectMemory eeInstantiateClass: (objectMemory splObj: ClassArray) indexableSize: argumentCount.
argumentCount - 1 to: 0 by: -1 do:
[:i| objectMemory storePointerUnchecked: i ofObject: runArgs withValue: self popStack].
runReceiver := self popStack.
"setup send of newMethod run: originalSelector with: runArgs in: runReceiver"
self push: newMethod. "newReceiver"
self push: messageSelector "original selector".
self push: runArgs.
self push: runReceiver.
"stack is clean here"
messageSelector := objectMemory splObj: SelectorRunWithIn.
argumentCount := 3.
+ lookupClassTag := objectMemory fetchClassTagOf: newMethod.
+ self findNewMethodInClassTag: lookupClassTag.
- lookupClass := objectMemory fetchClassOf: newMethod.
- self findNewMethodInClass: lookupClass.
self executeNewMethod. "Recursive xeq affects successFlag"
self initPrimCall!
Item was added:
+ ----- Method: NewObjectMemory>>classForClassTag: (in category 'interpreter access') -----
+ classForClassTag: classObj
+ "Compatibility with SpurObjectMemory. In ObjectMemory there is no distinction between a
+ classTag in the first-level method cache and a class itself."
+ ^classObj!
Item was added:
+ ----- Method: NewObjectMemory>>classTagForClass: (in category 'interpreter access') -----
+ classTagForClass: classObj
+ "Compatibility with SpurObjectMemory. In ObjectMemory there is no distinction between a
+ classTag in the first-level method cache and a class itself."
+ ^classObj!
Item was added:
+ ----- Method: NewObjectMemory>>classTagForSpecialObjectsIndex:compactClassIndex: (in category 'interpreter access') -----
+ classTagForSpecialObjectsIndex: splObjIndex compactClassIndex: compactClassIndex
+ "For compatibility with Spur. Answer the class tag to use to lookup a method in the
+ first-;evel method lookup cache."
+ ^self splObj: splObjIndex!
Item was added:
+ ----- Method: NewObjectMemory>>fetchClassTagOf: (in category 'interpreter access') -----
+ fetchClassTagOf: oop
+ "Compatibility with SpurObjectMemory. In ObjectMemory there is no distinction between a
+ classTag in the first-level method cache and a class itself."
+ ^self fetchClassOf: oop!
Item was added:
+ ----- Method: NewObjectMemory>>fetchClassTagOfNonImm: (in category 'interpreter access') -----
+ fetchClassTagOfNonImm: oop
+ "Compatibility with SpurObjectMemory. In ObjectMemory there is no distinction between a
+ classTag in the first-level method cache and a class itself."
+ ^self fetchClassOfNonImm: oop!
Item was changed:
----- Method: SimpleStackBasedCogit>>compileOpenPIC:numArgs: (in category 'in-line cacheing') -----
compileOpenPIC: selector numArgs: numArgs
"Compile the code for an open PIC. Perform a probe of the first-level method
lookup cache followed by a call of ceSendFromOpenPIC: if the probe fails."
| jumpSelectorMiss jumpClassMiss itsAHit jumpBCMethod routine |
<var: #jumpSelectorMiss type: #'AbstractInstruction *'>
<var: #jumpClassMiss type: #'AbstractInstruction *'>
<var: #itsAHit type: #'AbstractInstruction *'>
<var: #jumpBCMethod type: #'AbstractInstruction *'>
self compilePICProlog: numArgs.
self AlignmentNops: (BytesPerWord max: 8).
entry := self Label.
+ objectRepresentation genGetClassTagOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
- objectRepresentation genGetClassObjectOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
"Do first of three probes. See CoInterpreter>>lookupInMethodCacheSel:class:"
+ self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:classTag:"
- self flag: #lookupInMethodCacheSel:class:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
self MoveR: ClassReg R: SendNumArgsReg.
self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
self LogicalShiftLeftCq: ShiftForWord R: ClassReg.
self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
r: ClassReg
R: TempReg.
self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
jumpSelectorMiss := self JumpNonZero: 0.
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
r: ClassReg
R: TempReg.
self CmpR: SendNumArgsReg R: TempReg.
jumpClassMiss := self JumpNonZero: 0.
itsAHit := self Label.
"Fetch the method. The interpret trampoline requires the bytecoded method in SendNumArgsReg"
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheMethod << ShiftForWord)
r: ClassReg
R: SendNumArgsReg.
"If the method is compiled jump to its unchecked entry-point, otherwise interpret it."
objectRepresentation
genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: TempReg.
self MoveR: TempReg R: ClassReg.
jumpBCMethod := objectRepresentation genJumpSmallIntegerInScratchReg: TempReg.
jumpBCMethod jmpTarget: interpretCall.
self AddCq: cmNoCheckEntryOffset R: ClassReg.
self JumpR: ClassReg.
"First probe missed. Do second of three probes. Shift hash right one and retry."
jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
self MoveR: SendNumArgsReg R: ClassReg.
self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
self LogicalShiftLeftCq: ShiftForWord - 1 R: ClassReg.
self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
r: ClassReg
R: TempReg.
self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
jumpSelectorMiss := self JumpNonZero: 0.
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
r: ClassReg
R: TempReg.
self CmpR: SendNumArgsReg R: TempReg.
self JumpZero: itsAHit.
"Second probe missed. Do last probe. Shift hash right two and retry."
jumpSelectorMiss jmpTarget: self Label.
self MoveR: SendNumArgsReg R: ClassReg.
self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
ShiftForWord > 2 ifTrue:
[self LogicalShiftLeftCq: ShiftForWord - 1 R: ClassReg].
self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
r: ClassReg
R: TempReg.
self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
jumpSelectorMiss := self JumpNonZero: 0.
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
r: ClassReg
R: TempReg.
self CmpR: SendNumArgsReg R: TempReg.
self JumpZero: itsAHit.
"Last probe missed. Call ceSendFromOpenPIC: to do the full lookup."
jumpSelectorMiss jmpTarget: self Label.
self genSaveStackPointers.
self genLoadCStackPointers.
methodLabel addDependent: (self annotateAbsolutePCRef: (self MoveCw: methodLabel asInteger R: SendNumArgsReg)).
cStackAlignment > BytesPerWord ifTrue:
[backEnd
genAlignCStackSavingRegisters: false
numArgs: 1
wordAlignment: cStackAlignment / BytesPerWord].
backEnd genPassReg: SendNumArgsReg asArgument: 0.
routine := self cCode: '(sqInt)ceSendFromInLineCacheMiss'
inSmalltalk: [self simulatedAddressFor: #ceSendFromInLineCacheMiss:].
self annotateCall: (self Call: routine)
"Note that this call does not return."!
Item was changed:
----- Method: Spur32BitMemoryManager>>addressAfter: (in category 'object enumeration') -----
addressAfter: objOop
"Answer the address immediately following an object."
| numSlots slotBytes |
+ numSlots := self numSlotsOfAny: objOop.
- numSlots := self numSlotsOf: objOop.
slotBytes := numSlots = 0
ifTrue: [self allocationUnit]
ifFalse: [numSlots + (numSlots bitAnd: 1) << self shiftForWord].
^objOop + self baseHeaderSize + slotBytes!
Item was changed:
----- Method: Spur64BitMemoryManager>>bytesInObject: (in category 'object enumeration') -----
bytesInObject: objOop
"Answer the total number of bytes in an object including header and possible overflow size header."
| halfHeader headerNumSlots numSlots |
self flag: #endianness.
+ "numSlotsOf: should not be applied to free or forwarded objects."
+ self assert: (self classIndexOf: objOop) > self isForwardedObjectClassIndexPun.
halfHeader := self longAt: objOop + 4.
headerNumSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask.
numSlots := headerNumSlots = self numSlotsMask
ifTrue: [self longAt: objOop - self baseHeaderSize]
ifFalse: [numSlots = 0 ifTrue: [1] ifFalse: [numSlots]].
^numSlots << self shiftForWord
+ (headerNumSlots = self numSlotsMask
ifTrue: [self baseHeaderSize + self baseHeaderSize]
ifFalse: [self baseHeaderSize])!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager class>>initializeCompactClassIndices (in category 'class initialization') -----
initializeCompactClassIndices
"Reuse the compact class indices to name known classIndices.
This helps reduce the churn in the interpreters."
"c.f. SpurBootstrap>>defineKnownClassIndices"
+ FirstValidClassIndex :=
ClassLargeNegativeIntegerCompactIndex := 32.
ClassLargePositiveIntegerCompactIndex := 33.
ClassFloatCompactIndex := 34.
ClassMessageCompactIndex := 35.
ClassMethodContextCompactIndex := 36.
ClassBlockContextCompactIndex := 0.
ClassBlockClosureCompactIndex := 37.
ClassByteArrayCompactIndex := 50.
ClassArrayCompactIndex := 51.
ClassByteStringCompactIndex := 52.
ClassBitmapCompactIndex := 53!
Item was added:
+ ----- Method: SpurMemoryManager>>bytesInObject: (in category 'object enumeration') -----
+ bytesInObject: objOop
+ "Answer the total number of bytes in an object including header and possible overflow size header."
+ self subclassResponsibility!
Item was added:
+ ----- Method: SpurMemoryManager>>classForClassTag: (in category 'interpreter access') -----
+ classForClassTag: classIndex
+ ^self classAtIndex: classIndex!
Item was added:
+ ----- 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: (self rawHashBitsOf: classObj) ~= 0.
+ ^self rawHashBitsOf: classObj!
Item was changed:
----- Method: SpurMemoryManager>>fetchClassOfNonImm: (in category 'object access') -----
fetchClassOfNonImm: objOop
| classIndex |
classIndex := self classIndexOf: objOop.
classIndex = self classIsItselfClassIndexPun ifTrue:
[^objOop].
+ self assert: classIndex >= FirstValidClassIndex.
^self classAtIndex: classIndex!
Item was added:
+ ----- Method: SpurMemoryManager>>fetchClassTagOf: (in category 'interpreter access') -----
+ fetchClassTagOf: oop
+ | tagBits |
+ (tagBits := oop bitAnd: self tagMask) ~= 0 ifTrue:
+ [^(tagBits bitAnd: 1) ~= 0 ifTrue: [1] ifFalse: [tagBits]].
+ ^self classIndexOf: oop!
Item was added:
+ ----- Method: SpurMemoryManager>>fetchClassTagOfNonImm: (in category 'interpreter access') -----
+ fetchClassTagOfNonImm: obj
+ "In Spur an object's classIndex is the tag in all method caches."
+ ^self classIndexOf: obj!
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."
(#( makeBaseFrameFor:
quickFetchInteger:ofObject:
frameOfMarriedContext:
addressCouldBeClassObj:
isMarriedOrWidowedContext:
shortPrint:
bytecodePrimAt
commonAt:
loadFloatOrIntFrom:
positive32BitValueOf:
primitiveExternalCall
checkedIntegerValueOf:
bytecodePrimAtPut
commonAtPut:
primitiveVMParameter
checkIsStillMarriedContext:currentFP:
+ displayBitsOf:Left:Top:Right:Bottom:
+ fetchStackPointerOf:) includes: thisContext sender method selector) ifFalse:
- displayBitsOf:Left:Top:Right:Bottom:) includes: thisContext sender method selector) ifFalse:
[self halt].
^(oop bitAnd: 1) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>numSlotsOf: (in category 'object access') -----
numSlotsOf: objOop
<returnTypeC: #usqInt>
| halfHeader numSlots |
self flag: #endianness.
+ "numSlotsOf: should not be applied to free or forwarded objects."
+ self assert: (self classIndexOf: objOop) > self isForwardedObjectClassIndexPun.
halfHeader := self longAt: objOop + 4.
numSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask.
^numSlots = self numSlotsMask
ifTrue: [self longAt: objOop - self baseHeaderSize] "overflow slots; (2^32)-1 slots are plenty"
ifFalse: [numSlots]!
Item was added:
+ ----- Method: SpurMemoryManager>>numSlotsOfAny: (in category 'object access') -----
+ numSlotsOfAny: objOop
+ "A private internal version of numSlotsOf: that is happy to be applied to free or forwarded objects."
+ <returnTypeC: #usqInt>
+ | halfHeader numSlots |
+ self flag: #endianness.
+ halfHeader := self longAt: objOop + 4.
+ numSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask.
+ ^numSlots = self numSlotsMask
+ ifTrue: [self longAt: objOop - self baseHeaderSize] "overflow slots; (2^32)-1 slots are plenty"
+ ifFalse: [numSlots]!
Item was changed:
InterpreterPrimitives subclass: #StackInterpreter
+ instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassSizeBits interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals gcSemaphoreIndex classByteArrayCompactIndex'
- instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassSizeBits interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals gcSemaphoreIndex classByteArrayCompactIndex'
classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MixinIndex PrimitiveExternalCallIndex PrimitiveTable'
poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSqueakClassIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets'
category: 'VMMaker-Interpreter'!
+ !StackInterpreter commentStamp: 'eem 9/11/2013 18:30' prior: 0!
- !StackInterpreter commentStamp: '<historical>' prior: 0!
This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas. This VM supports Closures but *not* old-style BlockContexts.
It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
The VM does not use Contexts directly. Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image. There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up. The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations. A send establishes a new frame in the current stack page, a return returns to the previous frame. This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return. Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together). Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse frame has been returned from (died). A married context is specially marked (more details in the code) and refers to its frame. Likewise a married frame is specially marked and refers to its context.
In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
NOTE: Here follows a list of things to be borne in mind when working on this code, or when making changes for the future.
1. There are a number of things that should be done the next time we plan to release a completely incompatible image format. These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:. Also, contexts should be given a special format code (see next item).
+ 2. There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change. This is necessary because the oops may change during a compaction when the oops are being adjusted. It's important to be aware of this when writing a new image using the SystemTracer. A better solution would be to reserve one of the format codes for Contexts only. An even better solution is to eliminate compact classes altogether (see 6.).
- 2. There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change. This is necessary because the oops may change during a compaction when the oops are being adjusted. It's important to be aware of this when writing a new image using the SystemTracer. A better solution would be to reserve one of the format codes for Contexts only.
+ 3. We have made normal files tolerant to size and positions up to 32 bits. This has not been done for async files, since they are still experimental. The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes. [Late news, the support has been extended to 64-bit file sizes].
- 3. We have made normal files tolerant to size and positions up to 32 bits. This has not been done for async files, since they are still experimental. The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes.
4. Note that 0 is used in a couple of places as an impossible oop. This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment). The places include the method cache and the at cache.
+ 5. Moving to a 2 bit immediate tag and having immediate Characters is a good choice for Unicode and the JIT. We can still have 31-bit SmallIntegers by allowing two tag patterns for SmallInteger.
- 5. Moving to a 2 bit immediate tag and having immediate Characters is a good choice for Unicode and the JIT
+ 6. If Eliot Miranda's 2 word header scheme is acceptable in terms of footprint (we estimate about a 10% increase in image size with about 35 reclaimed by better representation of CompiledMethod - loss of MethodProperties) then the in-line cache for the JIT is simplified, class access is faster and header access is the same in 32-bit and full 64-bit images. [Late breaking news, the 2-word header scheme is more compact, by over 2%]. See SpurMemorymanager's class comment.!
- 6. If Eliot Miranda's 2 word header scheme is acceptable in terms of footprint (we estimate about a 10% increase in image size with about 35 reclaimed by better representation of CompiledMethod - loss of MethodProperties) then the in-line cache for the JIT is simplified, class access is faster and header access is the same in 32-bit and full 64-bit images.!
Item was changed:
----- Method: StackInterpreter>>addNewMethodToCache: (in category 'method lookup cache') -----
addNewMethodToCache: class
"Add the given entry to the method cache.
The policy is as follows:
Look for an empty entry anywhere in the reprobe chain.
If found, install the new entry there.
If not found, then install the new entry at the first probe position
and delete the entries in the rest of the reprobe chain.
This has two useful purposes:
If there is active contention over the first slot, the second
or third will likely be free for reentry after ejection.
Also, flushing is good when reprobe chains are getting full."
| probe hash primitiveIndex |
<inline: false>
hash := messageSelector bitXor: class. "drop low-order zeros from addresses"
(objectMemory isOopCompiledMethod: newMethod)
ifTrue:
[primitiveIndex := self primitiveIndexOf: newMethod.
primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: class]
ifFalse:
[primitiveFunctionPointer := #primitiveInvokeObjectAsMethod].
0 to: CacheProbeMax-1 do:
[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
(methodCache at: probe + MethodCacheSelector) = 0 ifTrue:
["Found an empty entry -- use it"
methodCache at: probe + MethodCacheSelector put: messageSelector.
+ methodCache at: probe + MethodCacheClass put: (objectMemory classTagForClass: class).
- methodCache at: probe + MethodCacheClass put: class.
methodCache at: probe + MethodCacheMethod put: newMethod.
methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod"
^ nil]].
"OK, we failed to find an entry -- install at the first slot..."
probe := hash bitAnd: MethodCacheMask. "first probe"
methodCache at: probe + MethodCacheSelector put: messageSelector.
methodCache at: probe + MethodCacheClass put: class.
methodCache at: probe + MethodCacheMethod put: newMethod.
methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod"
"...and zap the following entries"
1 to: CacheProbeMax-1 do:
[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
methodCache at: probe + MethodCacheSelector put: 0]!
Item was changed:
----- Method: StackInterpreter>>checkOkayInterpreterObjects: (in category 'debug support') -----
checkOkayInterpreterObjects: writeBack
<api>
| ok oopOrZero oop |
ok := true.
ok := ok & (self checkOkayFields: objectMemory nilObject).
ok := ok & (self checkOkayFields: objectMemory falseObject).
ok := ok & (self checkOkayFields: objectMemory trueObject).
ok := ok & (self checkOkayFields: objectMemory specialObjectsOop).
ok := ok & (self checkOkayFields: messageSelector).
ok := ok & (self checkOkayFields: newMethod).
ok := ok & (self checkOkayFields: lkupClass).
0 to: MethodCacheEntries - 1 by: MethodCacheEntrySize do:
[ :i |
oopOrZero := methodCache at: i + MethodCacheSelector.
oopOrZero = 0 ifFalse:
[ok := ok & (self checkOkayFields: (methodCache at: i + MethodCacheSelector)).
+ objectMemory hasSpurMemoryManagerAPI ifFalse:
+ [ok := ok & (self checkOkayFields: (methodCache at: i + MethodCacheClass))].
- ok := ok & (self checkOkayFields: (methodCache at: i + MethodCacheClass)).
ok := ok & (self checkOkayFields: (methodCache at: i + MethodCacheMethod))]].
1 to: objectMemory remapBufferCount do:
[ :i |
oop := objectMemory remapBuffer at: i.
(objectMemory isIntegerObject: oop) ifFalse:
[ok := ok & (self checkOkayFields: oop)]].
ok := ok & (self checkOkayStackZone: writeBack).
^ok!
Item was changed:
----- Method: StackInterpreter>>commonSendAbsentImplicit (in category 'send bytecodes') -----
commonSendAbsentImplicit
"Send a message to the implicit receiver for that message."
"Assume: messageSelector and argumentCount have been set, and that
the arguments but not the receiver have been pushed onto the stack,"
"Note: This method is inlined into the interpreter dispatch loop."
"160-175 1010 i i i i Send To Absent Implicit Receiver Literal Selector #iiii With 0 Arguments"
"240 11110000 i i i i i j j j Send To Absent Implicit Receiver Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
<sharedCodeNamed: 'commonSendAbsentImplicit' inCase: #extSendAbsentImplicitBytecode>
| implicitReceiver |
implicitReceiver := self
implicitReceiverFor: self receiver
mixin: (self methodClassOf: method)
implementing: messageSelector.
self shuffleArgumentsAndStoreAbsentReceiver: implicitReceiver.
+ lkupClassTag := objectMemory fetchClassTagOf: implicitReceiver.
+ self assert: lkupClassTag ~= objectMemory nilObject.
- lkupClass := objectMemory fetchClassOf: implicitReceiver.
- self assert: lkupClass ~= objectMemory nilObject.
self commonSend!
Item was changed:
----- Method: StackInterpreter>>dynamicSuperSendBytecode (in category 'send bytecodes') -----
dynamicSuperSendBytecode
"Send a message to self, starting lookup in the superclass of the method application of the currently executing method's mixin."
"Assume: messageSelector and argumentCount have been set, and that the receiver and arguments have been pushed onto the stack,"
"WE WANT THE RECEIVER PUSHED IMPLICITLY, BUT IT IS NOT - SO FAR"
"Note: This method is inlined into the interpreter dispatch loop."
| rcvr mClassMixin mixinApplication |
<inline: true>
argumentCount := self fetchByte.
messageSelector := self literal: self fetchByte.
rcvr := self internalStackValue: argumentCount.
mClassMixin := self methodClassOf: method.
mixinApplication := self
findApplicationOfTargetMixin: mClassMixin
startingAtBehavior: (objectMemory fetchClassOf: rcvr).
+ lkupClassTag := objectMemory classTagForClass: (self superclassOf: mixinApplication).
- lkupClass := self superclassOf: mixinApplication.
self commonSend!
Item was changed:
----- Method: StackInterpreter>>extSendAbsentDynamicSuperBytecode (in category 'send bytecodes') -----
extSendAbsentDynamicSuperBytecode
"241 11110001 i i i i i j j j Send To Dynamic Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
| byte mClassMixin mixinApplication |
byte := self fetchByte.
messageSelector := self literal: (byte >> 3) + (extA << 5).
extA := 0.
argumentCount := (byte bitAnd: 7) + (extB << 3).
extB := 0.
self shuffleArgumentsAndStoreAbsentReceiver: self receiver.
mClassMixin := self methodClassOf: method.
mixinApplication := self
findApplicationOfTargetMixin: mClassMixin
startingAtBehavior: (objectMemory fetchClassOf: self receiver).
+ lkupClassTag := objectMemory classTagForClass: (self superclassOf: mixinApplication).
- lkupClass := self superclassOf: mixinApplication.
self commonSend!
Item was changed:
----- Method: StackInterpreter>>extSendBytecode (in category 'send bytecodes') -----
extSendBytecode
"238 11101110 i i i i i j j j Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
| byte rcvr |
byte := self fetchByte.
messageSelector := self literal: (byte >> 3) + (extA << 5).
extA := 0.
argumentCount := (byte bitAnd: 7) + (extB << 3).
extB := 0.
rcvr := self internalStackValue: argumentCount.
+ lkupClassTag := objectMemory fetchClassTagOf: rcvr.
+ self assert: lkupClassTag ~= objectMemory nilObject.
- lkupClass := objectMemory fetchClassOf: rcvr.
- self assert: lkupClass ~= objectMemory nilObject.
self commonSend!
Item was removed:
- ----- Method: StackInterpreter>>findNewMethodInClass: (in category 'message sending') -----
- findNewMethodInClass: class
- "Find the compiled method to be run when the current
- messageSelector is sent to the given class, setting the values
- of 'newMethod' and 'primitiveIndex'."
- | ok |
- <inline: false>
- ok := self lookupInMethodCacheSel: messageSelector class: class.
- ok ifFalse: "entry was not found in the cache; look it up the hard way "
- [self lookupMethodInClass: class.
- self addNewMethodToCache: class]!
Item was added:
+ ----- Method: StackInterpreter>>findNewMethodInClassTag: (in category 'message sending') -----
+ findNewMethodInClassTag: classTag
+ "Find the compiled method to be run when the current
+ messageSelector is sent to the given class, setting the values
+ of 'newMethod' and 'primitiveIndex'."
+ | ok class |
+ <inline: false>
+ ok := self lookupInMethodCacheSel: messageSelector classTag: classTag.
+ ok ifFalse: "entry was not found in the cache; look it up the hard way "
+ [class := objectMemory classForClassTag: classTag.
+ self lookupMethodInClass: class.
+ self addNewMethodToCache: class]!
Item was changed:
----- Method: StackInterpreter>>internalFindNewMethod (in category 'message sending') -----
internalFindNewMethod
"Find the compiled method to be run when the current messageSelector is sent to the class 'lkupClass', setting the values of 'newMethod' and 'primitiveIndex'."
| ok |
<inline: true>
+ ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag.
- ok := self lookupInMethodCacheSel: messageSelector class: lkupClass.
ok ifFalse: "entry was not found in the cache; look it up the hard way"
+ [lkupClass := objectMemory classForClassTag: lkupClassTag.
+ self externalizeIPandSP.
+ self lookupMethodInClass: lkupClass.
+ self internalizeIPandSP.
+ self addNewMethodToCache: lkupClass]!
- [self externalizeIPandSP.
- self lookupMethodInClass: lkupClass.
- self internalizeIPandSP.
- self addNewMethodToCache: lkupClass]!
Item was removed:
- ----- Method: StackInterpreter>>lookupInMethodCacheSel:class: (in category 'method lookup cache') -----
- lookupInMethodCacheSel: selector class: class
- "This method implements a simple method lookup cache. If an entry for the given selector and class is found in the cache, set the values of 'newMethod' and 'primitiveFunctionPointer' and return true. Otherwise, return false."
- "About the re-probe scheme: The hash is the low bits of the XOR of two large addresses, minus their useless lowest two bits. If a probe doesn't get a hit, the hash is shifted right one bit to compute the next probe, introducing a new randomish bit. The cache is probed CacheProbeMax times before giving up."
- "WARNING: Since the hash computation is based on the object addresses of the class and selector, we must rehash or flush when compacting storage. We've chosen to flush, since that also saves the trouble of updating the addresses of the objects in the cache."
-
- | hash probe |
- <inline: true>
- <asmLabel: false>
- hash := selector bitXor: class. "shift drops two low-order zeros from addresses"
-
- probe := hash bitAnd: MethodCacheMask. "first probe"
- (((methodCache at: probe + MethodCacheSelector) = selector) and:
- [(methodCache at: probe + MethodCacheClass) = class]) ifTrue:
- [newMethod := methodCache at: probe + MethodCacheMethod.
- primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
- to: #'void (*)()'.
- ^ true "found entry in cache; done"].
-
- probe := (hash >> 1) bitAnd: MethodCacheMask. "second probe"
- (((methodCache at: probe + MethodCacheSelector) = selector) and:
- [(methodCache at: probe + MethodCacheClass) = class]) ifTrue:
- [newMethod := methodCache at: probe + MethodCacheMethod.
- primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
- to: #'void (*)()'.
- ^ true "found entry in cache; done"].
-
- probe := (hash >> 2) bitAnd: MethodCacheMask.
- (((methodCache at: probe + MethodCacheSelector) = selector) and:
- [(methodCache at: probe + MethodCacheClass) = class]) ifTrue:
- [newMethod := methodCache at: probe + MethodCacheMethod.
- primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
- to: #'void (*)()'.
- ^ true "found entry in cache; done"].
-
- ^ false
- !
Item was added:
+ ----- Method: StackInterpreter>>lookupInMethodCacheSel:classTag: (in category 'method lookup cache') -----
+ lookupInMethodCacheSel: selector classTag: classTag
+ "This method implements a simple method lookup cache. If an entry for the given selector and classTag is
+ found in the cache, set the values of 'newMethod' and 'primitiveFunctionPointer' and answer true. Otherwise,
+ answer false."
+ "About the re-probe scheme: The hash is the low bits of the XOR of two large addresses, minus their useless
+ lowest two bits. If a probe doesn't get a hit, the hash is shifted right one bit to compute the next probe,
+ introducing a new randomish bit. The cache is probed CacheProbeMax times before giving up."
+ "WARNING: Since the hash computation is based on the object addresses of the class and selector, we must
+ rehash or flush when compacting storage. We've chosen to flush, since that also saves the trouble of updating
+ the addresses of the objects in the cache."
+ "classTag is either a class object, if using NewObjectMemory, or a classIndex, if using SpurMemoryManager."
+
+ | hash probe |
+ <inline: true>
+ <asmLabel: false>
+ hash := selector bitXor: classTag. "shift drops two low-order zeros from addresses"
+
+ probe := hash bitAnd: MethodCacheMask. "first probe"
+ (((methodCache at: probe + MethodCacheSelector) = selector) and:
+ [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue:
+ [newMethod := methodCache at: probe + MethodCacheMethod.
+ primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
+ to: #'void (*)()'.
+ ^true "found entry in cache; done"].
+
+ probe := (hash >> 1) bitAnd: MethodCacheMask. "second probe"
+ (((methodCache at: probe + MethodCacheSelector) = selector) and:
+ [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue:
+ [newMethod := methodCache at: probe + MethodCacheMethod.
+ primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
+ to: #'void (*)()'.
+ ^true "found entry in cache; done"].
+
+ probe := (hash >> 2) bitAnd: MethodCacheMask.
+ (((methodCache at: probe + MethodCacheSelector) = selector) and:
+ [(methodCache at: probe + MethodCacheClass) = classTag]) ifTrue:
+ [newMethod := methodCache at: probe + MethodCacheMethod.
+ primitiveFunctionPointer := self cCoerceSimple: (methodCache at: probe + MethodCachePrimFunction)
+ to: #'void (*)()'.
+ ^true "found entry in cache; done"].
+
+ ^false!
Item was changed:
----- Method: StackInterpreter>>normalSend (in category 'send bytecodes') -----
normalSend
"Send a message, starting lookup with the receiver's class."
"Assume: messageSelector and argumentCount have been set, and that
the receiver and arguments have been pushed onto the stack,"
"Note: This method is inlined into the interpreter dispatch loop."
<sharedCodeNamed: 'normalSend' inCase: #singleExtendedSendBytecode>
| rcvr |
rcvr := self internalStackValue: argumentCount.
+ lkupClassTag := objectMemory fetchClassTagOf: rcvr.
+ self assert: lkupClassTag ~= objectMemory nilObject.
- lkupClass := objectMemory fetchClassOf: rcvr.
- self assert: lkupClass ~= objectMemory nilObject.
self commonSend!
Item was changed:
----- Method: StackInterpreter>>primitiveObject:perform:withArguments:lookedUpIn: (in category 'control primitives') -----
primitiveObject: actualReceiver perform: selector withArguments: argumentArray lookedUpIn: lookupClass
"Common routine used by perform:withArgs:, perform:withArgs:inSuperclass:,
object:perform:withArgs:inClass: et al. Answer nil on success.
NOTE: The case of doesNotUnderstand: is not a failure to perform.
The only failures are arg types and consistency of argumentCount.
Since we're in the stack VM we can assume there is space to push the arguments
provided they are within limits (max argument count is 15). We can therefore deal
with the arbitrary amount of state to remove from the stack (lookup class, selector,
mirror receiver) and arbitrary argument orders by deferring popping anything until
we know whether the send has succeeded. So on failure we merely have to remove
the actual receiver and arguments pushed, and on success we have to slide the actual
receiver and arguments down to replace the original ones."
| arraySize performArgCount delta |
(objectMemory isArray: argumentArray) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
"Check if number of arguments is reasonable; MaxNumArgs isn't available
so just use LargeContextSize"
arraySize := objectMemory fetchWordLengthOf: argumentArray.
arraySize > LargeContextSlots ifTrue:
[^self primitiveFailFor: PrimErrBadNumArgs].
performArgCount := argumentCount.
"Push newMethod to save it in case of failure,
then push the actual receiver and args out of the array."
self push: newMethod.
self push: actualReceiver.
"Copy the arguments to the stack, and execute"
1 to: arraySize do:
[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
argumentCount := arraySize.
messageSelector := selector.
self sendBreak: messageSelector + BaseHeaderSize
point: (objectMemory lengthOf: messageSelector)
receiver: actualReceiver.
self printSends ifTrue:
[self printActivationNameForSelector: messageSelector startClass: lookupClass; cr].
+ self findNewMethodInClassTag: (objectMemory classTagForClass: lookupClass).
- self findNewMethodInClass: lookupClass.
"Only test CompiledMethods for argument count - any other objects playacting as CMs will have to take their chances"
((objectMemory isOopCompiledMethod: newMethod)
and: [(self argumentCountOf: newMethod) ~= argumentCount]) ifTrue:
["Restore the state by popping all those array entries and pushing back the selector and array, and fail"
self pop: arraySize + 1.
newMethod := self popStack.
^self primitiveFailFor: PrimErrBadNumArgs].
"Cannot fail this primitive from here-on. Slide the actual receiver and arguments down
to replace the perform arguments and saved newMethod and then execute the new
method. Use argumentCount not arraySize because an MNU may have changed it."
delta := BytesPerWord * (performArgCount + 2). "+2 = receiver + saved newMethod"
argumentCount * BytesPerWord to: 0 by: BytesPerWord negated do:
[:offset|
stackPages
longAt: stackPointer + offset + delta
put: (stackPages longAt: stackPointer + offset)].
self pop: performArgCount + 2.
self executeNewMethod.
self initPrimCall. "Recursive xeq affects primErrorCode"
^nil!
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>
self flag: #obsolete.
+ lkupClassTag := self fetchClassTagOfNonImm: (self splObj: ClassAlien).
- lkupClass := self fetchClassOfNonImm: (self splObj: ClassAlien).
messageSelector := self splObj: SelectorInvokeCallback.
argumentCount := 4.
+ (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
+ [lkupClass := objectMemory classForClassTag: lkupClassTag.
+ (self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
- (self lookupInMethodCacheSel: messageSelector class: lkupClass) ifFalse:
- [(self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
[^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 *'>
+ lkupClassTag := self fetchClassTagOfNonImm: (self splObj: ClassAlien).
- lkupClass := self fetchClassOfNonImm: (self splObj: ClassAlien).
messageSelector := self splObj: SelectorInvokeCallback.
+ (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
+ [lkupClass := objectMemory classForClassTag: lkupClassTag.
+ (self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
- (self lookupInMethodCacheSel: messageSelector class: lkupClass) ifFalse:
- [(self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
[^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!
Item was changed:
----- Method: StackInterpreter>>sendLiteralSelector0ArgsBytecode (in category 'send bytecodes') -----
sendLiteralSelector0ArgsBytecode
"Can use any of the first 16 literals for the selector."
| rcvr |
messageSelector := self literal: (currentBytecode bitAnd: 16rF).
argumentCount := 0.
rcvr := self internalStackValue: 0.
+ lkupClassTag := objectMemory fetchClassTagOf: rcvr.
+ self assert: lkupClassTag ~= objectMemory nilObject.
- lkupClass := objectMemory fetchClassOf: rcvr.
- self assert: lkupClass ~= objectMemory nilObject.
self commonSend!
Item was changed:
----- Method: StackInterpreter>>sendLiteralSelector1ArgBytecode (in category 'send bytecodes') -----
sendLiteralSelector1ArgBytecode
"Can use any of the first 16 literals for the selector."
| rcvr |
messageSelector := self literal: (currentBytecode bitAnd: 16rF).
argumentCount := 1.
rcvr := self internalStackValue: 1.
+ lkupClassTag := objectMemory fetchClassTagOf: rcvr.
+ self assert: lkupClassTag ~= objectMemory nilObject.
- lkupClass := objectMemory fetchClassOf: rcvr.
- self assert: lkupClass ~= objectMemory nilObject.
self commonSend!
Item was changed:
----- Method: StackInterpreter>>sendLiteralSelector2ArgsBytecode (in category 'send bytecodes') -----
sendLiteralSelector2ArgsBytecode
"Can use any of the first 16 literals for the selector."
| rcvr |
messageSelector := self literal: (currentBytecode bitAnd: 16rF).
argumentCount := 2.
rcvr := self internalStackValue: 2.
+ lkupClassTag := objectMemory fetchClassTagOf: rcvr.
+ self assert: lkupClassTag ~= objectMemory nilObject.
- lkupClass := objectMemory fetchClassOf: rcvr.
- self assert: lkupClass ~= objectMemory nilObject.
self commonSend!
Item was changed:
----- Method: StackInterpreter>>superclassSend (in category 'send bytecodes') -----
superclassSend
"Send a message to self, starting lookup with the superclass of the class
containing the currently executing method."
"Assume: messageSelector and argumentCount have been set, and that
the receiver and arguments have been pushed onto the stack,"
"Note: This method is inlined into the interpreter dispatch loop."
<sharedCodeNamed: 'commonSupersend' inCase: #singleExtendedSuperBytecode>
+ lkupClassTag := objectMemory classTagForClass: (self superclassOf: (self methodClassOf: method)).
+ self assert: lkupClassTag ~= objectMemory nilObject.
- lkupClass := self superclassOf: (self methodClassOf: method).
- self assert: lkupClass ~= objectMemory nilObject.
self commonSend!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitivePerform (in category 'control primitives') -----
primitivePerform
<returnTypeC: #void>
+ | performSelector newReceiver lookupClassTag performMethod |
- | performSelector newReceiver lookupClass performMethod |
performSelector := messageSelector.
performMethod := newMethod.
messageSelector := self stackValue: argumentCount - 1.
newReceiver := self stackValue: argumentCount.
"NOTE: the following lookup may fail and be converted to #doesNotUnderstand:,
so we must adjust argumentCount and slide args now, so that will work."
"Slide arguments down over selector"
argumentCount := argumentCount - 1.
argumentCount to: 1 by: -1 do:
[:i|
stackPages
longAt: stackPointer + (i * BytesPerWord)
put: (stackPages longAt: stackPointer + ((i - 1) * BytesPerWord))].
self pop: 1.
+ lookupClassTag := objectMemory fetchClassTagOf: newReceiver.
- lookupClass := objectMemory fetchClassOf: newReceiver.
self sendBreak: messageSelector + BaseHeaderSize
point: (objectMemory lengthOf: messageSelector)
receiver: newReceiver.
self printSends ifTrue:
+ [self printActivationNameForSelector: messageSelector
+ startClass: (objectMemory classForClassTag: lookupClassTag); cr].
+ self findNewMethodInClassTag: lookupClassTag.
- [self printActivationNameForSelector: messageSelector startClass: lookupClass; cr].
- self findNewMethodInClass: lookupClass.
"Only test CompiledMethods for argument count - other objects will have to take their chances"
((objectMemory isOopCompiledMethod: newMethod)
and: [(self argumentCountOf: newMethod) = argumentCount]) ifFalse:
["Slide the args back up (sigh) and re-insert the selector."
self unPop: 1.
1 to: argumentCount by: 1 do:
[:i |
stackPages longAt: stackPointer + ((i - 1) * BytesPerWord)
put: (stackPages longAt: stackPointer + (i * BytesPerWord))].
stackPages longAt: stackPointer + (argumentCount * BytesPerWord) put: messageSelector.
argumentCount := argumentCount + 1.
newMethod := performMethod.
messageSelector := performSelector.
^self primitiveFail].
self executeNewMethod.
"Recursive xeq affects primErrorCode"
self initPrimCall!
Item was removed:
- ----- Method: StackInterpreterSimulator>>findNewMethodInClass: (in category 'testing') -----
- findNewMethodInClass: class
- "
- | cName |
- traceOn ifTrue:
- [cName := (self sizeBitsOf: class) = 16r20
- ifTrue: ['class ' , (self nameOfClass: (self fetchPointer: 6 ofObject: class))]
- ifFalse: [(self nameOfClass: class)].
- self cr; print: cName , '>>' , (self stringOf: messageSelector)].
- "
- (self stringOf: messageSelector) = 'doesNotUnderstand:' ifTrue: [self halt].
-
- sendCount := sendCount + 1.
-
- printSends ifTrue:
- [self cr; print: byteCount; space; printStringOf: messageSelector; cr].
- "
- (sendCount > 1000 and: [sendCount\\10 = 0]) ifTrue:
- [Transcript print: sendCount; space.
- self validate].
- "
- "
- (sendCount > 100150) ifTrue:
- [self qvalidate.
- messageQueue == nil ifTrue: [messageQueue := OrderedCollection new].
- messageQueue addLast: (self stringOf: messageSelector)].
- "
- super findNewMethodInClass: class.!
Item was added:
+ ----- Method: StackInterpreterSimulator>>findNewMethodInClassTag: (in category 'testing') -----
+ findNewMethodInClassTag: classTag
+ "
+ | cName |
+ traceOn ifTrue:
+ [cName := (self sizeBitsOf: class) = 16r20
+ ifTrue: ['class ' , (self nameOfClass: (self fetchPointer: 6 ofObject: class))]
+ ifFalse: [(self nameOfClass: class)].
+ self cr; print: cName , '>>' , (self stringOf: messageSelector)].
+ "
+ (self stringOf: messageSelector) = 'doesNotUnderstand:' ifTrue: [self halt].
+
+ sendCount := sendCount + 1.
+
+ printSends ifTrue:
+ [self cr; print: byteCount; space; printStringOf: messageSelector; cr].
+ "
+ (sendCount > 1000 and: [sendCount\\10 = 0]) ifTrue:
+ [Transcript print: sendCount; space.
+ self validate].
+ "
+ "
+ (sendCount > 100150) ifTrue:
+ [self qvalidate.
+ messageQueue == nil ifTrue: [messageQueue := OrderedCollection new].
+ messageQueue addLast: (self stringOf: messageSelector)].
+ "
+ ^super findNewMethodInClassTag: classTag!
Item was changed:
----- Method: StackInterpreterSimulator>>shortPrint: (in category 'debug support') -----
shortPrint: oop
| name classOop |
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue: [^ '=$' , (objectMemory integerValueOf: oop) printString ,
' (' , (String with: (Character value: (objectMemory integerValueOf: oop))) , ')'].
(objectMemory isIntegerObject: oop) ifTrue: [^ '=' , (objectMemory integerValueOf: oop) printString ,
' (' , (objectMemory integerValueOf: oop) hex , ')'].
^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')'].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [' is not on the heap']].
+ (objectMemory isFreeObject: oop) ifTrue:
+ [^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString].
+ (objectMemory isForwarded: oop) ifTrue:
+ [^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
+ ' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
classOop := objectMemory fetchClassOfNonImm: oop.
(objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
[^'class ' , (self nameOfClass: oop)].
name := self nameOfClass: classOop.
name size = 0 ifTrue: [name := '??'].
name = 'String' ifTrue: [^ (self stringOf: oop) printString].
name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters; ObjectMemory does not"
[^ '=' , (Character value: (objectMemory integerValueOf:
(objectMemory fetchPointer: 0 ofObject: oop))) printString].
name = 'UndefinedObject' ifTrue: [^ 'nil'].
name = 'False' ifTrue: [^ 'false'].
name = 'True' ifTrue: [^ 'true'].
name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
name = 'Association' ifTrue: [^ '(' ,
(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
' -> ' ,
(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
('AEIOU' includes: name first)
ifTrue: [^ 'an ' , name]
ifFalse: [^ 'a ' , name]!
Item was changed:
----- Method: StackToRegisterMappingCogit>>compileOpenPIC:numArgs: (in category 'in-line cacheing') -----
compileOpenPIC: selector numArgs: numArgs
"Compile the code for an open PIC. Perform a probe of the first-level method
lookup cache followed by a call of ceSendFromOpenPIC: if the probe fails.
Override to push the register args when calling ceSendFromOpenPIC:"
| jumpSelectorMiss jumpClassMiss itsAHit jumpBCMethod routine |
<var: #jumpSelectorMiss type: #'AbstractInstruction *'>
<var: #jumpClassMiss type: #'AbstractInstruction *'>
<var: #itsAHit type: #'AbstractInstruction *'>
<var: #jumpBCMethod type: #'AbstractInstruction *'>
self compilePICProlog: numArgs.
self AlignmentNops: (BytesPerWord max: 8).
entry := self Label.
+ objectRepresentation genGetClassTagOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
- objectRepresentation genGetClassObjectOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
+ "Do first of three probes. See CoInterpreter>>lookupInMethodCacheSel:classTag:"
+ self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
- "Do first of three probes. See CoInterpreter>>lookupInMethodCacheSel:class:"
- self flag: #lookupInMethodCacheSel:class:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
self MoveR: ClassReg R: SendNumArgsReg.
self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
self LogicalShiftLeftCq: ShiftForWord R: ClassReg.
self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
r: ClassReg
R: TempReg.
self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
jumpSelectorMiss := self JumpNonZero: 0.
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
r: ClassReg
R: TempReg.
self CmpR: SendNumArgsReg R: TempReg.
jumpClassMiss := self JumpNonZero: 0.
itsAHit := self Label.
"Fetch the method. The interpret trampoline requires the bytecoded method in SendNumArgsReg"
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheMethod << ShiftForWord)
r: ClassReg
R: SendNumArgsReg.
"If the method is compiled jump to its unchecked entry-point, otherwise interpret it."
objectRepresentation
genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: TempReg.
self MoveR: TempReg R: ClassReg.
jumpBCMethod := objectRepresentation genJumpSmallIntegerInScratchReg: TempReg.
jumpBCMethod jmpTarget: interpretCall.
self AddCq: cmNoCheckEntryOffset R: ClassReg.
self JumpR: ClassReg.
"First probe missed. Do second of three probes. Shift hash right one and retry."
jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
self MoveR: SendNumArgsReg R: ClassReg.
self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
self LogicalShiftLeftCq: ShiftForWord - 1 R: ClassReg.
self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
r: ClassReg
R: TempReg.
self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
jumpSelectorMiss := self JumpNonZero: 0.
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
r: ClassReg
R: TempReg.
self CmpR: SendNumArgsReg R: TempReg.
self JumpZero: itsAHit.
"Second probe missed. Do last probe. Shift hash right two and retry."
jumpSelectorMiss jmpTarget: self Label.
self MoveR: SendNumArgsReg R: ClassReg.
self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
ShiftForWord > 2 ifTrue:
[self LogicalShiftLeftCq: ShiftForWord - 1 R: ClassReg].
self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
r: ClassReg
R: TempReg.
self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
jumpSelectorMiss := self JumpNonZero: 0.
self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
r: ClassReg
R: TempReg.
self CmpR: SendNumArgsReg R: TempReg.
self JumpZero: itsAHit.
"Last probe missed. Call ceSendFromOpenPIC: to do the full lookup."
jumpSelectorMiss jmpTarget: self Label.
self genPushRegisterArgsForNumArgs: numArgs.
self genSaveStackPointers.
self genLoadCStackPointers.
methodLabel addDependent: (self annotateAbsolutePCRef: (self MoveCw: methodLabel asInteger R: SendNumArgsReg)).
cStackAlignment > BytesPerWord ifTrue:
[backEnd
genAlignCStackSavingRegisters: false
numArgs: 1
wordAlignment: cStackAlignment / BytesPerWord].
backEnd genPassReg: SendNumArgsReg asArgument: 0.
routine := self cCode: '(sqInt)ceSendFromInLineCacheMiss'
inSmalltalk: [self simulatedAddressFor: #ceSendFromInLineCacheMiss:].
self annotateCall: (self Call: routine)
"Note that this call does not return."!
More information about the Vm-dev
mailing list