Vm-dev December 2013

vm-dev@lists.squeakfoundation.org

27 participants
102 discussions

VM Maker: VMMaker.oscog-eem.528.mcz
by commits＠source.squeak.org 02 Dec '13

02 Dec '13

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."!

1 0

VM Maker: VMMaker.oscog-eem.527.mcz
by commits＠source.squeak.org 02 Dec '13

02 Dec '13

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.527.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.527 Author: eem Time: 27 November 2013, 1:24:26.609 pm UUID: 6effc8b0-7b1d-445b-b154-af4f89653734 Ancestors: VMMaker.oscog-eem.526 In Spur compaction, fix the edge case of firstFreeChunk being allocated but the start of the object being different from the start of firstFreeChunk. Move finding the new firstFreeChunk into fillHighestObjectsWithMovableObjectsFrom:upTo: and nuke findFirstFreeChunkPostCompactionPass. Fix the fence-post error in insertSegmentFor:. Fix the asserts in addSegmentOfSize:. =============== Diff against VMMaker.oscog-eem.526 =============== Item was changed: ----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') ----- exactFitCompact "Compact all of memory above firstFreeChunk using exact-fit, assuming free space is sorted and that as many of the the highest objects as will fit are recorded in highestObjects. Don't move pinned objects. Note that we don't actually move; we merely copy and forward. Eliminating forwarders will be done in a final pass. Leave the objects that don't fit exactly (the misfits), and hence aren't moved, in highestObjects." <inline: false> | misfits first nfits nmiss nHighest nMisses savedLimit | <var: #misfits type: #usqInt> self checkFreeSpace. totalFreeOldSpace = 0 ifTrue: [^self]. highestObjects isEmpty ifTrue: [^self]. nfits := nmiss := 0. misfits := highestObjects last + self wordSize. [statCompactPassCount := statCompactPassCount + 1. highestObjects from: misfits - self wordSize reverseDo: [:o| | b | (self oop: o isGreaterThan: firstFreeChunk) ifFalse: [highestObjects first: misfits. coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr. ^self]. ((self isForwarded: o) or: [self isPinned: o]) ifFalse: [b := self bytesInObject: o. (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o]) ifNil: [nmiss := nmiss + 1. misfits := misfits - self wordSize. misfits < highestObjects start ifTrue: [misfits := highestObjects limit - self wordSize]. self longAt: misfits put: o] ifNotNil: [:f| nfits := nfits + 1. + self copyAndForward: o withBytes: b toFreeChunk: f. + "here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk + is a large chunk then firstFreeChunk will no longer point to an object header. So check and + adjust firstFreeChunk if it is assigned to." + f = firstFreeChunk ifTrue: + [firstFreeChunk := self objectStartingAt: f]]]]. - self copyAndForward: o withBytes: b toFreeChunk: f]]]. self checkFreeSpace. "now highestObjects contains only misfits, if any, from misfits to last. set first to first failure and refill buffer. next cycle will add more misfits. give up on exact-fit when half of the highest objects fail to fit." first := self longAt: highestObjects first. self assert: (self oop: first isGreaterThan: firstFreeChunk). nHighest := highestObjects usedSize. highestObjects first: misfits. nMisses := highestObjects usedSize. nMisses > (nHighest // 2) ifTrue: [coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr. ^self]. - self findFirstFreeChunkPostCompactionPass. savedLimit := self moveMisfitsToTopOfHighestObjects: misfits. self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first. misfits := self moveMisfitsInHighestObjectsBack: savedLimit. highestObjects usedSize > 0] whileTrue! 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 | - | lastHighest highestObjectsWraps | highestObjects resetAsEmpty. lastHighest := highestObjects last. + highestObjectsWraps := firstFree := 0. + self allOldSpaceEntitiesFrom: startObj do: - highestObjectsWraps := 0. - self allOldSpaceObjectsFrom: 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]. + self longAt: lastHighest put: o]]]]. + highestObjects last: lastHighest. + (firstFree ~= 0 and: [(self isFreeObject: firstFreeChunk) not]) ifTrue: + [firstFreeChunk := firstFree]! - ((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]. - self longAt: lastHighest put: o]]]. - highestObjects last: lastHighest! Item was removed: - ----- Method: SpurMemoryManager>>findFirstFreeChunkPostCompactionPass (in category 'compaction') ----- - findFirstFreeChunkPostCompactionPass - (self isFreeObject: firstFreeChunk) ifFalse: - [firstFreeChunk := self findFirstFreeChunkAfter: firstFreeChunk]! Item was changed: ----- Method: SpurMemoryManager>>firstFitCompact (in category 'compaction') ----- firstFitCompact "Compact all of memory above firstFreeChunk using first-fit, assuming free space is sorted and that as many of the the highest objects as will fit are recorded in highestObjects. Don't move pinned objects. Note that we don't actually move; we merely copy and forward. Eliminating forwarders will be done in a final pass." <inline: false> | first nhits nmisses | self checkFreeSpace. totalFreeOldSpace = 0 ifTrue: [^self]. highestObjects isEmpty ifTrue: [^self]. nhits := nmisses := 0. [statCompactPassCount := statCompactPassCount + 1. highestObjects reverseDo: [:o| | b | (self oop: o isLessThanOrEqualTo: firstFreeChunk) ifTrue: [coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr. ^self]. ((self isForwarded: o) or: [self isPinned: o]) ifFalse: [b := self bytesInObject: o. (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNil: [nmisses := nmisses + 1] ifNotNil: [:f| nhits := nhits + 1. self copyAndForward: o withBytes: b toFreeChunk: f. + "here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk + is a large chunk then firstFreeChunk will no longer point to an object header. So check and + adjust firstFreeChunk if it is assigned to." + f = firstFreeChunk ifTrue: + [firstFreeChunk := self objectStartingAt: f]. self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: (self objectStartingAt: f)) = lastSubdividedFreeChunk])]]]. self checkFreeSpace. first := self longAt: highestObjects first. self assert: (self oop: first isGreaterThan: firstFreeChunk). - self findFirstFreeChunkPostCompactionPass. self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first. highestObjects usedSize > 0] whileTrue. coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr! Item was changed: ----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') ----- addSegmentOfSize: ammount <returnTypeC: #'SpurSegmentInfo *'> <inline: false> | allocatedSize | <var: #newSeg type: #'SpurSegmentInfo *'> <var: #segAddress type: #'void *'> self cCode: [] inSmalltalk: [segments ifNil: [^nil]]. "bootstrap" (manager "sent to the manager so that the simulator can increase memory to simulate a new segment" sqAllocateMemorySegmentOfSize: ammount Above: (segments at: 0) segLimit asVoidPointer AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize] inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil: [:segAddress| | newSegIndex newSeg | newSegIndex := self insertSegmentFor: segAddress asUnsignedLong. newSeg := self addressOf: (segments at: newSegIndex). newSeg segStart: segAddress asUnsignedLong; segSize: allocatedSize. self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg. self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse: [self addressOf: (segments at: newSegIndex + 1)]). "and add the new free chunk to the free list; done here instead of in assimilateNewSegment: for the assert" manager addFreeChunkWithBytes: allocatedSize - manager bridgeSize at: newSeg segStart. self assert: (manager addressAfter: (manager objectStartingAt: newSeg segStart)) = (newSeg segLimit - manager bridgeSize). "test isInMemory:" 0 to: numSegments - 1 do: [:i| + self assert: (self isInSegments: (segments at: i) segStart). + self assert: (self isInSegments: (segments at: i) segLimit - manager wordSize). + self assert: ((self isInSegments: (segments at: i) segLimit) not + or: [i < (numSegments - 1) + and: [(segments at: i) segLimit = (segments at: i + 1) segStart]]). + self assert: ((self isInSegments: (segments at: i) segStart - manager wordSize) not + or: [i > 0 + and: [(segments at: i - 1) segLimit = (segments at: i) segStart]])]. - self assert: (manager isInMemory: (segments at: i) segStart). - self assert: (manager isInMemory: (segments at: i) segLimit - manager wordSize). - self assert: (manager isInMemory: (segments at: i) segLimit) not. - (i between: 1 and: numSegments - 2) ifTrue: - [self assert: (manager isInMemory: (segments at: i) segStart - manager wordSize) not]]. ^newSeg]. ^nil! Item was changed: ----- Method: SpurSegmentManager>>insertSegmentFor: (in category 'growing/shrinking memory') ----- insertSegmentFor: segAddress "Reserve a new segInfo for segAddress. If segAddress is in the middle of the existing segments, shuffle them up to make room. Answer the new segment's index." | segIndex lastSegIndex | self assert: segAddress > (segments at: 0) segLimit. numSegments = numSegInfos ifTrue: [self allocateOrExtendSegmentInfos]. self assert: numSegments < numSegInfos. segIndex := lastSegIndex := numSegments - 1. numSegments := numSegments + 1. + [segAddress >= (segments at: segIndex) segLimit ifTrue: - [segAddress > (segments at: segIndex) segLimit ifTrue: [segIndex := segIndex + 1. lastSegIndex to: segIndex by: -1 do: [:idx| segments at: idx + 1 put: (segments at: idx)]. ^segIndex]. segIndex := segIndex - 1] repeat!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev December 2013