[Vm-dev] VM Maker: VMMaker.oscog-eem.528.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Dec 2 22:11:17 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.528.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.528
Author: eem
Time: 2 December 2013, 2:07:47.689 pm
UUID: 65840335-f6a4-4105-8afa-1b612a90e414
Ancestors: VMMaker.oscog-eem.527
Implement forwarding send faults from maqchine code and update
CoInterpreter's extant send fault code to match StackInterpreter's.
Refactor and rename StackInterpreter>>followField:in: into
ObjectMemory/SpurMemoryManager>>followField:ofObject:.
Implement forwarder following in makeBaseFrameFor:.
Nuke InterpreterStackPage's LargeContextBytes and refer to
LargeContextSize directly (to eliminate a source of initialization
bugs).
Fix adding a segment which is contiguous with another. Bridges
must be able to have zero length and hence have either 64-bit or
128-bit headers. Simulator changed to allocate segments
alternating between ajacent and disjoint.
Fix isScavengeSurvivor: in the Cogit (use isReallyYoung: to filter-out
cog methods).
Fix bug in allocateOldSpaceChunkOfBytes: which cauised failure to
allocate correctly-sized solitary tree node.
Fix bug in fillHighestObjectsWithMovableObjectsFrom:upTo: causing
filling of highestObjects to burst its banks.
Comment, categorization, returnType fixes and <api> marking.
=============== Diff against VMMaker.oscog-eem.527 ===============
Item was changed:
----- Method: CoInterpreter>>ceSendFromInLineCacheMiss: (in category 'trampolines') -----
+ ceSendFromInLineCacheMiss: cogMethodOrPIC
- 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),
+ or when a send has failed due to a forwarded receiver."
- or to continue when PIC creation has failed (e.g. because we're out of code space)."
<api>
+ <var: #cogMethodOrPIC type: #'CogMethod *'>
- <var: #oPIC type: #'CogMethod *'>
| numArgs rcvr classTag errSelIdx |
"self printFrame: stackPage headFP WithSP: stackPage headSP"
"self printStringOf: selector"
+ numArgs := cogMethodOrPIC cmNumArgs.
- numArgs := oPIC cmNumArgs.
rcvr := self stackValue: numArgs + 1. "skip return pc"
self assert: (objectMemory addressCouldBeOop: rcvr).
classTag := objectMemory fetchClassTagOf: rcvr.
argumentCount := numArgs.
+ (self lookupInMethodCacheSel: cogMethodOrPIC selector classTag: classTag)
- (self lookupInMethodCacheSel: oPIC selector classTag: classTag)
ifTrue:"check for coggability because method is in the cache"
[self
ifAppropriateCompileToNativeCode: newMethod
+ selector: cogMethodOrPIC selector]
- selector: oPIC selector]
ifFalse:
+ [messageSelector := cogMethodOrPIC selector.
+ ((objectMemory isOopForwarded: messageSelector)
+ or: [objectMemory isForwardedClassTag: classTag]) ifTrue:
+ [(objectMemory isOopForwarded: messageSelector) ifTrue:
+ [messageSelector := self handleForwardedSelectorFaultFor: messageSelector].
+ (objectMemory isForwardedClassTag: classTag) ifTrue:
+ [classTag := self handleForwardedSendFaultFor: classTag]].
- [messageSelector := oPIC selector.
(errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
"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>>findNewMethodInClassTag: (in category 'message sending') -----
+ findNewMethodInClassTag: classTagArg
- 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 classTag |
- | ok class |
<inline: false>
+ ok := self lookupInMethodCacheSel: messageSelector classTag: classTagArg.
- ok := self lookupInMethodCacheSel: messageSelector classTag: classTag.
ok ifTrue:
[self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]
ifFalse:
+ ["entry was not found in the cache; perhaps soemthing was forwarded."
+ classTag := classTagArg.
+ ((objectMemory isOopForwarded: messageSelector)
+ or: [objectMemory isForwardedClassTag: classTag]) ifTrue:
+ [(objectMemory isOopForwarded: messageSelector) ifTrue:
+ [messageSelector := self handleForwardedSelectorFaultFor: messageSelector].
+ (objectMemory isForwardedClassTag: classTag) ifTrue:
+ [classTag := self handleForwardedSendFaultFor: classTag].
+ ok := self lookupInMethodCacheSel: messageSelector classTag: classTag.
+ ok ifTrue:
+ [^self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]].
+ "entry was not found in the cache; look it up the hard way "
- ["entry was not found in the cache; look it up the hard way "
class := objectMemory classForClassTag: classTag.
- objectMemory hasSpurMemoryManagerAPI ifTrue:
- [| oop |
- oop := self stackValue: argumentCount.
- ((objectMemory isNonImmediate: oop)
- and: [objectMemory isForwarded: oop]) ifTrue:
- [self stackValue: argumentCount put: (objectMemory followForwarded: oop)]].
self lookupMethodInClass: class.
self addNewMethodToCache: class]!
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 ifTrue:
[self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]
ifFalse:
[self externalizeIPandSP.
((objectMemory isOopForwarded: messageSelector)
or: [objectMemory isForwardedClassTag: lkupClassTag]) ifTrue:
[(objectMemory isOopForwarded: messageSelector) ifTrue:
[messageSelector := self handleForwardedSelectorFaultFor: messageSelector].
(objectMemory isForwardedClassTag: lkupClassTag) ifTrue:
[lkupClassTag := self handleForwardedSendFaultFor: lkupClassTag].
ok := self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag.
ok ifTrue:
+ [^self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]].
- [self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector.
- ^nil]].
lkupClass := objectMemory classForClassTag: lkupClassTag.
self lookupMethodInClass: lkupClass.
self internalizeIPandSP.
self addNewMethodToCache: lkupClass]!
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 rcvr |
- | 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 followField: MethodIndex ofObject: aContext.
- 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.
+ rcvr := objectMemory followField: ReceiverIndex ofObject: 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: rcvr].
- 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).
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: rcvr.
- 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:
----- Method: Cogit>>ceCPICMiss:receiver: (in category 'in-line cacheing') -----
ceCPICMiss: cPIC receiver: receiver
"Code entry closed PIC miss. A send has fallen
through a closed (finite) polymorphic inline cache.
Either extend it or patch the send site to an open PIC.
The stack looks like:
receiver
args
sp=> sender return address"
<var: #cPIC type: #'CogMethod *'>
<api>
| outerReturn newTargetMethodOrNil errorSelectorOrNil cacheTag result |
self cCode: ''
inSmalltalk:
[cPIC isInteger ifTrue:
[^self ceCPICMiss: (self cogMethodSurrogateAt: cPIC) receiver: receiver]].
+ (objectMemory isOopForwarded: receiver) ifTrue:
+ [^coInterpreter ceSendFromInLineCacheMiss: cPIC].
outerReturn := coInterpreter stackTop.
cPIC cPICNumCases < numPICCases
ifTrue:
[self lookup: cPIC selector
for: receiver
methodAndErrorSelectorInto:
[:method :errsel|
newTargetMethodOrNil := method.
errorSelectorOrNil := errsel]]
ifFalse: [newTargetMethodOrNil := errorSelectorOrNil := nil].
"We assume lookupAndCog:for: will *not* reclaim the method zone"
self assert: outerReturn = coInterpreter stackTop.
cacheTag := objectRepresentation inlineCacheTagForInstance: receiver.
(cPIC cPICNumCases >= numPICCases
or: [(errorSelectorOrNil notNil and: [errorSelectorOrNil ~= SelectorDoesNotUnderstand])
or: [(objectRepresentation inlineCacheTagIsYoung: cacheTag)
or: [newTargetMethodOrNil isNil
or: [objectMemory isYoung: newTargetMethodOrNil]]]]) ifTrue:
[result := self patchToOpenPICFor: cPIC selector
numArgs: cPIC cmNumArgs
receiver: receiver.
self assert: result not. "If patchToOpenPICFor:.. returns we're out of code memory"
^coInterpreter ceSendFromInLineCacheMiss: cPIC].
"Now extend the PIC with the new case."
self cogExtendPIC: cPIC
CaseNMethod: newTargetMethodOrNil
tag: cacheTag
isMNUCase: errorSelectorOrNil = SelectorDoesNotUnderstand.
"Jump back into the pic at its entry in case this is an MNU."
coInterpreter
executeCogMethodFromLinkedSend: cPIC
withReceiver: receiver
andCacheTag: (backEnd inlineCacheTagAt: outerReturn).
"NOTREACHED"
^nil!
Item was changed:
----- Method: Cogit>>ceSICMiss: (in category 'in-line cacheing') -----
ceSICMiss: receiver
"An in-line cache check in a method has failed. The failing entry check has jumped
to the ceMethodAbort abort call at the start of the method which has called this routine.
If possible allocate a closed PIC for the current and existing classes.
The stack looks like:
receiver
args
sender return address
sp=> ceMethodAbort call return address
So we can find the method that did the failing entry check at
ceMethodAbort call return address - missOffset
and we can find the send site from the outer return address."
<api>
| pic innerReturn outerReturn entryPoint targetMethod newTargetMethodOrNil errorSelectorOrNil cacheTag extent result |
<var: #pic type: #'CogMethod *'>
<var: #targetMethod type: #'CogMethod *'>
"Whether we can relink to a PIC or not we need to pop off the inner return and identify the target method."
innerReturn := coInterpreter popStack.
targetMethod := self cCoerceSimple: innerReturn - missOffset to: #'CogMethod *'.
+ (objectMemory isOopForwarded: receiver) ifTrue:
+ [^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
outerReturn := coInterpreter stackTop.
self assert: (outerReturn between: methodZoneBase and: methodZone freeStart).
entryPoint := backEnd callTargetFromReturnAddress: outerReturn.
self assert: targetMethod selector ~= objectMemory nilObject.
self cppIf: NewspeakVM ifTrue:
[self assert: (targetMethod asInteger + cmEntryOffset = entryPoint
or: [targetMethod asInteger + cmDynSuperEntryOffset = entryPoint]).
"Avoid the effort of implementing PICs for the relatively low dynamic frequency
dynamic super send and simply rebind the send site."
targetMethod asInteger + cmDynSuperEntryOffset = entryPoint ifTrue:
[^coInterpreter
ceDynamicSuperSend: targetMethod selector
to: receiver
numArgs: targetMethod cmNumArgs]].
self assert: targetMethod asInteger + cmEntryOffset = entryPoint.
self lookup: targetMethod selector
for: receiver
methodAndErrorSelectorInto:
[:method :errsel|
newTargetMethodOrNil := method.
errorSelectorOrNil := errsel].
"We assume lookupAndCog:for: will *not* reclaim the method zone"
self assert: outerReturn = coInterpreter stackTop.
cacheTag := objectRepresentation inlineCacheTagForInstance: receiver.
((errorSelectorOrNil notNil and: [errorSelectorOrNil ~= SelectorDoesNotUnderstand])
or: [(objectRepresentation inlineCacheTagIsYoung: cacheTag)
or: [newTargetMethodOrNil isNil
or: [objectMemory isYoung: newTargetMethodOrNil]]]) ifTrue:
[result := self patchToOpenPICFor: targetMethod selector
numArgs: targetMethod cmNumArgs
receiver: receiver.
self assert: result not. "If patchToOpenPICFor:.. returns we're out of code memory"
^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
"See if an Open PIC is already available."
pic := methodZone openPICWithSelector: targetMethod selector.
pic isNil ifTrue:
["otherwise attempt to create a closed PIC for the two cases."
pic := self cogPICSelector: targetMethod selector
numArgs: targetMethod cmNumArgs
Case0Method: targetMethod
Case1Method: newTargetMethodOrNil
tag: cacheTag
isMNUCase: errorSelectorOrNil = SelectorDoesNotUnderstand.
(pic asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
["For some reason the PIC couldn't be generated, most likely a lack of code memory.
Continue as if this is an unlinked send."
pic asInteger = InsufficientCodeSpace ifTrue:
[coInterpreter callForCogCompiledCodeCompaction].
^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
processor flushICacheFrom: pic asInteger to: pic asInteger + closedPICSize].
"Relink the send site to the pic. If to an open PIC then reset the cache tag to the selector,
for the benefit of the cacheTag assert check in checkIfValidObjectRef:pc:cogMethod:."
extent := pic cmType = CMOpenPIC
ifTrue:
[backEnd
rewriteInlineCacheAt: outerReturn
tag: targetMethod selector
target: pic asInteger + cmEntryOffset]
ifFalse:
[backEnd
rewriteCallAt: outerReturn
target: pic asInteger + cmEntryOffset].
processor flushICacheFrom: outerReturn - 1 - extent to: outerReturn - 1.
"Jump back into the pic at its entry in case this is an MNU (newTargetMethodOrNil is nil)"
coInterpreter
executeCogMethodFromLinkedSend: pic
withReceiver: receiver
andCacheTag: (backEnd inlineCacheTagAt: outerReturn).
"NOTREACHED"
^nil!
Item was changed:
VMStructType subclass: #InterpreterStackPage
instanceVariableNames: 'stackLimit headSP headFP baseFP baseAddress realStackLimit lastAddress trace nextPage prevPage'
+ classVariableNames: ''
- classVariableNames: 'LargeContextBytes'
poolDictionaries: 'VMBasicConstants VMSqueakV3BytecodeConstants'
category: 'VMMaker-Interpreter'!
!InterpreterStackPage commentStamp: '<historical>' prior: 0!
I am a class that helps organize the StackInterpreter's collection of stack pages. I represent the control block for a single stack page in the collection of stack pages represented by an InterpreterStackPages instance.!
Item was removed:
- ----- Method: InterpreterStackPage class>>initialize (in category 'class initialization') -----
- initialize
- "InterpreterStackPage initialize"
- LargeContextBytes := LargeContextSize!
Item was changed:
----- Method: InterpreterStackPage>>headFP: (in category 'accessing') -----
headFP: pointer "<Integer>"
"Set the value of headFP"
"N.B. This assert is run in simulation only because headFP:
becomes a simple field assignment in the C code."
+ self assert: (pointer = 0 or: [pointer < baseAddress and: [realStackLimit - (LargeContextSize / 2) <= pointer]]).
- self assert: (pointer = 0 or: [pointer < baseAddress and: [realStackLimit - (LargeContextBytes / 2) <= pointer]]).
^headFP := pointer!
Item was changed:
----- Method: InterpreterStackPage>>headSP: (in category 'accessing') -----
headSP: pointer "<Integer>"
"Set the value of headSP"
"N.B. This assert is run in simulation only because headFP:
becomes a simple field assignment in the C code."
+ self assert: (pointer = 0 or: [pointer < baseAddress and: [realStackLimit - LargeContextSize <= pointer]]).
- self assert: (pointer = 0 or: [pointer < baseAddress and: [realStackLimit - LargeContextBytes <= pointer]]).
^headSP := pointer!
Item was added:
+ ----- Method: ObjectMemory>>followField:ofObject: (in category 'forward compatibility') -----
+ followField: fieldIndex ofObject: anObject
+ ^self fetchPointer: fieldIndex ofObject: anObject!
Item was changed:
----- Method: ObjectMemory>>isForwarded: (in category 'interpreter access') -----
isForwarded: oop
"Compatibility wth SpurMemoryManager. In ObjectMemory, no forwarding pointers
are visible to the VM."
+ <api>
+ <cmacro: '() false'>
<inline: true>
^false!
Item was changed:
----- Method: ObjectMemory>>isOopForwarded: (in category 'interpreter access') -----
isOopForwarded: oop
"Compatibility wth SpurMemoryManager. In ObjectMemory, no forwarding pointers
are visible to the VM."
+ <api>
+ <cmacro: '() false'>
<inline: true>
^false!
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 ceSendFromInLineCacheMiss: if the probe fails."
- 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.
"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 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 ceSendFromInLineCacheMiss: to do the full lookup."
- "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: Spur32BitMMLECoSimulator>>isIntegerObject: (in category 'object testing') -----
isIntegerObject: oop
"This list records the valid senders of isIntegerObject: as we replace uses of
isIntegerObject: by isImmediate: where appropriate."
| sel |
sel := thisContext sender method selector.
(#( DoIt
DoItIn:
on:do: "from the debugger"
makeBaseFrameFor:
quickFetchInteger:ofObject:
frameOfMarriedContext:
objCouldBeClassObj:
isMarriedOrWidowedContext:
shortPrint:
bytecodePrimAt
bytecodePrimAtPut
commonAt:
commonAtPut:
loadFloatOrIntFrom:
positive32BitValueOf:
primitiveExternalCall
checkedIntegerValueOf:
bytecodePrimAtPut
commonAtPut:
primitiveVMParameter
checkIsStillMarriedContext:currentFP:
displayBitsOf:Left:Top:Right:Bottom:
fetchStackPointerOf:
primitiveContextAt
primitiveContextAtPut
subscript:with:storing:format:
printContext:
compare31or32Bits:equal:
signed64BitValueOf:
primDigitMultiply:negative:
digitLength:
isNegativeIntegerValueOf:
magnitude64BitValueOf:
primitiveMakePoint
primitiveAsCharacter
primitiveInputSemaphore
baseFrameReturn
primitiveExternalCall
primDigitCompare:
isLiveContext:
numPointerSlotsOf:
fileValueOf:
loadBitBltDestForm
fetchIntOrFloat:ofObject:ifNil:
fetchIntOrFloat:ofObject:
loadBitBltSourceForm
loadPoint:from:
primDigitAdd:
primDigitSubtract:
positive64BitValueOf:
digitBitLogic:with:opIndex:
signed32BitValueOf:
isNormalized:
primDigitDiv:negative:
bytesOrInt:growTo:
primitiveNewMethod
isCogMethodReference:
functionForPrimitiveExternalCall:
genSpecialSelectorArithmetic
genSpecialSelectorComparison
ensureContextHasBytecodePC:
instVar:ofContext:
ceBaseFrameReturn:
inlineCacheTagForInstance:
primitiveObjectAtPut
commonVariable:at:put:cacheIndex:
primDigitBitShiftMagnitude:
externalInstVar:ofContext:
primitiveGrowMemoryByAtLeast
primitiveFileSetPosition
cogMethodDoesntLookKosher:
+ shortPrintOop:
+ primitiveSizeInBytesOfInstance) includes: sel) ifFalse:
- shortPrintOop:) includes: sel) ifFalse:
[self halt].
^super isIntegerObject: oop!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>longAt:put: (in category 'memory access') -----
longAt: byteAddress put: a32BitValue
"Note: Adjusted for Smalltalk's 1-based array indexing."
+ "(byteAddress = 16r32F600 and: [a32BitValue = 16rB31E18]) ifTrue:
- "(byteAddress = 16r32F644 and: [a32BitValue = 16r78FFB0]) ifTrue:
[self halt]."
byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
^memory at: byteAddress // 4 + 1 put: a32BitValue!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>setFree: (in category 'free space') -----
setFree: o
+ "o = 16rB34D40 ifTrue: [self halt]."
- "o = 16r113E7A8 ifTrue: [self halt]."
super setFree: o!
Item was changed:
----- Method: Spur32BitMemoryManager>>initSegmentBridgeWithBytes:at: (in category 'segments') -----
initSegmentBridgeWithBytes: numBytes at: address
<var: #numBytes type: #usqLong>
| numSlots |
"must have room for a double header"
self assert: (numBytes \\ self allocationUnit = 0
and: [numBytes >= (self baseHeaderSize + self baseHeaderSize)]).
- self flag: #endianness.
numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord.
+ self flag: #endianness.
+ numSlots = 0
+ ifTrue: "short bridge for adjacent segments"
+ [self longAt: address put: (1 << self pinnedBitShift)
+ + (self wordIndexableFormat << self formatShift)
+ + self segmentBridgePun;
+ longAt: address + 4 put: (1 << self markedBitHalfShift)]
+ ifFalse: "long bridge"
+ [self longAt: address put: numSlots;
+ longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift;
+ longAt: address + 8 put: (1 << self pinnedBitShift)
+ + (self wordIndexableFormat << self formatShift)
+ + self segmentBridgePun;
+ longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift
+ + (1 << self markedBitHalfShift)]!
- self longAt: address put: numSlots;
- longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift;
- longAt: address + 8 put: (1 << self pinnedBitShift)
- + (self wordIndexableFormat << self formatShift)
- + self segmentBridgePun;
- longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift
- + (1 << self markedBitHalfShift)!
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."
+ <returnTypeC: #usqLong>
| header headerNumSlots numSlots |
<var: 'header' type: #usqLong>
self flag: #endianness.
header := self longAt: objOop.
headerNumSlots := header >> self numSlotsFullShift.
numSlots := headerNumSlots = self numSlotsMask
ifTrue: [header bitAnd: 16rFFFFFFFFFFFFFF]
ifFalse: [headerNumSlots = 0 ifTrue: [1] ifFalse: [headerNumSlots]].
^numSlots << self shiftForWord
+ (headerNumSlots = self numSlotsMask
ifTrue: [self baseHeaderSize + self baseHeaderSize]
ifFalse: [self baseHeaderSize])!
Item was changed:
----- Method: Spur64BitMemoryManager>>initSegmentBridgeWithBytes:at: (in category 'segments') -----
initSegmentBridgeWithBytes: numBytes at: address
- | numSlots |
<var: #numBytes type: #usqLong>
+ | numSlots |
+ "must have room for a double header"
+ self assert: (numBytes \\ self allocationUnit = 0
+ and: [numBytes >= (self baseHeaderSize + self baseHeaderSize)]).
- self assert: (numBytes >= (self baseHeaderSize + self baseHeaderSize)
- and: [numBytes \\ self allocationUnit = 0]).
numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord.
+ numSlots = 0
+ ifTrue: "short bridge for adjacent segments"
+ [self longAt: address
+ put: (1 << self pinnedBitShift)
+ + (1 << self markedBitFullShift)
+ + (self wordIndexableFormat << self formatShift)
+ + self segmentBridgePun]
+ ifFalse: "long bridge"
+ [self longAt: address
+ put: self numSlotsMask << self numSlotsFullShift + numSlots;
+ longAt: address + self baseHeaderSize
+ put: (self numSlotsMask << self numSlotsFullShift)
+ + (1 << self pinnedBitShift)
+ + (1 << self markedBitFullShift)
+ + (self wordIndexableFormat << self formatShift)
+ + self segmentBridgePun]!
- self longAt: address
- put: self numSlotsMask << self numSlotsFullShift + numSlots;
- longAt: address + self baseHeaderSize
- put: (self numSlotsMask << self numSlotsFullShift)
- + (1 << self pinnedBitShift)
- + (1 << self markedBitFullShift)
- + (self wordIndexableFormat << self formatShift)
- + self segmentBridgePun!
Item was changed:
----- Method: SpurGenerationScavenger>>isScavengeSurvivor: (in category 'weakness and ephemerality') -----
isScavengeSurvivor: oop
"Answer whether the oop has survived a scavenge. This is equivalent to
| target |
(manager isImmediate: oop) ifTrue:
[^true].
target := (manager isForwarded: oop)
ifTrue: [manager followForwarded: oop]
ifFalse: [oop].
^((manager isInEden: target)
or: [(manager isInPastSpace: target)]) not"
| target |
(manager isImmediate: oop) ifTrue:
[^true].
(manager isForwarded: oop)
ifTrue: [target := manager followForwarded: oop]
ifFalse: [target := oop].
+ ^(manager isReallyYoung: target) not
- ^(manager isYoung: target) not
or: [manager isInFutureSpace: target]!
Item was changed:
----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') -----
allocateOldSpaceChunkOfBytes: chunkBytes
"Answer a chunk of oldSpace from the free lists, if available,
otherwise answer nil. Break up a larger chunk if one of the
exact size does not exist. N.B. the chunk is simply a pointer, it
has no valid header. The caller *must* fill in the header correctly."
| initialIndex chunk index nodeBytes parent child |
self assert: (lastSubdividedFreeChunk := 0) = 0.
"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
initialIndex := chunkBytes / self allocationUnit.
(initialIndex < self numFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue:
[(freeListsMask anyMask: 1 << initialIndex) ifTrue:
[(chunk := freeLists at: initialIndex) ~= 0 ifTrue:
[self assert: chunk = (self startOfObject: chunk).
self assert: (self isValidFreeObject: chunk).
^self unlinkFreeChunk: chunk atIndex: initialIndex].
freeListsMask := freeListsMask - (1 << initialIndex)].
"first search for free chunks of a multiple of chunkBytes in size"
index := initialIndex.
[(index := index + index) < self numFreeLists
and: [1 << index <= freeListsMask]] whileTrue:
[(freeListsMask anyMask: 1 << index) ifTrue:
[(chunk := freeLists at: index) ~= 0 ifTrue:
[self assert: chunk = (self startOfObject: chunk).
self assert: (self isValidFreeObject: chunk).
self unlinkFreeChunk: chunk atIndex: index.
self assert: (self bytesInObject: chunk) = (index * self allocationUnit).
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfObject: chunk) + chunkBytes.
^chunk].
freeListsMask := freeListsMask - (1 << index)]].
"now get desperate and use the first that'll fit.
Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
leave room for the forwarding pointer/next free link, we can only break chunks
that are at least 16 bytes larger, hence start at initialIndex + 2."
index := initialIndex + 1.
[(index := index + 1) < self numFreeLists
and: [1 << index <= freeListsMask]] whileTrue:
[(freeListsMask anyMask: 1 << index) ifTrue:
[(chunk := freeLists at: index) ~= 0 ifTrue:
[self assert: chunk = (self startOfObject: chunk).
self assert: (self isValidFreeObject: chunk).
self unlinkFreeChunk: chunk atIndex: index.
self assert: (self bytesInObject: chunk) = (index * self allocationUnit).
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfObject: chunk) + chunkBytes.
^chunk].
freeListsMask := freeListsMask - (1 << index)]]].
"Large chunk, or no space on small free lists. Search the large chunk list.
Large chunk list organized as a tree, each node of which is a list of chunks
of the same size. Beneath the node are smaller and larger blocks.
When the search ends parent should hold the smallest chunk at least as
large as chunkBytes, or 0 if none."
parent := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
[| childBytes |
self assert: (self isValidFreeObject: child).
childBytes := self bytesInObject: child.
childBytes = chunkBytes
ifTrue: "size match; try to remove from list at node."
[chunk := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: child.
chunk ~= 0 ifTrue:
[self assert: (self isValidFreeObject: chunk).
self storePointer: self freeChunkNextIndex
ofFreeChunk: child
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: chunk).
^self startOfObject: chunk].
+ nodeBytes := childBytes.
+ parent := child.
child := 0] "break out of loop to remove interior node"
ifFalse:
["Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
leave room for the forwarding pointer/next free link, we can only break chunks
that are at least 16 bytes larger, hence reject chunks < 2 * allocationUnit larger."
childBytes <= (chunkBytes + self allocationUnit)
ifTrue: "node too small; walk down the larger size of the tree"
[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
ifFalse:
[parent := child. "parent will be smallest node >= chunkBytes + allocationUnit"
nodeBytes := childBytes.
child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
parent = 0 ifTrue:
[totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
^nil].
"self printFreeChunk: parent"
self assert: (nodeBytes = chunkBytes or: [nodeBytes >= (chunkBytes + (2 * self allocationUnit))]).
self assert: (self bytesInObject: parent) = nodeBytes.
"attempt to remove from list"
chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent.
chunk ~= 0 ifTrue:
[self assert: (chunkBytes = nodeBytes or: [chunkBytes + self allocationUnit < nodeBytes]).
self storePointer: self freeChunkNextIndex
ofFreeChunk: parent
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: chunk).
chunkBytes ~= nodeBytes ifTrue:
[self freeChunkWithBytes: nodeBytes - chunkBytes
at: (self startOfObject: chunk) + chunkBytes].
^self startOfObject: chunk].
"no list; remove the interior node"
chunk := parent.
self unlinkSolitaryFreeTreeNode: chunk.
"if there's space left over, add the fragment back."
chunkBytes ~= nodeBytes ifTrue:
[self freeChunkWithBytes: nodeBytes - chunkBytes
at: (self startOfObject: chunk) + chunkBytes].
^self startOfObject: chunk!
Item was changed:
----- Method: SpurMemoryManager>>fillHighestObjectsWithMovableObjectsFrom:upTo: (in category 'compaction') -----
fillHighestObjectsWithMovableObjectsFrom: startObj upTo: limitObj
"Refill highestObjects with movable objects up to, but not including limitObj.
c.f. the loop in freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace."
| lastHighest highestObjectsWraps firstFree |
highestObjects resetAsEmpty.
lastHighest := highestObjects last.
highestObjectsWraps := firstFree := 0.
self allOldSpaceEntitiesFrom: startObj do:
[:o|
(self oop: o isGreaterThanOrEqualTo: limitObj) ifTrue:
[highestObjects last: lastHighest.
(firstFree ~= 0 and: [(self isFreeObject: firstFreeChunk) not]) ifTrue:
[firstFreeChunk := firstFree].
^self].
(self isFreeObject: o)
ifTrue: [firstFree = 0 ifTrue:
[firstFree := o]]
ifFalse:
[((self isForwarded: o) or: [self isPinned: o]) ifFalse:
[false "conceptually...: "
ifTrue: [highestObjects addLast: o]
ifFalse: "but we inline so we can use the local lastHighest"
[(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue:
+ [highestObjectsWraps := highestObjectsWraps + 1.
+ lastHighest := highestObjects start].
- [highestObjectsWraps := highestObjectsWraps + 1].
self longAt: lastHighest put: o]]]].
highestObjects last: lastHighest.
(firstFree ~= 0 and: [(self isFreeObject: firstFreeChunk) not]) ifTrue:
[firstFreeChunk := firstFree]!
Item was added:
+ ----- Method: SpurMemoryManager>>followField:ofObject: (in category 'forwarding') -----
+ followField: fieldIndex ofObject: anObject
+ "Make sure the oop at fieldIndex in anObject is not forwarded (follow the
+ forwarder there-in if so). Answer the (possibly followed) oop at fieldIndex.
+ N.B. the oop is assumed to be non-immediate."
+ | objOop |
+ objOop := self fetchPointer: fieldIndex ofObject: anObject.
+ self assert: (self isNonImmediate: objOop).
+ (self isForwarded: objOop) ifTrue:
+ [objOop := self followForwarded: objOop.
+ self storePointer: fieldIndex ofObject: anObject withValue: objOop].
+ ^objOop!
Item was changed:
+ ----- Method: SpurMemoryManager>>followForwarded: (in category 'forwarding') -----
- ----- Method: SpurMemoryManager>>followForwarded: (in category 'become api') -----
followForwarded: objOop
"Follow a forwarding pointer. Alas we cannot prevent forwarders to forwarders
being created by lazy become. Consider the following example by Igor Stasenko:
array := { a. b. c }.
- array at: 1 points to &a. array at: 2 points to &b. array at: 3 points to &c Ó
a becomeForward: b
- array at: 1 still points to &a. array at: 2 still points to &b. array at: 3 still points to &c
b becomeForward: c.
- array at: 1 still points to &a. array at: 2 still points to &b. array at: 3 still points to &c
- when accessing array first one has to follow a forwarding chain:
&a -> &b -> c"
| referent |
self assert: (self isForwarded: objOop).
referent := self fetchPointer: 0 ofMaybeForwardedObject: objOop.
[(self isOopForwarded: referent)] whileTrue:
[referent := self fetchPointer: 0 ofMaybeForwardedObject: referent].
^referent!
Item was changed:
+ ----- Method: SpurMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') -----
- ----- Method: SpurMemoryManager>>followForwardedObjectFields:toDepth: (in category 'become api') -----
followForwardedObjectFields: objOop toDepth: depth
"follow pointers in the object to depth.
How to avoid cyclic structures?? A temproary mark bit?"
| oop |
self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]).
0 to: (self numSlotsOf: objOop) - 1 do:
[:i|
oop := self fetchPointer: i ofObject: objOop.
((self isNonImmediate: oop)
and: [self isForwarded: oop]) ifTrue:
[oop := self followForwarded: oop.
self storePointer: i ofObject: objOop withValue: oop].
depth > 0 ifTrue:
[self followForwardedObjectFields: objOop toDepth: depth - 1]]!
Item was changed:
----- Method: SpurMemoryManager>>fullGC (in category 'gc - global') -----
fullGC
"Perform a full lazy compacting GC. Answer the size of the largest free chunk."
+ <returnTypeC: #usqLong>
<inline: false>
needGCFlag := false.
gcStartUsecs := self ioUTCMicrosecondsNow.
statMarkCount := 0.
coInterpreter preGCAction: GCModeFull.
self globalGarbageCollect.
coInterpreter postGCAction: GCModeFull.
statFullGCs := statFullGCs + 1.
statGCEndUsecs := self ioUTCMicrosecondsNow.
statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
^(freeLists at: 0) ~= 0
ifTrue: [self bytesInObject: self findLargestFreeChunk]
ifFalse: [0]!
Item was changed:
----- Method: SpurMemoryManager>>isForwarded: (in category 'object testing') -----
isForwarded: objOop
+ <api>
^(self classIndexOf: objOop) = self isForwardedObjectClassIndexPun!
Item was changed:
----- Method: SpurMemoryManager>>isOopForwarded: (in category 'object testing') -----
isOopForwarded: oop
+ <api>
^(self isNonImmediate: oop)
and: [(self classIndexOf: oop) = self isForwardedObjectClassIndexPun]!
Item was added:
+ ----- Method: SpurMemoryManager>>isReallyYoung: (in category 'object testing') -----
+ isReallyYoung: oop
+ <api>
+ "Answer if oop is young."
+ ^(self isNonImmediate: oop)
+ and: [self isReallyYoungObject: oop]!
Item was changed:
----- Method: SpurMemoryManager>>remapObj: (in category 'gc - scavenging') -----
remapObj: objOop
"Scavenge or simply follow objOop. Answer the new location of objOop. The
send should have been guarded by a send of shouldRemapOop: or shouldScavengeObj:.
The method is called remapObj: for compatibility with ObjectMemory."
<api>
<inline: false>
| resolvedObj |
self assert: (self shouldRemapOop: objOop).
(self isForwarded: objOop)
ifTrue:
[resolvedObj := self followForwarded: objOop.
(self isInFutureSpace: resolvedObj) ifTrue: "already scavenged"
[^resolvedObj]]
ifFalse:
[resolvedObj := objOop].
+ (self isReallyYoung: resolvedObj) ifFalse: "a becommed or compacted object whose target is in old space, or a CogMethod."
- (self isYoung: resolvedObj) ifFalse: "a becommed or compacted object whose target is in old space"
[^resolvedObj].
^scavenger copyAndForward: resolvedObj!
Item was changed:
----- Method: SpurMemoryManager>>shouldRemapObj: (in category 'gc - scavenging') -----
shouldRemapObj: objOop
<api>
"Answer if the obj should be scavenged (or simply followed). The method is called
shouldRemapObj: for compatibility with ObjectMemory."
^(self isForwarded: objOop)
+ or: [self isReallyYoungObject: objOop]!
- or: [self isYoungObject: objOop]!
Item was changed:
----- Method: SpurMemoryManager>>sqAllocateMemorySegmentOfSize:Above:AllocatedSizeInto: (in category 'simulation only') -----
sqAllocateMemorySegmentOfSize: segmentSize Above: minAddress AllocatedSizeInto: allocSizePtrOrBlock
<doNotGenerate>
+ "Simulate heap growth by growing memory by segmentSize + a delta.
+ To test bridges alternate the delta between 0 bytes and 1M bytes
+ depending on the number of segments.
+ The delta will be the distance between segments to be bridged."
+ | delta newMemory start |
+ delta := segmentManager numSegments odd ifTrue: [1024 * 1024] ifFalse: [0].
+ start := memory size * 4 + delta.
+ newMemory := memory class new: memory size + (segmentSize + delta / 4).
- "Simulate heap growth by growing memory by segmentSize + 1Meg.
- 1Meg will be the distance between segments to be bridged."
- | oneMeg newMemory start |
- oneMeg := 1024 * 1024.
- start := memory size * 4 + oneMeg.
- newMemory := memory class new: memory size + (segmentSize + oneMeg / 4).
newMemory replaceFrom: 1 to: memory size with: memory startingAt: 1.
memory := newMemory.
allocSizePtrOrBlock value: segmentSize.
^start!
Item was changed:
----- Method: SpurMemoryManager>>totalByteSizeOf: (in category 'indexing primitive support') -----
totalByteSizeOf: oop
+ <returnTypeC: #usqLong>
^(self isImmediate: oop)
ifTrue: [0]
ifFalse: [self bytesInObject: oop]!
Item was changed:
CogClass subclass: #SpurSegmentManager
instanceVariableNames: 'manager numSegments numSegInfos segments firstSegmentSize canSwizzle sweepIndex preferredPinningSegment'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-SpurMemoryManager'!
+ !SpurSegmentManager commentStamp: 'eem 11/29/2013 11:48' prior: 0!
- !SpurSegmentManager commentStamp: 'eem 10/21/2013 13:14' prior: 0!
Instances of SpurSegmentManager manage oldSpace, which is organized as a sequence of segments. Segments can be obtained from the operating system and returned to the operating system when empty and shrinkage is required. Segments are kept invisible from the SpurMemoryManager by using "bridge" objects, "fake" pinned objects to bridge the gaps between segments. A pinned object header occupies the last 16 bytes of each segment, and the pinned object's size is the distance to the start of the next segment. So when the memory manager enumerates objects it skips over these bridges and memory appears linear. The constraint is that segments obtained from the operating system must be at a higher address than the first segment. The maximum size of large objects, being an overflow slot size, should be big enough to bridge the gaps, because in 32-bits the maximum size is 2^32 slots. In 64-bits the maximum size of large objects is 2^56 slots, or 2^59 bits, which we hope will suffice.
When an image is written to a snapshot file the second word of the header of the bridge at the end of each segment is replaced by the size of the following segment, the segments are written to the file, and the second word of each bridge is restored. Hence the length of each segment is derived from the bridge at the end of the preceeding segment. The length of the first segment is stored in the image header as firstSegmentBytes. The start of each segment is also derived from the bridge as a delta from the start of the previous segment. The start of The first segment is stored in the image header as startOfMemory.
On load all segments are read into one single segment, eliminating the bridge objects, and computing the swizzle distance for each segment, based on where the segments were in memory when the image file was written, and where the coalesced segment ends up on load. Then the segment is traversed, swizzling pointers by selecting the relevant swizzle for each oop's segment.
Instance Variables
+ manager: <SpurMemoryManager>
+ numSegments: <Integer>
+ numSegInfos: <Integer>
+ segments: <Array of SpurSegmentInfo>
+ firstSegmentSize: <Integer>
+ canSwizzle: <Boolean>
+ sweepIndex: <Integer>
+ preferredPinningSegment: <SpurSegmentInfo>
- numSegments: <Integer>
- segments: <Array of SpurSegmentInfo>
- manager: <SpurMemoryManager>
+ canSwizzle
+ - a flag set and cleared during initialization to validate that swizzling is only performed at the right time
+
+ firstSegmentSize
+ - the size of the first segment when loading an image
+
+ manager
+ - the memory manager the receiver manages segments for (simulation only)
+
+ numSegInfos
+ - the size of the segments array in units of SpurSegmentInfo size
+
numSegments
+ - the number of segments (the number of used entries in segments, <= numSegInfos)
- - the number of segments
+ preferredPinningSegment
+ - the segment in which objects should be copied when pinned, so as to cluster pinned objects in as few segments as possible. As yet unimplemented.
+
segments
- the start addresses, lengths and offsets to adjust oops on image load, for each segment
+ sweepIndex
+ - a segment index used to optimize setting the containsPinned flag on segments during freeUnmarkedObjectsAndSortAndCoalesceFreeSpace!
- manager
- - the SpurMemoryManager whose oldSpace is managed (simulation only).!
Item was changed:
----- Method: SpurSegmentManager>>allBridgesMarked (in category 'debug support') -----
allBridgesMarked
0 to: numSegments - 1 do:
[:i| | bridgeObj |
+ bridgeObj := self bridgeAt: i.
+ self assert: (self isValidSegmentBridge: bridgeObj).
- bridgeObj := (segments at: i) segLimit - manager baseHeaderSize.
- self assert: (manager isSegmentBridge: bridgeObj).
(manager isMarked: bridgeObj) ifFalse:
[^false]].
^true
"for debugging:"
"(0 to: numSegments - 1) select:
[:i| | bridgeObj |
+ bridgeObj := self bridgeAt: i.
+ self assert: (self isValidSegmentBridge: bridgeObj).
- bridgeObj := (segments at: i) segStart
- + (segments at: i) segSize
- - manager baseHeaderSize.
- self assert: (manager isSegmentBridge: bridgeObj).
manager isMarked: bridgeObj]"!
Item was added:
+ ----- Method: SpurSegmentManager>>bridgeAt: (in category 'bridges') -----
+ bridgeAt: segIndex
+ ^self bridgeFor: (self addressOf: (segments at: segIndex))!
Item was added:
+ ----- Method: SpurSegmentManager>>bridgeFor: (in category 'bridges') -----
+ bridgeFor: aSegment
+ <var: 'aSegment' type: #'SpurSegmentInfo *'>
+ ^manager objectStartingAt: aSegment segLimit - manager bridgeSize!
Item was changed:
----- Method: SpurSegmentManager>>bridgeFrom:to: (in category 'growing/shrinking memory') -----
bridgeFrom: aSegment to: nextSegmentOrNil
"Create a bridge from aSegment to the next segment,
or create a terminating bridge if there is no next segment."
<var: #aSegment type: #'SpurSegmentInfo *'>
<var: #nextSegmentOrNil type: #'SpurSegmentInfo *'>
| segEnd clifton bridgeSpan |
segEnd := aSegment segLimit.
clifton := segEnd - manager bridgeSize. "clifton is where the Avon bridge begins..."
bridgeSpan := nextSegmentOrNil
ifNil: [manager bridgeSize]
ifNotNil: [nextSegmentOrNil segStart - segEnd + manager bridgeSize].
manager initSegmentBridgeWithBytes: bridgeSpan at: clifton.
"the revised bridge should get us to the new segment"
+ self assert: (manager addressAfter: (manager objectStartingAt: clifton))
+ = (nextSegmentOrNil
+ ifNil: [aSegment segLimit]
+ ifNotNil: [nextSegmentOrNil segStart])
- self assert: (nextSegmentOrNil isNil
- or: [(manager addressAfter: (manager objectStartingAt: clifton)) = nextSegmentOrNil segStart])
!
Item was changed:
----- Method: SpurSegmentManager>>checkSegments (in category 'debug support') -----
checkSegments
self assert: numSegments >= 1.
0 to: numSegments - 1 do:
[:i|
self assert: (manager addressCouldBeObj: (segments at: i) segStart).
+ self assert: (self isValidSegmentBridge: (self bridgeAt: i))].
- self assert: (self isValidSegmentBridge: (segments at: i) segLimit - manager baseHeaderSize)].
self assert: (segments at: numSegments - 1) segLimit = manager endOfMemory!
Item was changed:
----- Method: SpurSegmentManager>>collapseSegmentsPostSwizzle (in category 'snapshot') -----
collapseSegmentsPostSwizzle
"The image has been loaded, old segments reconstructed, and the heap
swizzled into a single contiguous segment. Collapse the segments into one."
<inline: false>
canSwizzle := false.
self cCode: []
inSmalltalk:
[segments ifNil:
[self allocateOrExtendSegmentInfos]].
numSegments := 1.
(segments at: 0)
segStart: manager oldSpaceStart;
segSize: manager endOfMemory - manager oldSpaceStart.
manager bootstrapping ifTrue:
["finally plant a bridge at the end of the coalesced segment and cut back the
manager's notion of the end of memory to immediately before the bridge."
self assert: manager endOfMemory = (segments at: 0) segLimit.
manager
initSegmentBridgeWithBytes: manager bridgeSize
at: manager endOfMemory - manager bridgeSize].
+ self assert: (manager isSegmentBridge: (self bridgeAt: 0)).
+ self assert: (manager numSlotsOfAny: (self bridgeAt: 0)) = 0!
- self assert: (self isValidSegmentBridge: manager endOfMemory - manager baseHeaderSize).
- self assert: (manager numSlotsOfAny: manager endOfMemory - manager baseHeaderSize) = 0!
Item was changed:
----- Method: SpurSegmentManager>>isValidSegmentBridge: (in category 'testing') -----
isValidSegmentBridge: objOop
"bridges bridge the gaps between segments. They are the last object in each segment."
+ ^(manager addressCouldBeObj: objOop - manager baseHeaderSize)
- ^(manager addressCouldBeObj: objOop)
and: [(manager isSegmentBridge: objOop)
+ and: [(manager hasOverflowHeader: objOop)
+ or: [(manager numSlotsOfAny: objOop) = 0]]]!
- and: [manager hasOverflowHeader: objOop]]!
Item was changed:
----- Method: SpurSegmentManager>>writeSegment:nextSegmentSize:toFile: (in category 'snapshot') -----
+ writeSegment: segment nextSegmentSize: nextSegSize toFile: aBinaryStream
+ <var: 'segment' type: #'SpurSegmentInfo *'>
- writeSegment: aSpurSegmentInfo nextSegmentSize: nextSegSize toFile: aBinaryStream
- <var: 'aSpurSegmentInfo' type: #'SpurSegmentInfo *'>
<var: 'aBinaryStream' type: #'FILE *'>
+ | lastDoubleWord savedDoubleWord nWritten |
+ <var: 'savedDoubleWord' type: #usqLong>
+ lastDoubleWord := segment segLimit - manager baseHeaderSize.
+ self assert: (self isValidSegmentBridge: (self bridgeFor: segment)).
+ self assert: (self bridgeFor: segment) = (lastDoubleWord - manager baseHeaderSize).
+ savedDoubleWord := manager longLongAt: lastDoubleWord.
+ manager longLongAt: lastDoubleWord put: nextSegSize.
- | bridge savedHeader nWritten |
- <var: 'savedHeader' type: #usqLong>
- bridge := aSpurSegmentInfo segLimit - manager baseHeaderSize.
- "last seg may be beyond endOfMemory/freeOldSpaceStart"
- self assert: (self isValidSegmentBridge: bridge).
- savedHeader := manager longLongAt: bridge.
- manager longLongAt: bridge put: nextSegSize.
nWritten := self cCode:
[self
+ sq: segment segStart asVoidPointer
- sq: aSpurSegmentInfo segStart asVoidPointer
Image: 1
+ File: segment segSize
- File: aSpurSegmentInfo segSize
Write: aBinaryStream]
inSmalltalk:
[aBinaryStream
+ next: segment segSize / 4
- next: aSpurSegmentInfo segSize / 4
putAll: manager memory
+ startingAt: segment segStart / 4 + 1.
+ segment segSize].
+ manager longLongAt: lastDoubleWord put: savedDoubleWord.
- startingAt: aSpurSegmentInfo segStart / 4 + 1.
- aSpurSegmentInfo segSize].
- manager longLongAt: bridge put: savedHeader.
^nWritten!
Item was removed:
- ----- Method: StackInterpreter>>followField:in: (in category 'lazy become') -----
- followField: fieldIndex in: anObject
- "Make sure the oop at fieldIndex in anObject is not forwarded (follow the
- forwarder there-in if so). Answer the (possibly followed) oop at fieldIndex.
- N.B. the oop is assumed to be non-immediate."
- | objOop |
- objOop := objectMemory fetchPointer: fieldIndex ofObject: anObject.
- self assert: (objectMemory isNonImmediate: objOop).
- (objectMemory isForwarded: objOop) ifTrue:
- [objOop := objectMemory followForwarded: objOop.
- objectMemory storePointer: fieldIndex ofObject: anObject withValue: objOop].
- ^objOop!
Item was changed:
----- Method: StackInterpreter>>followForwardingPointersInScheduler (in category 'object memory support') -----
followForwardingPointersInScheduler
| schedAssoc sched procLists |
schedAssoc := objectMemory splObj: SchedulerAssociation.
"the GC follows pointers in the special objects array for us."
self assert: (objectMemory isForwarded: schedAssoc) not.
+ sched := objectMemory followField: ValueIndex ofObject: schedAssoc.
- sched := self followField: ValueIndex in: schedAssoc.
+ procLists := objectMemory followField: ProcessListsIndex ofObject: sched.
- procLists := self followField: ProcessListsIndex in: sched.
0 to: (objectMemory numSlotsOf: procLists) - 1 do:
[:i| | list first last next |
+ list := objectMemory followField: i ofObject: procLists.
+ first := objectMemory followField: FirstLinkIndex ofObject: list.
+ last := objectMemory followField: LastLinkIndex ofObject: list.
- list := self followField: i in: procLists.
- first := self followField: FirstLinkIndex in: list.
- last := self followField: LastLinkIndex in: list.
[first ~= last] whileTrue:
+ [next := objectMemory followField: NextLinkIndex ofObject: first.
- [next := self followField: NextLinkIndex in: first.
first := next]]
!
Item was changed:
----- Method: StackInterpreter>>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."
<returnTypeC: #'StackPage *'>
+ | page pointer theMethod theIP numArgs stackPtrIndex maybeClosure rcvr |
- | page pointer theMethod theIP numArgs stackPtrIndex maybeClosure |
<inline: false>
<var: #page type: #'StackPage *'>
<var: #pointer type: #'char *'>
self assert: (self isSingleContext: aContext).
self assert: (objectMemory goodContextSize: aContext).
page := self newStackPage.
pointer := page baseAddress.
theIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
+ theMethod := objectMemory followField: MethodIndex ofObject: aContext.
- theMethod := objectMemory fetchPointer: MethodIndex ofObject: aContext.
(objectMemory isIntegerObject: theIP) ifFalse:
[self error: 'context is not resumable'].
theIP := objectMemory integerValueOf: theIP.
+ rcvr := objectMemory followField: ReceiverIndex ofObject: 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 followField: ClosureIndex ofObject: aContext.
- maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aContext.
maybeClosure ~= objectMemory nilObject
ifTrue:
[numArgs := self argumentCountOfClosure: maybeClosure.
stackPages longAt: pointer put: maybeClosure]
ifFalse:
+ [| header field |
- [| 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 put: rcvr].
- stackPages longAt: pointer 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 sender context in base frame"
stackPages
longAt: (pointer := pointer - BytesPerWord)
put: (objectMemory fetchPointer: SenderIndex ofObject: aContext).
"base frame's saved fp is null"
stackPages
longAt: (pointer := pointer - BytesPerWord)
put: 0.
page baseFP: pointer; headFP: pointer.
stackPages
longAt: (pointer := pointer - BytesPerWord)
put: theMethod.
stackPages
longAt: (pointer := pointer - BytesPerWord)
put: (self encodeFrameFieldHasContext: true isBlock: maybeClosure ~= objectMemory nilObject numArgs: numArgs).
self assert: (self frameHasContext: page baseFP).
self assert: (self frameNumArgs: page baseFP) == numArgs.
stackPages
longAt: (pointer := pointer - BytesPerWord)
put: aContext.
stackPages
longAt: (pointer := pointer - BytesPerWord)
+ put: rcvr.
- 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"
theIP := self iframeInstructionPointerForIndex: theIP method: theMethod.
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:
----- 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 ceSendFromInLineCacheMiss: if the probe fails.
+ Override to push the register args when calling ceSendFromInLineCacheMiss:"
- 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.
entry := objectRepresentation genGetClassTagOf: 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:"
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